春节假期过去了,今天是新年的第一天上班。闲来无事,写了一个窗体跟随的Demo(XE1下编写)。不怕大家说我班门弄斧,现与大家分享,不合适之处请大家指点。
免积分下载地址:窗体跟随的DELPHI实现
Child.DFM
object ChildForm: TChildForm
Left = 0
Top = 0
Caption = 'ChildForm'
ClientHeight = 307
ClientWidth = 292
Color = clBtnFace
Constraints.MinHeight = 200
Constraints.MinWidth = 300
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnKeyDown = FormKeyDown
OnMouseDown = FormMouseDown
OnMouseEnter = FormMouseEnter
PixelsPerInch = 96
TextHeight = 13
end
Child.PAS
unit Child;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TChildForm = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseEnter(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
FAdjustMainForm: Boolean;
{ Private declarations }
public
{ Public declarations }
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
procedure WMMIN(var Message: TMessage); message WM_SYSCOMMAND;
end;
implementation
uses Main;
{$R *.dfm}
procedure TChildForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SendMessage(Application.MainForm.Handle, WM_CHILDCLOSE, 0, 0);
end;
procedure TChildForm.FormCreate(Sender: TObject);
begin
FAdjustMainForm := False;
end;
procedure TChildForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
FAdjustMainForm := True;
end;
procedure TChildForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Handle, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0);
end;
procedure TChildForm.FormMouseEnter(Sender: TObject);
begin
FAdjustMainForm := True;
end;
procedure TChildForm.WMMIN(var Message: TMessage);
begin
case Message.WParam of
SC_MINIMIZE:
begin
// Application.Minimize;
// ShowWindow(Application.MainForm.Handle, SW_HIDE);
PostMessage(Application.MainForm.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
SC_RESTORE:
begin
// ShowWindow(Application.MainForm.Handle, SW_NORMAL);
PostMessage(Application.MainForm.Handle, WM_SYSCOMMAND, SC_RESTORE, 0);
end;
else
inherited;
end;
end;
procedure TChildForm.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
inherited;
if not FAdjustMainForm then Exit;
with Application.MainForm do
begin
Left := Message.WindowPos.x - Width;
Top := Message.WindowPos.y;
end;
end;
end.
Main.DFM
object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'MainForm'
ClientHeight = 433
ClientWidth = 292
Color = clBtnFace
Constraints.MinHeight = 200
Constraints.MinWidth = 300
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnMouseDown = FormMouseDown
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 96
Top = 104
Width = 81
Height = 25
Caption = #21019#24314#36319#38543#31383#20307
TabOrder = 0
OnClick = Button1Click
end
end
Main.PAS
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Child;
const
WM_CHILDCLOSE = WM_USER + $F00;
type
TMainForm = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
FRightForm: TChildForm;
public
{ Public declarations }
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); Message WM_WINDOWPOSCHANGED;
procedure ChildWndClose(var Message: TMessage); Message WM_CHILDCLOSE;
procedure WMMIN(var Message: TMessage); Message WM_SYSCOMMAND;
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.Button1Click(Sender: TObject);
begin
if not Assigned(FRightForm) then
begin
FRightForm := TChildForm.Create(Self);
FRightForm.Left := Left + Width;
FRightForm.Top := Top;
FRightForm.Height := Height;
FRightForm.Show;
end
else
FreeAndNil(FRightForm);
end;
procedure TMainForm.ChildWndClose(var Message: TMessage);
begin
FRightForm := nil;
end;
procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Handle, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0);
end;
procedure TMainForm.WMMIN(var Message: TMessage);
begin
inherited;
if Message.WParam = SC_RESTORE then
begin
if Assigned(FRightForm) then
ShowWindow(FRightForm.Handle, SW_NORMAL);
end;
end;
procedure TMainForm.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
inherited;
if Assigned(FRightForm) then
begin
if Message.WindowPos.x + Message.WindowPos.cx < 0 then Exit;
FRightForm.Left := Message.WindowPos.x + Message.WindowPos.cx;
FRightForm.Top := Message.WindowPos.y;
FRightForm.Height := Message.WindowPos.cy;
end;
end;
initialization
System.ReportMemoryLeaksOnShutdown := True;
end.
Project1.dpr
program Project1;
uses
Forms,
Main in 'Main.pas' {MainForm},
Child in 'Child.pas' {ChildForm};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.
Project1.dproj
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{6D03DD72-41E5-483D-888C-48203D16FD71}</ProjectGuid>
<MainSource>Project1.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform>Win32</Platform>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<ProjectVersion>12.3</ProjectVersion>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_DcuOutput>.\dcu\</DCC_DcuOutput>
<DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;WinTypes=Windows;WinProcs=Windows;$(DCC_UnitAlias)</DCC_UnitAlias>
<DCC_ExeOutput>.\Debug\Win32\</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>false</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="Project1.dpr">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="Main.pas">
<Form>MainForm</Form>
</DCCReference>
<DCCReference Include="Child.pas">
<Form>ChildForm</Form>
</DCCReference>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">Project1.dpr</Source>
</Source>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">2052</VersionInfo>
<VersionInfo Name="CodePage">936</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
<VersionInfoKeys Name="OriginalFilename"/>
<VersionInfoKeys Name="ProductName"/>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
</VersionInfoKeys>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
</Project>