From ddbe06048958f78e0f4b0036da6885a534e6c927 Mon Sep 17 00:00:00 2001 From: bart <9132501-flyingsheep@users.noreply.gitlab.com> Date: Tue, 22 Mar 2016 20:58:07 +0000 Subject: [PATCH] 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. (Separate patch for 1.6 fixes, not merged from trunk because of conflicts). git-svn-id: branches/fixes_1_6@52016 - --- ide/charactermapdlg.lfm | 188 ++++++++++++++++++++++++++-------------- ide/charactermapdlg.pas | 56 +++++++++++- 2 files changed, 176 insertions(+), 68 deletions(-) diff --git a/ide/charactermapdlg.lfm b/ide/charactermapdlg.lfm index d76aeff5c8..fe1df46029 100644 --- a/ide/charactermapdlg.lfm +++ b/ide/charactermapdlg.lfm @@ -14,11 +14,11 @@ object CharacterMapDialog: TCharacterMapDialog OnKeyDown = FormKeyDown OnShow = FormShow Position = poScreenCenter - LCLVersion = '1.5' + LCLVersion = '1.6.1.0' object ButtonPanel: TButtonPanel Left = 6 - Height = 29 - Top = 442 + Height = 26 + Top = 445 Width = 581 OKButton.Name = 'OKButton' OKButton.DefaultCaption = True @@ -42,81 +42,40 @@ object CharacterMapDialog: TCharacterMapDialog AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtonPanel Left = 6 - Height = 430 + Height = 433 Top = 6 Width = 581 - ActivePage = TabSheet1 + ActivePage = pgUnicode Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Around = 6 TabIndex = 0 TabOrder = 1 - object TabSheet1: 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 + object pgUnicode: TTabSheet Caption = 'Unicode' - ClientHeight = 399 - ClientWidth = 577 + ClientHeight = 405 + ClientWidth = 573 object UnicodeCharInfoLabel: TLabel AnchorSideLeft.Control = Owner AnchorSideTop.Control = cbUniRange AnchorSideTop.Side = asrCenter Left = 6 - Height = 17 - Top = 369 - Width = 150 + Height = 15 + Top = 380 + Width = 118 BorderSpacing.Around = 6 Caption = 'UnicodeCharInfoLabel' ParentColor = False end object StringGrid2: TStringGrid - AnchorSideLeft.Control = TabSheet2 - AnchorSideTop.Control = TabSheet2 - AnchorSideRight.Control = TabSheet2 + AnchorSideLeft.Control = pgUnicode + AnchorSideTop.Control = pgUnicode + AnchorSideRight.Control = pgUnicode AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = cbUniRange Left = 0 - Height = 356 + Height = 370 Top = 0 - Width = 577 + Width = 573 Anchors = [akTop, akLeft, akRight, akBottom] ColCount = 16 DefaultColWidth = 16 @@ -130,22 +89,123 @@ object CharacterMapDialog: TCharacterMapDialog OnMouseMove = StringGrid2MouseMove end object cbUniRange: TComboBox - AnchorSideRight.Control = TabSheet2 + AnchorSideRight.Control = pgUnicode AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = TabSheet2 + AnchorSideBottom.Control = pgUnicode AnchorSideBottom.Side = asrBottom - Left = 359 - Height = 31 - Top = 362 - Width = 212 + Left = 534 + Height = 23 + Top = 376 + Width = 33 Anchors = [akRight, akBottom] BorderSpacing.Around = 6 DropDownCount = 25 - ItemHeight = 0 + ItemHeight = 15 OnSelect = cbUniRangeSelect Style = csDropDownList TabOrder = 1 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 diff --git a/ide/charactermapdlg.pas b/ide/charactermapdlg.pas index bed8b57e5b..8e49c31a00 100644 --- a/ide/charactermapdlg.pas +++ b/ide/charactermapdlg.pas @@ -40,6 +40,7 @@ uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls, LCLType, LCLUnicodeData, GraphType, Grids, ButtonPanel, ComCtrls, IDEHelpIntf, LazUTF8, + {$ifdef Windows}Windows,{$endif}lconvencoding, LazarusIDEStrConsts, EditorOptions, EnvironmentOpts; type @@ -49,14 +50,17 @@ type TCharacterMapDialog = class(TForm) ButtonPanel: TButtonPanel; + cbCodePage: TComboBox; CharInfoLabel: TLabel; cbUniRange: TComboBox; + Label1: TLabel; UnicodeCharInfoLabel: TLabel; PageControl1: TPageControl; StringGrid1: TStringGrid; StringGrid2: TStringGrid; - TabSheet1: TTabSheet; - TabSheet2: TTabSheet; + pgAnsi: TTabSheet; + pgUnicode: TTabSheet; + procedure cbCodePageSelect(Sender: TObject); procedure cbUniRangeSelect(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState); procedure HelpButtonClick(Sender: TObject); @@ -72,6 +76,7 @@ type private FOnInsertCharacter: TOnInsertCharacterEvent; procedure FillCharMap; + procedure SelectSystemCP; public property OnInsertCharacter: TOnInsertCharacterEvent read FOnInsertCharacter write FOnInsertCharacter; @@ -104,11 +109,45 @@ begin ButtonPanel.CloseButton.Caption:=lisBtnClose; //EnvironmentOptions.IDEWindowLayoutList.Apply(Self, Name); + PageControl1.ActivePageIndex := 0; CharInfoLabel.Caption := '-'; UnicodeCharInfoLabel.Caption := '-'; + SelectSystemCP; FillCharMap; 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); begin LazarusHelp.ShowHelpForIDEControl(Self); @@ -121,6 +160,11 @@ begin Result:=(Value div Divi)+1; end; +procedure TCharacterMapDialog.cbCodePageSelect(Sender: TObject); +begin + FillCharMap; +end; + procedure TCharacterMapDialog.cbUniRangeSelect(Sender: TObject); var cnt, x, y :integer; S,E:Integer; @@ -247,8 +291,12 @@ end; procedure TCharacterMapDialog.FillCharMap; var - R, C: Integer; + 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(StringGrid1.RowCount) do begin if R <> 0 then StringGrid1.Cells[0, R] := Format('%.3d +', [Succ(R) * 16]); @@ -256,7 +304,7 @@ begin begin if R = 0 then StringGrid1.Cells[C, R] := Format('%.2d', [Pred(C)]) 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;