计算机编程

unit Unit1;
巴黎人游戏官网 1
巴黎人游戏官网 2interface
巴黎人游戏官网 3
巴黎人游戏官网 4uses
巴黎人游戏官网 5  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shellapi, //ADD shellapi  
巴黎人游戏官网 6
巴黎人游戏官网 7  AppEvnts, ImgList, Menus;
巴黎人游戏官网 8const   
巴黎人游戏官网 9  ghy_tray=wm_user+2;     
巴黎人游戏官网 10type
巴黎人游戏官网 11  TForm1 = class(TForm)
巴黎人游戏官网 12    ApplicationEvents1: TApplicationEvents;      
巴黎人游戏官网 13    ImageList1: TImageList;                      
巴黎人游戏官网 14    PopupMenu1: TPopupMenu;                      
巴黎人游戏官网 15    N1: TMenuItem;                               
巴黎人游戏官网 16    N2: TMenuItem;                               
巴黎人游戏官网 17    N3: TMenuItem;                               
巴黎人游戏官网 18    procedure ApplicationEvents1Minimize(Sender: TObject);  
巴黎人游戏官网 19    procedure FormClose(Sender: TObject; var Action: TCloseAction);
巴黎人游戏官网 20    procedure N1Click(Sender: TObject);
巴黎人游戏官网 21    procedure N2Click(Sender: TObject);
巴黎人游戏官网 22    procedure N3Click(Sender: TObject);
巴黎人游戏官网 23    procedure FormCreate(Sender: TObject);
巴黎人游戏官网 24  private
巴黎人游戏官网 25    { Private declarations }
巴黎人游戏官网 26    procedure   WMSysCommand(var   msg:   TMessage);message   wm_syscommand;    
巴黎人游戏官网 27  public
巴黎人游戏官网 28    { Public declarations }
巴黎人游戏官网 29    procedure   mytray(var   Msg:   TMessage);   message   ghy_tray;            
巴黎人游戏官网 30    procedure BeforeRestore;
巴黎人游戏官网 31  end;
巴黎人游戏官网 32
巴黎人游戏官网 33var
巴黎人游戏官网 34  Form1: TForm1;
巴黎人游戏官网 35  
巴黎人游戏官网 36  tray1,tray2:TNotifyIconData;      
巴黎人游戏官网 37  ico1,ico2:ticon;                  
巴黎人游戏官网 38  tags:boolean;                     
巴黎人游戏官网 39implementation
巴黎人游戏官网 40
巴黎人游戏官网 41{$R *.DFM}
巴黎人游戏官网 42
巴黎人游戏官网 43procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
巴黎人游戏官网 44begin   
巴黎人游戏官网 45  tags:=false;   
巴黎人游戏官网 46  ShowWindow(Application.Handle,SW_HIDE);   
巴黎人游戏官网 47
巴黎人游戏官网 48  tray2.cbSize:=sizeof(tray2);   
巴黎人游戏官网 49  tray2.Wnd:=form1.Handle;   
巴黎人游戏官网 50  tray2.uID:=0;   
巴黎人游戏官网 51  tray2.uFlags:=NIF_ICON   or   NIF_TIP   or   NIF_MESSAGE;   
巴黎人游戏官网 52  tray2.uCallbackMessage:=ghy_tray;   
巴黎人游戏官网 53  tray2.hIcon:=ico2.Handle;   
巴黎人游戏官网 54  tray2.szTip:='我的托盘程序';
巴黎人游戏官网 55  if   not   Shell_NotifyIcon(NIM_modify,@tray2)   then   
巴黎人游戏官网 56  begin   
巴黎人游戏官网 57    ShowMessage('no');   
巴黎人游戏官网 58  end;   
巴黎人游戏官网 59end;   
巴黎人游戏官网 60
巴黎人游戏官网 61procedure TForm1.BeforeRestore;
巴黎人游戏官网 62begin
巴黎人游戏官网 63  tags:=true;
巴黎人游戏官网 64  ShowWindow(Application.Handle,SW_SHOW);
巴黎人游戏官网 65
巴黎人游戏官网 66  ico1:=ticon.Create;
巴黎人游戏官网 67  ico2:=ticon.create;
巴黎人游戏官网 68  imagelist1.GetIcon(0,ico1);
巴黎人游戏官网 69  imagelist1.geticon(1,ico2);
巴黎人游戏官网 70  tray1.cbSize:=sizeof(tray1);
巴黎人游戏官网 71  tray1.Wnd:=form1.Handle;
巴黎人游戏官网 72  tray1.uID:=0;
巴黎人游戏官网 73  tray1.uFlags:=NIF_ICON   or   NIF_TIP   or   NIF_MESSAGE;
巴黎人游戏官网 74  tray1.uCallbackMessage:=ghy_tray;
巴黎人游戏官网 75  tray1.hIcon:=ico1.Handle;
巴黎人游戏官网 76  tray1.szTip:='我的托盘程序';
巴黎人游戏官网 77  if   not   Shell_NotifyIcon(NIM_modify,@tray1)   then
巴黎人游戏官网 78  begin
巴黎人游戏官网 79    ShowMessage('no');
巴黎人游戏官网 80  end;
巴黎人游戏官网 81end;
巴黎人游戏官网 82
巴黎人游戏官网 83procedure TForm1.mytray(var Msg: TMessage);
巴黎人游戏官网 84var   
巴黎人游戏官网 85  pt:tpoint;   
巴黎人游戏官网 86begin
巴黎人游戏官网 87  GetCursorPos(pt);   
巴黎人游戏官网 88    
巴黎人游戏官网 89  case   msg.lParam   of
巴黎人游戏官网 90  
巴黎人游戏官网 91  WM_LBUTTONDOWN:
巴黎人游戏官网 92  begin   
巴黎人游戏官网 93    //鼠标左键被按下
巴黎人游戏官网 94    if   tags=true   then
巴黎人游戏官网 95    begin
巴黎人游戏官网 96      application.Minimize;
巴黎人游戏官网 97      form1.Hide;
巴黎人游戏官网 98    end
巴黎人游戏官网 99    else
巴黎人游戏官网 100    begin
巴黎人游戏官网 101      BeforeRestore;
巴黎人游戏官网 102      application.Restore;
巴黎人游戏官网 103    end;   
巴黎人游戏官网 104  end;   
巴黎人游戏官网 105    
巴黎人游戏官网 106  WM_LBUTTONUP:   
巴黎人游戏官网 107  begin   
巴黎人游戏官网 108    //释放鼠标左键
巴黎人游戏官网 109  end;
巴黎人游戏官网 110   
巴黎人游戏官网 111  wm_rbuttondown:   
巴黎人游戏官网 112  begin   
巴黎人游戏官网 113    //鼠标右键被按下   
巴黎人游戏官网 114    SetForegroundWindow(Form1.Handle);
巴黎人游戏官网 115    form1.PopupMenu1.Popup(pt.x,pt.y);
巴黎人游戏官网 116  end
巴黎人游戏官网 117     
巴黎人游戏官网 118  else//调用父类的WndProc方法处理其它消息   
巴黎人游戏官网 119    inherited;   
巴黎人游戏官网 120  end;
巴黎人游戏官网 121end;
巴黎人游戏官网 122
巴黎人游戏官网 123procedure TForm1.WMSysCommand(var msg: TMessage);
巴黎人游戏官网 124begin
巴黎人游戏官网 125  if   msg.WParam   =   SC_MINIMIZE   then   
巴黎人游戏官网 126  begin   
巴黎人游戏官网 127    showwindow(application.handle,sw_hide);
巴黎人游戏官网 128    inherited;
巴黎人游戏官网 129  end
巴黎人游戏官网 130  else
巴黎人游戏官网 131    inherited;   
巴黎人游戏官网 132end;
巴黎人游戏官网 133
巴黎人游戏官网 134procedure TForm1.FormCreate(Sender: TObject);
巴黎人游戏官网 135begin
巴黎人游戏官网 136  tags:=true;   
巴黎人游戏官网 137  ShowWindow(Application.Handle,SW_HIDE);
巴黎人游戏官网 138
巴黎人游戏官网 139  ico1:=ticon.Create;   
巴黎人游戏官网 140  ico2:=ticon.create;   
巴黎人游戏官网 141  imagelist1.GetIcon(0,ico1);   
巴黎人游戏官网 142  imagelist1.geticon(1,ico2);   
巴黎人游戏官网 143  tray1.cbSize:=sizeof(tray1);   
巴黎人游戏官网 144  tray1.Wnd:=form1.Handle;   
巴黎人游戏官网 145  tray1.uID:=0;   
巴黎人游戏官网 146  tray1.uFlags:=NIF_ICON   or   NIF_TIP   or   NIF_MESSAGE;   
巴黎人游戏官网 147  tray1.uCallbackMessage:=ghy_tray;   
巴黎人游戏官网 148  tray1.hIcon:=ico1.Handle;   
巴黎人游戏官网 149  tray1.szTip:='我的托盘程序';
巴黎人游戏官网 150  if   not   Shell_NotifyIcon(NIM_ADD,@tray1)   then   
巴黎人游戏官网 151  begin   
巴黎人游戏官网 152    ShowMessage('no');   
巴黎人游戏官网 153  end;
巴黎人游戏官网 154end;
巴黎人游戏官网 155
巴黎人游戏官网 156procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
巴黎人游戏官网 157begin   
巴黎人游戏官网 158  ico1:=ticon.Create;   
巴黎人游戏官网 159  ico2:=ticon.create;   
巴黎人游戏官网 160  imagelist1.GetIcon(0,ico1);   
巴黎人游戏官网 161  imagelist1.geticon(1,ico2);   
巴黎人游戏官网 162  tray1.cbSize:=sizeof(tray1);   
巴黎人游戏官网 163  tray1.Wnd:=form1.Handle;   
巴黎人游戏官网 164  tray1.uID:=0;   
巴黎人游戏官网 165  tray1.uFlags:=NIF_ICON   or   NIF_TIP   or   NIF_MESSAGE;   
巴黎人游戏官网 166  tray1.uCallbackMessage:=ghy_tray;   
巴黎人游戏官网 167  tray1.hIcon:=ico1.Handle;
巴黎人游戏官网 168巴黎人游戏官网 ,  tray1.szTip:='我的托盘程序';
巴黎人游戏官网 169  if not Shell_NotifyIcon(NIM_delete,@tray1)   then   
巴黎人游戏官网 170  begin   
巴黎人游戏官网 171    ShowMessage('no');
巴黎人游戏官网 172  end;
巴黎人游戏官网 173end;
巴黎人游戏官网 174
巴黎人游戏官网 175procedure TForm1.N1Click(Sender: TObject);
巴黎人游戏官网 176begin
巴黎人游戏官网 177  showmessage('you   click   open');
巴黎人游戏官网 178end;
巴黎人游戏官网 179
巴黎人游戏官网 180procedure TForm1.N2Click(Sender: TObject);
巴黎人游戏官网 181begin
巴黎人游戏官网 182  showmessage('you   click   save');
巴黎人游戏官网 183end;
巴黎人游戏官网 184
巴黎人游戏官网 185procedure TForm1.N3Click(Sender: TObject);
巴黎人游戏官网 186begin
巴黎人游戏官网 187  showmessage('you   click   saveas');   
巴黎人游戏官网 188end;
巴黎人游戏官网 189
巴黎人游戏官网 190
巴黎人游戏官网 191
巴黎人游戏官网 192
巴黎人游戏官网 193end.

