⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 一个不用编写任何代码的DELPHI停靠窗体的控件原码
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, lbDockFormControl, Menus, ExtCtrls, ComCtrls,
  lbDelphiDockStyle, SupportClass;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    TopDocked: TMenuItem;
    BottomDocked: TMenuItem;
    LeftDocked: TMenuItem;
    RightDocked: TMenuItem;
    N6: TMenuItem;
    AllDocked: TMenuItem;
    EachOtherDocked: TMenuItem;
    lbDockClient1: TlbDockClient;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure lbDockClient1FormShow(Sender: TObject);
    procedure lbDockClient1FormHide(Sender: TObject);
    procedure FormEndDock(Sender, Target: TObject; X, Y: Integer);
    procedure TopDockedClick(Sender: TObject);
    procedure BottomDockedClick(Sender: TObject);
    procedure LeftDockedClick(Sender: TObject);
    procedure RightDockedClick(Sender: TObject);
    procedure EachOtherDockedClick(Sender: TObject);
    procedure AllDockedClick(Sender: TObject);
    procedure lbDockClient1NCButtonDblClk(DockClient: TlbDockClient;
      Button: TMouseButton; X, Y: Smallint; HitTest: Integer;
      MouseStation: TMouseStation);
    procedure lbDockClient1NCButtonDown(DockClient: TlbDockClient;
      Button: TMouseButton; X, Y: Smallint; HitTest: Integer;
      MouseStation: TMouseStation);
    procedure lbDockClient1NCButtonUp(DockClient: TlbDockClient;
      Button: TMouseButton; X, Y: Smallint; HitTest: Integer;
      MouseStation: TMouseStation);
    procedure lbDockClient1NCMouseMove(DockClient: TlbDockClient; X,
      Y: Smallint; HitTest: Integer; MouseStation: TMouseStation);
    procedure lbDockClient1PaintDockGrabber(Canvas: TCanvas;
      Control: TControl; const ARect: TRect);
    procedure FormResize(Sender: TObject);
    procedure FormHide(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Main;


{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TopDocked.Checked := lbDockClient1.TopDock;
  BottomDocked.Checked := lbDockClient1.BottomDock;
  LeftDocked.Checked := lbDockClient1.LeftDock;
  RightDocked.Checked := lbDockClient1.RightDock;
  EachOtherDocked.Checked := lbDockClient1.EachOtherDock;
  AllDocked.Checked := lbDockClient1.EnableDock;
end;

procedure TForm1.lbDockClient1FormShow(Sender: TObject);
begin
  TMenuItem(Tag).Checked := True;
end;

procedure TForm1.lbDockClient1FormHide(Sender: TObject);
begin
  TMenuItem(Tag).Checked := False;
end;

procedure TForm1.FormEndDock(Sender, Target: TObject; X, Y: Integer);
begin
//  Caption := 'Form1';
end;

procedure TForm1.TopDockedClick(Sender: TObject);
begin
  TopDocked.Checked := not TopDocked.Checked;
  lbDockClient1.TopDock := TopDocked.Checked;
end;

procedure TForm1.BottomDockedClick(Sender: TObject);
begin
  BottomDocked.Checked := not BottomDocked.Checked;
  lbDockClient1.BottomDock := BottomDocked.Checked;
end;

procedure TForm1.LeftDockedClick(Sender: TObject);
begin
  LeftDocked.Checked := not LeftDocked.Checked;
  lbDockClient1.LeftDock := LeftDocked.Checked;
end;

procedure TForm1.RightDockedClick(Sender: TObject);
begin
  RightDocked.Checked := not RightDocked.Checked;
  lbDockClient1.RightDock := RightDocked.Checked;
end;

procedure TForm1.EachOtherDockedClick(Sender: TObject);
begin
  EachOtherDocked.Checked := not EachOtherDocked.Checked;
  lbDockClient1.EachOtherDock := EachOtherDocked.Checked;
end;

procedure TForm1.AllDockedClick(Sender: TObject);
begin
  AllDocked.Checked := not AllDocked.Checked;
  lbDockClient1.EnableDock := AllDocked.Checked;
end;

procedure TForm1.lbDockClient1NCButtonDblClk(DockClient: TlbDockClient;
  Button: TMouseButton; X, Y: Smallint; HitTest: Integer;
  MouseStation: TMouseStation);
begin
//
end;

procedure TForm1.lbDockClient1NCButtonDown(DockClient: TlbDockClient;
  Button: TMouseButton; X, Y: Smallint; HitTest: Integer;
  MouseStation: TMouseStation);
begin
//
end;

procedure TForm1.lbDockClient1NCButtonUp(DockClient: TlbDockClient;
  Button: TMouseButton; X, Y: Smallint; HitTest: Integer;
  MouseStation: TMouseStation);
begin
//
end;

procedure TForm1.lbDockClient1NCMouseMove(DockClient: TlbDockClient; X,
  Y: Smallint; HitTest: Integer; MouseStation: TMouseStation);
begin
//
end;

procedure TForm1.lbDockClient1PaintDockGrabber(Canvas: TCanvas;
  Control: TControl; const ARect: TRect);
begin
//
end;

procedure TForm1.FormResize(Sender: TObject);
//var AHeight, AWidth: Integer;
begin
{  if Floating then
  begin
    AHeight := Height;
    AWidth := Width;
  end else
  begin
    AHeight := Height + 23;
    AWidth := Width + 8;
  end;
  Memo1.Text := IntToStr(AHeight) + ',' + IntToStr(AWidth);}
end;

procedure TForm1.FormHide(Sender: TObject);
begin
//
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -