1 {
2 /***************************************************************************
3 charactermapdlg.pas
4 -------------------
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 * *
10 * This source is free software; you can redistribute it and/or modify *
11 * it under the terms of the GNU General Public License as published by *
12 * the Free Software Foundation; either version 2 of the License, or *
13 * (at your option) any later version. *
14 * *
15 * This code is distributed in the hope that it will be useful, but *
16 * WITHOUT ANY WARRANTY; without even the implied warranty of *
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
18 * General Public License for more details. *
19 * *
20 * A copy of the GNU General Public License is available on the World *
21 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
22 * obtain it by writing to the Free Software Foundation, *
23 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
24 * *
25 ***************************************************************************
26
27 Author: Mattias Gaertner
28
29 Abstract:
30 Dialog for character map.
31 }
32
33 unit CharacterMapDlg;
34
35 {$mode objfpc}{$H+}
36
37 interface
38
39 uses
40 {$ifdef WINDOWS}Windows,{$endif}
41 Classes, SysUtils, Math,
42 // LCL
43 Controls, Graphics, Dialogs, Buttons, StdCtrls, Forms,
44 LCLType, LCLUnicodeData, Grids, ButtonPanel, ComCtrls,
45 // LazUtils
46 GraphType, LazUTF8, LConvEncoding,
47 // IdeIntf
48 IDEHelpIntf, IDEImagesIntf,
49 // IDE
50 LazarusIDEStrConsts, EditorOptions, EnvironmentOpts;
51
52 type
53 TOnInsertCharacterEvent = procedure (const C: TUTF8Char) of object;
54
55 { TCharacterMapDialog }
56
57 TCharacterMapDialog = class(TForm)
58 ButtonPanel: TButtonPanel;
59 cbCodePage: TComboBox;
60 AnsiCharInfoLabel: TLabel;
61 cbUniRange: TComboBox;
62 SortUniRangeListButton: TSpeedButton;
63 CodePageLabel: TLabel;
64 RangeLabel: TLabel;
65 UnicodeCharInfoLabel: TLabel;
66 PageControl1: TPageControl;
67 AnsiGrid: TStringGrid;
68 UnicodeGrid: TStringGrid;
69 pgAnsi: TTabSheet;
70 pgUnicode: TTabSheet;
71 procedure GridPrepareCanvas(sender: TObject; {%H-}aCol, {%H-}aRow: Integer;
72 {%H-}aState: TGridDrawState);
73 procedure cbCodePageSelect(Sender: TObject);
74 procedure cbUniRangeSelect(Sender: TObject);
75 procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
76 procedure HelpButtonClick(Sender: TObject);
77 procedure FormCreate(Sender: TObject);
78 procedure FormShow(Sender: TObject);
79 procedure SortUniRangeListButtonClick(Sender: TObject);
80 procedure AnsiGridSelectCell(Sender: TObject; aCol, aRow: Integer;
81 var {%H-}CanSelect: Boolean);
82 procedure UnicodeGridSelectCell(Sender: TObject; aCol, aRow: Integer;
83 var {%H-}CanSelect: Boolean);
84 procedure StringGridKeyPress(Sender: TObject; var Key: char);
85 procedure StringGridMouseDown(Sender: TObject; Button: TMouseButton;
86 {%H-}Shift: TShiftState; X, Y: Integer);
87 procedure AnsiGridMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X,
88 Y: Integer);
89 procedure UnicodeGridMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X,
90 Y: Integer);
91 private
92 FOnInsertCharacter: TOnInsertCharacterEvent;
93 FUnicodeBlockIndex: Integer;
94 procedure DoStatusAnsiGrid(ACol, ARow: integer);
95 procedure DoStatusUnicodeGrid(ACol, ARow: integer);
96 procedure FillAnsiGrid;
97 procedure FillUnicodeGrid;
98 procedure FillUniRangeList(ASorted: Boolean);
UnicodeBlockIndexByNamenull99 function UnicodeBlockIndexByName(AName: String): Integer;
UnicodeBlockSelectednull100 function UnicodeBlockSelected: Boolean;
101 procedure SelectSystemCP;
102 public
103 property OnInsertCharacter: TOnInsertCharacterEvent read FOnInsertCharacter
104 write FOnInsertCharacter;
105 end;
106
107 procedure ShowCharacterMap(AOnInsertChar: TOnInsertCharacterEvent);
108
109 var
110 CharacterMapDialog: TCharacterMapDialog;
111
112 implementation
113
114 {$R *.lfm}
115
116 const
117 NOT_SELECTED=Low(UnicodeBlocks)-1;
118
119 procedure ShowCharacterMap(AOnInsertChar: TOnInsertCharacterEvent);
120 begin
121 if CharacterMapDialog = nil then
122 Application.CreateForm(TCharacterMapDialog, CharacterMapDialog);
123
124 CharacterMapDialog.OnInsertCharacter := AOnInsertChar;
125 CharacterMapDialog.Show;
126 end;
127
128 { TCharacterMapDialog }
129
130 procedure TCharacterMapDialog.FormCreate(Sender: TObject);
131 begin
132 Caption := lisCharacterMap;
133 RangeLabel.Caption := lisRange;
134 SortUniRangeListButton.Flat:=True;
135 SortUniRangeListButton.Hint:=lisSortUnicodeRangeListAlphabetically;
136 IDEImages.AssignImage(SortUniRangeListButton, 'pkg_sortalphabetically');
137 ButtonPanel.HelpButton.Caption:=lisMenuHelp;
138 ButtonPanel.CloseButton.Caption:=lisBtnClose;
139
140 //EnvironmentOptions.IDEWindowLayoutList.Apply(Self, Name);
141 PageControl1.ActivePageIndex := 0;
142 AnsiCharInfoLabel.Caption := '-';
143 UnicodeCharInfoLabel.Caption := '-';
144 SelectSystemCP;
145 FillAnsiGrid;
146 end;
147
148 procedure TCharacterMapDialog.SelectSystemCP;
149 {$ifdef Windows}
150 var
151 i: Integer;
152 cp: Word;
153 cpStr: String;
154 {$endif}
155 begin
156 {$ifdef Windows}
157 // Find system code page on Windows...
158 // see: msdn.microsoft.com/library/windows/desktop/dd317756%28v=vs.85%29.aspx
159 cp := Windows.GetACP;
160 case cp of // add spaces to be sure of unique names found in the combobox
161 437..1258: cpStr := 'cp' + IntToStr(cp) + ' ';
162 10000 : cpStr := 'macintosh ';
163 20866 : cpStr := 'koi8 ';
164 28591 : cpStr := 'iso88591 ';
165 28592 : cpStr := 'iso88592 ';
166 28605 : cpStr := 'iso885915 ';
167 else cpStr := '';
168 end;
169 for i := 0 to cbCodePage.Items.Count-1 do
170 if pos(cpStr, cbCodePage.Items[i]) = 1 then
171 begin
172 cbCodePage.ItemIndex := i;
173 exit;
174 end;
175 {$endif}
176 // ... if not found, or non-Windows, just pick the first item.
177 cbCodePage.ItemIndex := 0;
178 end;
179
180 procedure TCharacterMapDialog.HelpButtonClick(Sender: TObject);
181 begin
182 LazarusHelp.ShowHelpForIDEControl(Self);
183 end;
184
RoundUpnull185 function RoundUp(Value, Divi:integer):integer;
186 begin
187 if Value mod Divi = 0 then
188 Result:=Value div Divi
189 else
190 Result:=(Value div Divi)+1;
191 end;
192
193 procedure TCharacterMapDialog.cbCodePageSelect(Sender: TObject);
194 begin
195 FillAnsiGrid;
196 end;
197
198 procedure TCharacterMapDialog.cbUniRangeSelect(Sender: TObject);
199 begin
200 FUnicodeBlockIndex:=UnicodeBlockIndexByName(cbUniRange.Text);
201 FillUnicodeGrid;
202 end;
203
204 procedure TCharacterMapDialog.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
205 begin
206 if Key=VK_ESCAPE then
207 begin
208 Close;
209 Key:= 0;
210 end;
211 end;
212
213 procedure TCharacterMapDialog.FormShow(Sender: TObject);
214 begin
215 AnsiGrid.Font.Name := EditorOpts.EditorFont;
216 UnicodeGrid.Font.Name := EditorOpts.EditorFont;
217 AnsiGrid.Font.Size := 10;
218 UnicodeGrid.Font.Size := 10;
219
220 AnsiGrid.AutoSizeColumn(0);
221 AnsiGrid.AutoFillColumns := true;
222
223 FUnicodeBlockIndex:=NOT_SELECTED;
224 FillUniRangeList(SortUniRangeListButton.Down);
225 FillUnicodeGrid;
226 cbCodePage.DropDownCount := Math.max(EnvironmentOptions.DropDownCount, 25);
227 cbUniRange.DropDownCount := Math.max(EnvironmentOptions.DropDownCount, 25);
228 end;
229
230 procedure TCharacterMapDialog.SortUniRangeListButtonClick(Sender: TObject);
231 begin
232 FillUniRangeList(SortUniRangeListButton.Down);
233 end;
234
235 procedure TCharacterMapDialog.AnsiGridSelectCell(Sender: TObject; aCol,
236 aRow: Integer; var CanSelect: Boolean);
237 begin
238 DoStatusAnsiGrid(aCol, aRow);
239 end;
240
241 procedure TCharacterMapDialog.UnicodeGridSelectCell(Sender: TObject; aCol,
242 aRow: Integer; var CanSelect: Boolean);
243 begin
244 DoStatusUnicodeGrid(aCol, aRow);
245 end;
246
247 procedure TCharacterMapDialog.StringGridKeyPress(Sender: TObject; var Key: char);
248 var
249 sg: TStringGrid;
250 s: string;
251 begin
252 if Key = #13 then
253 begin
254 sg := Sender as TStringGrid;
255 s := sg.Cells[sg.Col, sg.Row];
256 if (s <> '') and (Assigned(OnInsertCharacter)) then
257 OnInsertCharacter(s);
258 end;
259 end;
260
261 procedure TCharacterMapDialog.StringGridMouseDown(Sender: TObject;
262 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
263 var
264 Row, Col: Integer;
265 sg: TStringGrid;
266 begin
267 sg := Sender as TStringGrid;
268 if (Button = mbLeft) and (sg.MouseToGridZone(X, Y) = gzNormal) then
269 begin
270 Col:=0; Row:=0;
271 sg.MouseToCell(X, Y, Col, Row);
272 if (sg.Cells[Col, Row] <> '') and (Assigned(OnInsertCharacter)) then
273 OnInsertCharacter(sg.Cells[Col, Row]);
274 end;
275 end;
276
277 procedure TCharacterMapDialog.DoStatusAnsiGrid(ACol, ARow: integer);
278 var
279 N: integer;
280 begin
281 N := ACol-1 + (ARow-1)*16 + 32;
282 AnsiCharInfoLabel.Caption := Format('Decimal: %s, Hex: $%s', [IntToStr(N), IntToHex(N, 2)]);
283 end;
284
285 procedure TCharacterMapDialog.AnsiGridMouseMove(Sender: TObject;
286 Shift: TShiftState; X, Y: Integer);
287 var
288 Row, Col: Integer;
289 begin
290 if AnsiGrid.MouseToGridZone(X, Y) = gzNormal then
291 begin
292 Col:=0; Row:=0;
293 AnsiGrid.MouseToCell(X, Y, Col, Row);
294 DoStatusAnsiGrid(Col, Row);
295 end
296 else
297 AnsiCharInfoLabel.Caption := '-';
298 end;
299
300 procedure TCharacterMapDialog.GridPrepareCanvas(sender: TObject; aCol,
301 aRow: Integer; aState: TGridDrawState);
302 var
303 ts: TTextStyle;
304 begin
305 with (Sender as TStringGrid) do begin
306 ts := Canvas.TextStyle;
307 ts.Alignment := taCenter;
308 Canvas.TextStyle := ts;
309 end;
310 end;
311
312 procedure TCharacterMapDialog.DoStatusUnicodeGrid(ACol, ARow: integer);
313 var
314 S: Cardinal;
315 tmp, tmp2: String;
316 i: Integer;
317 begin
318 if not UnicodeBlockSelected then Exit;
319 S:=UnicodeBlocks[FUnicodeBlockIndex].S+(ACol)+(ARow*16);
320 tmp:=UnicodeToUTF8(S);
321 tmp2:='';
322 for i:=1 to Length(tmp) do
323 tmp2:=tmp2+'$'+IntToHex(Ord(tmp[i]),2);
324 UnicodeCharInfoLabel.Caption:='U+'+inttohex(S,4)+', UTF-8: '+tmp2;
325 end;
326
327 procedure TCharacterMapDialog.UnicodeGridMouseMove(Sender: TObject;
328 Shift: TShiftState; X, Y: Integer);
329 var
330 Row, Col: Integer;
331 begin
332 if UnicodeGrid.MouseToGridZone(X, Y) = gzNormal then
333 begin
334 Col:=0; Row:=0;
335 UnicodeGrid.MouseToCell(X, Y, Col, Row);
336 DoStatusUnicodeGrid(Col, Row);
337 end
338 else
339 AnsiCharInfoLabel.Caption := '-';
340 end;
341
342 procedure TCharacterMapDialog.FillAnsiGrid;
343 var
344 R, C, p: Integer;
345 cp: String;
346 begin
347 cp := cbCodePage.Items[cbCodePage.ItemIndex];
348 p := pos(' ', cp);
349 if p > 0 then SetLength(cp, p-1);
350 for R := 0 to Pred(AnsiGrid.RowCount) do
351 begin
352 if R <> 0 then AnsiGrid.Cells[0, R] := Format('%.3d +', [Succ(R) * 16]);
353 for C := 1 to Pred(AnsiGrid.ColCount) do
354 begin
355 if R = 0 then AnsiGrid.Cells[C, R] := Format('%.2d', [Pred(C)])
356 else
357 AnsiGrid.Cells[C, R] := ConvertEncoding(Chr(Succ(R) * 16 + Pred(C)), cp, 'utf8');
358 end;
359 end;
360 end;
361
362 procedure TCharacterMapDialog.FillUnicodeGrid;
363 var
364 cnt, x, y: integer;
365 S, E: integer;
366 begin
367 UnicodeGrid.Clear;
368 if not UnicodeBlockSelected then
369 Exit;
370 S:=UnicodeBlocks[FUnicodeBlockIndex].S;
371 E:=UnicodeBlocks[FUnicodeBlockIndex].E;
372 UnicodeGrid.ColCount:=16;
373 UnicodeGrid.RowCount:=RoundUp(E-S,16);
374 cnt:=0;
375 for y:=0 to UnicodeGrid.RowCount-1 do
376 for x:=0 to UnicodeGrid.ColCount-1 do
377 begin
378 if S+Cnt<=E then
379 UnicodeGrid.Cells[x,y]:=UnicodeToUTF8(S+Cnt);
380 inc(cnt);
381 end;
382 UnicodeGrid.AutoSizeColumns;
383 end;
384
385 procedure TCharacterMapDialog.FillUniRangeList(ASorted: Boolean);
386 var
387 BlockIdx: Integer;
388 begin
389 cbUniRange.Items.Clear;
390 cbUniRange.Sorted:=ASorted;
391
392 for BlockIdx:=Low(UnicodeBlocks) to High(UnicodeBlocks) do
393 cbUniRange.Items.Append(UnicodeBlocks[BlockIdx].PG);
394
395 if not UnicodeBlockSelected then
396 FUnicodeBlockIndex:=Low(UnicodeBlocks);
397 cbUniRange.Text:=UnicodeBlocks[FUnicodeBlockIndex].PG;
398 end;
399
UnicodeBlockIndexByNamenull400 function TCharacterMapDialog.UnicodeBlockIndexByName(AName: String): Integer;
401 var
402 BlockIdx: Integer;
403 begin
404 for BlockIdx:=Low(UnicodeBlocks) to High(UnicodeBlocks) do
405 if UnicodeBlocks[BlockIdx].PG=AName then
406 Exit(BlockIdx);
407 Result:=NOT_SELECTED;
408 end;
409
UnicodeBlockSelectednull410 function TCharacterMapDialog.UnicodeBlockSelected: Boolean;
411 begin
412 Result:=(FUnicodeBlockIndex>=Low(UnicodeBlocks)) and (FUnicodeBlockIndex<=High(UnicodeBlocks));
413 end;
414
415 end.
416
417