//Project1==========================================================================

 

//调用窗体 Begin

unit CMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, utchild;

const
 WM_CALLBACK = WM_USER + 100;

type
  TShowForm   = function (App: TApplication; CallProc: Pointer; FormID: Integer; ParentForm: TForm; ParentContralHandle: HWND): Tform; stdcall;
  TActiveForm = function : LongInt; stdcall;
  TCloseForm  = function : LongInt; stdcall;

  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    Open1: TMenuItem;
    mmFileOpen: TMenuItem;
    mmFileClose: TMenuItem;
    Panel1: TPanel;
    mmFileOpenFrm: TMenuItem;
    mmFileCloseFrm: TMenuItem;
    Report1: TMenuItem;
    N1111: TMenuItem;
    Panel2: TPanel;
    Change1: TMenuItem;
    procedure mmFileOpenClick(Sender: TObject);
    procedure mmFileCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mmFileOpenFrmClick(Sender: TObject);
    procedure N1111Click(Sender: TObject);
    procedure Change1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FLibHandle  : THandle;
    FShowForm   : TShowForm;
    FActiveForm : TActiveForm;
    FCloseForm  : TCloseForm;
    List : TList;
    //FFrm: TForm1;
    procedure CallPostMessage(ID:Integer);
    procedure BackCallMessage(var Msg: TMessage); message WM_CALLBACK;

    procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
    function GetSysFocus: Integer;
  public
    { Public declarations }
    procedure WMACTIVATEAPP(var Msg: TMessage); message WM_ACTIVATEAPP;
  end;

