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

* Added Unicode demo

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@618 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2008-12-07 16:30:56 +00:00
parent 86ccb284f4
commit 1e5996987a
5 changed files with 519 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

176
components/virtualtreeview-unstable/demos/unicode/fmain.lfm Normal file
View File

@ -0,0 +1,176 @@
object MainForm: TMainForm
Left = 379
Height = 504
Top = 166
Width = 613
Caption = 'Unicode Demo'
ClientHeight = 504
ClientWidth = 613
OnCreate = FormCreate
LCLVersion = '0.9.27'
object MainNotebook: TNotebook
Height = 504
Width = 613
Align = alClient
PageIndex = 0
TabOrder = 0
object WelcomePage: TPage
Caption = 'Welcome Translations'
ClientWidth = 605
ClientHeight = 478
object WelcomeTree: TVirtualStringTree
Left = 3
Height = 444
Top = 31
Width = 599
Align = alClient
BorderSpacing.Around = 3
BorderStyle = bsSingle
Header.Options = [hoColumnResize, hoDrag, hoVisible]
TabOrder = 0
OnFreeNode = WelcomeTreeFreeNode
OnGetText = WelcomeTreeGetText
Columns = <
item
Width = 200
WideText = 'Language'
end
item
Position = 1
Width = 200
WideText = 'Translation'
end>
end
object WelcomeTopPanel: TPanel
Height = 28
Width = 605
Align = alTop
BevelOuter = bvNone
ClientHeight = 28
ClientWidth = 605
TabOrder = 1
object ChooseWelcomeFontButton: TButton
Left = 4
Height = 25
Top = 2
Width = 120
BorderSpacing.Left = 3
BorderSpacing.Around = 1
Caption = 'Choose Font'
OnClick = ChooseWelcomeFontButtonClick
TabOrder = 0
end
end
end
object LCLTextPage: TPage
Caption = 'LCL Text'
ClientWidth = 605
ClientHeight = 478
object LCLTextTree: TVirtualStringTree
Left = 3
Height = 440
Top = 3
Width = 272
BorderSpacing.Around = 3
BorderStyle = bsSingle
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
TabOrder = 0
TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
OnFreeNode = LCLTextTreeFreeNode
OnGetText = LCLTextTreeGetText
OnNewText = LCLTextTreeNewText
Columns = <>
end
object AddEditTextButton: TButton
Left = 476
Height = 25
Top = 2
Width = 120
Caption = 'Add Text'
OnClick = AddEditTextButtonClick
TabOrder = 1
end
object TextEdit: TEdit
Left = 284
Height = 23
Top = 2
Width = 184
TabOrder = 2
end
object TextComboBox: TComboBox
Left = 284
Height = 21
Top = 58
Width = 184
ItemHeight = 13
Items.Strings = (
'Não'
'Coração'
'Sim'
)
TabOrder = 3
end
object AddComboTextButton: TButton
Left = 476
Height = 25
Top = 58
Width = 120
Caption = 'Add Text'
OnClick = AddComboTextButtonClick
TabOrder = 4
end
object TextListBox: TListBox
Left = 284
Height = 112
Top = 98
Width = 184
Items.Strings = (
'Não'
'Coração'
'Sim'
)
ItemHeight = 13
TabOrder = 5
end
object AddListTextButton: TButton
Left = 476
Height = 25
Top = 98
Width = 120
Caption = 'Add Text'
OnClick = AddListTextButtonClick
TabOrder = 6
end
object TextMemo: TMemo
Left = 284
Height = 138
Top = 234
Width = 184
TabOrder = 7
end
object AddMemoTextButton: TButton
Left = 476
Height = 25
Top = 234
Width = 120
Caption = 'Add Text'
OnClick = AddMemoTextButtonClick
TabOrder = 8
end
object ClearLCLTextTreeButton: TButton
Left = 3
Height = 25
Top = 449
Width = 97
Caption = 'Clear'
OnClick = ClearLCLTextTreeButtonClick
TabOrder = 9
end
end
end
object FontDialog1: TFontDialog
left = 136
top = 24
end
end

217
components/virtualtreeview-unstable/demos/unicode/fmain.pas Normal file
View File

