demos: add show header options to dragdrop examples + minor GUI tweaks

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2557 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2012-10-14 22:34:47 +00:00
parent c66386067c
commit d1f7228ff3
4 changed files with 104 additions and 40 deletions

View File

@ -1,17 +1,17 @@
object MainForm: TMainForm
Left = 569
Height = 362
Height = 349
Top = 219
Width = 461
Width = 454
Caption = 'VTV Drag and Drop'
ClientHeight = 362
ClientWidth = 461
Position = poDesktopCenter
ClientHeight = 349
ClientWidth = 454
Position = poScreenCenter
LCLVersion = '1.1'
object VirtualStringTree1: TVirtualStringTree
Left = 8
Height = 315
Top = 24
Top = 26
Width = 200
DefaultText = 'Node'
DragMode = dmAutomatic
@ -30,10 +30,10 @@ object MainForm: TMainForm
OnInitNode = VirtualStringTree1InitNode
end
object ListBox1: TListBox
Left = 256
Left = 248
Height = 315
Top = 24
Width = 192
Top = 26
Width = 200
DragMode = dmAutomatic
Items.Strings = (
'List Item 1'
@ -49,4 +49,13 @@ object MainForm: TMainForm
ScrollWidth = 190
TabOrder = 1
end
object ShowHeaderCheckBox: TCheckBox
Left = 8
Height = 19
Top = 3
Width = 90
Caption = 'Show Header'
OnChange = ShowHeaderCheckBoxChange
TabOrder = 2
end
end

View File

@ -13,11 +13,13 @@ type
{ TMainForm }
TMainForm = class(TForm)
ShowHeaderCheckBox: TCheckBox;
ListBox1: TListBox;
VirtualStringTree1: TVirtualStringTree;
procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ShowHeaderCheckBoxChange(Sender: TObject);
procedure VirtualStringTree1DragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; const Pt: TPoint; var Effect: Integer; Mode: TDropMode);
@ -73,6 +75,14 @@ begin
Accept := (Source = VirtualStringTree1) or (Source = ListBox1);
end;
procedure TMainForm.ShowHeaderCheckBoxChange(Sender: TObject);
begin
if ShowHeaderCheckBox.Checked then
VirtualStringTree1.Header.Options := VirtualStringTree1.Header.Options + [hoVisible]
else
VirtualStringTree1.Header.Options := VirtualStringTree1.Header.Options - [hoVisible];
end;
procedure TMainForm.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
Node: PVirtualNode;

View File

