Пример реализации Drag-and-Dock
Материал из DRKB
Пример реализации Drag-and-Dock[править | править код]
Пример реализации Drag-and-Dock
MainUnit.pas[править | править код]
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin;
type
TMainForm = class(TForm)
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ColorsBar: TToolBar;
WhiteBtn: TToolButton;
BlueBtn: TToolButton;
GreenBtn: TToolButton;
LimeBtn: TToolButton;
PurpleBtn: TToolButton;
RedBtn: TToolButton;
SoundsBar: TToolBar;
SoundBtn1: TToolButton;
SoundBtn2: TToolButton;
SoundBtn3: TToolButton;
TealBtn: TToolButton;
UndoBtn: TToolButton;
procedure WhiteBtnClick(Sender: TObject);
procedure BlueBtnClick(Sender: TObject);
procedure GreenBtnClick(Sender: TObject);
procedure LimeBtnClick(Sender: TObject);
procedure PurpleBtnClick(Sender: TObject);
procedure RedBtnClick(Sender: TObject);
procedure TealBtnClick(Sender: TObject);
procedure UndoBtnClick(Sender: TObject);
procedure SoundBtn1Click(Sender: TObject);
procedure SoundBtn2Click(Sender: TObject);
procedure SoundBtn3Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.WhiteBtnClick(Sender: TObject);
begin
MainForm.Color :=clWhite;
end;
procedure TMainForm.BlueBtnClick(Sender: TObject);
begin
MainForm.Color :=clBlue;
end;
procedure TMainForm.GreenBtnClick(Sender: TObject);
begin
MainForm.Color :=clGreen;
end;
procedure TMainForm.LimeBtnClick(Sender: TObject);
begin
MainForm.Color :=clLime;
end;
procedure TMainForm.PurpleBtnClick(Sender: TObject);
begin
MainForm.Color :=clPurple;
end;
procedure TMainForm.RedBtnClick(Sender: TObject);
begin
MainForm.Color :=clRed;
end;
procedure TMainForm.TealBtnClick(Sender: TObject);
begin
MainForm.Color :=clTeal;
end;
procedure TMainForm.UndoBtnClick(Sender: TObject);
begin
MainForm.Color :=clBtnFace;
end;
procedure TMainForm.SoundBtn1Click(Sender: TObject);
begin
Beep;
end;
procedure TMainForm.SoundBtn2Click(Sender: TObject);
begin
Beep;
Beep;
end;
procedure TMainForm.SoundBtn3Click(Sender: TObject);
begin
Beep;
Beep;
Beep;
end;
procedure TMainForm.ToolButton1Click(Sender: TObject);
begin
Close;
end;
end.
MainUnit.dfm[править | править код]
object MainForm: TMainForm
Left = 192
Top = 107
Width = 696
Height = 480
Caption = 'DemoDocking'
Color = clBtnFace
DockSite = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object CoolBar1: TCoolBar
Left = 0
Top = 0
Width = 688
Height = 97
Bands = <
item
Control = ToolBar1
ImageIndex = -1
MinHeight = 29
Width = 684
end
item
Control = ColorsBar
ImageIndex = -1
Width = 684
end
item
Control = SoundsBar
ImageIndex = -1
Width = 684
end>
object ToolBar1: TToolBar
Left = 9
Top = 0
Width = 671
Height = 29
ButtonHeight = 21
ButtonWidth = 88
Caption = 'ToolBar1'
DragKind = dkDock
DragMode = dmAutomatic
ShowCaptions = True
TabOrder = 0
object ToolButton1: TToolButton
Left = 0
Top = 2
Caption = 'Close Application'
ImageIndex = 0
OnClick = ToolButton1Click
end
end
object ColorsBar: TToolBar
Left = 9
Top = 31
Width = 671
Height = 25
ButtonHeight = 21
ButtonWidth = 60
Caption = 'ColorsBar'
DragKind = dkDock
DragMode = dmAutomatic
ShowCaptions = True
TabOrder = 1
object WhiteBtn: TToolButton
Left = 0
Top = 2
Caption = 'White'
ImageIndex = 0
OnClick = WhiteBtnClick
end
object BlueBtn: TToolButton
Left = 60
Top = 2
Caption = 'Blue'
ImageIndex = 1
OnClick = BlueBtnClick
end
object GreenBtn: TToolButton
Left = 120
Top = 2
Caption = 'Green'
ImageIndex = 2
OnClick = GreenBtnClick
end
object LimeBtn: TToolButton
Left = 180
Top = 2
Caption = 'Lime'
ImageIndex = 3
OnClick = LimeBtnClick
end
object PurpleBtn: TToolButton
Left = 240
Top = 2
Caption = 'Purple'
ImageIndex = 4
OnClick = PurpleBtnClick
end
object RedBtn: TToolButton
Left = 300
Top = 2
Caption = 'Red'
ImageIndex = 5
OnClick = RedBtnClick
end
object TealBtn: TToolButton
Left = 360
Top = 2
Caption = 'Teal'
ImageIndex = 6
OnClick = TealBtnClick
end
object UndoBtn: TToolButton
Left = 420
Top = 2
Caption = 'Undo Color'
ImageIndex = 7
OnClick = UndoBtnClick
end
end
object SoundsBar: TToolBar
Left = 9
Top = 58
Width = 671
Height = 25
ButtonHeight = 21
ButtonWidth = 63
Caption = 'SoundsBar'
DragKind = dkDock
DragMode = dmAutomatic
ShowCaptions = True
TabOrder = 2
object SoundBtn1: TToolButton
Left = 0
Top = 2
Caption = 'One Beep'
ImageIndex = 0
OnClick = SoundBtn1Click
end
object SoundBtn2: TToolButton
Left = 63
Top = 2
Caption = 'Two Beep'
ImageIndex = 1
OnClick = SoundBtn2Click
end
object SoundBtn3: TToolButton
Left = 126
Top = 2
Caption = 'Three Beep'
ImageIndex = 2
OnClick = SoundBtn3Click
end
end
end
end
DemoDocking.dpr[править | править код]
program DemoDocking;
uses
Forms,
MainUnit in 'MainUnit.pas' {MainForm};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.
Author: Akella
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00376