@ -0,0 +1,217 @@
unit fMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, VirtualTrees, StdCtrls, LCLProc;
type
{ TMainForm }
TMainForm = class(TForm)
AddEditTextButton: TButton;
AddComboTextButton: TButton;
AddListTextButton: TButton;
AddMemoTextButton: TButton;
ClearLCLTextTreeButton: TButton;
ChooseWelcomeFontButton: TButton;
TextMemo: TMemo;
TextListBox: TListBox;
TextComboBox: TComboBox;
TextEdit: TEdit;
FontDialog1: TFontDialog;
MainNotebook: TNotebook;
LCLTextPage: TPage;
LCLTextTree: TVirtualStringTree;
WelcomeTopPanel: TPanel;
WelcomeTree: TVirtualStringTree;
WelcomePage: TPage;
procedure AddComboTextButtonClick(Sender: TObject);
procedure AddEditTextButtonClick(Sender: TObject);
procedure AddListTextButtonClick(Sender: TObject);
procedure AddMemoTextButtonClick(Sender: TObject);
procedure ChooseWelcomeFontButtonClick(Sender: TObject);
procedure ClearLCLTextTreeButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure LCLTextTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure LCLTextTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
procedure LCLTextTreeNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; const NewText: WideString);
procedure WelcomeTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure WelcomeTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
private
procedure AddLCLText(const AText: String);
{ private declarations }
procedure AddWelcomeString(const WelcomeString: String);
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
uses
strutils;
type
TWelcomeData = record
Language: String;
Translation: String;
end;
PWelcomeData = ^TWelcomeData;
TLCLTextData = record
Text: String;
end;
PLCLTextData = ^TLCLTextData;
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
var
WelcomeList: TStrings;
i: Integer;
begin
LCLTextTree.NodeDataSize := SizeOf(TLCLTextData);
WelcomeTree.NodeDataSize := SizeOf(TWelcomeData);
//Load the welcome list from an UTF-8 encoded file
WelcomeList := TStringList.Create;
try
WelcomeList.LoadFromFile('welcome.txt');
WelcomeTree.BeginUpdate;
for i := 0 to WelcomeList.Count - 1 do
AddWelcomeString(WelcomeList[i]);
WelcomeTree.EndUpdate;
finally
WelcomeList.Destroy;
end;
end;
procedure TMainForm.LCLTextTreeFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
Data: PLCLTextData;
begin
Data := Sender.GetNodeData(Node);
Data^.Text := '';
end;
procedure TMainForm.LCLTextTreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
Data: PLCLTextData;
begin
Data := Sender.GetNodeData(Node);
CellText := UTF8Decode(Data^.Text);
end;
procedure TMainForm.LCLTextTreeNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; const NewText: WideString);
var
Data: PLCLTextData;
begin
Data := Sender.GetNodeData(Node);
Data^.Text := NewText;
end;
procedure TMainForm.ChooseWelcomeFontButtonClick(Sender: TObject);
begin
if FontDialog1.Execute then
WelcomeTree.Font := FontDialog1.Font;
end;
procedure TMainForm.ClearLCLTextTreeButtonClick(Sender: TObject);
begin
LCLTextTree.Clear;
end;
procedure TMainForm.AddEditTextButtonClick(Sender: TObject);
begin
AddLCLText(TextEdit.Text);
end;
procedure TMainForm.AddListTextButtonClick(Sender: TObject);
begin
if TextListBox.ItemIndex <> -1 then
AddLCLText(TextListBox.Items[TextListBox.ItemIndex]);
end;
procedure TMainForm.AddMemoTextButtonClick(Sender: TObject);
var
i: Integer;
begin
for i := 0 to TextMemo.Lines.Count - 1 do
AddLCLText(TextMemo.Lines[i]);
end;
procedure TMainForm.AddComboTextButtonClick(Sender: TObject);
begin
AddLCLText(TextComboBox.Text);
end;
procedure TMainForm.WelcomeTreeFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
Data: PWelcomeData;
begin
Data := Sender.GetNodeData(Node);
Data^.Language := '';
Data^.Translation := '';
end;
procedure TMainForm.WelcomeTreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
Data: PWelcomeData;
begin
Data := Sender.GetNodeData(Node);
case Column of
0: CellText := UTF8Decode(Data^.Language);
1: CellText := UTF8Decode(Data^.Translation);
end;
end;
procedure TMainForm.AddLCLText(const AText: String);
var
Data: PLCLTextData;
Node: PVirtualNode;
begin
with LCLTextTree do
begin
Node := AddChild(nil);
Data := GetNodeData(Node);
Data^.Text := AText;
ValidateNode(Node, False);
end;
end;
procedure TMainForm.AddWelcomeString(const WelcomeString: String);
var
Data: PWelcomeData;
Node: PVirtualNode;
begin
with WelcomeTree do
begin
Node := AddChild(nil);
Data := GetNodeData(Node);
Data^.Language := ExtractWord(1, WelcomeString, [Chr(9)]);
Data^.Translation := ExtractWord(2, WelcomeString, [Chr(9)]);
ValidateNode(Node, False);
end;
end;
initialization
{$I fmain.lrs}
end.

70
components/virtualtreeview-unstable/demos/unicode/unicode.lpi Normal file
View File

@ -0,0 +1,70 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="6"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<Icon Value="0"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="virtualtreeview_package"/>
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="unicode.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="unicode"/>
</Unit0>
<Unit1>
<Filename Value="fmain.pas"/>
<ComponentName Value="MainForm"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<ResourceFilename Value="fmain.lrs"/>
<UnitName Value="fMain"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

21
components/virtualtreeview-unstable/demos/unicode/unicode.lpr Normal file
View File

@ -0,0 +1,21 @@
program unicode;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
{ you can add units after this }, fMain, LResources, virtualtreeview_package;
{$IFDEF WINDOWS}{$R unicode.rc}{$ENDIF}
begin
{$I unicode.lrs}
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

35
components/virtualtreeview-unstable/demos/unicode/welcome.txt Normal file
View File

@ -0,0 +1,35 @@
Arabic مرحباً
Armenian բարի գալուստ
Azeri xoş gəlmişsiniz
Catalan benvinguts
Cherokee ᎤᎵᎮᎵᏍᏗ
Chinese (trad.) 歡迎
Chinese (simp.) 欢迎
Czech vítejte
Danish velkommen
Dutch welkom
English welcome
Esperanto bonveno
Estonian tere tulemast
Finnish tervetuloa
French bienvenue
German willkommen
Greek καλώς ορίσατε
Hebrew ברוכים הבאים
Italian benvenuti
Japanese ようこそ
Latin salve
Norwegian velkommen
Persian خوش آمدید
Polish zapraszamy
Portuguese bem-vindo
Romanian bun venit
Sindhi ڀلي ڪري آيا
Slovak víta vás
Slovenian dobrodošli
Spanish bienvenido
Swahili karibu
Swedish välkommen
Turkish hoş geldiniz
Uyghur خۇش كەپسىز
Zulu sawubona