@ -1,23 +1,23 @@
object MainForm: TMainForm
Left = 192
Height = 575
Top = 261
Left = 356
Height = 574
Top = 70
Width = 790
ActiveControl = Button1
Caption = 'Demo for drag''n drop and clipboard transfers'
ClientHeight = 575
ClientHeight = 574
ClientWidth = 790
Font.CharSet = ANSI_CHARSET
Font.Height = -12
Font.Name = 'Arial'
OnCreate = FormCreate
LCLVersion = '0.9.27'
LCLVersion = '1.1'
Visible = True
object Label1: TLabel
Left = 10
Height = 15
Left = 8
Height = 14
Top = 96
Width = 239
Width = 238
Caption = 'Tree 1 uses OLE when initiating a drag operation.'
Font.CharSet = ANSI_CHARSET
Font.Height = -11
@ -26,7 +26,7 @@ object MainForm: TMainForm
ParentFont = False
end
object Label2: TLabel
Left = 360
Left = 364
Height = 33
Top = 80
Width = 337
@ -40,7 +40,9 @@ object MainForm: TMainForm
WordWrap = True
end
object Panel3: TPanel
Left = 0
Height = 69
Top = 0
Width = 790
Align = alTop
ClientHeight = 69
@ -67,7 +69,7 @@ object MainForm: TMainForm
object Button1: TButton
Left = 705
Height = 25
Top = 527
Top = 526
Width = 75
Anchors = [akRight, akBottom]
BorderSpacing.InnerBorder = 4
@ -92,7 +94,6 @@ object MainForm: TMainForm
Height = 180
Top = 116
Width = 330
BorderStyle = bsSingle
ClipboardFormats.Strings = (
'Plain text'
'Unicode text'
@ -109,9 +110,12 @@ object MainForm: TMainForm
Font.CharSet = ANSI_CHARSET
Font.Height = -11
Font.Name = 'Lucida Sans Unicode'
Header.AutoSizeIndex = 0
Header.Columns = <>
Header.DefaultHeight = 17
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Height = 24
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
HintMode = hmTooltip
@ -137,7 +141,6 @@ object MainForm: TMainForm
Height = 180
Top = 116
Width = 330
BorderStyle = bsSingle
ClipboardFormats.Strings = (
'CSV'
'HTML Format'
@ -156,9 +159,12 @@ object MainForm: TMainForm
Font.CharSet = ANSI_CHARSET
Font.Height = -11
Font.Name = 'Verdana'
Header.AutoSizeIndex = 0
Header.Columns = <>
Header.DefaultHeight = 17
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Height = 24
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
HintMode = hmTooltip
@ -179,32 +185,33 @@ object MainForm: TMainForm
OnNewText = Tree1NewText
end
object PageControl1: TPageControl
Left = 12
Height = 245
Top = 308
Width = 685
ActivePage = TabSheet1
Left = 8
Height = 224
Top = 328
Width = 686
ActivePage = LogTabSheet
Anchors = [akTop, akLeft, akBottom]
TabIndex = 3
TabIndex = 1
TabOrder = 5
object RichTextTabSheet: TTabSheet
Caption = 'Rich text'
ClientHeight = 217
ClientWidth = 677
ClientHeight = 196
ClientWidth = 678
ImageIndex = 1
TabVisible = False
object Label3: TLabel
Left = 8
Height = 15
Top = 8
Width = 453
Width = 452
Caption = 'You can use the rich edit control as source and as target. It initiates OLE drag'' drop.'
ParentColor = False
end
end
object LogTabSheet: TTabSheet
Caption = 'Drag''n drop operation log'
ClientHeight = 217
ClientWidth = 677
ClientHeight = 196
ClientWidth = 678
object Label7: TLabel
Left = 6
Height = 41
@ -217,18 +224,19 @@ object MainForm: TMainForm
end
object LogListBox: TListBox
Left = 4
Height = 143
Height = 122
Hint = 'Use the list box to initiate a VCL drag''n drop.'
Top = 56
Width = 661
Width = 662
Anchors = [akTop, akLeft, akRight, akBottom]
DragMode = dmAutomatic
ItemHeight = 0
ParentShowHint = False
ShowHint = True
TabOrder = 0
end
object Button2: TButton
Left = 590
Left = 591
Height = 25
Top = 10
Width = 75
@ -241,7 +249,7 @@ object MainForm: TMainForm
end
object TabSheet2: TTabSheet
Caption = 'More info'
ClientHeight = 217
ClientHeight = 197
ClientWidth = 677
ImageIndex = 3
object Label4: TLabel
@ -277,7 +285,7 @@ object MainForm: TMainForm
end
object TabSheet1: TTabSheet
Caption = 'Tips'
ClientHeight = 217
ClientHeight = 197
ClientWidth = 677
ImageIndex = 2
object Label8: TLabel
@ -302,24 +310,39 @@ object MainForm: TMainForm
end
end
end
object ShowHeader1CheckBox: TCheckBox
Left = 8
Height = 19
Top = 302
Width = 95
Caption = 'Show Header'
OnChange = ShowHeader1CheckBoxChange
TabOrder = 6
end
object ShowHeader2CheckBox: TCheckBox
Left = 364
Height = 19
Top = 302
Width = 95
Caption = 'Show Header'
OnChange = ShowHeader2CheckBoxChange
TabOrder = 7
end
object ActionList1: TActionList
left = 724
top = 156
object CutAction: TAction
Caption = 'Cut'
DisableIfNoHandler = True
OnExecute = CutActionExecute
ShortCut = 16472
end
object CopyAction: TAction
Caption = 'Copy'
DisableIfNoHandler = True
OnExecute = CopyActionExecute
ShortCut = 16451
end
object PasteAction: TAction
Caption = 'Paste'
DisableIfNoHandler = True
OnExecute = PasteActionExecute
ShortCut = 16470
end
@ -327,6 +350,8 @@ object MainForm: TMainForm
object FontDialog: TFontDialog
Font.Height = -11
Font.Name = 'MS Sans Serif'
MinFontSize = 0
MaxFontSize = 0
left = 756
top = 168
end

View File

@ -19,6 +19,7 @@ type
TMainForm = class(TForm)
ActionList1: TActionList;
ShowHeader1CheckBox: TCheckBox;
CutAction: TAction;
CopyAction: TAction;
PasteAction: TAction;
@ -27,6 +28,7 @@ type
Label6: TLabel;
Button1: TButton;
Button3: TButton;
ShowHeader2CheckBox: TCheckBox;
Tree2: TVirtualStringTree;
Label1: TLabel;
Tree1: TVirtualStringTree;
@ -51,6 +53,8 @@ type
procedure CutActionExecute(Sender: TObject);
procedure CopyActionExecute(Sender: TObject);
procedure PasteActionExecute(Sender: TObject);
procedure ShowHeader1CheckBoxChange(Sender: TObject);
procedure ShowHeader2CheckBoxChange(Sender: TObject);
procedure TreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var Text: String);
@ -187,6 +191,22 @@ begin
// RichEdit1.PasteFromClipboard;
end;
procedure TMainForm.ShowHeader1CheckBoxChange(Sender: TObject);
begin
if ShowHeader1CheckBox.Checked then
Tree1.Header.Options := Tree1.Header.Options + [hoVisible]
else
Tree1.Header.Options := Tree1.Header.Options - [hoVisible];
end;
procedure TMainForm.ShowHeader2CheckBoxChange(Sender: TObject);
begin
if ShowHeader2CheckBox.Checked then
Tree2.Header.Options := Tree2.Header.Options + [hoVisible]
else
Tree2.Header.Options := Tree2.Header.Options - [hoVisible];
end;
procedure TMainForm.TreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data: PNodeData;