* Update vtbasic demo to use utf8

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@660 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2009-01-12 00:57:10 +00:00
parent 6f975e1206
commit 26a1d72de5
12 changed files with 105 additions and 104 deletions

View File

@ -1,10 +1,8 @@
object frmMain: TfrmMain
Left = 354
Left = 220
Height = 254
Top = 441
Top = 220
Width = 401
HorzScrollBar.Page = 400
VertScrollBar.Page = 253
ActiveControl = VT
Caption = 'Virtual Treeview Examples'
ClientHeight = 254
@ -14,7 +12,7 @@ object frmMain: TfrmMain
OnCreate = FormCreate
OnDestroy = FormDestroy
Position = poDefaultPosOnly
LCLVersion = '0.9.25'
LCLVersion = '0.9.27'
object panMain: TPanel
Height = 254
Width = 401
@ -38,6 +36,7 @@ object frmMain: TfrmMain
Font.Height = -11
Font.Name = 'Tahoma'
ParentColor = False
ParentFont = False
end
object VT: TVirtualStringTree
Left = 7
@ -46,6 +45,8 @@ object frmMain: TfrmMain
Width = 387
Align = alClient
BorderStyle = bsSingle
DefaultText = 'Node'
Header.Columns = <>
Header.Font.Height = -11
Header.Font.Name = 'MS Shell Dlg 2'
Header.MainColumn = -1
@ -61,7 +62,6 @@ object frmMain: TfrmMain
OnGetImageIndex = VTGetImageIndex
OnGetNodeDataSize = VTGetNodeDataSize
OnInitNode = VTInitNode
Columns = <>
end
object panBase: TPanel
Left = 7
@ -85,27 +85,27 @@ object frmMain: TfrmMain
end
object chkRadioButtons: TCheckBox
Left = 85
Height = 24
Height = 17
Top = 8
Width = 127
Width = 87
Caption = 'Radio Buttons'
OnClick = chkRadioButtonsClick
TabOrder = 0
end
object chkChangeHeight: TCheckBox
Left = 184
Height = 24
Height = 17
Top = 8
Width = 109
Width = 76
Caption = 'Vary Height'
OnClick = chkChangeHeightClick
TabOrder = 1
end
object chkHotTrack: TCheckBox
Left = 11
Height = 24
Height = 17
Top = 8
Width = 95
Width = 66
Caption = 'Hot Track'
OnClick = chkHotTrackClick
TabOrder = 2

View File

@ -41,7 +41,7 @@ TfrmMain =
procedure VTGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
procedure VTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var CellText: UTF8String);
procedure VTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
procedure VTDblClick(Sender: TObject);
@ -105,7 +105,7 @@ implementation
end;
procedure TfrmMain.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String);
begin
Celltext := FCaptions[Node.Index]; {this is where we say what the text to display}
end;

View File

@ -41,7 +41,6 @@ object frmVTCheckList: TfrmVTCheckList
OnGetText = VTGetText
OnGetNodeDataSize = VTGetNodeDataSize
OnInitNode = VTInitNode
Columns = <>
end
object panBase: TPanel
Left = 7

View File

@ -36,7 +36,7 @@ interface
procedure VTGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String);
procedure VTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
procedure btnOkClick(Sender: TObject);
@ -127,7 +127,7 @@ implementation
end;
procedure TfrmVTCheckList.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String);
begin
Celltext := FCaptions[Node.Index]; {top-level}
end;

View File

