1 unit select;
2
3 {
4 Copyright (C) 2005-2008 Olaf Klein, o.b.klein@gpsbabel.org
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111 USA
19 }
20
21 interface
22
23 uses
24 gnugettext, gnugettextDx,
25 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
26 StdCtrls, Buttons, ExtCtrls;
27
28 type
29 TfrmSelect = class(TForm)
30 pnTop: TPanel;
31 pnBottom: TPanel;
32 lbSelect: TListBox;
33 btnOK: TBitBtn;
34 btnCancel: TBitBtn;
35 procedure FormCreate(Sender: TObject);
36 procedure FormShow(Sender: TObject);
37 private
38 { Private declarations }
39 public
40 { Public declarations }
41 end;
42
43 var
44 frmSelect: TfrmSelect;
45
SelectFromStringListnull46 function SelectFromStringList(const Title: string; List: TStrings; var Str: string): Boolean;
SelectLanguagenull47 function SelectLanguage(const Title: string; const Builtin: TStrings; var Lang: string; const Default: string = ''): Boolean;
48
49 implementation
50
51 {$R *.DFM}
52
SelectFromStringListnull53 function SelectFromStringList(const Title: string; List: TStrings; var Str: string): Boolean;
54 var
55 i, res: Integer;
56
57 begin
58 Application.CreateForm(TfrmSelect, frmSelect);
59 try
60 frmSelect.Caption := Title;
61 frmSelect.lbSelect.Items.Assign(List);
62 frmSelect.ActiveControl := frmSelect.lbSelect;
63 if (str <> '') then
64 begin
65 i := frmSelect.lbSelect.Items.IndexOf(str);
66 if (i >= 0) then
67 frmSelect.lbSelect.ItemIndex := i;
68 end;
69 res := frmSelect.ShowModal;
70 Result := (res = mrOk);
71 i := frmSelect.lbSelect.ItemIndex;
72 if Result and (i >= 0) then
73 Str := frmSelect.lbSelect.Items[i];
74 finally
75 frmSelect.Release;
76 end;
77 end;
78
SelectLanguagenull79 function SelectLanguage(const Title: string; const Builtin: TStrings; var Lang: string; const Default: string = ''): Boolean;
80 var
81 i: Integer;
82 s, sx, sy: string;
83 l: TStringList;
84
85 begin
86 Result := False;
87
88 if (Default = '') then
89 Lang := Copy(gnugettext.GetCurrentLanguage, 1, 2);
90
91 l := TStringList.Create;
92 try
93 l.Sorted := True;
94
95 sy := '';
96 for i := 0 to Builtin.Count - 1 do
97 begin
98 s := Builtin.Strings[i];
99 if (s = '') then Continue;
100
101 if (CompareText(s, 'de') = 0) then sx := _('German') else
102 if (CompareText(s, 'es') = 0) then sx := _('Spanish') else
103 if (CompareText(s, 'fr') = 0) then sx := _('French') else
104 if (CompareText(s, 'en') = 0) then sx := _('English') else
105 if (CompareText(s, 'hu') = 0) then sx := _('Hungarian') else
106 if (CompareText(s, 'it') = 0) then sx := _('Italian') else
107 sx := '???';
108
109 sx := Format('%s - %s', [s, sx]);
110 if (CompareText(s, Lang) = 0) then sy := sx;
111
112 l.Add(sx);
113 end;
114
115 if SelectFromStringList(Title, l, sy) then
116 begin
117 Lang := Copy(sy, 1, 2);
118 Result := True;
119 end;
120
121 finally
122 l.Free;
123 end;
124 end;
125
126 { TfrmSelect }
127
128 procedure TfrmSelect.FormCreate(Sender: TObject);
129 begin
130 TranslateComponent(Self);
131
132 // !!! work-arround !!!
133 btnOK.Caption := dgettext('delphi', 'OK');
134 btnCancel.Caption := dgettext('delphi', 'Abort');
135 // !!! work-arround !!!
136 end;
137
138 procedure TfrmSelect.FormShow(Sender: TObject);
139 var
140 i: Integer;
141 s: string;
142 t: TLabel;
143 begin
144 t := TLabel.Create(Self);
145 try
146
147 t.Caption := '';
148 t.Font := lbSelect.Font;
149 t.ParentFont := lbSelect.ParentFont;
150 t.Parent := lbSelect.Parent;
151
152 for i := 0 to lbSelect.Items.Count - 1 do
153 begin
154 s := Copy(lbSelect.Items[i], 1, 4);
155 while (t.Canvas.TextWidth(s) < 32) do
156 s := s + ' ';
157 s := s + Copy(lbSelect.Items[i], 5, 256);
158 lbSelect.Items[i] := s;
159 end;
160
161 finally
162 t.Free;
163 end;
164 end;
165
166 end.
167