var
  frmMain: TfrmMain;
  FFrm: TForm1;
implementation
const id_SnapShot = 115; //定义热键标识符

{$R *.dfm}
procedure TfrmMain.WMHotKey(var Msg: TWMHotKey);
var
  H: THandle;
begin
  if Msg.HotKey = id_SnapShot then
  begin
    H := GetSysFocus;
    while IsWindow(H) and (H <> frmMain.Handle) do
    begin
      SendMessage(H,WM_NEXTDLGCTL,0,0);
      H := GetParent(H);
    end;
  end;
end;

function TfrmMain.GetSysFocus: Integer;
var
  hOtherWin,OtherThreadID,hFocusWin:integer;
begin
  hOtherWin:=GetForegroundWindow;
  OtherThreadID:=GetWindowThreadProcessID(hOtherWin,nil);
  if AttachThreadInput(GetcurrentThreadID,OtherThreadID,True) then
  begin
    hFocusWin:=GetFocus;
    result:=GetFocus;
  if HFocusWin<>0 then
  try
  //
  finally
    AttachThreadInput(GetcurrentThreadID,OtherThreadID,False);
  end;
  end
  else result:=GetFocus;
end;

procedure TfrmMain.WMACTIVATEAPP(var Msg: TMessage);
begin
  if Boolean(Msg.WParam) then
    RegisterHotKey(frmMain.Handle, id_SnapShot, 0, VK_TAB)
  else
    UnRegisterHotKey(frmMain.Handle, id_SnapShot);