@ -1,10 +1,8 @@
object frmVTDBExample: TfrmVTDBExample
Left = 448
Left = 132
Height = 482
Top = 124
Top = 132
Width = 553
HorzScrollBar.Page = 552
VertScrollBar.Page = 481
ActiveControl = VT
Caption = 'Database Test'
ClientHeight = 482
@ -15,12 +13,12 @@ object frmVTDBExample: TfrmVTDBExample
OnClose = FormClose
OnCreate = FormCreate
Position = poDefaultPosOnly
LCLVersion = '0.9.25'
LCLVersion = '0.9.27'
object Label1: TLabel
Left = 12
Height = 17
Height = 14
Top = 12
Width = 171
Width = 117
Caption = 'Last operation duration:'
ParentColor = False
end
@ -44,8 +42,28 @@ object frmVTDBExample: TfrmVTDBExample
Colors.FocusedSelectionColor = 16756912
Colors.HotColor = clBlue
DefaultNodeHeight = 22
DefaultText = 'Node'
Font.Height = -11
Font.Name = 'Tahoma'
Header.Columns = <
item
ImageIndex = 3
Layout = blGlyphRight
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coResizable, coShowDropMark, coVisible]
Position = 1
Text = 'Company'
Width = 200
end
item
Position = 2
Text = 'Contact'
Width = 150
end
item
Alignment = taCenter
Text = 'Status'
Width = 42
end>
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Images = imgMaster
@ -55,6 +73,7 @@ object frmVTDBExample: TfrmVTDBExample
Images = imgMaster
IncrementalSearch = isAll
LineMode = lmBands
ParentFont = False
TabOrder = 0
TextMargin = 3
TreeOptions.AnimationOptions = [toAnimatedToggle]
@ -76,25 +95,6 @@ object frmVTDBExample: TfrmVTDBExample
OnInitChildren = VTInitChildren
OnInitNode = VTInitNode
OnNewText = VTNewText
Columns = <
item
ImageIndex = 3
Layout = blGlyphRight
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coResizable, coShowDropMark, coVisible]
Position = 1
Width = 200
WideText = 'Company'
end
item
Position = 2
Width = 150
WideText = 'Contact'
end
item
Alignment = taCenter
Width = 42
WideText = 'Status'
end>
end
object Panel2: TPanel
Left = 7
@ -108,36 +108,39 @@ object frmVTDBExample: TfrmVTDBExample
TabOrder = 1
object Label2: TLabel
Left = 16
Height = 17
Height = 14
Top = 12
Width = 98
Width = 65
Caption = 'Add Node(s):'
Font.Color = clBlue
Font.Height = -11
Font.Name = 'Tahoma'
ParentColor = False
ParentFont = False
end
object Label3: TLabel
Left = 168
Height = 17
Height = 14
Top = 5
Width = 50
Width = 33
Caption = 'Toggle'
Font.Color = clBlue
Font.Height = -11
Font.Name = 'Tahoma'
ParentColor = False
ParentFont = False
end
object Label4: TLabel
Left = 239
Height = 17
Height = 14
Top = 5
Width = 57
Width = 38
Caption = 'Options'
Font.Color = clBlue
Font.Height = -11
Font.Name = 'Tahoma'
ParentColor = False
ParentFont = False
end
object Bevel1: TBevel
Left = 228
@ -147,15 +150,16 @@ object frmVTDBExample: TfrmVTDBExample
end
object Label5: TLabel
Left = 307
Height = 17
Height = 14
Top = 6
Width = 292
Width = 197
Alignment = taCenter
Caption = '(Tip: Start typing for incremental search)'
Font.Color = clRed
Font.Height = -11
Font.Name = 'Tahoma'
ParentColor = False
ParentFont = False
end
object ed: TEdit
Left = 16
@ -198,9 +202,9 @@ object frmVTDBExample: TfrmVTDBExample
end
object chkShowIDs: TCheckBox
Left = 244
Height = 24
Height = 17
Top = 35
Width = 86
Width = 60
Caption = 'Show ID'
OnClick = chkShowIDsClick
TabOrder = 4
@ -217,18 +221,18 @@ object frmVTDBExample: TfrmVTDBExample
end
object chkAllVisible: TCheckBox
Left = 429
Height = 24
Height = 17
Top = 35
Width = 92
Width = 63
Caption = 'All Visible'
OnClick = chkAllVisibleClick
TabOrder = 6
end
object chkDynHt: TCheckBox
Left = 324
Height = 24
Height = 17
Top = 35
Width = 139
Width = 94
Caption = 'Dynamic Height'
OnClick = chkDynHtClick
TabOrder = 7

View File

