You've already forked lazarus-ccr
* Update images demo to use utf8
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@659 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -18,9 +18,34 @@ object Form1: TForm1
|
||||
Align = alClient
|
||||
CheckImageKind = ckXP
|
||||
DefaultNodeHeight = 20
|
||||
DefaultText = 'Node'
|
||||
DragMode = dmAutomatic
|
||||
DragOperations = [doCopy, doMove, doLink]
|
||||
DrawSelectionMode = smBlendedRectangle
|
||||
Header.Columns = <
|
||||
item
|
||||
Hint = 'Glavna kolona'
|
||||
ImageIndex = 0
|
||||
Text = 'Main'
|
||||
Width = 200
|
||||
end
|
||||
item
|
||||
ImageIndex = 1
|
||||
Position = 1
|
||||
Text = 'One'
|
||||
Width = 70
|
||||
end
|
||||
item
|
||||
ImageIndex = 2
|
||||
Position = 2
|
||||
Text = 'Two'
|
||||
Width = 70
|
||||
end
|
||||
item
|
||||
Position = 3
|
||||
Text = 'Percent'
|
||||
Width = 150
|
||||
end>
|
||||
Header.Font.Height = -11
|
||||
Header.Font.Name = 'MS Sans Serif'
|
||||
Header.Height = 24
|
||||
@ -39,30 +64,6 @@ object Form1: TForm1
|
||||
OnGetImageIndex = VST1GetImageIndex
|
||||
OnHeaderClick = VST1HeaderClick
|
||||
OnInitNode = VST1InitNode
|
||||
Columns = <
|
||||
item
|
||||
ImageIndex = 0
|
||||
Width = 200
|
||||
WideText = 'Main'
|
||||
WideHint = 'Glavna kolona'
|
||||
end
|
||||
item
|
||||
ImageIndex = 1
|
||||
Position = 1
|
||||
Width = 70
|
||||
WideText = 'One'
|
||||
end
|
||||
item
|
||||
ImageIndex = 2
|
||||
Position = 2
|
||||
Width = 70
|
||||
WideText = 'Two'
|
||||
end
|
||||
item
|
||||
Position = 3
|
||||
Width = 150
|
||||
WideText = 'Percent'
|
||||
end>
|
||||
end
|
||||
object ImageList1: TImageList
|
||||
Height = 24
|
||||
|
@ -26,8 +26,8 @@ unit Unit1;
|
||||
interface
|
||||
|
||||
uses
|
||||
DelphiCompat, LCLIntf, Messages, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, ImgList, VirtualTrees, LResources;
|
||||
DelphiCompat, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, VirtualTrees, LResources;
|
||||
|
||||
type
|
||||
|
||||
@ -45,7 +45,7 @@ type
|
||||
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
|
||||
procedure VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||||
Column: TColumnIndex; TextType: TVSTTextType;
|
||||
var CellText: WideString);
|
||||
var CellText: UTF8String);
|
||||
procedure VST1GetImageIndex(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||||
var Ghosted: Boolean; var ImageIndex: Integer);
|
||||
@ -63,7 +63,7 @@ type
|
||||
|
||||
PMyRec = ^TMyRec;
|
||||
TMyRec = record
|
||||
Main: WideString;
|
||||
Main: UTF8String;
|
||||
One, Two: integer;
|
||||
Percent : integer;
|
||||
Index: Integer;
|
||||
@ -76,21 +76,6 @@ implementation
|
||||
|
||||
uses Math;
|
||||
|
||||
//fpc 204 does not have comparevalue
|
||||
|
||||
function CompareValue ( const A, B : Integer) : Integer;
|
||||
|
||||
begin
|
||||
result:=1;
|
||||
if a=b then
|
||||
result:=0
|
||||
else
|
||||
if a<b then
|
||||
result:=-1;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
|
||||
@ -131,21 +116,18 @@ begin
|
||||
RndPercent:=Data.Percent;
|
||||
|
||||
InflateRect(CellRect, -1, -1);
|
||||
DrawEdge(TargetCanvas.Handle, CellRect, EDGE_SUNKEN, BF_ADJUST or
|
||||
BF_RECT);
|
||||
DrawEdge(TargetCanvas.Handle, CellRect, EDGE_SUNKEN, BF_ADJUST or BF_RECT);
|
||||
PercentageSize := (CellRect.Right - CellRect.Left) * RndPercent div 100;
|
||||
|
||||
if True then
|
||||
//Multy color approach
|
||||
//Multi color approach
|
||||
begin
|
||||
|
||||
ColorStart :=clYellow;
|
||||
|
||||
R:= GetRValue(ColorStart);
|
||||
G:= GetGValue(ColorStart);
|
||||
B:= GetBValue(ColorStart);
|
||||
|
||||
|
||||
for I := CellRect.Right downto CellRect.Left do
|
||||
begin
|
||||
TargetCanvas.Brush.Color := RGB(R,G,B);
|
||||
@ -155,7 +137,6 @@ BF_RECT);
|
||||
Dec(CellRect.Right);
|
||||
|
||||
Dec(G);
|
||||
|
||||
end;
|
||||
end else
|
||||
//One color approach
|
||||
@ -168,7 +149,6 @@ BF_RECT);
|
||||
TargetCanvas.FillRect(CellRect);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.VST1InitNode(Sender: TBaseVirtualTree; ParentNode,
|
||||
@ -218,7 +198,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TForm1.VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
|
||||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String);
|
||||
var
|
||||
Data: PMyRec;
|
||||
begin
|
||||
|
@ -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"/>
|
||||
@ -46,7 +47,6 @@
|
||||
<HasResources Value="True"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<ResourceFilename Value="Unit1.lrs"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
|
Reference in New Issue
Block a user