- 浏览: 496212 次
- 性别:
- 来自: 杭州
文章分类
最新评论
-
chimpp55:
java.lang.NoSuchMethodError: or ...
基于Junit2.0的StrutsTestCase应用 -
opmic:
<property name="srcDir& ...
使用Eclipse与Ant进行java程序开发 -
univasity:
非常好,谢谢分享。
使用Eclipse与Ant进行java程序开发 -
peanut_sei:
exception handlers 译成 例外处理 倒是第 ...
JavaScript高级应用:例外处理
//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));
//Result := Longint(frmChild);
Result := frmChild;
frmChild.Show;
frmChild.BringToFront;
end;
function ActiveForm: LongInt; stdcall;
begin
if Assigned(frmChild) then
begin
frmChild.BringToFront;
frmChild.SetFocus;
end;
Result := 0;
end;
function CloseForm: LongInt;stdcall;
begin
if Assigned(frmChild) then
begin
frmChild.Close;
end;
Result := 0;
end;
exports
ShowForm, ActiveForm, CloseForm;
{Dll Entry Point}
procedure ExitDll(Reason: Integer);
begin
if Reason = DLL_PROCESS_DETACH then // detaching from process
begin
// restore application
Application := DllApp;
end;
end;
begin
// backup application
DllApp := Application;
DllProc := @ExitDll;
end.
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxGrid, ExtCtrls, dxBar, cxLookAndFeels, dxSkinsForm;
type
TFreeProc = procedure (ProcID: Integer); stdcall;
TfrmChildCustomer = class(TForm)
dxBarManager1: TdxBarManager;
dxBarManager1Bar1: TdxBar;
dxBarButton1: TdxBarButton;
dxBarButton2: TdxBarButton;
dxBarButton3: TdxBarButton;
dxBarButton4: TdxBarButton;
dxBarButton5: TdxBarButton;
dxBarButton6: TdxBarButton;
dxBarButton7: TdxBarButton;
Panel1: TPanel;
cxGrid1DBTableView1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
dxSkinController1: TdxSkinController;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmChildCustomer: TfrmChildCustomer;
FreeProc : TFreeProc; //if childform is free(close), notify parent process
ProcID : Integer; //handle that is loaded from parent process
DllApp : TApplication; //a copy of dll application
implementation
{$R *.dfm}
procedure TfrmChildCustomer.Button1Click(Sender: TObject);
begin
close;
end;
procedure TfrmChildCustomer.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmChildCustomer.FormDestroy(Sender: TObject);
begin
if Assigned(@FreeProc) then
FreeProc(ProcID);
end;
end.
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Unit1;
type
TfrmChild = class(TfrmChildCustomer)
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmChild: TfrmChild;
implementation
{$R *.dfm}
end.
发表评论
-
Delphi6函数大全(1)
2008-05-27 12:14 866Delphi6函数大全1-StrUtils.pas 首部 fu ... -
Delphi6函数大全(2)
2008-05-27 12:14 886Delphi6函数大全2-SysUtils.pas 首部 fu ... -
Delphi6函数大全(3)
2008-05-27 12:13 1104Delphi6函数大全3-SysUtils.pas 首部 fu ... -
Delphi6函数大全(4)
2008-05-27 12:12 1069Delphi6函数大全4-SysUtils.pas 首部 fu ... -
Delphi6函数大全(5)
2008-05-27 12:11 997Delphi6函数大全5-SysUtils.pas 首部 fu ... -
delphi中使用词霸2005的动态库XdictGrb.dll实现屏幕取词
2008-05-27 12:10 3546delphi中使用词霸2005的动 ... -
DELPHI定义的条件编译的全部说明
2008-05-27 09:36 1851经常看到一些程序里面 ... -
Delphi控件开发浅入深出(二)
2008-01-23 16:13 2323二、控件开发纵览 通 ... -
Delphi控件开发浅入深出(一)
2008-01-23 16:09 2800有人说过“不会开发控件的Delphi程序员不是真正的程 ... -
绑架窗体之Delphi版
2004-05-09 10:58 1294“绑架窗体”:顾名思义,就是将其它应用程序甚至系统程序的窗体活 ... -
delphi的面向对象之路1
2004-05-09 10:59 717规则一:为每一个类 ...
相关推荐
Delphi创建Dll和调用Dll示例(包含Dll窗体调用) 网上介绍比较杂乱,特地整理了一份Demo代大家学习参考。 1.socketA_dll 为dll工程目录。 2.LoadDllDemo 为【静态调用】dll工程目录。 3.LoadDllDemo_动态调用 为...
DELPHI 简单调用DLL窗体源码
DLL窗体的创建与调用 可在主窗体中调用DLL中的模式窗体、MDIChild子窗体。
调用DLL中窗体相关演示源码
主程序调用打开DLL窗体,DLL窗体发消息控制主程序,很简单的代码,仅供参考
用DLL封装窗体 ,然后通过调用DLL打开窗体!
简单调用DLL窗体源码.rar
调用DLL中窗体相关源码
从外部Dll中调用子窗体
带参的dll窗体制作与调用源码,带返回值的dll 窗体的制作与调用源码!
C++Builder MDI 程序调用 DLL窗体实例。基于 BCB2010
c#窗体通过dll调用opencv的简单示例,可打开图片,以数组形式返回一列像素的值,完整的opencv dll函数编写示例。
delphi调用C# DLL
这是一个调用dll中封装窗体的例子! dll文件夹中编译出Mydll.dll
vbs显示窗体(显示控件,调用标准DLL还要大家再去扩展) 用一个方法可以直接让PY显示任意控件,VBS也可以做界面 VBS就可以当软件用了,支持API调用(Findwindow),支持加载控件,他本身就支持调用对象creatobject,那...
动态调用DLL中窗体源码,可以把不同的窗体功能封装成dll,由主功能界面调用
delphi 从外部Dll中调用子窗体. 关于DLL文件 的调用
简单的dll 窗体文件的编辑,与调用源码