paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-27 13:20:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: Fix not showing Chars > Chr(127) in ANSI Tab of CharactermapDlg. Improve ANSI charater map. Patch by wp, minor modifications by me. Issue #0029856.

Browse Source 
(Separate patch for 1.6 fixes, not merged from trunk because of conflicts).

git-svn-id: branches/fixes_1_6@52016 -
This commit is contained in:
bart 2016-03-22 20:58:07 +00:00
parent c96115ece1
commit ddbe060489
2 changed files with 176 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

188
ide/charactermapdlg.lfm
View File

@ -14,11 +14,11 @@ object CharacterMapDialog: TCharacterMapDialog
OnKeyDown = FormKeyDown OnKeyDown = FormKeyDown
OnShow = FormShow OnShow = FormShow
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '1.5' LCLVersion = '1.6.1.0'
object ButtonPanel: TButtonPanel object ButtonPanel: TButtonPanel
Left = 6 Left = 6
Height = 29 Height = 26
Top = 442 Top = 445
Width = 581 Width = 581
OKButton.Name = 'OKButton' OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True OKButton.DefaultCaption = True
@ -42,81 +42,40 @@ object CharacterMapDialog: TCharacterMapDialog
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonPanel AnchorSideBottom.Control = ButtonPanel
Left = 6 Left = 6
Height = 430 Height = 433
Top = 6 Top = 6
Width = 581 Width = 581
ActivePage = TabSheet1 ActivePage = pgUnicode
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 6 BorderSpacing.Around = 6
TabIndex = 0 TabIndex = 0
TabOrder = 1 TabOrder = 1
object TabSheet1: TTabSheet object pgUnicode: TTabSheet
Caption = 'ANSI'
ClientHeight = 399
ClientWidth = 577
object CharInfoLabel: TLabel
AnchorSideLeft.Control = TabSheet1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = TabSheet1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = TabSheet1
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 17
Top = 376
Width = 565
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Around = 6
Caption = 'CharInfoLabel'
ParentColor = False
end
object StringGrid1: TStringGrid
AnchorSideLeft.Control = TabSheet1
AnchorSideTop.Control = TabSheet1
AnchorSideRight.Control = TabSheet1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CharInfoLabel
Left = 0
Height = 370
Top = 0
Width = 577
Anchors = [akTop, akLeft, akRight, akBottom]
ColCount = 17
DefaultColWidth = 16
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goSmoothScroll]
RowCount = 15
TabOrder = 0
OnKeyPress = StringGridKeyPress
OnMouseDown = StringGridMouseDown
OnMouseMove = StringGrid1MouseMove
end
end
object TabSheet2: TTabSheet
Caption = 'Unicode' Caption = 'Unicode'
ClientHeight = 399 ClientHeight = 405
ClientWidth = 577 ClientWidth = 573
object UnicodeCharInfoLabel: TLabel object UnicodeCharInfoLabel: TLabel
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = cbUniRange AnchorSideTop.Control = cbUniRange
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 17 Height = 15
Top = 369 Top = 380
Width = 150 Width = 118
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'UnicodeCharInfoLabel' Caption = 'UnicodeCharInfoLabel'
ParentColor = False ParentColor = False
end end
object StringGrid2: TStringGrid object StringGrid2: TStringGrid
AnchorSideLeft.Control = TabSheet2 AnchorSideLeft.Control = pgUnicode
AnchorSideTop.Control = TabSheet2 AnchorSideTop.Control = pgUnicode
AnchorSideRight.Control = TabSheet2 AnchorSideRight.Control = pgUnicode
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = cbUniRange AnchorSideBottom.Control = cbUniRange
Left = 0 Left = 0
Height = 356 Height = 370
Top = 0 Top = 0
Width = 577 Width = 573
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
ColCount = 16 ColCount = 16
DefaultColWidth = 16 DefaultColWidth = 16
@ -130,22 +89,123 @@ object CharacterMapDialog: TCharacterMapDialog
OnMouseMove = StringGrid2MouseMove OnMouseMove = StringGrid2MouseMove
end end
object cbUniRange: TComboBox object cbUniRange: TComboBox
AnchorSideRight.Control = TabSheet2 AnchorSideRight.Control = pgUnicode
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = TabSheet2 AnchorSideBottom.Control = pgUnicode
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 359 Left = 534
Height = 31 Height = 23
Top = 362 Top = 376
Width = 212 Width = 33
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
BorderSpacing.Around = 6 BorderSpacing.Around = 6
DropDownCount = 25 DropDownCount = 25
ItemHeight = 0 ItemHeight = 15
OnSelect = cbUniRangeSelect OnSelect = cbUniRangeSelect
Style = csDropDownList Style = csDropDownList
TabOrder = 1 TabOrder = 1
end end
end end
object pgAnsi: TTabSheet
Caption = 'ANSI'
ClientHeight = 405
ClientWidth = 573
object CharInfoLabel: TLabel
AnchorSideLeft.Control = pgAnsi
AnchorSideTop.Control = cbCodePage
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = pgAnsi
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = pgAnsi
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 15
Top = 380
Width = 74
BorderSpacing.Around = 6
Caption = 'CharInfoLabel'
ParentColor = False
end
object StringGrid1: TStringGrid
AnchorSideLeft.Control = pgAnsi
AnchorSideTop.Control = pgAnsi
AnchorSideRight.Control = pgAnsi
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = cbCodePage
Left = 0
Height = 370
Top = 0
Width = 573
Anchors = [akTop, akLeft, akRight, akBottom]
ColCount = 17
DefaultColWidth = 16
DefaultDrawing = False
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goSmoothScroll]
RowCount = 15
TabOrder = 0
OnKeyPress = StringGridKeyPress
OnMouseDown = StringGridMouseDown
OnMouseMove = StringGrid1MouseMove
end
object cbCodePage: TComboBox
AnchorSideTop.Control = StringGrid1
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = pgAnsi
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = pgAnsi
AnchorSideBottom.Side = asrBottom
Left = 248
Height = 23
Top = 376
Width = 319
Anchors = [akRight, akBottom]
BorderSpacing.Around = 6
DropDownCount = 25
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'cp1250 - Central and East European Latin'
'cp1251 - Cyrillic'
'cp1252 - West European Latin'
'cp1253 - Greek'
'cp1254 - Turkish'
'cp1255 - Hebrew'
'cp1256 - Arabic'
'cp1257 - Baltic'
'cp1258 - Vietnamese'
'cp437 - Original IBM PC hardware'
'cp850 - Latin-1'
'cp852 - Latin-2'
'cp866 - Belarusian, Russian, Ukrainian'
'cp874 - Thai'
'cp932 - Japanese'
'cp936 - ANSI/OEM Simplified Chinese'
'cp949 - Korean'
'cp950 - Traditional Chinese'
'macintosh'
'koi8'
'iso88591 - ISO Latin-1 (Western Europe)'
'iso88592 - ISO Latin-2 (Central and Eastern Europe)'
'iso885915 - ISO Latin-9 (Western Europe)'
)
OnSelect = cbCodePageSelect
Style = csDropDownList
TabOrder = 1
Text = 'cp1250 - Central and East European Latin'
end
object Label1: TLabel
AnchorSideLeft.Control = CharInfoLabel
AnchorSideTop.Control = cbCodePage
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = cbCodePage
Left = 185
Height = 15
Top = 380
Width = 57
Anchors = [akTop, akRight]
Caption = 'Code page'
ParentColor = False
end
end
end end
end end

