diff --git a/components/synedit/syncompletion.pas b/components/synedit/syncompletion.pas index 01c2e8a399..c09f14a42f 100644 --- a/components/synedit/syncompletion.pas +++ b/components/synedit/syncompletion.pas @@ -218,6 +218,7 @@ type procedure Cancel(Sender: TObject); procedure Validate(Sender: TObject; Shift: TShiftState); procedure KeyPress(Sender: TObject; var Key: char); + procedure UTF8KeyPress(Sender: TObject; var Key: TUTF8Char); procedure EditorKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure EditorKeyPress(Sender: TObject; var Key: char); function GetPreviousToken(FEditor: TCustomSynEdit): string; @@ -408,12 +409,7 @@ begin #33..'z': begin if Assigned(OnKeyPress) then OnKeyPress(self, Key); - {$ifdef SYN_LAZARUS} - if Key in [#33..#255] then - CurrentString := CurrentString + key; - {$else} CurrentString := CurrentString + key; - {$ENDIF} end; #8: if Assigned(OnKeyPress) then OnKeyPress(self, Key); @@ -1032,6 +1028,18 @@ begin end; end; +procedure TSynCompletion.UTF8KeyPress(Sender: TObject; var Key: TUTF8Char); +var + F: TSynBaseCompletionForm; +begin + F := Sender as TSynBaseCompletionForm; + if F.CurrentEditor <> nil then begin + with F.CurrentEditor as TCustomSynEdit do begin + CommandProcessor(ecChar, Key, nil); + end; + end; +end; + procedure TSynCompletion.SetEditor(const Value: TCustomSynEdit); begin AddEditor(Value); @@ -1050,6 +1058,7 @@ constructor TSynCompletion.Create(AOwner: TComponent); begin inherited Create(AOwner); Form.OnKeyPress := {$IFDEF FPC}@{$ENDIF}KeyPress; + Form.OnUTF8KeyPress := {$IFDEF FPC}@{$ENDIF}UTF8KeyPress; Form.OnKeyDelete := {$IFDEF FPC}@{$ENDIF}Backspace; Form.OnValidate := {$IFDEF FPC}@{$ENDIF}Validate; Form.OnCancel := {$IFDEF FPC}@{$ENDIF}Cancel; diff --git a/components/synedit/synedit.pp b/components/synedit/synedit.pp index ac6dc0241c..a56db86414 100644 --- a/components/synedit/synedit.pp +++ b/components/synedit/synedit.pp @@ -61,6 +61,9 @@ interface uses {$IFDEF SYN_LAZARUS} + {$IFDEF USE_UTF8BIDI_LCL} + utf8bidi, + {$ENDIF} FPCAdds, LCLIntf, LCLType, LMessages, LCLProc, {$ELSE} Windows, @@ -131,13 +134,16 @@ type of object; THookedCommandEvent = procedure(Sender: TObject; AfterProcessing: boolean; - var Handled: boolean; var Command: TSynEditorCommand; var AChar: char; + var Handled: boolean; var Command: TSynEditorCommand; + var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer; HandlerData: pointer) of object; TPaintEvent = procedure(Sender: TObject; ACanvas: TCanvas) of object; TProcessCommandEvent = procedure(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer) of object; + var Command: TSynEditorCommand; + var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; + Data: pointer) of object; TReplaceTextEvent = procedure(Sender: TObject; const ASearch, AReplace: string; Line, Column: integer; var ReplaceAction: TSynReplaceAction) of object; @@ -512,6 +518,11 @@ type procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: char); override; {$IFDEF SYN_LAZARUS} + procedure UTF8KeyPress(var Key: TUTF8Char); override; + {$ELSE} + procedure KeyPress(var Key: Char); override; + {$ENDIF} + {$IFDEF SYN_LAZARUS} procedure KeyUp(var Key : Word; Shift : TShiftState); override; {$ENDIF} procedure ListAdded(Index: integer); //mh 2000-10-10 @@ -532,7 +543,9 @@ type procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure NotifyHookedCommandHandlers(AfterProcessing: boolean; - var Command: TSynEditorCommand; var AChar: char; Data: pointer); virtual; + var Command: TSynEditorCommand; + var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; + Data: pointer); virtual; procedure Paint; override; procedure PaintGutter(AClip: TRect; FirstLine, LastLine: integer); virtual; procedure PaintTextLines(AClip: TRect; FirstLine, LastLine, @@ -563,14 +576,16 @@ type {$ENDIF} SavedCanvas: TCanvas; // the normal TCustomControl canvas during paint procedure DoOnClearBookmark(var Mark: TSynEditMark); virtual; // djlp - 2000-08-29 - procedure DoOnCommandProcessed(Command: TSynEditorCommand; AChar: char; + procedure DoOnCommandProcessed(Command: TSynEditorCommand; + AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer); virtual; // no method DoOnDropFiles, intercept the WM_DROPFILES instead procedure DoOnGutterClick(X, Y: integer); virtual; procedure DoOnPaint; virtual; procedure DoOnPlaceMark(var Mark: TSynEditMark); virtual; procedure DoOnProcessCommand(var Command: TSynEditorCommand; - var AChar: char; Data: pointer); virtual; + var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; + Data: pointer); virtual; function DoOnReplaceText(const ASearch, AReplace: string; Line, Column: integer): TSynReplaceAction; virtual; function DoOnSpecialLineColors(Line: integer; @@ -589,8 +604,9 @@ type procedure ClearAll; procedure ClearBookMark(BookMark: Integer); procedure ClearSelection; - procedure CommandProcessor(Command: TSynEditorCommand; AChar: char; - Data: pointer); virtual; + procedure CommandProcessor(Command:TSynEditorCommand; + AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; + Data:pointer); virtual; procedure ClearUndo; procedure CopyToClipboard; constructor Create(AOwner: TComponent); override; @@ -604,7 +620,8 @@ type {$IFDEF SYN_COMPILER_4_UP} function ExecuteAction(ExeAction: TBasicAction): boolean; override; {$ENDIF} - procedure ExecuteCommand(Command: TSynEditorCommand; AChar: char; + procedure ExecuteCommand(Command: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const AChar: TUTF8Char{$ELSE}AChar: Char{$ENDIF}; Data: pointer); virtual; function GetBookMark(BookMark: integer; var X, Y: integer): boolean; function GetHighlighterAttriAtRowCol(XY: TPoint; var Token: string; @@ -857,9 +874,6 @@ implementation // { $R SynEdit.res} uses -{$IFDEF USE_UTF8BIDI_LCL} - utf8bidi, -{$ENDIF USE_UTF8BIDI_LCL} {$IFDEF SYN_COMPILER_4_UP} StdActns, {$ENDIF} @@ -1844,6 +1858,34 @@ begin Exclude(fStateFlags, sfIgnoreNextChar); end; +{$IFDEF SYN_LAZARUS} +procedure TCustomSynEdit.UTF8KeyPress(var Key: TUTF8Char); +{$ELSE} +procedure TCustomSynEdit.KeyPress(var Key: Char); +{$ENDIF} +begin +{$IFDEF SYN_MBCSSUPPORT} + if (fImeCount > 0) then begin + Dec(fImeCount); + Exit; + end; +{$ENDIF} + // don't fire the event if key is to be ignored + if not (sfIgnoreNextChar in fStateFlags) then begin + {$IFDEF SYN_LAZARUS} + if Assigned(OnUTF8KeyPress) then OnUTF8KeyPress(Self, Key); + {$ELSE} + if Assigned(OnKeyPress) then OnKeyPress(Self, Key); + {$ENDIF} + CommandProcessor(ecChar, Key, nil); + //Key was handled, any way, so eat it! + Key:=''; + end else + // don't ignore further keys + Exclude(fStateFlags, sfIgnoreNextChar); +end; + + function TCustomSynEdit.LeftSpaces(const Line: string): Integer; var p: PChar; @@ -2527,7 +2569,12 @@ var pszText: PChar; nX, nCharsToPaint: integer; const - ETOOptions = {$IFNDEF SYN_LAZARUS}ETO_CLIPPED or {$ENDIF}ETO_OPAQUE; + ETOOptions = + {$IFNDEF SYN_LAZARUS} + // clipping is slow and not needed for lazarus + ETO_CLIPPED or + {$ENDIF} + ETO_OPAQUE; begin if (Last >= First) and (rcToken.Right > rcToken.Left) then begin nX := ColumnToXValue(First); @@ -2561,6 +2608,7 @@ var pszText, nCharsToPaint); end else begin // draw text with background + //debugln('PaintToken nX=',nX,' Token=',dbgstr(copy(pszText,1,nCharsToPaint))); fTextDrawer.ExtTextOut(nX, rcToken.Top, ETOOptions, rcToken, pszText, nCharsToPaint); end; @@ -2888,11 +2936,11 @@ var end; {begin} //mh 2000-10-19 // Find the fastest function for the tab expansion. -// pConvert := GetBestConvertTabsProc(fTabWidth); + // pConvert := GetBestConvertTabsProc(fTabWidth); // Now loop through all the lines. The indices are valid for Lines. for nLine := FirstLine to LastLine do begin // Get the expanded line. -// sLine := pConvert(Lines[nLine - 1], fTabWidth); + // sLine := pConvert(Lines[nLine - 1], fTabWidth); sLine := TSynEditStringList(Lines).ExpandedStrings[nLine - 1]; {end} //mh 2000-10-19 // Get the information about the line selection. Three different parts @@ -5788,7 +5836,8 @@ begin end; procedure TCustomSynEdit.CommandProcessor(Command: TSynEditorCommand; - AChar: char; Data: pointer); + AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; + Data: pointer); begin {$IFDEF VerboseKeys} DebugLn('[TCustomSynEdit.CommandProcessor] ',Command @@ -5810,7 +5859,8 @@ begin DoOnCommandProcessed(Command, AChar, Data); end; -procedure TCustomSynEdit.ExecuteCommand(Command: TSynEditorCommand; AChar: char; +procedure TCustomSynEdit.ExecuteCommand(Command: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const AChar: TUTF8Char{$ELSE}AChar: Char{$ENDIF}; Data: pointer); const ALPHANUMERIC = DIGIT + ALPHA_UC + ALPHA_LC; @@ -6283,18 +6333,18 @@ begin if bChangeScroll then Include(fOptions, eoScrollPastEol); StartOfBlock := CaretXY; if fInserting then begin -{$IFDEF USE_UTF8BIDI_LCL} - Len := CaretX; - utf8bidi.insert(AChar, Temp, Len); - CaretX := Len; -{$ELSE USE_UTF8BIDI_LCL} + {$IFDEF USE_UTF8BIDI_LCL} + CaretNew := CaretX; + utf8bidi.Insert(AChar, Temp, CaretNew); + CaretX := CaretNew; + {$ELSE USE_UTF8BIDI_LCL} Len := Length(Temp); if Len < CaretX then // Temp := Temp + StringOfChar(' ', CaretX - Len); Temp := Temp + StringOfChar(' ', CaretX - Len - Ord(fInserting)); //JGF 2000-09-23 System.Insert(AChar, Temp, CaretX); CaretX := CaretX + 1; -{$ENDIF USE_UTF8BIDI_LCL} + {$ENDIF not USE_UTF8BIDI_LCL} TrimmedSetLine(CaretY - 1, Temp); //JGF 2000-09-23 fUndoList.AddChange(crInsert, StartOfBlock, CaretXY, '', smNormal); @@ -6307,7 +6357,11 @@ begin end; {$ENDIF} Helper := Copy(Temp, CaretX, counter); + {$IFDEF SYN_LAZARUS} + Temp[CaretX] := AChar[1]; + {$ELSE} Temp[CaretX] := AChar; + {$ENDIF} {$IFDEF SYN_MBCSSUPPORT} if (counter > 1) then begin Temp[CaretX + 1] := ' '; @@ -6468,14 +6522,15 @@ begin end; procedure TCustomSynEdit.DoOnCommandProcessed(Command: TSynEditorCommand; - AChar: char; Data: pointer); + AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; + Data: pointer); begin if Assigned(fOnCommandProcessed) then fOnCommandProcessed(Self, Command, AChar, Data); end; procedure TCustomSynEdit.DoOnProcessCommand(var Command: TSynEditorCommand; - var AChar: char; Data: pointer); + var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer); begin if Command < ecUserFirst then begin if Assigned(FOnProcessCommand) then @@ -8123,7 +8178,8 @@ begin end; procedure TCustomSynEdit.NotifyHookedCommandHandlers(AfterProcessing: boolean; - var Command: TSynEditorCommand; var AChar: char; Data: pointer); + var Command: TSynEditorCommand; + var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer); var Handled: boolean; i: integer; diff --git a/components/synedit/syneditautocomplete.pp b/components/synedit/syneditautocomplete.pp index 9003b64cf3..70a9e9abba 100644 --- a/components/synedit/syneditautocomplete.pp +++ b/components/synedit/syneditautocomplete.pp @@ -45,6 +45,9 @@ interface uses {$IFDEF SYN_LAZARUS} + {$IFDEF USE_UTF8BIDI_LCL} + utf8bidi, + {$ENDIF} LCLIntf, LCLType, {$ELSE} Windows, @@ -83,7 +86,8 @@ type procedure SetAutoCompleteList(Value: TStrings); virtual; procedure SetEditor(Value: TCustomSynEdit); procedure SynEditCommandHandler(Sender: TObject; AfterProcessing: boolean; - var Handled: boolean; var Command: TSynEditorCommand; var AChar: char; + var Handled: boolean; var Command: TSynEditorCommand; + var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer; HandlerData: pointer); public constructor Create(AOwner: TComponent); override; @@ -563,7 +567,8 @@ end; procedure TCustomSynAutoComplete.SynEditCommandHandler(Sender: TObject; AfterProcessing: boolean; var Handled: boolean; - var Command: TSynEditorCommand; var AChar: char; Data: pointer; + var Command: TSynEditorCommand; + var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer; HandlerData: pointer); begin if not AfterProcessing and not Handled and (Command = ecAutoCompletion) then diff --git a/components/synedit/syneditplugins.pas b/components/synedit/syneditplugins.pas index 29d853f8db..01917fdc07 100644 --- a/components/synedit/syneditplugins.pas +++ b/components/synedit/syneditplugins.pas @@ -48,6 +48,9 @@ uses QMenus, {$ELSE} {$IFDEF SYN_LAZARUS} + {$IFDEF USE_UTF8BIDI_LCL} + utf8bidi, + {$ENDIF} LCLIntf, {$ELSE} Windows, @@ -89,7 +92,8 @@ type procedure UnHookEditor(aEditor: TCustomSynEdit; aCommandID: TSynEditorCommand; aShortCut: TShortCut); procedure OnCommand(Sender: TObject; AfterProcessing: boolean; - var Handled: boolean; var Command: TSynEditorCommand; var aChar: char; + var Handled: boolean; var Command: TSynEditorCommand; + var aChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer; HandlerData: pointer); virtual; abstract; end; @@ -134,7 +138,8 @@ type protected procedure SetCurrentString(const Value: String); virtual; procedure OnCommand(Sender: TObject; AfterProcessing: boolean; - var Handled: boolean; var Command: TSynEditorCommand; var aChar: char; + var Handled: boolean; var Command: TSynEditorCommand; + var aChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer; HandlerData: pointer); override; procedure DoExecute; override; procedure DoAccept; override; @@ -485,8 +490,9 @@ end; procedure TAbstractSynCompletion.OnCommand(Sender: TObject; AfterProcessing: boolean; var Handled: boolean; - var Command: TSynEditorCommand; var aChar: char; Data, - HandlerData: pointer); + var Command: TSynEditorCommand; + var aChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; + Data, HandlerData: pointer); var iString: String; begin @@ -512,9 +518,15 @@ begin end else begin - if not(aChar in CurrentEditor.IdentChars) then + {$IFDEF SYN_LAZARUS} + if (length(aChar)<>1) + or (not (aChar[1] in CurrentEditor.IdentChars)) then + Accept; + {$ELSE} + if not (aChar in CurrentEditor.IdentChars) then Accept; {don't handle the char} + {$ENDIF} end; ecLineBreak: begin diff --git a/components/synedit/synmacrorecorder.pas b/components/synedit/synmacrorecorder.pas index cd77113204..657279358f 100644 --- a/components/synedit/synmacrorecorder.pas +++ b/components/synedit/synmacrorecorder.pas @@ -56,6 +56,9 @@ uses StdCtrls, Controls, {$IFDEF SYN_LAZARUS} + {$IFDEF USE_UTF8BIDI_LCL} + utf8bidi, + {$ENDIF} LCLIntf, LCLType, {$ELSE} Windows, Messages, @@ -86,8 +89,9 @@ type procedure InitEventParameters(aStr : string); virtual; abstract; public constructor Create; {$IFNDEF FPC}virtual;{$ENDIF} - procedure Initialize(aCmd: TSynEditorCommand; aChar: Char; aData: Pointer); - virtual; abstract; + procedure Initialize(aCmd: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; + aData: Pointer); virtual; abstract; { the CommandID must not be read inside LoadFromStream/SaveToStream. It's read by the MacroRecorder component to decide which MacroEvent class to instanciate } procedure LoadFromStream(aStream: TStream); virtual; abstract; @@ -103,8 +107,9 @@ type function GetAsString : string; override; procedure InitEventParameters(aStr : string); override; public - procedure Initialize(aCmd: TSynEditorCommand; aChar: Char; aData: Pointer); - override; + procedure Initialize(aCmd: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; + aData: Pointer); override; procedure LoadFromStream(aStream: TStream); override; procedure SaveToStream(aStream: TStream); override; procedure Playback(aEditor: TCustomSynEdit); override; @@ -114,17 +119,22 @@ type TSynCharEvent = class(TSynMacroEvent) protected - fKey: char; + fKey: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; function GetAsString : string; override; procedure InitEventParameters(aStr : string); override; public - procedure Initialize(aCmd: TSynEditorCommand; aChar: Char; aData: Pointer); - override; + procedure Initialize(aCmd: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; + aData: Pointer); override; procedure LoadFromStream(aStream: TStream); override; procedure SaveToStream(aStream: TStream); override; procedure Playback(aEditor: TCustomSynEdit); override; public - property Key: char read fKey write fKey; + {$IFDEF SYN_LAZARUS} + property Key: TUTF8Char read fKey write fKey; + {$ELSE} + property Key: Char read fKey write fKey; + {$ENDIF} end; TSynStringEvent = class(TSynMacroEvent) @@ -133,8 +143,9 @@ type function GetAsString : string; override; procedure InitEventParameters(aStr : string); override; public - procedure Initialize(aCmd: TSynEditorCommand; aChar: Char; aData: Pointer); - override; + procedure Initialize(aCmd: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; + aData: Pointer); override; procedure LoadFromStream(aStream: TStream); override; procedure SaveToStream(aStream: TStream); override; procedure Playback(aEditor: TCustomSynEdit); override; @@ -148,8 +159,9 @@ type function GetAsString : string; override; procedure InitEventParameters(aStr : string); override; public - procedure Initialize(aCmd: TSynEditorCommand; aChar: Char; aData: Pointer); - override; + procedure Initialize(aCmd: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; + aData: Pointer); override; procedure LoadFromStream(aStream: TStream); override; procedure SaveToStream(aStream: TStream); override; procedure Playback(aEditor: TCustomSynEdit); override; @@ -161,8 +173,9 @@ type protected fData: Pointer; public - procedure Initialize(aCmd: TSynEditorCommand; aChar: Char; aData: Pointer); - override; + procedure Initialize(aCmd: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; + aData: Pointer); override; procedure LoadFromStream(aStream: TStream); override; procedure SaveToStream(aStream: TStream); override; procedure Playback(aEditor: TCustomSynEdit); override; @@ -204,7 +217,8 @@ type procedure DoAddEditor(aEditor: TCustomSynEdit); override; procedure DoRemoveEditor(aEditor: TCustomSynEdit); override; procedure OnCommand(Sender: TObject; AfterProcessing: boolean; - var Handled: boolean; var Command: TSynEditorCommand; var aChar: char; + var Handled: boolean; var Command: TSynEditorCommand; + var aChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer; HandlerData: pointer); override; function CreateMacroEvent(aCmd: TSynEditorCommand): TSynMacroEvent; protected @@ -279,7 +293,8 @@ uses { TSynDataEvent } -procedure TSynDataEvent.Initialize(aCmd: TSynEditorCommand; aChar: Char; +procedure TSynDataEvent.Initialize(aCmd: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; aData: Pointer); begin fCommand := aCmd; @@ -502,7 +517,8 @@ end; procedure TCustomSynMacroRecorder.OnCommand(Sender: TObject; AfterProcessing: boolean; var Handled: boolean; - var Command: TSynEditorCommand; var aChar: char; Data, + var Command: TSynEditorCommand; + var aChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data, HandlerData: pointer); var iEvent: TSynMacroEvent; @@ -754,7 +770,8 @@ begin RepeatCount := Byte(StrToIntDef(Trim(aStr), 1)); end; -procedure TSynBasicEvent.Initialize(aCmd: TSynEditorCommand; aChar: Char; +procedure TSynBasicEvent.Initialize(aCmd: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; aData: Pointer); begin Command := aCmd; @@ -806,7 +823,8 @@ begin RepeatCount := Byte(StrToIntDef(Trim(aStr), 1)); end; -procedure TSynCharEvent.Initialize(aCmd: TSynEditorCommand; aChar: Char; +procedure TSynCharEvent.Initialize(aCmd: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; aData: Pointer); begin Key := aChar; @@ -876,7 +894,8 @@ begin end; procedure TSynPositionEvent.Initialize(aCmd: TSynEditorCommand; - aChar: Char; aData: Pointer); + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; + aData: Pointer); begin inherited; if aData <> nil then @@ -946,7 +965,8 @@ begin RepeatCount := Byte(StrToIntDef(Trim(aStr), 1)); end; -procedure TSynStringEvent.Initialize(aCmd: TSynEditorCommand; aChar: Char; +procedure TSynStringEvent.Initialize(aCmd: TSynEditorCommand; + {$IFDEF SYN_LAZARUS}const aChar: TUTF8Char{$ELSE}aChar: Char{$ENDIF}; aData: Pointer); begin Value := String(aData); diff --git a/components/synedit/syntextdrawer.pp b/components/synedit/syntextdrawer.pp index 24cf0b14ab..ac87465301 100644 --- a/components/synedit/syntextdrawer.pp +++ b/components/synedit/syntextdrawer.pp @@ -417,6 +417,7 @@ begin DC := GetDC(0); hOldFont := SelectObject(DC, ABaseFont.Handle); IsDBCSFont := (0 <> (GCP_DBCS and GetFontLanguageInfo(DC))); + //debugln('TheFontsInfoManager.CreateFontsInfo IsDBCSFont=',IsDBCSFont); SelectObject(DC, hOldFont); ReleaseDC(0, DC); except @@ -718,6 +719,7 @@ begin {$ENDIF} end; {$IFDEF SYN_LAZARUS} + //debugln('TheFontStock.InternalCreateFont A ',FBaseFontName); Result := CreateFontIndirectEx(FBaseLF,FBaseFontName); {$ELSE} Result := CreateFontIndirect(FBaseLF); @@ -844,6 +846,10 @@ begin hOldFont := SelectObject(DC, FCrntFont); // retrieve height and advances of new font + {$IFDEF SYN_LAZARUS} + FpInfo^.IsDBCSFont := (0 <> (GCP_DBCS and GetFontLanguageInfo(DC))); + //debugln('TheFontStock.SetStyle A IsDBCSFont=',IsDBCSFont); + {$ENDIF} with FpCrntFontData^ do begin Handle := FCrntFont; @@ -958,6 +964,7 @@ begin with FFontStock do begin SetBaseFont(Value); + //debugln('TheTextDrawer.SetBaseFont B ',Value.Name); Style := FCalcExtentBaseStyle; FBaseCharWidth := CharAdvance; FBaseCharHeight := CharHeight; @@ -1080,7 +1087,7 @@ begin if FETOSizeInChar < Length then InitETODist(GetCharWidth); {$IFDEF SYN_LAZARUS} - LCLIntf.ExtTextOut(FDC, X, Y, fuOptions, @ARect, Text, + LCLIntf.ExtUTF8Out(FDC, X, Y, fuOptions, @ARect, Text, Length, PInteger(FETODist)); {$ELSE} Windows.ExtTextOut(FDC, X, Y, fuOptions, @ARect, Text, diff --git a/components/synunihighlighter/synunidesigner.pas b/components/synunihighlighter/synunidesigner.pas index af4fd83bd4..57711447c9 100644 --- a/components/synunihighlighter/synunidesigner.pas +++ b/components/synunihighlighter/synunidesigner.pas @@ -243,6 +243,8 @@ begin F.KeyPreview:=true; ////TL added 2 @ prefixes f.OnKeyPress:=@FormKeyPress; +{$WARNING TODO Fix UTF8BIDI issue} + f.OnUTF8KeyPress:=@FormUTF8KeyPress; f.OnKeyDown:=@FormKeyDown; f.caption:='Unihighlighter Designer (c) Fantasist, Vit (2002)'; diff --git a/ide/uniteditor.pp b/ide/uniteditor.pp index fa9d61c7df..83aef1cf9a 100644 --- a/ide/uniteditor.pp +++ b/ide/uniteditor.pp @@ -41,6 +41,9 @@ uses {$IFDEF IDE_MEM_CHECK} MemCheck, {$ENDIF} + {$IFDEF USE_UTF8BIDI_LCL} + utf8bidi, + {$ENDIF} Classes, SysUtils, Controls, LCLProc, LCLType, LResources, LCLIntf, FileCtrl, Forms, Buttons, ComCtrls, Dialogs, StdCtrls, GraphType, Graphics, Extctrls, Menus, @@ -169,11 +172,11 @@ type Procedure ReParent(AParent: TWinControl); Procedure ProcessCommand(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer); + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); Procedure ProcessUserCommand(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer); + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); Procedure UserCommandProcessed(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer); + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); Procedure ccOnTimer(sender: TObject); Procedure ccAddMessage(Texts: String); @@ -458,10 +461,10 @@ type procedure MoveActivePageLeft; procedure MoveActivePageRight; Procedure ProcessParentCommand(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer; + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer; var Handled: boolean); Procedure ParentCommandProcessed(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer; + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer; var Handled: boolean); // marks @@ -906,7 +909,7 @@ begin end; Procedure TSourceEditor.ProcessCommand(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer); + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); // these are normal commands for synedit, define extra actions here // otherwise use ProcessUserCommand begin @@ -957,16 +960,11 @@ begin end; end; - else - if (CurCompletionControl<>nil) - and (not (AChar in ['a'..'z','A'..'Z','0'..'9',#128..#255])) then begin - - end; end; end; Procedure TSourceEditor.ProcessUserCommand(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer); + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); // define all extra keys here, that should are not handled by synedit var I: Integer; @@ -1136,7 +1134,7 @@ Begin end; Procedure TSourceEditor.UserCommandProcessed(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer); + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); var Handled: boolean; begin Handled:=true; @@ -3863,15 +3861,13 @@ end; procedure TSourceNotebook.ViewCallStackClick(Sender: TObject); var Command: TSynEditorCommand; - AChar: char; - Data: pointer; + AChar: TUTF8Char; Handled: boolean; begin Command:=ecToggleCallStack; AChar:=#0; - Data:=nil; Handled:=false; - ProcessParentCommand(Self,Command,AChar,Data,Handled); + ProcessParentCommand(Self,Command,AChar,nil,Handled); end; Procedure TSourceNotebook.BookMarkSet(Value: Integer); @@ -4197,7 +4193,7 @@ Begin end; Procedure TSourceNotebook.ProcessParentCommand(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer; + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer; var Handled: boolean); begin FProcessingCommand:=true; @@ -4270,7 +4266,7 @@ begin end; Procedure TSourceNotebook.ParentCommandProcessed(Sender: TObject; - var Command: TSynEditorCommand; var AChar: char; Data: pointer; + var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer; var Handled: boolean); begin if Assigned(FOnUserCommandProcessed) then begin diff --git a/lcl/controls.pp b/lcl/controls.pp index e7206e6ebd..079c271589 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -331,7 +331,7 @@ type TKeyEvent = procedure(Sender: TObject; var Key: Word; Shift:TShiftState) of Object; TKeyPressEvent = procedure(Sender: TObject; var Key: char) of Object; - TUTF8KeyPressEvent = procedure(Sender: TObject; var UTF8Key: string) of Object; + TUTF8KeyPressEvent = procedure(Sender: TObject; var UTF8Key: TUTF8Char) of Object; TMouseEvent = Procedure(Sender: TOBject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object; @@ -1427,7 +1427,7 @@ type function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; dynamic; function DoKeyDown(var Message: TLMKey): Boolean; function DoKeyPress(var Message: TLMKey): Boolean; - function DoUTF8KeyPress(var UTF8Key: string): boolean; dynamic; + function DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; dynamic; function DoKeyUp(var Message: TLMKey): Boolean; procedure ControlKeyDown(var Key: Word; Shift: TShiftState); dynamic; procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic; @@ -1435,7 +1435,7 @@ type procedure KeyDownAfterInterface(var Key: Word; Shift: TShiftState); dynamic; procedure KeyPress(var Key: char); dynamic; procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic; - procedure UTF8KeyPress(var UTF8Key: string); dynamic; + procedure UTF8KeyPress(var UTF8Key: TUTF8Char); dynamic; protected Function FindNextControl(CurrentControl: TControl; GoForward, CheckTabStop, CheckParent, OnlyWinControls @@ -1561,7 +1561,8 @@ type procedure HandleNeeded; function BrushCreated: Boolean; procedure EraseBackground(DC: HDC); virtual; - function UTF8KeyPressMessage(var UTF8Key: string; RepeatCount: integer): boolean; dynamic; + function IntfUTF8KeyPress(var UTF8Key: TUTF8Char; + RepeatCount: integer): boolean; dynamic; public property BoundsLockCount: integer read FBoundsLockCount; property Brush: TBrush read GetBrush; @@ -2411,6 +2412,9 @@ end. { ============================================================================= $Log$ + Revision 1.243 2004/09/02 09:16:58 mattias + improved double byte char fonts for gtk1, started synedit UTF8 support + Revision 1.242 2004/08/30 16:37:58 mattias added OnUTF8KeyPresss diff --git a/lcl/include/intfbaselcl.inc b/lcl/include/intfbaselcl.inc index 0faddca40f..4970211b59 100644 --- a/lcl/include/intfbaselcl.inc +++ b/lcl/include/intfbaselcl.inc @@ -114,6 +114,12 @@ procedure TWidgetSet.DrawArrow(Arrow: TComponent; Canvas: TPersistent); begin end; +function TWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; + Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; +begin + Result:=ExtTextOut(DC,X,Y,Options,Rect,Str,Count,Dx); +end; + function TWidgetSet.Frame(DC: HDC; const ARect: TRect) : integer; begin Result:= 0; @@ -349,6 +355,11 @@ begin Result:=false; end; +function TWidgetSet.IntfSendsUTF8KeyPress: boolean; +begin + Result:=false; +end; + Function TWidgetSet.InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean; BorderWidth: integer) : Boolean; @@ -630,6 +641,9 @@ end; { ============================================================================= $Log$ + Revision 1.29 2004/09/02 09:16:59 mattias + improved double byte char fonts for gtk1, started synedit UTF8 support + Revision 1.28 2004/04/10 17:58:57 mattias implemented mainunit hints for include files diff --git a/lcl/include/lclintf.inc b/lcl/include/lclintf.inc index cced3b1fb2..3590e9f4d2 100644 --- a/lcl/include/lclintf.inc +++ b/lcl/include/lclintf.inc @@ -112,9 +112,15 @@ begin InterfaceObject.DrawArrow(Arrow, Canvas); end; +function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; + Str: PChar; Count: Longint; Dx: PInteger): Boolean; +begin + Result := InterfaceObject.ExtUTF8Out(DC,X,Y,Options,Rect,Str,Count,Dx); +end; + function Frame(DC: HDC; const ARect: TRect): Integer; begin - Result:= InterfaceObject.Frame(DC, ARect); + Result := InterfaceObject.Frame(DC, ARect); end; function Frame3d(DC : HDC; var ARect : TRect; const FrameWidth : integer; @@ -263,6 +269,16 @@ begin Result := InterfaceObject.GetWindowRelativePosition(Handle,Left,Top); end; +{------------------------------------------------------------------------------ + function IntfSendsUTF8KeyPress: Boolean; + + Returns true if interface sends UTF8 KeyPress notifications. +------------------------------------------------------------------------------} +function IntfSendsUTF8KeyPress: Boolean; +begin + Result := InterfaceObject.IntfSendsUTF8KeyPress; +end; + {------------------------------------------------------------------------------ Function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean; BorderWidth: integer) : Boolean; @@ -526,6 +542,9 @@ end; { ============================================================================= $Log$ + Revision 1.26 2004/09/02 09:16:59 mattias + improved double byte char fonts for gtk1, started synedit UTF8 support + Revision 1.25 2004/05/11 12:16:47 mattias replaced writeln by debugln diff --git a/lcl/include/lclintfh.inc b/lcl/include/lclintfh.inc index 759c1ab173..c2529508dc 100644 --- a/lcl/include/lclintfh.inc +++ b/lcl/include/lclintfh.inc @@ -58,6 +58,8 @@ function CreateRegionCopy(SrcRGN: hRGN): hRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ function DCClipRegionValid(DC: HDC): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} +function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} + function Frame(DC: HDC; const ARect: TRect): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function Frame3d(DC: HDC; var ARect: TRect; const FrameWidth : integer; const Style : TGraphicsBevelCut): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} @@ -81,6 +83,7 @@ function GetScrollBarSize(Handle: HWND; SBStyle: Integer): integer; {$IFDEF IF_B function GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetWindowRelativePosition(Handle : hwnd; var Left, Top: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} +function IntfSendsUTF8KeyPress: Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean; BorderWidth: integer) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function LoadStockPixmap(StockID: longint) : HBitmap; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} @@ -150,6 +153,9 @@ procedure RaiseLastOSError; { ============================================================================= $Log$ + Revision 1.25 2004/09/02 09:16:59 mattias + improved double byte char fonts for gtk1, started synedit UTF8 support + Revision 1.24 2004/04/10 17:58:57 mattias implemented mainunit hints for include files diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 84c60863e0..d743c57677 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -1627,13 +1627,13 @@ begin end; {------------------------------------------------------------------------------ - function TWinControl.UTF8KeyPressMessage(var UTF8Key: string; + function TWinControl.IntfUTF8KeyPress(var UTF8Key: string; RepeatCount: integer): boolean; Called by the interface after the navigation and specials keys are handled (e.g. after KeyDown). ------------------------------------------------------------------------------} -function TWinControl.UTF8KeyPressMessage(var UTF8Key: string; +function TWinControl.IntfUTF8KeyPress(var UTF8Key: TUTF8Char; RepeatCount: integer): boolean; begin Result:=(RepeatCount>0) and DoUTF8KeyPress(UTF8Key) @@ -2128,7 +2128,7 @@ end; {------------------------------------------------------------------------------ TWinControl KeyPress ------------------------------------------------------------------------------} -procedure TWinControl.UTF8KeyPress(var UTF8Key: string); +procedure TWinControl.UTF8KeyPress(var UTF8Key: TUTF8Char); begin if Assigned(FOnUTF8KeyPress) then FOnUTF8KeyPress(Self, UTF8Key); end; @@ -2279,7 +2279,7 @@ End; Returns True if key handled ------------------------------------------------------------------------------} -function TWinControl.DoUTF8KeyPress(var UTF8Key: string): boolean; +function TWinControl.DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; var AParent: TWinControl; F: TCustomForm; @@ -3131,8 +3131,18 @@ end; WMChar is sent by the interface befor it has handled the keypress by itself. ------------------------------------------------------------------------------} procedure TWinControl.CNChar(var Message: TLMKeyUp); +var + c: TUTF8Char; begin if not DoKeyPress(Message) then {inherited}; // there is nothing to inherit + if not IntfSendsUTF8KeyPress then begin + // current interface does not (yet) send UTF8 key press notifications + // -> emulate + if Message.CharCode < %11000000 then begin + c:=chr(Message.CharCode); + IntfUTF8KeyPress(c,1); + end; + end; end; {------------------------------------------------------------------------------ @@ -3898,6 +3908,9 @@ end; { ============================================================================= $Log$ + Revision 1.269 2004/09/02 09:16:59 mattias + improved double byte char fonts for gtk1, started synedit UTF8 support + Revision 1.268 2004/08/30 16:37:58 mattias added OnUTF8KeyPresss diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index 8142b10bd2..a3a40a189e 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -115,11 +115,13 @@ type FStockWhitePen: HPEN; {$Ifdef GTK2} - FDefaultFontDesc : PPangoFontDescription; + FDefaultFontDesc: PPangoFontDescription; {$Else} - FDefaultFont : PGdkFont; + FDefaultFont: PGdkFont; {$EndIf} - FStockSystemFont : HFONT; + FStockSystemFont: HFONT; + FExtUTF8OutCache: Pointer; + FExtUTF8OutCacheSize: integer; Function CreateSystemFont : hFont; @@ -460,6 +462,9 @@ end. { ============================================================================= $Log$ + Revision 1.188 2004/09/02 09:16:59 mattias + improved double byte char fonts for gtk1, started synedit UTF8 support + Revision 1.187 2004/08/27 08:55:22 micha implement tapplication.minimize for win32, stub for gtk diff --git a/lcl/interfaces/gtk/gtklclintf.inc b/lcl/interfaces/gtk/gtklclintf.inc index 6bcd41cf3b..0f7fbc751d 100644 --- a/lcl/interfaces/gtk/gtklclintf.inc +++ b/lcl/interfaces/gtk/gtklclintf.inc @@ -75,6 +75,34 @@ begin Result:=true; end; +{------------------------------------------------------------------------------ + function TGtkWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; + Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; + + As ExtTextOut except that Str is treated as UTF8 + ------------------------------------------------------------------------------} +function TGtkWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; + Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; +var + IsDBCSFont: Boolean; + NewCount: Integer; +begin + UpdateDCTextMetric(TDeviceContext(DC)); + IsDBCSFont:=TDeviceContext(DC).DCTextMetric.IsDoubleByteChar; + if IsDBCSFont then begin + NewCount:=Count*2; + if FExtUTF8OutCacheSize#0 then begin + // ASCII key: send a normal KeyPress Event for Delphi compatibility + FillChar(Msg,SizeOf(Msg),0); - if (EventString<>nil) and (Msg.CharCode <> ord(EventString^)) - then begin - //writeln('HandleGTKKeyUpDown A ',Msg.CharCode,' BeforeEvent=',BeforeEvent); - // key was changed by lcl - if Msg.CharCode=0 then - StopKeyEvent('key_press_event') - else begin - EventString^:=chr(Msg.CharCode); - EventString[1]:=#0; - gdk_event_key_set_string(Event,EventString); + Msg.KeyData := CommonKeyData; + + if BeforeEvent then begin + if SysKey + then Msg.msg := CN_SYSCHAR + else Msg.msg := CN_CHAR + end else begin + if SysKey + then Msg.msg := LM_SYSCHAR + else Msg.msg := LM_CHAR; + end; + + Msg.Result:=0; + Msg.CharCode:=ord(KeyPressesChar); + // send the message directly (not queued) to the LCL + Result := DeliverMessage(TargetData, Msg) = 0; + + if (ord(KeyPressesChar)<>Msg.CharCode) + then begin + // key was changed by lcl + //writeln('HandleGTKKeyUpDown A ',Msg.CharCode,' BeforeEvent=',BeforeEvent); + if (Msg.CharCode=0) or (Msg.CharCode>=128) then + // key set to invalid => just stop + StopKeyEvent('key_press_event') + else begin + // try to change the key + EventString^:=chr(Msg.CharCode); + EventString[1]:=#0; + Event^.KeyVal:=Msg.CharCode; + gdk_event_key_set_string(Event,EventString); + end; + end; + end; + + end; + + if (not EventStopped) and (not BeforeEvent) then begin + // send the UTF8 keypress + // try to get the UTF8 representation of the key + Character:=''; + if (Event^.length>0) and (Event^.length<7) then begin + SetLength(Character,Event^.length); + System.Move(Event^.thestring^,Character[1],length(Character)); + end else begin + {$IFDEF Gtk2} + Character := UnicodeToUTF8(gdk_keyval_to_unicode(Event^.KeyVal)); + {$ENDIF} + end; + {$IFDEF VerboseKeyboard} + debugln('[HandleGTKKeyUpDown] GDK_KEY_PRESS UTF8="',DbgStr(Character),'"'); + {$ENDIF} + if Character<>'' then begin + LCLObject:=GetNearestLCLObject(TargetWidget); + if LCLObject is TWinControl then begin + Result:=TWinControl(LCLObject).IntfUTF8KeyPress(Character,1); + if Result or (Character='') then + StopKeyEvent('key_press_event'); end; end; end; + end; end; //DebugLn('[HandleGTKKeyUpDown] ',TControl(Data).Name,':',TControl(Data).ClassName,' Result=',Result); @@ -7198,6 +7235,9 @@ end; { ============================================================================= $Log$ + Revision 1.299 2004/09/02 09:17:00 mattias + improved double byte char fonts for gtk1, started synedit UTF8 support + Revision 1.298 2004/08/30 15:46:22 mazen * Fix a compile problem, still need to find the correct way to fix that. diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index c92288ddc2..43b07792db 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/lcl/interfaces/gtk/gtkproc.pp @@ -45,16 +45,19 @@ uses {$ELSE} glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} {$ENDIF} + {$IFDEF USE_UTF8BIDI_LCL} + utf8bidi, + {$ENDIF} LMessages, LCLProc, LCLStrConsts, LCLIntf, LCLType, DynHashArray, GraphType, GraphMath, Graphics, GTKWinApiWindow, LResources, Controls, Forms, Buttons, Menus, StdCtrls, ComCtrls, CommCtrl, ExtCtrls, Dialogs, ExtDlgs, FileCtrl, ImgList, GTKGlobals, gtkDef; - {$IFDEF gtk2} - const - gdkdll = gdklib; - {$ENDIF} +{$IFDEF gtk2} +const + gdkdll = gdklib; +{$ENDIF} {$IFNDEF GTK2} @@ -756,6 +759,7 @@ procedure EndGDKErrorTrap; implementation + const VKEY_FLAG_SHIFT = $01; VKEY_FLAG_CTRL = $02; diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index fb89985a04..4ad1349a5b 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -1327,7 +1327,7 @@ var end; {$IFDEF VerboseFonts} - DebugLn(' Trying "',S,'" Success=',GdiObject^.GDIFontObject<>nil); + DebugLn(' Trying "',S,'" Success=',dbgs(GdiObject^.GDIFontObject<>nil)); {$ENDIF} end; @@ -1563,43 +1563,45 @@ begin if LoadFont then exit; end; - // try instead of mono spaced, character cell spaced + // try all weights + WeightName := '*'; + if LoadFont then exit; + + // try one height lower + PixelSize := IntToStr(Abs(LogFont.lfHeight)-1); + if LoadFont then exit; + + // try one height higher + PixelSize := IntToStr(Abs(LogFont.lfHeight)+1); + if LoadFont then exit; + + PixelSize := IntToStr(Abs(LogFont.lfHeight)); + + // try instead of mono spaced -> character cell spaced if (Spacing='m') then begin Spacing:='c'; if LoadFont then exit; end; - // try instead of italic oblique + // try instead of italic -> oblique if (Slant='i') then begin Slant := 'o'; - if GdiObject^.GDIFontObject <> nil then exit; + if LoadFont then exit; end; - // try all weights - WeightName := '*'; - if GdiObject^.GDIFontObject <> nil then exit; - // try all slants Slant := '*'; - if GdiObject^.GDIFontObject <> nil then exit; + if LoadFont then exit; // try all spacings Spacing := '*'; - if GdiObject^.GDIFontObject <> nil then exit; - - // try one height lower - PixelSize := IntToStr(Abs(LogFont.lfHeight)-1); - if GdiObject^.GDIFontObject <> nil then exit; - - // try one height higher - PixelSize := IntToStr(Abs(LogFont.lfHeight)+1); - if GdiObject^.GDIFontObject <> nil then exit; + if LoadFont then exit; if (Foundry<>'*') then begin // try all Families PixelSize := IntToStr(Abs(LogFont.lfHeight)); FamilyName := '*'; - if GdiObject^.GDIFontObject <> nil then exit; + if LoadFont then exit; end; // nothing exists -> use default @@ -3135,6 +3137,7 @@ var CurDistX: PInteger; CharsWritten, CurX, i: integer; LinePos: PChar; + CharLen: LongInt; begin {$IFDEF DebugGDKTraps} BeginGDKErrorTrap; @@ -3142,21 +3145,29 @@ var with TDeviceContext(DC) do begin if (Dx=nil) then begin // no dist array -> write as one block + //debugln('TGtkWidgetSet.ExtTextOut.DrawTextLine Dx=nil ',dbgs(LineLen),' DCTextMetric.IsDoubleByteChar=',dbgs(DCTextMetric.IsDoubleByteChar)); gdk_draw_text(Buffer, UseFont, GC, TxtPt.X, TxtPt.Y, LineStart, LineLen); end else begin // dist array -> write each char separately CharsWritten:=integer(LineStart-Str); - if DCTextMetric.IsDoubleByteChar then + if DCTextMetric.IsDoubleByteChar then begin + CharLen:=2; CharsWritten:=CharsWritten div 2; + end else + CharLen:=1; CurDistX:=Dx+CharsWritten*SizeOf(Integer); CurX:=TxtPt.X; LinePos:=LineStart; - for i:=1 to LineLen do begin - gdk_draw_text(Buffer, UseFont, GC, CurX, TxtPt.Y, LinePos, 1); - inc(LinePos); + //debugln('TGtkWidgetSet.ExtTextOut.DrawTextLine ',dbgs(dx),' DCTextMetric.IsDoubleByteChar=',dbgs(DCTextMetric.IsDoubleByteChar)); + i:=1; + while (i<=LineLen) do begin + //debugln('TGtkWidgetSet.ExtTextOut.DrawTextLine ',dbgs(CharLen),' ',dbgs(ord(LinePos^))); + gdk_draw_text(Buffer, UseFont, GC, CurX, TxtPt.Y, LinePos, CharLen); + inc(LinePos,CharLen); inc(CurX,CurDistX^); inc(CurDistX); + inc(i,CharLen); end; end; if UnderLine then begin @@ -8718,6 +8729,9 @@ end; { ============================================================================= $Log$ + Revision 1.364 2004/09/02 09:17:00 mattias + improved double byte char fonts for gtk1, started synedit UTF8 support + Revision 1.363 2004/08/30 10:49:20 mattias fixed focus catch for combobox csDropDownList diff --git a/lcl/interfaces/gtk2/gtk2object.inc b/lcl/interfaces/gtk2/gtk2object.inc index 18d5136580..faa077fdfb 100644 --- a/lcl/interfaces/gtk2/gtk2object.inc +++ b/lcl/interfaces/gtk2/gtk2object.inc @@ -64,8 +64,8 @@ function GTK2KeyUpDown(Widget: PGtkWidget; Event : pgdkeventkey; Data: gPointer) : GBoolean; cdecl; begin Result := GtkWidgetIsA(Widget,GTK_APIWIDGETCLIENT_TYPE) and - HandleGtkKeyUpDown(Widget, Event, Data, True) and - HandleGtkKeyUpDown(Widget, Event, Data, False); + (HandleGtkKeyUpDown(Widget, Event, Data, True) or + HandleGtkKeyUpDown(Widget, Event, Data, False)); end; function GTK2KillFocusCB(widget: PGtkWidget; event:PGdkEventFocus; @@ -1375,6 +1375,9 @@ end; { ============================================================================= $Log$ + Revision 1.15 2004/09/02 09:17:00 mattias + improved double byte char fonts for gtk1, started synedit UTF8 support + Revision 1.14 2004/07/30 14:26:11 mazen * move HandleGtkKeyUpDown to gtkProc.inc make it visible to gtk2 this allow saving a call in a hevely called callback diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas index 2d6fcd4e3f..ed7f7cd258 100644 --- a/lcl/lclproc.pas +++ b/lcl/lclproc.pas @@ -148,9 +148,17 @@ function DbgS(const p: pointer): string; function DbgS(const e: extended): string; function DbgS(const b: boolean): string; function DbgSName(const p: TObject): string; +function DbgStr(const StringWithSpecialChars: string): string; function DbgS(const i1,i2,i3,i4: integer): string; +function UTF8CharacterLength(p: PChar): integer; +function UTF8Length(const s: string): integer; +function UTF8Length(p: PChar; Count: integer): integer; +function UTF8CharacterToUnicode(p: PChar; var CharLen: integer): Cardinal; +function UTF8ToDoubleByteString(const s: string): string; +function UTF8ToDoubleByte(UTF8Str: PChar; Len: integer; DBStr: PByte): integer; + implementation @@ -907,11 +915,174 @@ begin Result:=p.ClassName; end; +function DbgStr(const StringWithSpecialChars: string): string; +var + i: Integer; + s: String; +begin + Result:=StringWithSpecialChars; + i:=1; + while (i<=length(Result)) do begin + case Result[i] of + ' '..'z': inc(i); + else + s:='#'+IntToStr(ord(Result[i])); + Result:=copy(Result,1,i-1)+s+copy(Result,i+1,length(Result)-i); + inc(i,length(s)); + end; + end; +end; + function DbgS(const i1, i2, i3, i4: integer): string; begin Result:=dbgs(i1)+','+dbgs(i2)+','+dbgs(i3)+','+dbgs(i4); end; +function UTF8CharacterLength(p: PChar): integer; +begin + if p<>nil then begin + if ord(p^)<%11000000 then begin + // regular single byte character (#0 is single byte, this is pascal ;) + Result:=1; + end + else if ((ord(p^) and %11100000) = %11000000) then begin + // could be 2 byte character + if (ord(p[1]) and %11000000) = %10000000 then + Result:=2 + else + Result:=1; + end + else if ((ord(p^) and %11110000) = %11100000) then begin + // could be 3 byte character + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) then + Result:=3 + else + Result:=1; + end + else if ((ord(p^) and %11111000) = %11110000) then begin + // could be 4 byte character + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) + and ((ord(p[3]) and %11000000) = %10000000) then + Result:=4 + else + Result:=1; + end + else + Result:=1 + end else + Result:=0; +end; + +function UTF8Length(const s: string): integer; +begin + Result:=UTF8Length(PChar(s),length(s)); +end; + +function UTF8Length(p: PChar; Count: integer): integer; +var + CharLen: LongInt; +begin + Result:=0; + while (Count>0) do begin + inc(Result); + CharLen:=UTF8CharacterLength(p); + inc(p,CharLen); + dec(Count,CharLen); + end; +end; + +function UTF8CharacterToUnicode(p: PChar; var CharLen: integer): Cardinal; +begin + if p<>nil then begin + if ord(p^)<%11000000 then begin + // regular single byte character (#0 is single byte, this is pascal ;) + Result:=ord(p^); + CharLen:=1; + end + else if ((ord(p^) and %11100000) = %11000000) then begin + // could be double byte character + if (ord(p[1]) and %11000000) = %10000000 then begin + Result:=((ord(p^) and %00011111) shl 6) + or (ord(p[1]) and %00111111); + CharLen:=2; + end else begin + Result:=ord(p^); + CharLen:=1; + end; + end + else if ((ord(p^) and %11110000) = %11100000) then begin + // could be triple byte character + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) then begin + Result:=((ord(p^) and %00011111) shl 12) + or ((ord(p[1]) and %00111111) shl 6) + or (ord(p[2]) and %00111111); + CharLen:=3; + end else begin + Result:=ord(p^); + CharLen:=1; + end; + end + else if ((ord(p^) and %11111000) = %11110000) then begin + // could be 4 byte character + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) + and ((ord(p[3]) and %11000000) = %10000000) then begin + Result:=((ord(p^) and %00011111) shl 18) + or ((ord(p[1]) and %00111111) shl 12) + or ((ord(p[2]) and %00111111) shl 6) + or (ord(p[3]) and %00111111); + CharLen:=4; + end else begin + Result:=ord(p^); + CharLen:=1; + end; + end + else begin + Result:=ord(p^); + CharLen:=1; + end; + end else begin + Result:=0; + CharLen:=0; + end; +end; + +function UTF8ToDoubleByteString(const s: string): string; +var + Len: Integer; +begin + Len:=UTF8Length(s); + SetLength(Result,Len*2); + if Len=0 then exit; + UTF8ToDoubleByte(PChar(s),length(s),PByte(Result)); +end; + +function UTF8ToDoubleByte(UTF8Str: PChar; Len: integer; DBStr: PByte): integer; +// returns number of double bytes +var + SrcPos: PChar; + CharLen: LongInt; + DestPos: PByte; + u: Cardinal; +begin + SrcPos:=UTF8Str; + DestPos:=DBStr; + Result:=0; + while Len>0 do begin + u:=UTF8CharacterToUnicode(SrcPos,CharLen); + DestPos^:=byte((u shr 8) and $ff); + inc(DestPos); + DestPos^:=byte(u and $ff); + inc(DestPos); + inc(SrcPos,CharLen); + dec(Len,CharLen); + inc(Result); + end; +end; + initialization SendApplicationMessageFunction:=nil; OwnerFormDesignerModifiedProc:=nil; diff --git a/lcl/lcltype.pp b/lcl/lcltype.pp index 02dd6c7a53..f683f48bac 100644 --- a/lcl/lcltype.pp +++ b/lcl/lcltype.pp @@ -46,12 +46,20 @@ interface {$endif} uses +{$IFDEF USE_UTF8BIDI_LCL} + UTF8BIDI, +{$ENDIF USE_UTF8BIDI_LCL} {$ifdef win32} windows, {$endif win32} Classes, SysUtils; type +{$IFDEF USE_UTF8BIDI_LCL} + TUTF8Char = UTF8BIDI.TUTF8Char; +{$ELSE USE_UTF8BIDI_LCL} + TUTF8Char = String[7]; +{$ENDIF USE_UTF8BIDI_LCL} PRect = ^TRect; UINT = LongWord; PPoint = ^TPoint; @@ -2233,6 +2241,9 @@ end. { $Log$ + Revision 1.66 2004/09/02 09:16:59 mattias + improved double byte char fonts for gtk1, started synedit UTF8 support + Revision 1.65 2004/08/30 16:37:58 mattias added OnUTF8KeyPresss