end;

procedure CallBackProc(ID:Integer); stdcall;
begin
  frmMain.CallPostMessage(ID);
end;

procedure TfrmMain.CallPostMessage(ID: Integer);
begin
 PostMessage(self.Handle, WM_CALLBACK, ID, 0);
end;

procedure TfrmMain.BackCallMessage(var Msg: TMessage);
begin
 if Msg.Msg = WM_CALLBACK then
 begin
   if Msg.WParam = FLibHandle then
   begin
     FreeLibrary(FLibHandle);
     FLibHandle := 0;
   end;
 end;
end;

procedure TfrmMain.mmFileOpenClick(Sender: TObject);
var
 FarPointer : FarProc;
begin
 if FLibHandle = 0 then
 begin
   try
     FLibHandle := LoadLibrary('Project2.dll');
   except
     FLibHandle := 0;
   end;
   if FLibHandle <> 0 then
   begin
     FarPointer  := GetProcAddress(FLibHandle, 'ShowForm');
     FShowForm   := FarPointer;
     FarPointer  :=  GetProcAddress(FLibHandle, 'ActiveForm');
     FActiveForm := FarPointer;
     FarPointer  := GetProcAddress(FLibHandle, 'CloseForm');
     FCloseForm  := FarPointer;
     if Assigned(FShowForm) then
       //FShowForm(Application, @CallBackProc, FLibHandle, self, panel1.Handle);
       List.add(FShowForm(Application, @CallBackProc, FLibHandle, self, panel1.Handle));
   end;
 end
 else
 begin
   if Assigned(FActiveForm) then
   begin
     FActiveForm;
   end;
 end;