56
ide/charactermapdlg.pas
View File

@ -40,6 +40,7 @@ uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons,
StdCtrls, LCLType, LCLUnicodeData, GraphType, Grids, ButtonPanel, ComCtrls, StdCtrls, LCLType, LCLUnicodeData, GraphType, Grids, ButtonPanel, ComCtrls,
IDEHelpIntf, LazUTF8, IDEHelpIntf, LazUTF8,
{$ifdef Windows}Windows,{$endif}lconvencoding,
LazarusIDEStrConsts, EditorOptions, EnvironmentOpts; LazarusIDEStrConsts, EditorOptions, EnvironmentOpts;
type type
@ -49,14 +50,17 @@ type
TCharacterMapDialog = class(TForm) TCharacterMapDialog = class(TForm)
ButtonPanel: TButtonPanel; ButtonPanel: TButtonPanel;
cbCodePage: TComboBox;
CharInfoLabel: TLabel; CharInfoLabel: TLabel;
cbUniRange: TComboBox; cbUniRange: TComboBox;
Label1: TLabel;
UnicodeCharInfoLabel: TLabel; UnicodeCharInfoLabel: TLabel;
PageControl1: TPageControl; PageControl1: TPageControl;
StringGrid1: TStringGrid; StringGrid1: TStringGrid;
StringGrid2: TStringGrid; StringGrid2: TStringGrid;
TabSheet1: TTabSheet; pgAnsi: TTabSheet;
TabSheet2: TTabSheet; pgUnicode: TTabSheet;
procedure cbCodePageSelect(Sender: TObject);
procedure cbUniRangeSelect(Sender: TObject); procedure cbUniRangeSelect(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState); procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure HelpButtonClick(Sender: TObject); procedure HelpButtonClick(Sender: TObject);
@ -72,6 +76,7 @@ type
private private
FOnInsertCharacter: TOnInsertCharacterEvent; FOnInsertCharacter: TOnInsertCharacterEvent;
procedure FillCharMap; procedure FillCharMap;
procedure SelectSystemCP;
public public
property OnInsertCharacter: TOnInsertCharacterEvent read FOnInsertCharacter property OnInsertCharacter: TOnInsertCharacterEvent read FOnInsertCharacter
write FOnInsertCharacter; write FOnInsertCharacter;
@ -104,11 +109,45 @@ begin
ButtonPanel.CloseButton.Caption:=lisBtnClose; ButtonPanel.CloseButton.Caption:=lisBtnClose;
//EnvironmentOptions.IDEWindowLayoutList.Apply(Self, Name); //EnvironmentOptions.IDEWindowLayoutList.Apply(Self, Name);
PageControl1.ActivePageIndex := 0;
CharInfoLabel.Caption := '-'; CharInfoLabel.Caption := '-';
UnicodeCharInfoLabel.Caption := '-'; UnicodeCharInfoLabel.Caption := '-';
SelectSystemCP;
FillCharMap; FillCharMap;
end; end;
procedure TCharacterMapDialog.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 := 'koi8 ';
28591 : cpStr := 'iso88591 ';
28592 : cpStr := 'iso88592 ';
28605 : cpStr := 'iso885915 ';
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;
procedure TCharacterMapDialog.HelpButtonClick(Sender: TObject); procedure TCharacterMapDialog.HelpButtonClick(Sender: TObject);
begin begin
LazarusHelp.ShowHelpForIDEControl(Self); LazarusHelp.ShowHelpForIDEControl(Self);
@ -121,6 +160,11 @@ begin
Result:=(Value div Divi)+1; Result:=(Value div Divi)+1;
end; end;
procedure TCharacterMapDialog.cbCodePageSelect(Sender: TObject);
begin
FillCharMap;
end;
procedure TCharacterMapDialog.cbUniRangeSelect(Sender: TObject); procedure TCharacterMapDialog.cbUniRangeSelect(Sender: TObject);
var cnt, x, y :integer; var cnt, x, y :integer;
S,E:Integer; S,E:Integer;
@ -247,8 +291,12 @@ end;
procedure TCharacterMapDialog.FillCharMap; procedure TCharacterMapDialog.FillCharMap;
var var
R, C: Integer; R, C, p: Integer;
cp: String;
begin begin
cp := cbCodePage.Items[cbCodePage.ItemIndex];
p := pos(' ', cp);
if p > 0 then SetLength(cp, p-1);
for R := 0 to Pred(StringGrid1.RowCount) do for R := 0 to Pred(StringGrid1.RowCount) do
begin begin
if R <> 0 then StringGrid1.Cells[0, R] := Format('%.3d +', [Succ(R) * 16]); if R <> 0 then StringGrid1.Cells[0, R] := Format('%.3d +', [Succ(R) * 16]);
@ -256,7 +304,7 @@ begin
begin begin
if R = 0 then StringGrid1.Cells[C, R] := Format('%.2d', [Pred(C)]) if R = 0 then StringGrid1.Cells[C, R] := Format('%.2d', [Pred(C)])
else else
StringGrid1.Cells[C, R] := AnsiToUTF8(Chr(Succ(R) * 16 + Pred(C))); StringGrid1.Cells[C, R] := ConvertEncoding(Chr(Succ(R) * 16 + Pred(C)), cp, 'utf8');
end; end;
end; end;
end; end;