?? umain.pas
字號:
unit uMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Magnetic, StdCtrls;
type
TfrmParent = class(TForm)
btnShowChild: TButton;
btnClose: TButton;
btnCreateChild: TButton;
btnShowChild2: TButton;
btnShowChild3: TButton;
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnShowChildClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure btnCreateChildClick(Sender: TObject);
procedure btnShowChild2Click(Sender: TObject);
procedure btnShowChild3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WMEnterSizeMove(var Msg: TMessage); message WM_ENTERSIZEMOVE;
procedure WMSizing(var Msg: TMessage); message WM_SIZING;
procedure WMMoving(var Msg: TMessage); message WM_MOVING;
procedure WMExitSizeMove(var Msg: TMessage); message WM_EXITSIZEMOVE;
procedure WMSysCommand(var Msg: TMessage); message WM_SYSCOMMAND;
procedure WMCommand(var Msg: TMessage); message WM_COMMAND;
end;
var
frmParent: TfrmParent;
// MagneticWnd: TMagnetic; // defined in Magnetic unit
implementation
{$R *.dfm}
uses uSub1, uSub2, uSub3;
const
NumForms = 5;
var
MagneticWndProc : TSubClass_Proc;
dummyHandled : boolean;
ChildForms : array[1..NumForms] of TfrmChild1;
//---------------------- Custom Message Handling procedures ----------------------
procedure TfrmParent.WMEnterSizeMove(var Msg: TMessage);
begin
inherited;
if Assigned(MagneticWndProc) then
MagneticWndProc(Self.Handle, WM_ENTERSIZEMOVE, Msg, dummyHandled);
end;
procedure TfrmParent.WMSizing(var Msg: TMessage);
var
bHandled: Boolean;
begin
if not Assigned(MagneticWndProc) then
inherited
else
if MagneticWndProc(Self.Handle, WM_SIZING, Msg, bHandled) then
if not bHandled then
inherited;
end;
procedure TfrmParent.WMMoving(var Msg: TMessage);
var
bHandled: Boolean;
begin
if not Assigned(MagneticWndProc) then
inherited
else
if MagneticWndProc(Self.Handle, WM_MOVING, Msg, bHandled) then
if not bHandled then
inherited;
end;
procedure TfrmParent.WMExitSizeMove(var Msg: TMessage);
begin
inherited;
if Assigned(MagneticWndProc) then
MagneticWndProc(Self.Handle, WM_EXITSIZEMOVE, Msg, dummyHandled);
end;
procedure TfrmParent.WMSysCommand(var Msg: TMessage);
begin
inherited;
if Assigned(MagneticWndProc) then
MagneticWndProc(Self.Handle, WM_SYSCOMMAND, Msg, dummyHandled);
end;
procedure TfrmParent.WMCommand(var Msg: TMessage);
begin
inherited;
if Assigned(MagneticWndProc) then
MagneticWndProc(Self.Handle, WM_COMMAND, Msg, dummyHandled);
end;
//------------------ end of Custom Message Handling procedures -------------------
// procedure to subclass ChildForms window procedure for magnetic effect.
function SubFormWindowProc(Wnd: HWND; Msg, wParam, lParam: Integer): Integer; stdcall;
var
Handled: boolean;
Message_: TMessage;
OrgWndProc: Integer;
begin
Result := 0;
if not Assigned(MagneticWndProc) then
begin
Result := CallWindowProc(Pointer(OrgWndProc), Wnd, Msg, wParam, lParam);
exit;
end;
OrgWndProc := GetWindowLong(Wnd, GWL_USERDATA);
if (OrgWndProc = 0) then
exit;
Message_.WParam := wParam;
Message_.LParam := lParam;
Message_.Result := 0;
if (Msg = WM_SYSCOMMAND) or (Msg = WM_ENTERSIZEMOVE) or (Msg = WM_EXITSIZEMOVE) or
(Msg = WM_WINDOWPOSCHANGED) or (Msg = WM_COMMAND)then
begin
Result := CallWindowProc(Pointer(OrgWndProc), Wnd, Msg, wParam, lParam);
MagneticWndProc(Wnd, Msg, Message_, dummyHandled);
end else if (Msg = WM_MOVING) or (Msg = WM_SIZING) then
begin
MagneticWndProc(Wnd, Msg, Message_, Handled);
if Handled then
begin
Result := Message_.Result;
exit;
end else
Result := CallWindowProc(Pointer(OrgWndProc), Wnd, Msg, wParam, lParam);
end else if (Msg = WM_DESTROY) then
begin
if Assigned(MagneticWnd) then
MagneticWnd.RemoveWindow(Wnd);
Result := CallWindowProc(Pointer(OrgWndProc), Wnd, Msg, wParam, lParam);
end else
Result := CallWindowProc(Pointer(OrgWndProc), Wnd, Msg, wParam, lParam);
end;
procedure TfrmParent.btnCreateChildClick(Sender: TObject);
var
i : integer;
OrgWndProc: Integer;
begin
if Assigned(ChildForms[1]) then // already created child forms ?
exit;
for i := 1 to NumForms do
begin
ChildForms[i] := TfrmChild1.Create(Self);
ChildForms[i].Caption := 'Magnetic Child1-' + intToStr(i);
ChildForms[i].Left := 100 + i * 35;
ChildForms[i].top := 100 + i * 35;
ChildForms[i].Show;
if not MagneticWnd.AddWindow(ChildForms[i].Handle, self.Handle, MagneticWndProc) then
exit;
// Subclassing sub form, the original Window Proc is saved in its own 32-bit value space.
OrgWndProc := GetWindowLong(ChildForms[i].Handle, GWL_WNDPROC);
SetWindowLong(ChildForms[i].Handle, GWL_USERDATA, OrgWndProc); // Save Original Window Proc
SetWindowLong(ChildForms[i].Handle, GWL_WNDPROC, Integer(@SubFormWindowProc));
end;
end;
procedure TfrmParent.btnShowChild2Click(Sender: TObject);
begin
frmChild2.Show;
end;
procedure TfrmParent.btnShowChild3Click(Sender: TObject);
begin
frmChild3.Show;
end;
procedure TfrmParent.btnShowChildClick(Sender: TObject);
var
i : integer;
begin
for i := 1 to NumForms do
begin
if ChildForms[i] <> nil then
if (not ChildForms[i].Visible) then
ChildForms[i].Show;
end;
if (not frmChild2.Visible) then
frmChild2.Show;
if (not frmChild3.Visible) then
frmChild3.Show;
end;
procedure TfrmParent.FormCreate(Sender: TObject);
begin
// Create a TMagnetic Class
MagneticWnd := TMagnetic.Create;
end;
procedure TfrmParent.FormDestroy(Sender: TObject);
begin
// Release TMagnetic Class
MagneticWnd.Free;
end;
procedure TfrmParent.FormShow(Sender: TObject);
begin
if Assigned(MagneticWnd) then
begin
// Set Snap width
MagneticWnd.SnapWidth := 15;
// Register main window as a serviced window of TMagnetic Class
MagneticWnd.AddWindow(Self.Handle, 0, MagneticWndProc);
end;
end;
procedure TfrmParent.btnCloseClick(Sender: TObject);
begin
Close;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -