pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

* Update ole demo to use utf8

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@663 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2009-01-18 02:31:57 +00:00
parent d818eb1292
commit 66b736e324
3 changed files with 44 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
components/virtualtreeview-unstable/demos/ole/Main.lfm
View File

@ -101,6 +101,7 @@ object MainForm: TMainForm
Colors.BorderColor = clWindowText Colors.BorderColor = clWindowText
Colors.HotColor = clBlack Colors.HotColor = clBlack
DefaultNodeHeight = 24 DefaultNodeHeight = 24
DefaultText = 'Node'
DragOperations = [doCopy, doMove, doLink] DragOperations = [doCopy, doMove, doLink]
DragType = dtVCL DragType = dtVCL
DragWidth = 350 DragWidth = 350
@ -108,6 +109,7 @@ 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.Columns = <>
Header.Font.Height = -11 Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif' Header.Font.Name = 'MS Sans Serif'
Header.MainColumn = -1 Header.MainColumn = -1
@ -125,10 +127,10 @@ object MainForm: TMainForm
OnDragAllowed = Tree2DragAllowed OnDragAllowed = Tree2DragAllowed
OnDragOver = TreeDragOver OnDragOver = TreeDragOver
OnDragDrop = TreeDragDrop OnDragDrop = TreeDragDrop
OnFreeNode = TreeFreeNode
OnGetText = Tree1GetText OnGetText = Tree1GetText
OnInitNode = TreeInitNode OnInitNode = TreeInitNode
OnNewText = Tree1NewText OnNewText = Tree1NewText
Columns = <>
end end
object Tree1: TVirtualStringTree object Tree1: TVirtualStringTree
Left = 8 Left = 8
@ -147,12 +149,14 @@ object MainForm: TMainForm
Colors.BorderColor = clWindowText Colors.BorderColor = clWindowText
Colors.HotColor = clBlack Colors.HotColor = clBlack
DefaultNodeHeight = 24 DefaultNodeHeight = 24
DefaultText = 'Node'
DragMode = dmAutomatic DragMode = dmAutomatic
DragWidth = 350 DragWidth = 350
EditDelay = 500 EditDelay = 500
Font.CharSet = ANSI_CHARSET Font.CharSet = ANSI_CHARSET
Font.Height = -11 Font.Height = -11
Font.Name = 'Verdana' Font.Name = 'Verdana'
Header.Columns = <>
Header.Font.Height = -11 Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif' Header.Font.Name = 'MS Sans Serif'
Header.MainColumn = -1 Header.MainColumn = -1
@ -169,10 +173,10 @@ object MainForm: TMainForm
TreeOptions.SelectionOptions = [toMultiSelect] TreeOptions.SelectionOptions = [toMultiSelect]
OnDragOver = TreeDragOver OnDragOver = TreeDragOver
OnDragDrop = TreeDragDrop OnDragDrop = TreeDragDrop
OnFreeNode = TreeFreeNode
OnGetText = Tree1GetText OnGetText = Tree1GetText
OnInitNode = TreeInitNode OnInitNode = TreeInitNode
OnNewText = Tree1NewText OnNewText = Tree1NewText
Columns = <>
end end
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 12 Left = 12
@ -185,7 +189,7 @@ object MainForm: TMainForm
TabOrder = 5 TabOrder = 5
object RichTextTabSheet: TTabSheet object RichTextTabSheet: TTabSheet
Caption = 'Rich text' Caption = 'Rich text'
ClientHeight = 219 ClientHeight = 217
ClientWidth = 677 ClientWidth = 677
ImageIndex = 1 ImageIndex = 1
object Label3: TLabel object Label3: TLabel
@ -199,7 +203,7 @@ object MainForm: TMainForm
end end
object LogTabSheet: TTabSheet object LogTabSheet: TTabSheet
Caption = 'Drag''n drop operation log' Caption = 'Drag''n drop operation log'
ClientHeight = 219 ClientHeight = 217
ClientWidth = 677 ClientWidth = 677
object Label7: TLabel object Label7: TLabel
Left = 6 Left = 6
@ -213,13 +217,12 @@ object MainForm: TMainForm
end end
object LogListBox: TListBox object LogListBox: TListBox
Left = 4 Left = 4
Height = 145 Height = 143
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 = 661
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
DragMode = dmAutomatic DragMode = dmAutomatic
ItemHeight = 15
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 0 TabOrder = 0
@ -238,7 +241,7 @@ object MainForm: TMainForm
end end
object TabSheet2: TTabSheet object TabSheet2: TTabSheet
Caption = 'More info' Caption = 'More info'
ClientHeight = 219 ClientHeight = 217
ClientWidth = 677 ClientWidth = 677
ImageIndex = 3 ImageIndex = 3
object Label4: TLabel object Label4: TLabel

36
components/virtualtreeview-unstable/demos/ole/Main.pas
View File

