main.~pas

来自「一个不用编写任何代码的DELPHI停靠窗体的控件原码」· ~PAS 代码 · 共 329 行

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus, ComCtrls, ToolWin, lbDockFormControl, lbDockTree,
  lbVCDockStyle, lbDelphiDockStyle, lbVIDDockStyle, SupportClass, ActnList,
  AppEvnts, ImgList, IniFiles;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    DockForm_Menu: TMenuItem;
    DockForm1: TMenuItem;
    DockForm2: TMenuItem;
    DockForm3: TMenuItem;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ShowWindow_Menu: TMenuItem;
    PopupMenu1: TPopupMenu;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    Set_Menu: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    bsToolWindow1: TMenuItem;
    N18: TMenuItem;
    bsDialog1: TMenuItem;
    bsNone1: TMenuItem;
    bsSingle1: TMenuItem;
    bsSizeable1: TMenuItem;
    bsSizeToolWin1: TMenuItem;
    bsToolWindow2: TMenuItem;
    DockInfo_Menu: TMenuItem;
    SaveToFile: TMenuItem;
    LoadFromFile: TMenuItem;
    SaveToReg: TMenuItem;
    LoadFromReg: TMenuItem;
    N24: TMenuItem;
    DockOption_Menu: TMenuItem;
    TopDocked: TMenuItem;
    BottomDocked: TMenuItem;
    LeftDocked: TMenuItem;
    RightDocked: TMenuItem;
    AllDocked: TMenuItem;
    N31: TMenuItem;
    lbDockServer1: TlbDockServer;
    lbDelphiDockStyle1: TlbDelphiDockStyle;
    lbVCDockStyle1: TlbVCDockStyle;
    lbVIDDockStyle1: TlbVIDDockStyle;
    StatusBar1: TStatusBar;
    DockStyle_Menu: TMenuItem;
    DelphiDockStyle: TMenuItem;
    VCDockStyle: TMenuItem;
    VIDDockStyle: TMenuItem;
    Default: TMenuItem;
    Memo1: TMemo;
    procedure DockForm1Click(Sender: TObject);
    procedure DockForm2Click(Sender: TObject);
    procedure DockForm3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure bsToolWindow1Click(Sender: TObject);
    procedure bsToolWindow2Click(Sender: TObject);
    procedure SaveToFileClick(Sender: TObject);
    procedure LoadFromFileClick(Sender: TObject);
    procedure SaveToRegClick(Sender: TObject);
    procedure LoadFromRegClick(Sender: TObject);
    procedure TopDockedClick(Sender: TObject);
    procedure BottomDockedClick(Sender: TObject);
    procedure LeftDockedClick(Sender: TObject);
    procedure RightDockedClick(Sender: TObject);
    procedure AllDockedClick(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure DefaultClick(Sender: TObject);
    procedure DelphiDockStyleClick(Sender: TObject);
    procedure VCDockStyleClick(Sender: TObject);
    procedure VIDDockStyleClick(Sender: TObject);
  private
    { Private declarations }
    FForm1Count,
    FForm2Count,
    FForm3Count: Integer;
    procedure AddItemToShowDockMenu(AForm: TForm);
    procedure ShowDockWindowMenuClick(Sender: TObject);
//    procedure WMSettingChange(var Message: TMessage); message WM_SETTINGCHANGE;
  public
    { Public declarations }
  end;

const
  BoolStr: array[Boolean] of string =
    ('FALSE', 'TRUE');

var
  MainForm: TMainForm;

implementation

uses Unit1, Unit2, Unit3, SupportProc;

{$R *.DFM}

procedure TMainForm.DockForm1Click(Sender: TObject);
var Form: TForm1;
begin
  Form := TForm1.Create(Application);
  Form.Caption := Form.Caption + ' _ ' + IntToStr(FForm1Count);
  Inc(FForm1Count);
  AddItemToShowDockMenu(Form);
end;

procedure TMainForm.DockForm2Click(Sender: TObject);
var Form: TForm2;
begin
  Form := TForm2.Create(Application);
  Form.Caption := Form.Caption + ' _ ' + IntToStr(FForm2Count);
  Inc(FForm2Count);
  AddItemToShowDockMenu(Form);
end;

procedure TMainForm.DockForm3Click(Sender: TObject);
var Form: TForm3;
begin
  Form := TForm3.Create(Self);
  Form.Caption := Form.Caption + ' _ ' + IntToStr(FForm3Count);
  Inc(FForm3Count);
  AddItemToShowDockMenu(Form);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FForm1Count := 0;
  FForm2Count := 0;
  FForm3Count := 0;
  TopDocked.Checked := lbDockServer1.TopDock;
  BottomDocked.Checked := lbDockServer1.BottomDock;
  LeftDocked.Checked := lbDockServer1.LeftDock;
  RightDocked.Checked := lbDockServer1.RightDock;
  AllDocked.Checked := lbDockServer1.EnableDock;
  Memo1.WordWrap := True;
end;

procedure TMainForm.AddItemToShowDockMenu(AForm: TForm);
var
  AMenuItem: TMenuItem;
begin
  AMenuItem := NewItem(AForm.Caption, 0, True, True,
    ShowDockWindowMenuClick, 0, '');
  ShowWindow_Menu.Add(AMenuItem);
  AMenuItem.Tag := Integer(AForm);
  AForm.Tag := Integer(AMenuItem);
end;

procedure TMainForm.ShowDockWindowMenuClick(Sender: TObject);
var MenuItem: TMenuItem;
  Form: TForm;
begin
  MenuItem := TMenuItem(Sender);
  Form := TForm(MenuItem.Tag);
  if MenuItem.Checked then
  begin
    if GetFormVisible(Form) then
    begin
      HideDockForm(Form);
      MenuItem.Checked := False;
    end else
    begin
      ShowDockForm(Form);
    end;
  end else
  begin
    ShowDockForm(Form);
    MenuItem.Checked := True;
  end;
//  MenuItem.Checked := not MenuItem.Checked;
end;

procedure TMainForm.N5Click(Sender: TObject);
var DockPage: TlbTabPageControl;
begin
  if PopupMenu1.PopupComponent is TlbTabPageControl then
  begin
    DockPage := PopupMenu1.PopupComponent as TlbTabPageControl;
    case TPopupMenu(Sender).Tag of
      1: DockPage.TabPosition := tpTop;
      2: DockPage.TabPosition := tpLeft;
      3: DockPage.TabPosition := tpBottom;
      4: DockPage.TabPosition := tpRight;
    end;
  end;
end;

procedure TMainForm.N10Click(Sender: TObject);
begin
  N10.Checked := not N10.Checked;
  if N10.Checked then
    SetDockPageControlPopupMenu(PopupMenu1)
  else SetDockPageControlPopupMenu(nil);
end;

procedure TMainForm.N11Click(Sender: TObject);
begin
  N11.Checked := not N11.Checked;
  if N11.Checked then
    SetDockPageControlHotTrack(True)
  else SetDockPageControlHotTrack(False);
end;

procedure TMainForm.bsToolWindow1Click(Sender: TObject);
begin
  case TMenuItem(Sender).Tag of
    1: SetTabDockHostBorderStyle(bsDialog);
    2: SetTabDockHostBorderStyle(bsNone);
    3: SetTabDockHostBorderStyle(bsSingle);
    4: SetTabDockHostBorderStyle(bsSizeable);
    5: SetTabDockHostBorderStyle(bsSizeToolWin);
    6: SetTabDockHostBorderStyle(bsToolWindow);
  end;
end;

procedure TMainForm.bsToolWindow2Click(Sender: TObject);
begin
  case TMenuItem(Sender).Tag of
    1: SetConjoinDockHostBorderStyle(bsDialog);
    2: SetConjoinDockHostBorderStyle(bsNone);
    3: SetConjoinDockHostBorderStyle(bsSingle);
    4: SetConjoinDockHostBorderStyle(bsSizeable);
    5: SetConjoinDockHostBorderStyle(bsSizeToolWin);
    6: SetConjoinDockHostBorderStyle(bsToolWindow);
  end;
end;

procedure TMainForm.SaveToFileClick(Sender: TObject);
begin
  SaveDockTreeToFile(ExtractFilePath(Application.ExeName) + 'DockInfo.ini');
end;

procedure TMainForm.LoadFromFileClick(Sender: TObject);
begin
  LoadDockTreeFromFile(ExtractFilePath(Application.ExeName) + 'DockInfo.ini');
end;

procedure TMainForm.SaveToRegClick(Sender: TObject);
begin
  SaveDockTreeToReg(HKEY_CURRENT_USER, '\Software\DockInfo');
end;

procedure TMainForm.LoadFromRegClick(Sender: TObject);
begin
  LoadDockTreeFromReg(HKEY_CURRENT_USER, '\Software\DockInfo');
end;

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

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

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

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

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

procedure TMainForm.Action1Execute(Sender: TObject);
begin
end;

{procedure TMainForm.WMSettingChange(var Message: TMessage);
begin
  Caption := Caption + IntToStr(Message.WParam) + ',';
end;}

procedure TMainForm.DefaultClick(Sender: TObject);
begin
  lbDockServer1.DockStyle := nil;
end;

procedure TMainForm.DelphiDockStyleClick(Sender: TObject);
begin
  lbDockServer1.DockStyle := lbDelphiDockStyle1;
end;

procedure TMainForm.VCDockStyleClick(Sender: TObject);
begin
  lbDockServer1.DockStyle := lbVCDockStyle1;
end;

procedure TMainForm.VIDDockStyleClick(Sender: TObject);
begin
  lbDockServer1.DockStyle := lbVIDDockStyle1;
end;

end.