收到,多谢你了.分给你了
调用--------------------------------------------------------------------------------
unit mdiform;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, ADODB, Menus, ExtCtrls, jpeg;
type
Tfrmmain = class(TForm)
ADOConnection1: TADOConnection;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
miWindow: TMenuItem;
miCloseAll: TMenuItem;
imgMain: TImage;
mmiImage: TMenuItem;
mmiTile: TMenuItem;
mmiCenter: TMenuItem;
mmiStretch: TMenuItem;
procedure N5Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure miCloseAllClick(Sender: TObject);
procedure mmiTileClick(Sender: TObject);
private
FOldClientProc,
FNewClientProc: TFarProc;
FDrawDC: hDC;
procedure CloseAllMDI ;
function GetMdiChildreCaption(mdichildhandle:HWND):String ;
procedure ClientWndProc(var Message: TMessage);
procedure DrawStretched;
procedure DrawCentered;
procedure DrawTiled;
protected
procedure CreateWnd; override;
{ Private declarations }
end;
var
frmmain: Tfrmmain ;
strmdichildhandle: TStrings ;
implementation
//静态调用dll
function showdllform(mainform:TForm;ado:TADOConnection):longint;stdcall;external 'showmdi.dll' ;
{$R *.DFM}
procedure Tfrmmain.N5Click(Sender: TObject);
begin
Application.Terminate ;
end;
procedure Tfrmmain.N2Click(Sender: TObject);
var
mdichildhandle:Longint ;
begin
mdichildhandle := showdllform(Application.MainForm,ADOConnection1) ;
strmdichildhandle.Add(inttostr(mdichildhandle)) ;
miCloseAll.Enabled := True ;
end;
procedure Tfrmmain.CloseAllMDI ;
var
i:integer ;
begin
for i:= 0 to strmdichildhandle.Count - 1 do
begin
sendmessage(strtoint(strmdichildhandle),WM_CLOSE,0,0) ;
end ;
strmdichildhandle.Clear ;
end ;
procedure Tfrmmain.FormCreate(Sender: TObject);
begin
//加入背景图
// Self.brush.bitmap:=imgMain.picture.bitmap;
strmdichildhandle := TStringList.Create ;
end;
procedure Tfrmmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseAllMDI ;
strmdichildhandle.Free ;
end;
function Tfrmmain.GetMdiChildreCaption(mdichildhandle:HWND):String ;
var
TheText: PChar; // this will hold the window text
TextLen: Integer; // the length of the window text
begin
{get the length of the window text}
TextLen:=GetWindowTextLength(mdichildhandle);
{dynamically allocate space based on the window text length}
GetMem(TheText,TextLen);
{get the window text. we must add 1 to account for the terminating null character}
GetWindowText(mdichildhandle,TheText,TextLen+1);
{display this text in the edit box}
Result:=string(TheText);
{free the memory for the new string}
FreeMem(TheText);
end ;
procedure Tfrmmain.miCloseAllClick(Sender: TObject);
begin
// LockWindowUpdate(Handle) ;
CloseAllMDI ;
miCloseAll.Enabled := False ;
// LockWindowUpdate(0) ;
end;
procedure Tfrmmain.mmiTileClick(Sender: TObject);
begin
mmiTile.Checked := false;
mmiCenter.Checked := False;
mmiStretch.Checked := False;
{ Set the Checked property for the menu item which invoked }
{ this event handler to Checked }
if Sender is TMenuItem then
TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
{ Redraw the client area of the form }
InvalidateRect(ClientHandle, nil, True);
end;
procedure Tfrmmain.CreateWnd;
begin
inherited CreateWnd;
// Turn the ClientWndProc method into a valid window procedure
FNewClientProc := MakeObjectInstance(ClientWndProc);
// Get a pointer to the original window procedure
FOldClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
// Set ClientWndProc as the new window procedure
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FNewClientProc));
end;
procedure Tfrmmain.DrawCentered;
{ This procedure centers the image on the form's client area }
var
CR: TRect;
begin
GetWindowRect(ClientHandle, CR);
with imgMain do
BitBlt(FDrawDC, ((CR.Right - CR.Left) - Picture.Width) div 2,
((CR.Bottom - CR.Top) - Picture.Height) div 2,
Picture.Graphic.Width, Picture.Graphic.Height,
Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure Tfrmmain.DrawStretched;
{ This procedure stretches the image on the form's client area }
var
CR: TRect;
begin
GetWindowRect(ClientHandle, CR);
StretchBlt(FDrawDC, 0, 0, CR.Right, CR.Bottom,
imgMain.Picture.Bitmap.Canvas.Handle, 0, 0,
imgMain.Picture.Width, imgMain.Picture.Height, SRCCOPY);
end;
procedure Tfrmmain.DrawTiled;
{ This procedure tiles the image on the form's client area }
var
Row, Col: Integer;
CR, IR: TRect;
NumRows, NumCols: Integer;
begin
GetWindowRect(ClientHandle, CR);
IR := imgMain.ClientRect;
NumRows := CR.Bottom div IR.Bottom;
NumCols := CR.Right div IR.Right;
with imgMain do
for Row := 0 to NumRows+1 do
for Col := 0 to NumCols+1 do
BitBlt(FDrawDC, Col * Picture.Width, Row * Picture.Height,
Picture.Width, Picture.Height, Picture.Bitmap.Canvas.Handle,
0, 0, SRCCOPY);
end;
procedure Tfrmmain.ClientWndProc(var Message: TMessage);
begin
case Message.Msg of
// Capture the WM_ERASEBKGND messages and perform the client area drawing
WM_ERASEBKGND:
begin
CallWindowProc(FOldClientProc, ClientHandle, Message.Msg, Message.wParam,
Message.lParam);
FDrawDC := TWMEraseBkGnd(Message).DC;
if mmiStretch.Checked then
DrawStretched
else if mmiCenter.Checked then
DrawCentered
else DrawTiled;
Message.Result := 1;
end;
{ Capture the scrolling messages and ensure the client area
is redrawn by calling InvalidateRect }
WM_VSCROLL, WM_HSCROLL:
begin
Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
Message.wParam, Message.lParam);
InvalidateRect(ClientHandle, nil, True);
end;
else
// By Default, call the original window procedure
Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
Message.wParam, Message.lParam);
end; { case }
end;
end.
-------------------------------------------------------------------------------
dll-------------------------------------------------------------------------------
library showmdi;
uses
SysUtils,
Classes,
Forms,
ADOdb,
mdidll in 'mdidll.pas' {frmmdi};
{$R *.RES}
function showdllform(mainform:TForm;ado:TADOConnection):longint;stdcall ;
var
ptr:^LongInt ;
begin
{//只生成一个实例
If Assigned(frmmdi) then
begin
frmmdi.BringToFront;
result := frmmdi.handle ;
exit ;
end ;}
ptr := @(Application.mainform) ;
ptr^ := longint(mainform) ;
frmmdi := Tfrmmdi.Create(mainform) ;
frmmdi.ADOQuery1.Connection := ado ;
result := frmmdi.Handle ;
frmmdi.Caption := 'longint:'+inttostr(longint(frmmdi)) + '---handle:'+ inttostr(frmmdi.Handle) ;
frmmdi.Icon := frmmdi.Image1.Picture.Icon ;
end ;
exports
showdllform;
begin
end.
----------------------------------------------------------------------------------
dll窗口---------------------------------------------------------------------------
unit mdidll;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, Grids, DBGrids, ADODB, ExtCtrls;
type
Tfrmmdi = class(TForm)
ADOQuery1: TADOQuery;
DataSource1: TDataSource;
Panel2: TPanel;
DBGrid1: TDBGrid;
Panel1: TPanel;
Panel3: TPanel;
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmmdi: Tfrmmdi;
implementation
{$R *.DFM}
procedure Tfrmmdi.Button1Click(Sender: TObject);
begin
ADOQuery1.Open ;
end;
procedure Tfrmmdi.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree ;
end;
procedure Tfrmmdi.FormDestroy(Sender: TObject);
begin
frmmdi := nil ;
end;
end.
-------------------------------------------------------------------------------
贴出来,希望对大家有帮助