@ -14,6 +14,9 @@ uses
LResources, vtLogger,ipcchannel; LResources, vtLogger,ipcchannel;
type type
{ TMainForm }
TMainForm = class(TForm) TMainForm = class(TForm)
ActionList1: TActionList; ActionList1: TActionList;
CutAction: TAction; CutAction: TAction;
@ -48,15 +51,16 @@ 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 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: WideString); var Text: UTF8String);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure TreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; procedure TreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject;
Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure Button2Click(Sender: TObject); procedure Button2Click(Sender: TObject);
procedure TreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; procedure TreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates); var InitialStates: TVirtualNodeInitStates);
procedure Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Text: WideString); procedure Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Text: UTF8String);
procedure Button3Click(Sender: TObject); procedure Button3Click(Sender: TObject);
procedure Tree2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); procedure Tree2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
procedure TreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; procedure TreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState;
@ -65,7 +69,7 @@ type
var ItemColor: TColor; var EraseAction: TItemEraseAction); var ItemColor: TColor; var EraseAction: TItemEraseAction);
private private
procedure AddUnicodeText(DataObject: IDataObject; Target: TVirtualStringTree; Mode: TVTNodeAttachMode); procedure AddUnicodeText(DataObject: IDataObject; Target: TVirtualStringTree; Mode: TVTNodeAttachMode);
procedure AddVCLText(Target: TVirtualStringTree; const Text: WideString; Mode: TVTNodeAttachMode); procedure AddVCLText(Target: TVirtualStringTree; const Text: UTF8String; Mode: TVTNodeAttachMode);
function FindCPFormatDescription(CPFormat: Word): string; function FindCPFormatDescription(CPFormat: Word): string;
procedure InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray; Effect: Integer; procedure InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray; Effect: Integer;
Mode: TVTNodeAttachMode); Mode: TVTNodeAttachMode);
@ -86,7 +90,7 @@ uses
type type
PNodeData = ^TNodeData; PNodeData = ^TNodeData;
TNodeData = record TNodeData = record
Caption: WideString; Caption: UTF8String;
end; end;
procedure ReleaseStgMedium(_para1:LPSTGMEDIUM);stdcall;external 'ole32.dll' name 'ReleaseStgMedium'; procedure ReleaseStgMedium(_para1:LPSTGMEDIUM);stdcall;external 'ole32.dll' name 'ReleaseStgMedium';
@ -183,10 +187,18 @@ begin
// RichEdit1.PasteFromClipboard; // RichEdit1.PasteFromClipboard;
end; end;
procedure TMainForm.TreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data: PNodeData;
begin
Data := Sender.GetNodeData(Node);
Data^.Caption := '';
end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; procedure TMainForm.Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var Text: WideString); var Text: UTF8String);
var var
Data: PNodeData; Data: PNodeData;
@ -244,6 +256,7 @@ var
Medium: TStgMedium; Medium: TStgMedium;
OLEData, OLEData,
Head, Tail: PWideChar; Head, Tail: PWideChar;
WideStr: WideString;
TargetNode, TargetNode,
Node: PVirtualNode; Node: PVirtualNode;
Data: PNodeData; Data: PNodeData;
@ -290,8 +303,10 @@ begin
begin begin
// add a new node if we got a non-empty caption // add a new node if we got a non-empty caption
Node := Target.InsertNode(TargetNode, Mode); Node := Target.InsertNode(TargetNode, Mode);
Target.ValidateNode(Node, False);
Data := Target.GetNodeData(Node); Data := Target.GetNodeData(Node);
SetString(Data.Caption, Head, Tail - Head); SetString(WideStr, Head, Tail - Head);
Data.Caption := UTF8Decode(WideStr);
end; end;
// Skip any tab. // Skip any tab.
if Tail^ = #9 then if Tail^ = #9 then
@ -317,13 +332,14 @@ end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.AddVCLText(Target: TVirtualStringTree; const Text: WideString; Mode: TVTNodeAttachMode); procedure TMainForm.AddVCLText(Target: TVirtualStringTree; const Text: UTF8String; Mode: TVTNodeAttachMode);
// This method is called when the drop handler gets called with a VCL drag source. // This method is called when the drop handler gets called with a VCL drag source.
// The given text is retrieved and splitted in lines. // The given text is retrieved and splitted in lines.
var var
Head, Tail: PWideChar; Head, Tail: PWideChar;
WideStr: WideString;
TargetNode, TargetNode,
Node: PVirtualNode; Node: PVirtualNode;
Data: PNodeData; Data: PNodeData;
@ -347,8 +363,10 @@ begin
begin begin
// add a new node if we got a non-empty caption // add a new node if we got a non-empty caption
Node := Target.InsertNode(TargetNode, Mode); Node := Target.InsertNode(TargetNode, Mode);
Target.ValidateNode(Node, False);
Data := Target.GetNodeData(Node); Data := Target.GetNodeData(Node);
SetString(Data.Caption, Head, Tail - Head); SetString(WideStr, Head, Tail - Head);
Data.Caption := UTF8Decode(WideStr);
end; end;
// skip line separators // skip line separators
if Tail^ = #13 then if Tail^ = #13 then
@ -550,7 +568,7 @@ end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Text: WideString); procedure TMainForm.Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Text: UTF8String);
var var
Data: PNodeData; Data: PNodeData;

14
components/virtualtreeview-unstable/demos/ole/ole.lpi
View File

@ -2,10 +2,11 @@
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<Version Value="6"/> <Version Value="7"/>
<General> <General>
<Flags> <Flags>
<AlwaysBuild Value="False"/> <AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
@ -45,7 +46,6 @@
<HasResources Value="True"/> <HasResources Value="True"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<ResourceFilename Value="Main.lrs"/>
<UnitName Value="Main"/> <UnitName Value="Main"/>
</Unit1> </Unit1>
</Units> </Units>
@ -53,15 +53,15 @@
<CompilerOptions> <CompilerOptions>
<Version Value="8"/> <Version Value="8"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking> <Linking>
<Debugging> <Debugging>
<UseHeaptrc Value="True"/> <UseHeaptrc Value="True"/>
</Debugging> </Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking> </Linking>
<Other> <Other>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>