mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 00:37:55 +02:00
527 lines
16 KiB
ObjectPascal
527 lines
16 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
charactermapdlg.pas
|
|
-------------------
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
Dialog for character map.
|
|
}
|
|
|
|
unit CharacterMapFrm;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$ifdef WINDOWS}Windows,{$endif}
|
|
Classes, SysUtils, Math,
|
|
// LCL
|
|
Controls, Graphics, Dialogs, Buttons, StdCtrls, Forms,
|
|
LCLType, LCLUnicodeData, Grids, ButtonPanel, ComCtrls, Spin, ImgList,
|
|
// LazUtils
|
|
GraphType, LazUTF8, LConvEncoding;
|
|
|
|
type
|
|
TCharMapPage = (cmpUnicode, cmpAnsi);
|
|
TOnInsertCharacterEvent = procedure (const C: TUTF8Char) of object;
|
|
|
|
{ TCharacterMapForm }
|
|
|
|
TCharacterMapForm = class(TForm)
|
|
ButtonPanel: TButtonPanel;
|
|
cbCodePage: TComboBox;
|
|
AnsiCharInfoLabel: TLabel;
|
|
cbUniRange: TComboBox;
|
|
AnsiSizeLabel: TLabel;
|
|
UniSizeLabel: TLabel;
|
|
seUniSize: TSpinEdit;
|
|
SortUniRangeListButton: TSpeedButton;
|
|
CodePageLabel: TLabel;
|
|
RangeLabel: TLabel;
|
|
seAnsiSize: TSpinEdit;
|
|
UnicodeCharInfoLabel: TLabel;
|
|
PageControl1: TPageControl;
|
|
AnsiGrid: TStringGrid;
|
|
UnicodeGrid: TStringGrid;
|
|
pgAnsi: TTabSheet;
|
|
pgUnicode: TTabSheet;
|
|
procedure GridPrepareCanvas(sender: TObject; {%H-}aCol, {%H-}aRow: Integer;
|
|
{%H-}aState: TGridDrawState);
|
|
procedure cbCodePageSelect(Sender: TObject);
|
|
procedure cbUniRangeSelect(Sender: TObject);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure seAnsiSizeChange(Sender: TObject);
|
|
procedure seUniSizeChange(Sender: TObject);
|
|
procedure SortUniRangeListButtonClick(Sender: TObject);
|
|
procedure AnsiGridSelectCell(Sender: TObject; aCol, aRow: Integer;
|
|
var {%H-}CanSelect: Boolean);
|
|
procedure UnicodeGridSelectCell(Sender: TObject; aCol, aRow: Integer;
|
|
var {%H-}CanSelect: Boolean);
|
|
procedure StringGridKeyPress(Sender: TObject; var Key: char);
|
|
procedure StringGridMouseDown(Sender: TObject; Button: TMouseButton;
|
|
{%H-}Shift: TShiftState; X, Y: Integer);
|
|
procedure AnsiGridMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X,
|
|
Y: Integer);
|
|
procedure UnicodeGridMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X,
|
|
Y: Integer);
|
|
private
|
|
FOnShowHelp: TNotifyEvent;
|
|
FOnInsertCharacter: TOnInsertCharacterEvent;
|
|
FUnicodeBlockIndex: Integer;
|
|
procedure DoStatusAnsiGrid(ACol, ARow: integer);
|
|
procedure DoStatusUnicodeGrid(ACol, ARow: integer);
|
|
procedure FillAnsiGrid;
|
|
procedure FillUnicodeGrid;
|
|
procedure FillUniRangeList(ASorted: Boolean);
|
|
function GetActivePage: TCharMapPage;
|
|
function GetAlphaSort: Boolean;
|
|
function GetDropDownCount: Integer;
|
|
function GetFontSize: Integer;
|
|
function UnicodeBlockIndexByName(AName: String): Integer;
|
|
function UnicodeBlockSelected: Boolean;
|
|
procedure SelectSystemCP;
|
|
procedure SetActivePage(AValue: TCharMapPage);
|
|
procedure SetAlphaSort(AValue: Boolean);
|
|
procedure SetDropDownCount(AValue: Integer);
|
|
procedure SetFontSize(AValue: Integer);
|
|
procedure SetOnShowHelp(AValue: TNotifyEvent);
|
|
public
|
|
property ActivePage: TCharMapPage read GetActivePage write SetActivePage;
|
|
property AlphaSort: Boolean read GetAlphaSort write SetAlphaSort;
|
|
property DropDownCount: Integer read GetDropDownCount write SetDropDownCount;
|
|
property FontSize: Integer read GetFontSize write SetFontSize;
|
|
property OnInsertCharacter: TOnInsertCharacterEvent
|
|
read FOnInsertCharacter write FOnInsertCharacter;
|
|
property OnShowHelp: TNotifyEvent
|
|
read FOnShowHelp write SetOnShowHelp;
|
|
end;
|
|
|
|
procedure ShowCharacterMap(AOnInsertChar: TOnInsertCharacterEvent);
|
|
|
|
var
|
|
CharacterMapForm: TCharacterMapForm;
|
|
|
|
resourcestring
|
|
lisCharacterMap = 'Character Map';
|
|
lisRange = 'Range';
|
|
lisSortUnicodeRangeListAlphabetically = 'Sort Unicode range list alphabetically';
|
|
lisInsertCharacter = 'Insert from Character Map...';
|
|
lisCharSize = 'Character Size';
|
|
lisCodePage = 'Code Page';
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
{$R charactermap_images.res}
|
|
|
|
uses
|
|
LCLStrConsts;
|
|
|
|
const
|
|
NOT_SELECTED=Low(UnicodeBlocks)-1;
|
|
|
|
procedure ShowCharacterMap(AOnInsertChar: TOnInsertCharacterEvent);
|
|
begin
|
|
if CharacterMapForm = nil then
|
|
Application.CreateForm(TCharacterMapForm, CharacterMapForm);
|
|
|
|
CharacterMapForm.OnInsertCharacter := AOnInsertChar;
|
|
CharacterMapForm.Show;
|
|
end;
|
|
|
|
{ TCharacterMapForm }
|
|
|
|
procedure TCharacterMapForm.FormCreate(Sender: TObject);
|
|
begin
|
|
Caption := lisCharacterMap;
|
|
RangeLabel.Caption := lisRange;
|
|
UniSizeLabel.Caption := lisCharSize;
|
|
CodePageLabel.Caption := lisCodePage;
|
|
AnsiSizeLabel.Caption := lisCharSize;
|
|
SortUniRangeListButton.Flat := True;
|
|
SortUniRangeListButton.Hint := lisSortUnicodeRangeListAlphabetically;
|
|
SortUniRangeListButton.Images := LCLGlyphs;
|
|
SortUniRangeListButton.ImageIndex := LCLGlyphs.GetImageIndex('charmap_sortalphabetically');
|
|
ButtonPanel.HelpButton.Caption := rsMbHelp;
|
|
ButtonPanel.CloseButton.Caption := rsMbClose;
|
|
ButtonPanel.ShowButtons := [pbClose];
|
|
|
|
//EnvironmentOptions.IDEWindowLayoutList.Apply(Self, Name);
|
|
PageControl1.ActivePageIndex := 0;
|
|
AnsiCharInfoLabel.Caption := '-';
|
|
UnicodeCharInfoLabel.Caption := '-';
|
|
SelectSystemCP;
|
|
FillAnsiGrid;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.SelectSystemCP;
|
|
{$ifdef Windows}
|
|
var
|
|
i: Integer;
|
|
cp: Word;
|
|
cpStr: String;
|
|
{$endif}
|
|
begin
|
|
{$ifdef Windows}
|
|
// Find system code page on Windows...
|
|
// see: msdn.microsoft.com/library/windows/desktop/dd317756%28v=vs.85%29.aspx
|
|
cp := Windows.GetACP;
|
|
case cp of // add spaces to be sure of unique names found in the combobox
|
|
437..1258: cpStr := 'cp' + IntToStr(cp) + ' ';
|
|
10000 : cpStr := 'macintosh ';
|
|
20866 : cpStr := 'koi8r ';
|
|
21866 : cpStr := 'koi8u ';
|
|
28591 : cpStr := 'iso88591 ';
|
|
28592 : cpStr := 'iso88592 ';
|
|
28593 : cpStr := 'iso88593 ';
|
|
28594 : cpStr := 'iso88594 ';
|
|
28595 : cpStr := 'iso88595 ';
|
|
28597 : cpStr := 'iso88597 ';
|
|
28599 : cpStr := 'iso88599 ';
|
|
28600 : cpStr := 'iso885910 ';
|
|
28603 : cpStr := 'iso885913 ';
|
|
28604 : cpStr := 'iso885914 ';
|
|
28605 : cpStr := 'iso885915 ';
|
|
28606 : cpStr := 'iso885916 ';
|
|
else cpStr := '';
|
|
end;
|
|
for i := 0 to cbCodePage.Items.Count-1 do
|
|
if pos(cpStr, cbCodePage.Items[i]) = 1 then
|
|
begin
|
|
cbCodePage.ItemIndex := i;
|
|
exit;
|
|
end;
|
|
{$endif}
|
|
// ... if not found, or non-Windows, just pick the first item.
|
|
cbCodePage.ItemIndex := 0;
|
|
end;
|
|
|
|
function RoundUp(Value, Divi:integer):integer;
|
|
begin
|
|
if Value mod Divi = 0 then
|
|
Result:=Value div Divi
|
|
else
|
|
Result:=(Value div Divi)+1;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.cbCodePageSelect(Sender: TObject);
|
|
begin
|
|
FillAnsiGrid;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.cbUniRangeSelect(Sender: TObject);
|
|
begin
|
|
FUnicodeBlockIndex:=UnicodeBlockIndexByName(cbUniRange.Text);
|
|
FillUnicodeGrid;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if Key=VK_ESCAPE then
|
|
begin
|
|
Close;
|
|
Key:= 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.FormShow(Sender: TObject);
|
|
var
|
|
savedFontSize: Integer;
|
|
begin
|
|
// Auto-adjust the width of the AnsiGrid's fixed column. Note that
|
|
// the font defined in PrepareCanvas is ignored by AutoSizeColumn.
|
|
savedfontSize := AnsiGrid.Font.Size;
|
|
AnsiGrid.Font.Size := 10;
|
|
AnsiGrid.AutoSizeColumn(0);
|
|
AnsiGrid.Font.Size := savedFontSize;
|
|
// Now also auto-adjust the widths of the other AnsiGrid to fill the client area.
|
|
AnsiGrid.AutoFillColumns := true;
|
|
|
|
FUnicodeBlockIndex:=NOT_SELECTED;
|
|
FillUniRangeList(SortUniRangeListButton.Down);
|
|
FillUnicodeGrid;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.seAnsiSizeChange(Sender: TObject);
|
|
begin
|
|
AnsiGrid.Font.Size := seAnsiSize.Value;
|
|
seUniSize.Value := seAnsiSize.Value;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.seUniSizeChange(Sender: TObject);
|
|
begin
|
|
UnicodeGrid.Font.Size := seUniSize.Value;
|
|
seAnsiSize.Value := seUniSize.Value;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.SortUniRangeListButtonClick(Sender: TObject);
|
|
begin
|
|
FillUniRangeList(SortUniRangeListButton.Down);
|
|
end;
|
|
|
|
procedure TCharacterMapForm.AnsiGridSelectCell(Sender: TObject; aCol,
|
|
aRow: Integer; var CanSelect: Boolean);
|
|
begin
|
|
DoStatusAnsiGrid(aCol, aRow);
|
|
end;
|
|
|
|
procedure TCharacterMapForm.UnicodeGridSelectCell(Sender: TObject; aCol,
|
|
aRow: Integer; var CanSelect: Boolean);
|
|
begin
|
|
DoStatusUnicodeGrid(aCol, aRow);
|
|
end;
|
|
|
|
procedure TCharacterMapForm.StringGridKeyPress(Sender: TObject; var Key: char);
|
|
var
|
|
sg: TStringGrid;
|
|
s: string;
|
|
begin
|
|
if Key = #13 then
|
|
begin
|
|
sg := Sender as TStringGrid;
|
|
s := sg.Cells[sg.Col, sg.Row];
|
|
if (s <> '') and (Assigned(OnInsertCharacter)) then
|
|
OnInsertCharacter(s);
|
|
end;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.StringGridMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Row, Col: Integer;
|
|
sg: TStringGrid;
|
|
begin
|
|
sg := Sender as TStringGrid;
|
|
if (Button = mbLeft) and (sg.MouseToGridZone(X, Y) = gzNormal) then
|
|
begin
|
|
Col:=0; Row:=0;
|
|
sg.MouseToCell(X, Y, Col, Row);
|
|
if (sg.Cells[Col, Row] <> '') and (Assigned(OnInsertCharacter)) then
|
|
OnInsertCharacter(sg.Cells[Col, Row]);
|
|
end;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.DoStatusAnsiGrid(ACol, ARow: integer);
|
|
var
|
|
N: integer;
|
|
begin
|
|
N := ACol-1 + (ARow-1)*16 + 32;
|
|
AnsiCharInfoLabel.Caption := Format('%s / $%s', [IntToStr(N), IntToHex(N, 2)]);
|
|
end;
|
|
|
|
procedure TCharacterMapForm.AnsiGridMouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Row, Col: Integer;
|
|
begin
|
|
if AnsiGrid.MouseToGridZone(X, Y) = gzNormal then
|
|
begin
|
|
Col:=0; Row:=0;
|
|
AnsiGrid.MouseToCell(X, Y, Col, Row);
|
|
DoStatusAnsiGrid(Col, Row);
|
|
end
|
|
else
|
|
AnsiCharInfoLabel.Caption := '-';
|
|
end;
|
|
|
|
procedure TCharacterMapForm.GridPrepareCanvas(sender: TObject; aCol,
|
|
aRow: Integer; aState: TGridDrawState);
|
|
var
|
|
ts: TTextStyle;
|
|
begin
|
|
with (Sender as TStringGrid) do begin
|
|
ts := Canvas.TextStyle;
|
|
ts.Alignment := taCenter;
|
|
Canvas.TextStyle := ts;
|
|
if (Sender = AnsiGrid) and ((aCol = 0) or (aRow = 0)) then
|
|
Canvas.Font.Size := 10;
|
|
end;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.DoStatusUnicodeGrid(ACol, ARow: integer);
|
|
var
|
|
S: Cardinal;
|
|
tmp, tmp2: String;
|
|
i: Integer;
|
|
begin
|
|
if not UnicodeBlockSelected then Exit;
|
|
S:=UnicodeBlocks[FUnicodeBlockIndex].S+(ACol)+(ARow*16);
|
|
tmp:=UnicodeToUTF8(S);
|
|
tmp2:='';
|
|
for i:=1 to Length(tmp) do
|
|
tmp2:=tmp2+'$'+IntToHex(Ord(tmp[i]),2);
|
|
UnicodeCharInfoLabel.Caption:='U+'+inttohex(S,4)+', UTF-8: '+tmp2;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.UnicodeGridMouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Row, Col: Integer;
|
|
begin
|
|
if UnicodeGrid.MouseToGridZone(X, Y) = gzNormal then
|
|
begin
|
|
Col:=0; Row:=0;
|
|
UnicodeGrid.MouseToCell(X, Y, Col, Row);
|
|
DoStatusUnicodeGrid(Col, Row);
|
|
end
|
|
else
|
|
AnsiCharInfoLabel.Caption := '-';
|
|
end;
|
|
|
|
procedure TCharacterMapForm.FillAnsiGrid;
|
|
var
|
|
R, C, p: Integer;
|
|
cp: String;
|
|
begin
|
|
cp := cbCodePage.Items[cbCodePage.ItemIndex];
|
|
p := pos(' ', cp);
|
|
if p > 0 then SetLength(cp, p-1);
|
|
for R := 0 to Pred(AnsiGrid.RowCount) do
|
|
begin
|
|
if R <> 0 then AnsiGrid.Cells[0, R] := Format('%.3d +', [Succ(R) * 16]);
|
|
for C := 1 to Pred(AnsiGrid.ColCount) do
|
|
begin
|
|
if R = 0 then AnsiGrid.Cells[C, R] := Format('%.2d', [Pred(C)])
|
|
else
|
|
AnsiGrid.Cells[C, R] := ConvertEncoding(Chr(Succ(R) * 16 + Pred(C)), cp, 'utf8');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.FillUnicodeGrid;
|
|
var
|
|
cnt, x, y: integer;
|
|
S, E: integer;
|
|
begin
|
|
UnicodeGrid.Clear;
|
|
if not UnicodeBlockSelected then
|
|
Exit;
|
|
S:=UnicodeBlocks[FUnicodeBlockIndex].S;
|
|
E:=UnicodeBlocks[FUnicodeBlockIndex].E;
|
|
UnicodeGrid.ColCount:=16;
|
|
UnicodeGrid.RowCount:=RoundUp(E-S,16);
|
|
cnt:=0;
|
|
for y:=0 to UnicodeGrid.RowCount-1 do
|
|
for x:=0 to UnicodeGrid.ColCount-1 do
|
|
begin
|
|
if S+Cnt<=E then
|
|
UnicodeGrid.Cells[x,y]:=UnicodeToUTF8(S+Cnt);
|
|
inc(cnt);
|
|
end;
|
|
UnicodeGrid.AutoSizeColumns;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.FillUniRangeList(ASorted: Boolean);
|
|
var
|
|
BlockIdx: Integer;
|
|
begin
|
|
cbUniRange.Items.Clear;
|
|
cbUniRange.Sorted:=ASorted;
|
|
|
|
for BlockIdx:=Low(UnicodeBlocks) to High(UnicodeBlocks) do
|
|
cbUniRange.Items.Append(UnicodeBlocks[BlockIdx].PG);
|
|
|
|
if not UnicodeBlockSelected then
|
|
FUnicodeBlockIndex:=Low(UnicodeBlocks);
|
|
cbUniRange.Text:=UnicodeBlocks[FUnicodeBlockIndex].PG;
|
|
end;
|
|
|
|
function TCharacterMapForm.GetActivePage: TCharMapPage;
|
|
begin
|
|
Result := TCharMapPage(PageControl1.ActivePageIndex);
|
|
end;
|
|
|
|
function TCharacterMapForm.GetAlphaSort: Boolean;
|
|
begin
|
|
Result := SortUniRangeListButton.Down;
|
|
end;
|
|
|
|
function TCharacterMapForm.GetDropDownCount: Integer;
|
|
begin
|
|
Result := CbUniRange.DropDownCount;
|
|
end;
|
|
|
|
function TCharacterMapForm.GetFontSize: Integer;
|
|
begin
|
|
Result := seUniSize.Value;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.SetActivePage(AValue: TCharMapPage);
|
|
begin
|
|
PageControl1.ActivePageIndex := ord(AValue);
|
|
end;
|
|
|
|
procedure TCharacterMapForm.SetAlphaSort(AValue: Boolean);
|
|
begin
|
|
SortUniRangeListButton.Down := AValue;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.SetDropDownCount(AValue: Integer);
|
|
begin
|
|
CbUniRange.DropDownCount := AValue;
|
|
CbCodePage.DropDownCount := AValue;
|
|
end;
|
|
|
|
procedure TCharacterMapForm.SetFontSize(AValue: Integer);
|
|
begin
|
|
seUniSize.Value := AValue;
|
|
seAnsiSize.Value := AValue;
|
|
|
|
UnicodeGrid.Font.Size := AValue;
|
|
AnsiGrid.Font.Size := AValue;
|
|
end;
|
|
|
|
function TCharacterMapForm.UnicodeBlockIndexByName(AName: String): Integer;
|
|
var
|
|
BlockIdx: Integer;
|
|
begin
|
|
for BlockIdx:=Low(UnicodeBlocks) to High(UnicodeBlocks) do
|
|
if UnicodeBlocks[BlockIdx].PG=AName then
|
|
Exit(BlockIdx);
|
|
Result:=NOT_SELECTED;
|
|
end;
|
|
|
|
function TCharacterMapForm.UnicodeBlockSelected: Boolean;
|
|
begin
|
|
Result:=(FUnicodeBlockIndex>=Low(UnicodeBlocks)) and (FUnicodeBlockIndex<=High(UnicodeBlocks));
|
|
end;
|
|
|
|
procedure TCharacterMapForm.SetOnShowHelp(AValue: TNotifyEvent);
|
|
begin
|
|
FOnShowHelp := AValue;
|
|
ButtonPanel.HelpButton.OnClick := FOnShowHelp;
|
|
if FOnShowHelp <> nil then
|
|
ButtonPanel.ShowButtons := ButtonPanel.ShowButtons + [pbHelp]
|
|
else
|
|
ButtonPanel.ShowButtons := ButtonPanel.ShowButtons - [pbHelp];
|
|
end;
|
|
|
|
end.
|
|
|