You've already forked lazarus-ccr
* Update ole demo to use utf8
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@663 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -101,6 +101,7 @@ object MainForm: TMainForm
|
||||
Colors.BorderColor = clWindowText
|
||||
Colors.HotColor = clBlack
|
||||
DefaultNodeHeight = 24
|
||||
DefaultText = 'Node'
|
||||
DragOperations = [doCopy, doMove, doLink]
|
||||
DragType = dtVCL
|
||||
DragWidth = 350
|
||||
@ -108,6 +109,7 @@ object MainForm: TMainForm
|
||||
Font.CharSet = ANSI_CHARSET
|
||||
Font.Height = -11
|
||||
Font.Name = 'Lucida Sans Unicode'
|
||||
Header.Columns = <>
|
||||
Header.Font.Height = -11
|
||||
Header.Font.Name = 'MS Sans Serif'
|
||||
Header.MainColumn = -1
|
||||
@ -125,10 +127,10 @@ object MainForm: TMainForm
|
||||
OnDragAllowed = Tree2DragAllowed
|
||||
OnDragOver = TreeDragOver
|
||||
OnDragDrop = TreeDragDrop
|
||||
OnFreeNode = TreeFreeNode
|
||||
OnGetText = Tree1GetText
|
||||
OnInitNode = TreeInitNode
|
||||
OnNewText = Tree1NewText
|
||||
Columns = <>
|
||||
end
|
||||
object Tree1: TVirtualStringTree
|
||||
Left = 8
|
||||
@ -147,12 +149,14 @@ object MainForm: TMainForm
|
||||
Colors.BorderColor = clWindowText
|
||||
Colors.HotColor = clBlack
|
||||
DefaultNodeHeight = 24
|
||||
DefaultText = 'Node'
|
||||
DragMode = dmAutomatic
|
||||
DragWidth = 350
|
||||
EditDelay = 500
|
||||
Font.CharSet = ANSI_CHARSET
|
||||
Font.Height = -11
|
||||
Font.Name = 'Verdana'
|
||||
Header.Columns = <>
|
||||
Header.Font.Height = -11
|
||||
Header.Font.Name = 'MS Sans Serif'
|
||||
Header.MainColumn = -1
|
||||
@ -169,10 +173,10 @@ object MainForm: TMainForm
|
||||
TreeOptions.SelectionOptions = [toMultiSelect]
|
||||
OnDragOver = TreeDragOver
|
||||
OnDragDrop = TreeDragDrop
|
||||
OnFreeNode = TreeFreeNode
|
||||
OnGetText = Tree1GetText
|
||||
OnInitNode = TreeInitNode
|
||||
OnNewText = Tree1NewText
|
||||
Columns = <>
|
||||
end
|
||||
object PageControl1: TPageControl
|
||||
Left = 12
|
||||
@ -185,7 +189,7 @@ object MainForm: TMainForm
|
||||
TabOrder = 5
|
||||
object RichTextTabSheet: TTabSheet
|
||||
Caption = 'Rich text'
|
||||
ClientHeight = 219
|
||||
ClientHeight = 217
|
||||
ClientWidth = 677
|
||||
ImageIndex = 1
|
||||
object Label3: TLabel
|
||||
@ -199,7 +203,7 @@ object MainForm: TMainForm
|
||||
end
|
||||
object LogTabSheet: TTabSheet
|
||||
Caption = 'Drag''n drop operation log'
|
||||
ClientHeight = 219
|
||||
ClientHeight = 217
|
||||
ClientWidth = 677
|
||||
object Label7: TLabel
|
||||
Left = 6
|
||||
@ -213,13 +217,12 @@ object MainForm: TMainForm
|
||||
end
|
||||
object LogListBox: TListBox
|
||||
Left = 4
|
||||
Height = 145
|
||||
Height = 143
|
||||
Hint = 'Use the list box to initiate a VCL drag''n drop.'
|
||||
Top = 56
|
||||
Width = 661
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
DragMode = dmAutomatic
|
||||
ItemHeight = 15
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 0
|
||||
@ -238,7 +241,7 @@ object MainForm: TMainForm
|
||||
end
|
||||
object TabSheet2: TTabSheet
|
||||
Caption = 'More info'
|
||||
ClientHeight = 219
|
||||
ClientHeight = 217
|
||||
ClientWidth = 677
|
||||
ImageIndex = 3
|
||||
object Label4: TLabel
|
||||
|
@ -14,6 +14,9 @@ uses
|
||||
LResources, vtLogger,ipcchannel;
|
||||
|
||||
type
|
||||
|
||||
{ TMainForm }
|
||||
|
||||
TMainForm = class(TForm)
|
||||
ActionList1: TActionList;
|
||||
CutAction: TAction;
|
||||
@ -48,15 +51,16 @@ type
|
||||
procedure CutActionExecute(Sender: TObject);
|
||||
procedure CopyActionExecute(Sender: TObject);
|
||||
procedure PasteActionExecute(Sender: TObject);
|
||||
procedure TreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||||
procedure Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||
var Text: WideString);
|
||||
var Text: UTF8String);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure TreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject;
|
||||
Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
|
||||
procedure Button2Click(Sender: TObject);
|
||||
procedure TreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
|
||||
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 Tree2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
|
||||
procedure TreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState;
|
||||
@ -65,7 +69,7 @@ type
|
||||
var ItemColor: TColor; var EraseAction: TItemEraseAction);
|
||||
private
|
||||
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;
|
||||
procedure InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray; Effect: Integer;
|
||||
Mode: TVTNodeAttachMode);
|
||||
@ -86,7 +90,7 @@ uses
|
||||
type
|
||||
PNodeData = ^TNodeData;
|
||||
TNodeData = record
|
||||
Caption: WideString;
|
||||
Caption: UTF8String;
|
||||
end;
|
||||
|
||||
procedure ReleaseStgMedium(_para1:LPSTGMEDIUM);stdcall;external 'ole32.dll' name 'ReleaseStgMedium';
|
||||
@ -183,10 +187,18 @@ begin
|
||||
// RichEdit1.PasteFromClipboard;
|
||||
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;
|
||||
var Text: WideString);
|
||||
var Text: UTF8String);
|
||||
|
||||
var
|
||||
Data: PNodeData;
|
||||
@ -244,6 +256,7 @@ var
|
||||
Medium: TStgMedium;
|
||||
OLEData,
|
||||
Head, Tail: PWideChar;
|
||||
WideStr: WideString;
|
||||
TargetNode,
|
||||
Node: PVirtualNode;
|
||||
Data: PNodeData;
|
||||
@ -290,8 +303,10 @@ begin
|
||||
begin
|
||||
// add a new node if we got a non-empty caption
|
||||
Node := Target.InsertNode(TargetNode, Mode);
|
||||
Target.ValidateNode(Node, False);
|
||||
Data := Target.GetNodeData(Node);
|
||||
SetString(Data.Caption, Head, Tail - Head);
|
||||
SetString(WideStr, Head, Tail - Head);
|
||||
Data.Caption := UTF8Decode(WideStr);
|
||||
end;
|
||||
// Skip any tab.
|
||||
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.
|
||||
// The given text is retrieved and splitted in lines.
|
||||
|
||||
var
|
||||
Head, Tail: PWideChar;
|
||||
WideStr: WideString;
|
||||
TargetNode,
|
||||
Node: PVirtualNode;
|
||||
Data: PNodeData;
|
||||
@ -347,8 +363,10 @@ begin
|
||||
begin
|
||||
// add a new node if we got a non-empty caption
|
||||
Node := Target.InsertNode(TargetNode, Mode);
|
||||
Target.ValidateNode(Node, False);
|
||||
Data := Target.GetNodeData(Node);
|
||||
SetString(Data.Caption, Head, Tail - Head);
|
||||
SetString(WideStr, Head, Tail - Head);
|
||||
Data.Caption := UTF8Decode(WideStr);
|
||||
end;
|
||||
// skip line separators
|
||||
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
|
||||
Data: PNodeData;
|
||||
|
@ -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"/>
|
||||
@ -45,7 +46,6 @@
|
||||
<HasResources Value="True"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<ResourceFilename Value="Main.lrs"/>
|
||||
<UnitName Value="Main"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
@ -53,15 +53,15 @@
|
||||
<CompilerOptions>
|
||||
<Version Value="8"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<CStyleOperator Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseHeaptrc Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
|
Reference in New Issue
Block a user