@ -55,7 +55,7 @@ interface
procedure AddButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var Text: WideString);
var Text: UTF8String);
procedure VTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure VTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
@ -72,7 +72,7 @@ interface
procedure VTCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
procedure VTGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
procedure VTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
procedure VTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: UTF8String);
procedure VTInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
procedure btnHasChildrenClick(Sender: TObject);
procedure btnToggleVisibilityClick(Sender: TObject);
@ -80,7 +80,7 @@ interface
procedure VTFocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode;
OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean);
procedure chkDynHtClick(Sender: TObject);
procedure VTIncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const SearchText: WideString;
procedure VTIncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const SearchText: UTF8String;
var Result: Integer);
private
@ -214,7 +214,7 @@ implementation
Finalize( Data^ );
end;
procedure TfrmVTDBExample.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var Text: WideString);
procedure TfrmVTDBExample.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var Text: UTF8String);
var
Data : PBasicNodeRec;
bnd : TBasicNodeAddData;
@ -369,7 +369,7 @@ implementation
end;
procedure TfrmVTDBExample.VTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; NewText: WideString);
Column: TColumnIndex; NewText: UTF8String);
var
Data : PBasicNodeRec;
begin
@ -483,7 +483,7 @@ implementation
end;
procedure TfrmVTDBExample.VTIncrementalSearch(Sender: TBaseVirtualTree;
Node: PVirtualNode; const SearchText: WideString; var Result: Integer);
Node: PVirtualNode; const SearchText: UTF8String; var Result: Integer);
function Min(const A, B: Integer): Integer; {save us linking in math.pas}
begin
@ -495,12 +495,12 @@ implementation
var
sCompare1, sCompare2 : string;
DisplayText : WideString;
DisplayText : UTF8String;
begin
VT.IncrementalSearchDirection := sdForward; // note can be backward
// Note: This code requires a proper Unicode/WideString comparation routine which I did not want to link here for
// Note: This code requires a proper Unicode/UTF8String comparation routine which I did not want to link here for
// size and clarity reasons. For now strings are (implicitely) converted to ANSI to make the comparation work.
// Search is not case sensitive.
VTGetText( Sender, Node, 0 {Column}, ttNormal, DisplayText );

View File

@ -30,7 +30,7 @@ interface
TPropertyData =
record
ValueType: TValueType;
Value : WideString; // This value can actually be a date or a number too.
Value : UTF8String; // This value can actually be a date or a number too.
Changed : Boolean;
end;
PPropertyData = ^TPropertyData;
@ -324,7 +324,7 @@ implementation
var
Data: PPropertyData;
Buffer: array[0..1024] of Char;
S: WideString;
S: UTF8String;
P: TPoint;
Dummy: Integer;
begin
@ -431,7 +431,7 @@ implementation
var
Data: PGridData;
Buffer: array[0..1024] of Char;
S: WideString;
S: UTF8String;
I: Integer;
begin

View File

@ -1,7 +1,7 @@
object frmVTNoData: TfrmVTNoData
Left = 220
Left = 154
Height = 346
Top = 220
Top = 154
Width = 401
ActiveControl = VT
Caption = 'Basic VT as a Tree (no node data used)'
@ -32,6 +32,8 @@ object frmVTNoData: TfrmVTNoData
Width = 387
Align = alClient
BorderStyle = bsSingle
DefaultText = 'Node'
Header.Columns = <>
Header.Font.Height = -11
Header.Font.Name = 'MS Shell Dlg 2'
Header.MainColumn = -1
@ -48,7 +50,6 @@ object frmVTNoData: TfrmVTNoData
OnGetNodeDataSize = VTGetNodeDataSize
OnInitChildren = VTInitChildren
OnInitNode = VTInitNode
Columns = <>
end
object panBase: TPanel
Left = 7
@ -75,27 +76,27 @@ object frmVTNoData: TfrmVTNoData
end
object chkCheckBoxes: TCheckBox
Left = 180
Height = 19
Height = 17
Top = 7
Width = 87
Width = 81
Caption = 'Check Boxes'
OnClick = chkCheckBoxesClick
TabOrder = 0
end
object chkFullExpand: TCheckBox
Left = 100
Height = 19
Height = 17
Top = 7
Width = 81
Width = 75
Caption = 'Full Expand'
OnClick = chkFullExpandClick
TabOrder = 1
end
object chkShowLevel: TCheckBox
Left = 271
Height = 19
Height = 17
Top = 7
Width = 80
Width = 74
Caption = 'Show Level'
OnClick = chkShowLevelClick
TabOrder = 2

