mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-06 01:57:16 +01:00
improved double byte char fonts for gtk1, started synedit UTF8 support
git-svn-id: trunk@5906 -
This commit is contained in:
mattias
parent
962815f369
commit
725ee3133d
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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)';
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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<NewCount then begin
|
||||
ReAllocMem(FExtUTF8OutCache,NewCount);
|
||||
FExtUTF8OutCacheSize:=NewCount;
|
||||
end;
|
||||
NewCount:=UTF8ToDoubleByte(Str,Count,FExtUTF8OutCache)*2;
|
||||
//debugln('TGtkWidgetSet.ExtUTF8Out Count=',dbgs(Count),' NewCount=',dbgs(NewCount));
|
||||
Result:=ExtTextOut(DC,X,Y,Options,Rect,FExtUTF8OutCache,NewCount,Dx);
|
||||
end else begin
|
||||
Result:=ExtTextOut(DC,X,Y,Options,Rect,Str,Count,Dx);
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: GetAcceleratorString
|
||||
Params: AVKey:
|
||||
@ -295,6 +323,15 @@ begin
|
||||
end;
|
||||
{$EndIf}
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TGtkWidgetSet.IntfSendsUTF8KeyPress: boolean;
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
function TGtkWidgetSet.IntfSendsUTF8KeyPress: boolean;
|
||||
begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: MenuItemSetCheck
|
||||
Params: BaseMenuItem
|
||||
@ -464,6 +501,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.30 2004/09/02 09:17:00 mattias
|
||||
improved double byte char fonts for gtk1, started synedit UTF8 support
|
||||
|
||||
Revision 1.29 2004/06/19 21:06:38 mattias
|
||||
menu separators are now created disabled
|
||||
|
||||
|
||||
@ -32,12 +32,17 @@
|
||||
//##apiwiz##sps## // Do not remove
|
||||
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean; override;
|
||||
|
||||
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
|
||||
Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
|
||||
|
||||
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; override;
|
||||
function GetControlConstraints(Constraints: TObject): boolean; override;
|
||||
function GetLCLOwnerObject(Handle: HWnd): TObject; override;
|
||||
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override;
|
||||
function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRect): boolean; override;
|
||||
|
||||
function IntfSendsUTF8KeyPress: boolean; override;
|
||||
|
||||
function MenuItemSetCheck(BaseMenuItem: TComponent): Boolean; override;
|
||||
function MenuItemSetEnable(BaseMenuItem: TComponent): Boolean; override;
|
||||
|
||||
@ -52,6 +57,9 @@ procedure StatusBarUpdate(StatusBar: TObject); override;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.18 2004/09/02 09:17:00 mattias
|
||||
improved double byte char fonts for gtk1, started synedit UTF8 support
|
||||
|
||||
Revision 1.17 2004/03/22 19:10:04 mattias
|
||||
implemented icons for TPage in gtk, mask for TCustomImageList
|
||||
|
||||
|
||||
@ -281,6 +281,9 @@ var
|
||||
QueueItem : TGtkMessageQueueItem;
|
||||
NextQueueItem : TGtkMessageQueueItem;
|
||||
begin
|
||||
ReAllocMem(FExtUTF8OutCache,0);
|
||||
FExtUTF8OutCacheSize:=0;
|
||||
|
||||
FreeAllStyles;
|
||||
FreeGDKCursors;
|
||||
FreeStockItems;
|
||||
@ -8641,14 +8644,21 @@ begin
|
||||
end;
|
||||
{$Else}
|
||||
const
|
||||
TestString = '{Am|g_}';
|
||||
TestString: array[boolean] of string = (
|
||||
// single byte char font
|
||||
'{ABCDEFGHIJKLMNOPQRSTUVWXYZXYZabcdefghijklmnopqrstuvwxyz|_}',
|
||||
// double byte char font
|
||||
#0'{'#0'A'#0'B'#0'C'#0'D'#0'E'#0'F'#0'G'#0'H'#0'I'#0'J'#0'K'#0'L'#0'M'#0'N'
|
||||
+#0'O'#0'P'#0'Q'#0'R'#0'S'#0'T'#0'U'#0'V'#0'W'#0'X'#0'Y'#0'Z'#0'X'#0'Y'#0'Z'
|
||||
+#0'a'#0'b'#0'c'#0'd'#0'e'#0'f'#0'g'#0'h'#0'i'#0'j'#0'k'#0'l'#0'm'#0'n'#0'o'
|
||||
+#0'p'#0'q'#0'r'#0's'#0't'#0'u'#0'v'#0'w'#0'x'#0'y'#0'z'#0'|'#0'_'#0'}'
|
||||
);
|
||||
var
|
||||
XT : TSize;
|
||||
dummy: LongInt;
|
||||
UseFont : PGDKFont;
|
||||
UnRef : Boolean;
|
||||
AvgTxtLen: Integer;
|
||||
CachedFont: TGdkFontCacheItem;
|
||||
width: LongInt;
|
||||
begin
|
||||
with TDeviceContext(DC) do begin
|
||||
if dcfTextMetricsValid in DCFlags then begin
|
||||
@ -8675,35 +8685,45 @@ begin
|
||||
end
|
||||
else with DCTextMetric do begin
|
||||
IsDoubleByteChar:=FontIsDoubleByteCharsFont(UseFont);
|
||||
gdk_text_extents(UseFont, TestString,
|
||||
length(TestString), @lbearing, @rBearing, @dummy,
|
||||
@TextMetric.tmAscent, @TextMetric.tmDescent);
|
||||
if IsDoubleByteChar then
|
||||
// Quick hack for double byte char fonts
|
||||
AvgTxtLen:=AvgFontCharsBufLen div 2
|
||||
else
|
||||
AvgTxtLen:=AvgFontCharsBufLen;
|
||||
GetTextExtentPoint(HDC(DC),
|
||||
@AvgFontCharsBuffer[Low(AvgFontCharsBuffer)],
|
||||
AvgTxtLen, XT);
|
||||
if not IsDoubleByteChar then
|
||||
XT.cX := XT.cX div AvgTxtLen
|
||||
else
|
||||
XT.cX := XT.cX div AvgTxtLen;
|
||||
TextMetric.tmHeight := XT.cY;
|
||||
TextMetric.tmAscent := TextMetric.tmHeight - TextMetric.tmDescent;
|
||||
TextMetric.tmAveCharWidth := XT.cX;
|
||||
AvgTxtLen:=length(TestString[false]);
|
||||
if IsDoubleByteChar then begin
|
||||
gdk_text_extents_wc(UseFont, PGdkWChar(TestString[IsDoubleByteChar]),
|
||||
AvgTxtLen*2, @lBearing, @rBearing, @Width,
|
||||
@TextMetric.tmAscent, @TextMetric.tmDescent);
|
||||
TextMetric.tmHeight := gdk_text_height(UseFont,
|
||||
PChar(TestString[IsDoubleByteChar]),
|
||||
AvgTxtLen*2)
|
||||
{$IfNDef Win32} + TextMetric.tmdescent div 2{$EndIf};
|
||||
end else begin
|
||||
gdk_text_extents(UseFont, PChar(TestString[IsDoubleByteChar]),
|
||||
AvgTxtLen, @lBearing, @rBearing, @Width,
|
||||
@TextMetric.tmAscent, @TextMetric.tmDescent);
|
||||
TextMetric.tmHeight := gdk_text_height(UseFont,
|
||||
PChar(TestString[IsDoubleByteChar]),
|
||||
AvgTxtLen)
|
||||
{$IfNDef Win32} + TextMetric.tmdescent div 2{$EndIf};
|
||||
end;
|
||||
//TextMetric.tmAscent := TextMetric.tmHeight - TextMetric.tmDescent;
|
||||
TextMetric.tmAveCharWidth := Width div AvgTxtLen;
|
||||
if TextMetric.tmAveCharWidth<1 then TextMetric.tmAveCharWidth:=1;
|
||||
TextMetric.tmMaxCharWidth :=
|
||||
Max(gdk_char_width(UseFont, 'W'),
|
||||
gdk_char_width(UseFont, 'M')); // temp hack
|
||||
if TextMetric.tmMaxCharWidth<1 then
|
||||
TextMetric.tmMaxCharWidth:=1;
|
||||
if TextMetric.tmMaxCharWidth<TextMetric.tmAveCharWidth then
|
||||
TextMetric.tmMaxCharWidth:=TextMetric.tmAveCharWidth;
|
||||
{debugln('TGtkWidgetSet.UpdateDCTextMetric A IsDoubleByteChar=',dbgs(IsDoubleByteChar),
|
||||
' lbearing=',dbgs(lBearing),' rbearing=',dbgs(rBearing),
|
||||
' width='+dbgs(width),' tmAscent='+dbgs(TextMetric.tmAscent),
|
||||
' tmDescent='+dbgs(TextMetric.tmdescent),
|
||||
' tmHeight='+dbgs(TextMetric.tmHeight),
|
||||
' AvgTxtLen='+dbgs(AvgTxtLen),
|
||||
' tmMaxCharWidth='+dbgs(TextMetric.tmMaxCharWidth),
|
||||
' tmAveCharWidth='+dbgs(TextMetric.tmAveCharWidth));}
|
||||
if (CachedFont<>nil) then begin
|
||||
CachedFont.lBearing:=DCTextMetric.lBearing;
|
||||
CachedFont.rBearing:=DCTextMetric.rBearing;
|
||||
CachedFont.IsDoubleByteChar:=DCTextMetric.IsDoubleByteChar;
|
||||
CachedFont.TextMetric:=DCTextMetric.TextMetric;
|
||||
CachedFont.lBearing:=lBearing;
|
||||
CachedFont.rBearing:=rBearing;
|
||||
CachedFont.IsDoubleByteChar:=IsDoubleByteChar;
|
||||
CachedFont.TextMetric:=TextMetric;
|
||||
CachedFont.MetricsValid:=true;
|
||||
end;
|
||||
end;
|
||||
@ -9254,6 +9274,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.537 2004/09/02 09:17:00 mattias
|
||||
improved double byte char fonts for gtk1, started synedit UTF8 support
|
||||
|
||||
Revision 1.536 2004/08/30 10:49:20 mattias
|
||||
fixed focus catch for combobox csDropDownList
|
||||
|
||||
|
||||
@ -1896,6 +1896,7 @@ var
|
||||
EventStopped: Boolean;
|
||||
EventString: PChar; // GTK1 and GTK2 workaround
|
||||
// (and easy access to bytes)
|
||||
Character: TUTF8Char;
|
||||
|
||||
procedure StopKeyEvent(const AnEventName: PChar);
|
||||
begin
|
||||
@ -1945,11 +1946,7 @@ var
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
{$IFDEF GTK2}
|
||||
Result := Event^.KeyVal < $F000;
|
||||
{$ELSE GTK2}
|
||||
Result := (Event^.Length = 1) and (EventString <> nil);
|
||||
{$ENDIF GTK2}
|
||||
end;
|
||||
|
||||
var
|
||||
@ -1963,6 +1960,7 @@ var
|
||||
HandledByLCL: Boolean;
|
||||
TargetWidget: PGtkWidget;
|
||||
TargetData: gPointer;
|
||||
KeyPressesChar: char;
|
||||
begin
|
||||
Result := True;
|
||||
EventStopped := False;
|
||||
@ -2102,49 +2100,88 @@ begin
|
||||
StopKeyEvent('key_press_event');
|
||||
end;
|
||||
|
||||
if not EventStopped and CanSendChar
|
||||
if (not EventStopped) and (not BeforeEvent) and CanSendChar
|
||||
then begin
|
||||
EventTrace('char', data);
|
||||
FillChar(Msg,SizeOf(Msg),0);
|
||||
|
||||
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;
|
||||
|
||||
if Event^.Length = 0 then begin
|
||||
KeyPressesChar:=#0;
|
||||
if Event^.Length = 1 then begin
|
||||
// ASCII key was pressed
|
||||
KeyPressesChar := EventString^;
|
||||
end else if Event^.KeyVal<128 then begin
|
||||
// non ASCII key was pressed
|
||||
{$IFDEF GTK2}
|
||||
Msg.CharCode := gdk_keyval_to_unicode(Event^.KeyVal);
|
||||
{$ELSE}
|
||||
Msg.CharCode := Event^.KeyVal;
|
||||
{$ENDIF}
|
||||
end else
|
||||
Msg.CharCode := ord(EventString^);
|
||||
Msg.Result:=0;
|
||||
// send the message directly (not queued) to the LCL
|
||||
Result := DeliverMessage(TargetData, Msg) = 0;
|
||||
//{$IFDEF GTK2}
|
||||
//Msg.CharCode := gdk_keyval_to_unicode(Event^.KeyVal);
|
||||
//{$ELSE}
|
||||
KeyPressesChar := chr(byte(Event^.KeyVal));
|
||||
//{$ENDIF}
|
||||
end;
|
||||
|
||||
if KeyPressesChar<>#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.
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
171
lcl/lclproc.pas
171
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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user