umain.pas

来自「EXE文件内部打开浏览器连接页面；自己写的小程序大家可以交流讨论」· PAS 代码 · 共 196 行

unit UMain;

interface

uses
  Windows, Messages, SysUtils,Classes, Graphics, Controls, Forms,Dialogs,ShellAPI,
  OleCtrls, SHDocVw, XPForm_LIB, ExtCtrls;
const
  WM_BARICON=WM_USER+200;

type
  Tfrm_Main = class(TForm)
    wbOA: TWebBrowser;
    Image_Back: TImage;
    Image_Min: TImage;
    Image_Close: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image_BackMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_BackMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image_BackMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_MinClick(Sender: TObject);
    procedure Image_CloseClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
     procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
     procedure WMBarIcon(var Message:TMessage);message WM_BARICON;
  public
    { Public declarations }
    NotifyIcon:TNotifyIconData;
  end;

var
  frm_Main: Tfrm_Main;
  Opos, Cpos: Tpoint;
  Flag: boolean = false;  //窗体移动
  fFlag: boolean =true;   //程序是否运行

implementation

{$R *.dfm}

procedure Tfrm_Main.WMSysCommand
(var Message:TMessage);
var
   lpData:PNotifyIconData;
begin
  if Message.WParam = SC_ICON then
  begin
     //如果用户最小化窗口则将窗口隐藏并在任务栏上添加图标
     lpData := new(PNotifyIconDataA);
     lpData.cbSize := 88;
     //SizeOf(PNotifyIconDataA);
     lpData.Wnd := frm_Main.Handle;
     lpData.hIcon := frm_Main.Icon.Handle;
     lpData.uCallbackMessage := WM_BARICON;
     lpData.uID :=0;
     lpData.szTip := '即时消息';
     lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
     Shell_NotifyIcon(NIM_ADD,lpData);
     dispose(lpData);
     frm_Main.Visible := False;
  end
  else
  begin
     //如果是其它的SystemCommand消息则调用系统缺省处理函数处理之。
     DefWindowProc(frm_Main.Handle,Message.Msg,Message.WParam,Message.LParam);
  end;
end;

//如果用户点击任务栏图标则将图标删除并回复窗口。
procedure Tfrm_Main.WMBarIcon(var Message:TMessage);
var
   lpData:PNotifyIconData;
begin
  if (Message.LParam = WM_LBUTTONDOWN) then
   begin
     lpData := new(PNotifyIconDataA);
     lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
     lpData.Wnd := frm_Main.Handle;
     lpData.hIcon := frm_Main.Icon.Handle;
     lpData.uCallbackMessage := WM_BARICON;
     lpData.uID :=0;
     lpData.szTip := '即时消息';
     lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
     Shell_NotifyIcon(NIM_DELETE,lpData);
     dispose(lpData);
     frm_Main.Visible := True;
   end;
end;

//打开页面
procedure Tfrm_Main.FormCreate(Sender: TObject);
var
  Filepath,FileName: string;
begin
  //判断文件是否存在
  Filepath := ExtractFilePath(Application.ExeName);
  Filename :=Filepath+'back.bmp';
  if fileexists(Filename) then
    image_back.Picture.LoadFromFile(Filename)
  else
    begin
      fFlag :=false;
      MessageDlg('指定背景文件(back.bmp)不存在,请检查!', mtInformation, [mbOk], 0);
    end;

  Filename :=Filepath+'min.bmp';
  if fileexists(Filename) then
    image_min.Picture.LoadFromFile(Filename)
  else
    begin
      fFlag :=false;
      MessageDlg('指定按键文件(min.bmp)不存在,请检查!', mtInformation, [mbOk], 0);
    end;

  Filename :=Filepath+'close.bmp';
  if fileexists(Filename) then
    image_close.Picture.LoadFromFile(Filename)
  else
    begin
      fFlag :=false;
      MessageDlg('指定按键文件(close.bmp)不存在,请检查!', mtInformation, [mbOk], 0);
    end;

  Filename :=Filepath+'OAQQ.htm';
  if fileexists(Filename) then
    wbOA.Navigate(FileName)
  else
    begin
      fFlag :=false;
      MessageDlg('指定登录文件(OAQQ.htm)不存在,请检查!', mtInformation, [mbOk], 0);
    end;
end;

//以下为无边框窗体移动
procedure Tfrm_Main.Image_BackMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Flag := true;
   Opos.X := X;
   Opos.Y := Y;
end;

procedure Tfrm_Main.Image_BackMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Flag then
    begin
      Cpos.X := X;
      Cpos.y := Y;
      Left := Left + Cpos.X - Opos.X;
      Top := Top + Cpos.Y - Opos.Y;
    end;
end;

procedure Tfrm_Main.Image_BackMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Flag := false;
end;

   //如果用户最小化窗口则将窗口隐藏并在任务栏上添加图标
procedure Tfrm_Main.Image_MinClick(Sender: TObject);
var
   lpData:PNotifyIconData;
begin
   lpData := new(PNotifyIconDataA);
   lpData.cbSize := 88;
   //SizeOf(PNotifyIconDataA);
   lpData.Wnd := frm_Main.Handle;
   lpData.hIcon := frm_Main.Icon.Handle;
   lpData.uCallbackMessage := WM_BARICON;
   lpData.uID :=0;
   lpData.szTip := 'OA即时消息';
   lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
   Shell_NotifyIcon(NIM_ADD,lpData);
   dispose(lpData);
   frm_Main.Visible := False;
end;

procedure Tfrm_Main.Image_CloseClick(Sender: TObject);
begin
  close;
end;

procedure Tfrm_Main.FormShow(Sender: TObject);
begin
  if fFlag=False then close;
end;

end.