View File

@ -40,7 +40,7 @@ interface
procedure VTGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String);
procedure VTGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
procedure VTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
@ -128,7 +128,7 @@ implementation
end;
procedure TfrmVTNoData.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String);
const
aAnimOpts : array[0..Ord(High(TVTAnimationOption ))] of string[25] =
( 'Animated Toggle' );

View File

@ -1,7 +1,7 @@
object frmVTPropEdit: TfrmVTPropEdit
Left = 198
Left = 176
Height = 601
Top = 198
Top = 176
Width = 458
ActiveControl = VT
Caption = 'Property Editor'
@ -34,7 +34,20 @@ object frmVTPropEdit: TfrmVTPropEdit
Color = 15921906
Colors.BorderColor = clWindowText
Colors.HotColor = clBlack
DefaultText = 'Node'
Header.AutoSizeIndex = 1
Header.Columns = <
item
Text = 'Properties'
Width = 186
end
item
Color = clWhite
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coResizable, coShowDropMark, coVisible]
Position = 1
Text = 'Values'
Width = 258
end>
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Height = 18
@ -64,18 +77,6 @@ object frmVTPropEdit: TfrmVTPropEdit
OnGetNodeDataSize = VTGetNodeDataSize
OnInitChildren = VTInitChildren
OnInitNode = VTInitNode
Columns = <
item
Width = 186
WideText = 'Properties'
end
item
Color = clWhite
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coResizable, coShowDropMark, coVisible]
Position = 1
Width = 258
WideText = 'Values'
end>
end
object cmb: TComboBox
Left = 7
@ -118,9 +119,9 @@ object frmVTPropEdit: TfrmVTPropEdit
TabOrder = 2
object chkTriangleButtons: TCheckBox
Left = 321
Height = 19
Height = 17
Top = 8
Width = 104
Width = 98
Caption = 'Triangle Buttons'
OnClick = chkTriangleButtonsClick
TabOrder = 0

View File

@ -82,7 +82,7 @@ interface
procedure VTCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
procedure VTEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var Text: WideString);
var Text: UTF8String);
procedure VTInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
procedure VTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
@ -241,7 +241,7 @@ implementation
end;
procedure TfrmVTPropEdit.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var Text: WideString);
TextType: TVSTTextType; var Text: UTF8String);
var
Data: PPropertyData;
ped : TVTPropEditData;

View File

@ -2,10 +2,11 @@
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="6"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
@ -52,7 +53,7 @@
<ComponentName Value="frmMain"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="Main.lrs"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit1>
<Unit2>
@ -66,7 +67,6 @@
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<ResourceFilename Value="VTNoData.lrs"/>
<UnitName Value="VTNoData"/>
</Unit3>
<Unit4>
@ -75,7 +75,6 @@
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<ResourceFilename Value="VTPropEdit.lrs"/>
<UnitName Value="VTPropEdit"/>
</Unit4>
<Unit5>
@ -88,7 +87,6 @@
<ComponentName Value="frmViewCode"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="ViewCode.lrs"/>
<UnitName Value="ViewCode"/>
</Unit6>
<Unit7>
@ -96,7 +94,6 @@
<ComponentName Value="frmVTCheckList"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="VTCheckList.lrs"/>
<UnitName Value="VTCheckList"/>
</Unit7>
<Unit8>
@ -105,7 +102,6 @@
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<ResourceFilename Value="VTDBExample.lrs"/>
<UnitName Value="VTDBExample"/>
</Unit8>
</Units>