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

View File

@ -13,11 +13,13 @@ type
{ TMainForm } { TMainForm }
TMainForm = class(TForm) TMainForm = class(TForm)
ShowHeaderCheckBox: TCheckBox;
ListBox1: TListBox; ListBox1: TListBox;
VirtualStringTree1: TVirtualStringTree; VirtualStringTree1: TVirtualStringTree;
procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer); procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer; procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean); State: TDragState; var Accept: Boolean);
procedure ShowHeaderCheckBoxChange(Sender: TObject);
procedure VirtualStringTree1DragDrop(Sender: TBaseVirtualTree; procedure VirtualStringTree1DragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; const Pt: TPoint; var Effect: Integer; Mode: TDropMode); Shift: TShiftState; const Pt: TPoint; var Effect: Integer; Mode: TDropMode);
@ -73,6 +75,14 @@ begin
Accept := (Source = VirtualStringTree1) or (Source = ListBox1); Accept := (Source = VirtualStringTree1) or (Source = ListBox1);
end; 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); procedure TMainForm.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var var
Node: PVirtualNode; Node: PVirtualNode;

View File

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

View File

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