跟随窗体的实现

最新推荐文章于 2019-08-13 14:14:00 发布
最新推荐文章于 2019-08-13 14:14:00 发布
阅读量846 收藏 1
点赞数
文章标签： button include integer forms windows delphi
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/onlyou13/article/details/7219966
版权

        春节假期过去了，今天是新年的第一天上班。闲来无事，写了一个窗体跟随的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>




onlyou13
关注
  • 0
    点赞
  • 踩
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
窗体跟随的DELPHI实现
01-30
窗体跟随的DELPHI实现，是在XE1下开发的，如果要在D7下运行，需要做少量修改。
jQuery实现的右下角广告窗体跟随效果示例
10-21
主要介绍了jQuery实现的右下角广告窗体跟随效果,涉及jQuery结合时间函数动态操作页面元素属性的相关技巧,需要的朋友可以参考下
让子窗口跟这主窗口移动
随矜而去 BLOG
01-29 1048
procedure WMWindowPosChanged(var   Msg:   TWMWindowPosChanged); message WM_WindowPosChanged;const   uFlag   =   SWP_NOACTIVATE   or   SWP_NOZORDER   or   SWP_NOMOVE   or   SWP_NOSIZE;procedure   TForm
如何实现一个窗体移动时另一个窗体也跟着动的效果
weixin_34351321的博客
10-01 1261
新建一个工程，添加2个窗体（Form1.frm和Form2.frm），添加1个模块（Module1.bas）。 实现目的：Form2停靠在Form1的右侧，移动Form1时Form2跟随移动。 代码：（Form2中无代码，代码写在Form1中和Module1中） '************************************************** '窗体代码...
在vue中实现echarts随窗体变化
10-15
主要介绍了在vue中实现echarts随窗体变化，具有很好的参考价值，希望对大家有所帮助。一起跟随小编过来看看吧
python Qt5实现窗体跟踪鼠标移动
01-20
我就废话不多说了， 直接上代码吧！ from PyQt5.Qt import * import sys class Window(QWidget): def __init__(self): super().__init__() self.Flag=False self.setWindowTitle(窗口移动学习) ...
Delphi 为窗体增加边框.rar
07-10
Delphi 为窗体增加边框，大家看下演示截图就明白了，可看到窗体的外框增加了一圈红色的边框，看上去更醒目了。以下是相关的实现代码，仅供参考，完整可编译的实例请下载本源码包： 　　begin 　　 inherited; 　　 aa:= GetWindowDC(handle); 　　 msg.Result := 1; 　　 bb := CreatePen(ps_solid,10,rgb(0,200,0)); 　　 pen:= SelectObject(aa,bb); 　　 brush:= SelectObject(aa,getstockobject(null_brush)); 　　 Rectangle(aa,0,0,form1.Width ,form1.Height ); 　　 SelectObject(aa,brush); 　　 SelectObject(aa,pen); 　　 DeleteObject(bb); 　　 ReleaseDc(handle,canvas.Handle ); 　　end;
Delphi Shadow窗口阴影立体效果.rar
07-10
Delphi 制作立体窗口阴影效果，这个阴影看上去很明显，不过不是线性的，线性的实现起来要比这种阴影复杂一些。 　　ShadowWidth:integer; //用于确定阴影的宽度或高度 　　RightShadow:TForm; //主窗口的右边产生一个阴影窗口 　　BottomShadow:TForm; //主窗口的下部产生一个阴影窗口 　　procedure WMWindowPosChanged(var Msg:TWMWindowPosChanged);message wm_windowposchanged;
delphi 无标题栏时，窗体跟随其他控件移动的方法
weixin_33814685的博客
12-13 172
procedure   image1.onMouseDown(Sender:   TObject;   Button:   TMouseButton;     Shift:   TShiftState;   X,   Y:   Integer); begin ReleaseCapture;     SendMessage(Handle,   WM_SYSCOMMAND,   $F012,   0)...
如何实现窗体跟随另一个程序一起显示,一起隐藏!!
aibi9196的博客
11-27 149
如何实现窗体跟随另一个程序一起显示,一起隐藏!! Delphi / Windows SDK/APIhttp://www.delphi2007.net/DelphiAPI/html/delphi_20061120120925193.html 编写一个窗口,启动计算器,计算器最小化,则该窗口也最小化,计算器显示,则窗口也显示(在计算器旁),... 就是说,计算器的窗口处于什么状...
一个窗口移动时，另一个窗口跟随移动
anna2117的博客
08-13 1789
在duilib框架下进行的界面显示，windows有个message是WM_WINDOWPOSCHANGING，在handlemessage中，定义这个消息的处理函数 然后在自己的窗口子类中，实现该函数 用户移动child_window后，通过窗口名找到对应的两个窗口(此处start_form是跟随窗口，child_window是用户控制移动的窗口)，获取child_window的坐...
winform窗体跟随窗体
weixin_30699741的博客
05-30 234
Form2frm2=newForm2();privatevoidMoveProc(){frm2.StartPosition=FormStartPosition.CenterParent;frm2.Left=this.Left+panel1.Left;frm2...
在.Net的WinForm开发中如何实现控件随窗体大小的改变而自动适应其改变
热门推荐
海纳百川@一亩三分地
05-23 2万+
在设计可供用户调整大小的窗体时，如何实现该窗体上的控件也应能正确地随窗体的改变而自动调整大小并且能重新定位？此时就要借助控件的．Anchor属性。Anchor属性定义控件的定位点位置。当控件锚定到某个窗体时，如果该窗体的大小被调整，那么该控件维持它与定位点位置之间的距离不变。例如，如果“：Button”控件锚定到窗体的左、右和底边缘，那么当调整该窗体的大小时，Button控件水平调整大小，维持到该
winform 窗体嵌套
最新发布
06-05
这种方法操作简单，但里面的子窗体不能单独拖动和拉伸，只能跟随主窗体的大小改变相应。 2.使用自定义控件：创建一个继承自 UserControl 的自定义控件，在其中设计、布置所需的子窗体控件，并在主窗体中加载该...

“相关推荐”对你有帮助么？

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值