通讯录管理软件 [轩辕版 V8.0]

unit star; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, SHDocVw, StdCtrls, Buttons,mshtml,shellapi, Menus; const wm_traynotify = 3000; type TForm1 = class(TForm) WebBrowser1: TWebBrowser; PopupMenu1: TPopupMenu; N1: TMenuItem; procedure FormCreate(Sender: TObject); procedure WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); procedure FormShow(Sender: TObject); procedure N1Click(Sender: TObject); private { Private declarations } public { Public declarations } MINIFTPFF: TNotifyIconData; MsgTaskbarRestart: Cardinal; procedure MiniToTaskbar; procedure WndProc(var Msg: TMessage); override; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.MiniToTaskbar; begin try begin MsgTaskbarRestart := RegisterWindowMessage('TaskbarCreated'); MINIFTPFF.cbSize := SizeOf(TNotifyIconData); MINIFTPFF.Wnd := Handle; MINIFTPFF.uID := 1985629; MINIFTPFF.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; MINIFTPFF.uCallbackMessage := wm_traynotify; MINIFTPFF.hIcon := Application.Icon.Handle; MINIFTPFF.szTip := '右击关闭'; Shell_NotifyIcon(NIM_ADD, @MINIFTPFF); end except begin end; end; end; procedure TForm1.WndProc(var Msg: TMessage); var P:TPoint; begin try begin inherited; GetCursorPos(p); if Msg.LParam = WM_RBUTTONDOWN then begin PopupMenu1.Popup(p.x,p.y); end; end except begin end; end; end; procedure WB_Set3DBorderStyle(Sender: TObject; bValue: Boolean); var Document : IHTMLDocument2; Element : IHTMLElement; StrBorderStyle: string; begin try Document := TWebBrowser(Sender).Document as IHTMLDocument2; TWebBrowser(Sender).OleObject.Document.Body.Scroll := 'no'; if Assigned(Document) then begin Element := Document.Body; if Element <> nil then begin case BValue of False: StrBorderStyle := 'none'; True: StrBorderStyle := ''; end; Element.Style.BorderStyle := StrBorderStyle; end; end; except end; end; procedure TForm1.FormCreate(Sender: TObject); var filepath:string; begin filepath:=extractfilepath(application.ExeName)+'star.html'; webbrowser1.Navigate(filepath); SetWindowLong(Application.Handle, GWL_EXSTYLE, GetWindowLong(Application.handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW); end; procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); begin WB_Set3DBorderStyle(webbrowser1,false); end; procedure TForm1.FormShow(Sender: TObject); var OldStyle: Integer; begin OldStyle := GetWindowLong(Handle, GWL_EXSTYLE); SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED); SetLayeredWindowAttributes(Handle, 0, 150, LWA_ALPHA); SetWindowLong(Handle, GWL_EXSTYLE, OldStyle Or WS_EX_LAYERED Or WS_EX_TRANSPARENT); with Application do SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_APPWINDOW or WS_EX_TOOLWINDOW); SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); end; procedure TForm1.N1Click(Sender: TObject); begin Shell_NotifyIcon(NIM_Delete, @MINIFTPFF); application.Terminate; end; end.