Examples Delphi

Title: How to create a Multilingual Program
Question: This description tells you a system to create Delphi programs also in Delphi standard version with on-line language switch over and correct display of characters even in Asia writing.
Answer:
Note: There are a lot of possibilities to change language. Also the Delphi version with language Manager and language DLLs. The plus of my description is, you have all functions in your hand and do not need any addional software. The output is only one EXE with no DLLs.
UpDate at 02 Jan 2004 ... please look at the end...
TMainMenu
=========
Place a new Headline named Language and arrange all the languages you like behind, first all in English writing. This Column is the only one that will not turn, because every one has to read his own language.
TToolBar
=======
If you like, you can use only or additionaly a TToolbar with Style tbsDropDown. You have to place a TPopupMenu with the same list of Languages on the form and tell the TToolButton what its PopupMenu.
Language Unit
==========
The best is to put a new unit in the program called uLanguage. Here we have all what has to do with language turn over.
Character Converting
===============
To store all text displaying into the program code, it is necessary to convert other than ANSI character to their special code page, because you cannot place Unicode writing in program code. In DELPHI3000 is a good article describing how to do that (the article 3198 is from Daniel Wischnewski, Converting Text for different Code Pages). Place anywhere in your program a Button and turn him to NOT VISIBLE. This button is only for you. Behind the Button is the call:
procedure TForm1.Button1Click(Sender: TObject);
var
InList:WideString;
OutList:TStringList;
F: File of WideChar;
s:WideChar;
begin
//This part is only for developing to translate Chinese text to
//code page. The Button is normaly unvisible !!!!!
//working only until 2 GB Files (because of WideString Max)!!!
OutList:=TStringList.Create;
InList:='';
AssignFile(F,'Program Translation.txt');
Reset(F);
Read(F,S); //we do not need the unicode file mark
while not EOF(F) do begin
Read(F,S);
InList:=InList+s;
end;
CloseFile(F);
OutList.Text:=TransferUnicodeToCodePage(CODEPAGE_Chinese_PRC,InList);
OutList.SaveToFile('Program Translation CodePage.txt');
OutList.Free;
end;
Here the little bit modified version of the article 3198:
Uses ..............., ComObj;
const
IID_MLangConvertCharset: TGUID = '{D66D6F98-CDAA-11D0-B822-00C04FC9B31F}';
CLASS_MLangConvertCharset :TGUID = '{D66D6F99-CDAA-11D0-B822-00C04FC9B31F}';
type
tagCODEPAGE = UINT;
tagMLCONVCHARF = DWORD;
IMLangConvertCharset = interface
['{D66D6F98-CDAA-11D0-B822-00C04FC9B31F}']
function Initialize(uiSrcCodePage: tagCODEPAGE; uiDstCodePage: tagCODEPAGE;
dwProperty: tagMLCONVCHARF ): HResult; stdcall;
function DoConversionToUnicode(pSrcStr: PChar; pcSrcSize: PUINT;
pDstStr: PWChar; pcDstSize: PUINT): HResult; stdcall;
function DoConversionFromUnicode(pSrcStr: PWChar; pcSrcSize: PUINT;
pDstStr: PChar; pcDstSize: PUINT): HResult; stdcall;
end;
CoMLangConvertCharset = class
class function Create: IMLangConvertCharset;
class function CreateRemote(const MachineName: string): IMLangConvertCharset;
end;
Const
CODEPAGE_Thai : tagCODEPAGE = 0874;
CODEPAGE_Japanese : tagCODEPAGE = 0932;
CODEPAGE_Chinese_PRC : tagCODEPAGE = 0936;
CODEPAGE_Korean : tagCODEPAGE = 0949;
CODEPAGE_Chinese_Taiwan : tagCODEPAGE = 0950;
CODEPAGE_UniCode : tagCODEPAGE = 1200;
CODEPAGE_Windows_31_EastEurope : tagCODEPAGE = 1250;
CODEPAGE_Windows_31_Cyrillic : tagCODEPAGE = 1251;
CODEPAGE_Windows_31_Latin1 : tagCODEPAGE = 1252;
CODEPAGE_Windows_31_Greek : tagCODEPAGE = 1253;
CODEPAGE_Windows_31_Turkish : tagCODEPAGE = 1254;
CODEPAGE_Hebrew : tagCODEPAGE = 1255;
CODEPAGE_Arabic : tagCODEPAGE = 1256;
CODEPAGE_Baltic : tagCODEPAGE = 1257;
CODEPAGE_MSDOS_Latin1 : tagCODEPAGE = 0850; //Multilingual
CODEPAGE_MSDOS_Latin2 : tagCODEPAGE = 0852; //Slavic
MLCONVCHARF_AUTODETECT: tagMLCONVCHARF = 1;
MLCONVCHARF_ENTITIZE : tagMLCONVCHARF = 2;
Implementation
class function CoMLangConvertCharset.Create: IMLangConvertCharset;
begin
Result := CreateComObject(CLASS_MLangConvertCharset) as IMLangConvertCharset;
end;
class function CoMLangConvertCharset.CreateRemote(
const MachineName: string): IMLangConvertCharset;
begin
Result := CreateRemoteComObject(
MachineName, CLASS_MLangConvertCharset) as IMLangConvertCharset;
end;
function TransferUnicodeToCodePage(ToCP:tagCODEPAGE;SText:WideString):String;
var
Conv: IMLangConvertCharset;
Source: PWChar;
Dest: PChar;
SourceSize, DestSize: UINT;
begin
Conv := CoMLangConvertCharset.Create;
Conv.Initialize(CODEPAGE_UniCode,ToCP, MLCONVCHARF_ENTITIZE);
Source := PWChar(SText);
SourceSize := Succ(Length(SText));
DestSize := 0;
Conv.DoConversionFromUnicode(Source, @SourceSize, nil, @DestSize);
GetMem(Dest, DestSize);
try
Conv.DoConversionFromUnicode(Source, @SourceSize, Dest, @DestSize);
result:= Dest;
finally
FreeMem(Dest);
end;
end;
function TransferCodePageToUnicode(FromCP:tagCODEPAGE;QText:String):WideString;
var
Conv: IMLangConvertCharset;
Dest: WideString;
SourceSize, DestSize: UINT;
begin
Conv:= CoMLangConvertCharset.Create;
Conv.Initialize(FromCP, CODEPAGE_UniCode, MLCONVCHARF_ENTITIZE);
SourceSize := length(QText);
DestSize := 0;
Conv.DoConversionToUnicode(PChar(QText),@SourceSize,nil,@DestSize);
SetLength(Dest,DestSize);
try
Conv.DoConversionToUnicode(PChar(QText),@SourceSize,PWChar(Dest),@DestSize);
finally
result:=Dest;
Finalize(Dest);
end;
end;
Collecting all your Text
=================
To get all your text, you have do a little more work. After you have finished your Form, turn it to Viewing as Text (right mouse key on Form). Then pick out all text lines. Create in uLanguage a procedure for language switch over and place all texts, also in program used text (use text variables) in this procedure.
The Form in text mode:
object Form1: TForm1
Left = 80
Top = 258
Width = 696
Height = 480
Caption = 'Form1' Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 32
Top = 112
Width = 32
Height = 13
Caption = 'Label1' end
object Label2: TLabel
Left = 32
Top = 136
Width = 32
Height = 13
Caption = 'Label2' end
end
In the Form you have to place a variable e.g. called ActualLanguage. In the procedure TForm1.FormCreate you have to tell each menu language line his code. Best way is to place it in TAG property.
const
ENGLISH = (SUBLANG_ENGLISH_US shl 10) or LANG_ENGLISH;
Spain = (SUBLANG_SPANISH shl 10) or LANG_SPANISH;
Frensh = (SUBLANG_FRENCH shl 10) or LANG_FRENCH;
CHINESE = (SUBLANG_CHINESE_SIMPLIFIED shl 10) or LANG_CHINESE;
procedure Tform1.FormCreate(Sender: TObject);
begin
//adjust the program language
English1.Tag:=ENGLISH;
Espanol1.Tag:=Spain;
Francais1.Tag:=Frensh;
Chinese1.Tag:=CHINESE;
ActualLanguage:=ENGLISH; //default
//possible read Registry and override
end;
The click of one language will start this procedure: (Tell all languages the same procedure)
procedure Tform1.English1Click(Sender: TObject);
begin
ActualLanguage:=TMenuItem(Sender).Tag;
English1.Checked:=English1.Tag= ActualLanguage;
Espanol1.Checked:=Espanol1.Tag= ActualLanguage;
Francais1.Checked:=Francais1.Tag= ActualLanguage;
Chinese1.Checked:=Chinese1.Tag= ActualLanguage;
TurnLanguage(ActualLanguage);
end;
Important is to design all components with the option: ParentFont = true. So we have to change only the font of the form (do this for each form) to turn all components. Except you like to give a component a special looking, you have to transfer the other font properties to the component separate. A nother way I told in the article "How to change a property of all components in one time". The procedure in the unit uLanguage will turn all:
procedure TurnLanguage(Lang:Longint);
var
NewFont:TFont;
procedure SetFont;
begin
screen.MenuFont:=NewFont;
Form1.Font:=NewFont;
end;
begin
NewFont:=TFont.Create;
NewFont.Name:='MS Sans Serif';
NewFont.Charset:=ANSI_CHARSET;
NewFont.Size:=8;
SetFont;
case Lang of
ENGLISH: with Form1 do begin
Label1.Caption = 'Log on';
Label2.Caption = 'Log off';
end;
Spain:with Form1 do begin
Label1.Caption = 'Entre';
Label2.Caption = 'Trmino de sesin';
end;
Frensh:with Form1 do begin
Label1.Caption = 'Entrez';
Label2.Caption = 'Fermeture de session';
end;
CHINESE: with Form1 do begin
NewFont.Name:='SimSun';
NewFont.Charset:= GB2312_CHARSET;
NewFont.Size:=12;
SetFont;
Label1.Caption = '';
Label2.Caption = '?';
end;
end;
LFont.Free;
end;
A good way to do all this is, first get all text and turn them to English part. Then use Microsoft Excel and place all English texts in the first column. Fill each column for each language with the translation (use http://babelfish. altavista.com/), also with e.g. Chinese writing (Excel can use Unicode). Now make the other language parts of the procedure. To get for example Chinese to your program, save the Excel file as Unicode text file and translate this file with the code page transformation I described above. Now you can finish all languages.
Language Menu Items
================
To display the MenuItems of Languages in the own language you have to tell each MenuItem not to get the Font of the parent (ParentFont = false). For this special displaying you have to write your own draw procedure (OnDrawItem =
Chinese1DrawItem):
procedure TForm1.Chinese1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
var
Text:string;
Glyph:TBitmap;
begin
case TMenuItem(Sender).Tag of
ENGLISH,Spain,Frensh:Begin
ACanvas.Font.Name:='MS Sans Serif';
ACanvas.Font.Charset:=ANSI_CHARSET;
ACanvas.Font.Size:=8;
end;
CHINESE:begin
ACanvas.Font.Name:='SimSun';
ACanvas.Font.Charset:=GB2312_CHARSET;
ACanvas.Font.Size:=12;
end;
end;
Text:=TMenuItem(Sender).Caption;
with ACanvas do begin
if Selected then begin
Brush.Style:=bsSolid;
Brush.Color:=clHighlight;
Pen.Color:=clHighlight;
Font.Color := clBtnHighlight;
end else begin
Pen.Color:=clBtnFace;
Brush.Style:=bsSolid;
Font.Color := clMenuText;
end;
Rectangle(ARect);
ARect.Left:=ARect.Left+20;
DrawText(Handle, PChar(Text), Length(Text), ARect, DT_LEFT);
{ Draw a menu check }
if NOT TMenuItem(Sender).Checked then exit;
Glyph := TBitmap.Create;
try
Glyph.Transparent:=True;
Glyph.Handle:=LoadBitmap(0, PChar(OBM_CHECK));
Draw(ARect.Left-18,ARect.Top,Glyph);
finally
Glyph.Free;
end;
end;
end;
Special effect: Use Windows predefined Bitmaps
====================================
You will see above "Glyph.Handle:=LoadBitmap(0, PChar(OBM_CHECK));" that I use to show the check hook a Windows predefined Bitmap (also described at article 880). In Delphi at the folder "..\Delphi5\Demos\Resxplor\resxplor.exe" you have to compile the resource explorer and start. Load your EXE and see how much predefined Bitmaps already into the program.
Use Windows predefined translations
============================
You do not need to translate names of day, month, year and so on. These did Bill Gates already for you. You have just to read them and display for example in a ComboBox:
//fill ComboBox of Month
ComboBox1.Items.Clear;
for n := 1 to 12 do
ComboBox1.Items.Add(GetLocaleStr(ActualLanguage,LOCALE_SMONTHNAME1+n-1,''));
For the ComboBox you have to use a little trick ... normally is the ComboBox a Windows Component and use the System code page. But if you say the component: "Style = csOwnerDrawFixed" the component looking for the paint procedure. This procedure is nil because we do nothing. In this case Delphi paint the component with a default procedure and use (ParentFont = True) your adjustment of code page ("TurnLanguage").
You can get more information about the Date/Time predefined names at Help "Windows SDK" and search for "LCTYPE Constants".
Using of Windows Components
=======================
Some components cannot change the code page. This is especially for CheckBox and RadioButton, because these are windows components and not paint by Delphi. So use CheckBoxList and or RadioGroup instead. Also do not use TButton, better use TBitBtn. All other can change the code page or you have to draw by yourself. Here is the example for the PageControl:
Page Control Tabs
==============
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
Text:string;
R:TRect;
begin
Text:=TPageControl(Control).Pages[TabIndex].Caption;
R:=Rect;
with Control.Canvas do begin
Font:=PageControl1.Font;
Brush.Style:=bsClear;
Font.Color := clMenuText;
DrawText(Handle, PChar(Text), Length(Text), R, DT_CENTER OR DT_VCENTER);
end;
end;
Menu Item
========
We change the Menu code page in the procedure "TurnLanguage" by the line Screen.MenuFont:=NewFont.
Hint Window
===========
To change the Hint Window Code Page you have to link the OnShowHint-Event with your procedure ("Application.OnShowHint:=MyShowHint;") in the procedure TForm1.FormCreate". In your procedure you have to find the HintWindow and to tell him what's the font:
procedure TForm1.MyShowHint(var HintStr:string;var CanShow: Boolean;var HintInfo: THintInfo);
var
i : integer;
begin
for i := 0 to Application.ComponentCount - 1 do
if application.Components[i] is THintWindow then
with THintWindow(application.Components[i]).Canvas do begin
case ActualLanguage of
ENGLISH,Spain,Frensh:Begin
Font.Name:='MS Sans Serif';
Font.Charset:=ANSI_CHARSET;
Font.Size:=8;
HintInfo.HintColor := $C0FFFF;
end;
CHINESE:begin
Font.Name:='SimSun';
Font.Charset:=GB2312_CHARSET;
Font.Size:=12;
HintInfo.HintColor := clWhite;
end;
end;
end;
end;
Message Dialogs
=============
You can use the following function to get the actual code page writing, without changing of headline and button caption. Other wise you have to design your own message form. To change all resource strings is much more work and mostly not necessary, because the every one knows what means "OK". To prevent at not translated messages use for all possibilities the TRY function and show your own message in your Message Dialog.
function MessageDlgPosSetFont(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint):Integer;
begin
with CreateMessageDialog(Msg, DlgType, Buttons) do
try
HelpContext := HelpCtx;
Left:=trunc(screen.Width/2-width/2);
Top:=trunc(screen.height/2-height/2);
case ActualLanguage of
ENGLISH,Spain,Frensh:Begin
Font.Name:='MS Sans Serif';
Font.Charset:=ANSI_CHARSET;
Font.Size:=8;
end;
CHINESE:begin
Font.Name:='SimSun';
Font.Charset:=GB2312_CHARSET;
Font.Size:=12;
end;
end;
Result := ShowModal;
finally
Free;
end;
end;
===============================================================
Update at 02 Jan 2004
To write an own Component or a complete Program in Unicode, you have to create every paint routine by yourself. To store Unicode direct in the program use the "const"-Field (look at "TimeTextChinese"). How to get the Unicode numbers? Very easy: Let it translate with e.g. "http://babelfish. altavista.com/". Then let the translated htm page display as "source text" and get the numbers out of the htm text.
Tip: The most Windows functions have also a function with same name and "W" what means Wide or Unicode.
Here is a abbreviated example:
const
TimeTextEnglish :Array [0..5] of WideString =
('1 day','6 h','1 h','30 min','10 min','1 min');
TimeTextSpain :Array [0..5] of WideString =
('1 Da','6 H','1 H','30 Min','10 Min','1 Min');
TimeTextFrensh :Array [0..5] of WideString =
('1 Jour','6 H','1 H','30 Min','10 Min','1 Min');
TimeTextChinese :Array [0..5,0..5] of WideChar =
((#$0031,#$0020,#$5929,#$0000,#$0000,#$0000),
(#$0036,#$0020,#$5C0F,#$65F6,#$0000,#$0000),
(#$0031,#$0020,#$5C0F,#$65F6,#$0000,#$0000),
(#$0033,#$0030,#$0020,#$5206,#$949F,#$0000),
(#$0031,#$0030,#$0020,#$5206,#$949F,#$0000),
(#$0031,#$0020,#$5206,#$949F,#$0000,#$0000));
procedure xxxxxX.DrawTheText(lang:Integer; ArrCount:Integer; Canvas: TCanvas; ARect: TRect);
var
Text:WideString;
begin
case lang of
ENGLISH:Text:=TimeTextEnglish[ArrCount];
Spain:Text:=TimeTextSpain[ArrCount];
Frensh:Text:=TimeTextFrensh[ArrCount];
CHINESE:Text:=TimeTextChinese[ArrCount];
end;
with Canvas do begin
Font.Name:='Arial UniCode MS';
Font.Size:=10;
Brush.Style:=bsClear;
Font.Color := clMenuText;
DrawTextW(Handle,PWideChar(Text),Length(Text),ARect,DT_LEFT OR DT_VCENTER);
end;
end;