end;

procedure TfrmMain.mmFileCloseClick(Sender: TObject);
begin
 if FLibHandle <> 0 then
   FCloseForm;

end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FLibHandle <> 0 then
    FCloseForm;
  if assigned(FFrm) then
    FreeAndNil(FFrm);
end;

procedure TfrmMain.mmFileOpenFrmClick(Sender: TObject);
begin
  if not assigned(FFrm) then
  begin
    FFrm := TForm1.Create(nil);
    with FFrm do
    begin
      ParentWindow := panel1.Handle;
      align := alClient;
      BorderStyle := bsNone;
      BorderIcons := [];
    end;
  end;
  FFrm.Show;
end;

procedure TfrmMain.N1111Click(Sender: TObject);
begin
  FFrm.Edit2.Text := 'abc';
 
end;

procedure TfrmMain.Change1Click(Sender: TObject);
begin
  if FFrm.ParentWindow = Panel1.handle then
    FFrm.ParentWindow := Panel2.handle
  else
    FFrm.ParentWindow := Panel1.handle
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  List := TList.Create;
end;

end.
//调用窗体End

//Project2.Dll==========================================================================

library Project2;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  SysUtils,
  Classes,
  Forms,
  Windows,
  Controls,
  Unit2 in 'Unit2.pas' {frmChild},
  Unit1 in 'Unit1.pas' {frmChildCustomer};

{$R *.res}

//function ShowForm(App: TApplication; CallProc: Pointer; CallID: Integer; ParentForm: TForm; ParentContral: HWND): LongInt; stdcall;
function ShowForm(App: TApplication; CallProc: Pointer; CallID: Integer; ParentForm: TForm; ParentContral: HWND): TForm; stdcall;
begin
 Application   := App;
 @FreeProc     := CallProc;
 ProcID        := CallID;

 frmChild      := TfrmChild.Create(ParentForm);
 frmChild.ParentWindow := ParentContral;
 frmChild.Align := alClient;
 frmChild.BorderStyle := bsNone;
 frmChild.BorderIcons := [];
 //SetWindowLong(frmChild.Handle,GWL_STYLE,GetWindowLong(ParentForm.Handle,GWL_STYLE));

其他新闻
  • unit Unit1; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shellapi, //ADD shellapi     AppEvnts, ImgList, Menus; const      ghy_tray=wm_user+2;      type   TForm1 ...
    2020-02-26
  • 最近在公司写一个外壳程序,调用DLL插件把FORM嵌入到EXE中的一个PANEL中,其中遇到了不少的问题,大部分已经解决,还有几个至今没有找到解决方法,有待研究,也希望知道解决方法的富翁共享...
    2020-02-26
  •   unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls; type TForm1 = class(TForm)     Button1: TButton;     Button2: TButton;     procedure Button1Click(Sender: TO...
    2020-02-26
友情链接

公司名称巴黎人电玩
版权所有:Copyright © 2015-2019 http://www.zhongqiangjy.com. 巴黎人电玩有限公司 版权所有

友情链接

Copyright © 2015-2019 http://www.zhongqiangjy.com. 巴黎人电玩有限公司 版权所有
公司地址http://www.zhongqiangjy.com