paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-22 19:39:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

synedit: add support for FrameColor in Markups, TextDrawer, etc

Browse Source 
git-svn-id: trunk@17549 -
This commit is contained in:
paul 2008-11-23 16:33:41 +00:00
parent a3e24a5bec
commit 469bafd646
5 changed files with 181 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
components/synedit/synedit.pp
View File

@ -2916,7 +2916,7 @@ var
Len, MaxLen: integer; Len, MaxLen: integer;
PhysicalStartPos, PhysicalEndPos: integer; PhysicalStartPos, PhysicalEndPos: integer;
p: PChar; p: PChar;
FG, BG: TColor; FG, BG, FC: TColor;
Style: TFontStyles; Style: TFontStyles;
end; end;
dc: HDC; dc: HDC;
@ -3135,6 +3135,7 @@ var
with fTextDrawer do begin with fTextDrawer do begin
SetBackColor(TokenAccu.BG); SetBackColor(TokenAccu.BG);
SetForeColor(TokenAccu.FG); SetForeColor(TokenAccu.FG);
SetFrameColor(TokenAccu.FC);
SetStyle(TokenAccu.Style); SetStyle(TokenAccu.Style);
end; end;
// Paint the chars // Paint the chars
@ -3188,7 +3189,7 @@ var
procedure AddHighlightToken( procedure AddHighlightToken(
Token: PChar; Token: PChar;
TokenLen, PhysicalStartPos, PhysicalEndPos: integer; TokenLen, PhysicalStartPos, PhysicalEndPos: integer;
Foreground, Background: TColor; Foreground, Background, FrameColor: TColor;
Style: TFontStyles); Style: TFontStyles);
var var
bCanAppend: boolean; bCanAppend: boolean;
@ -3267,6 +3268,7 @@ var
TokenAccu.PhysicalEndPos := PhysicalEndPos; TokenAccu.PhysicalEndPos := PhysicalEndPos;
TokenAccu.FG := Foreground; TokenAccu.FG := Foreground;
TokenAccu.BG := Background; TokenAccu.BG := Background;
TokenAccu.FC := FrameColor;
TokenAccu.Style := Style; TokenAccu.Style := Style;
end; end;
{debugln('AddHighlightToken END bCanAppend=',dbgs(bCanAppend), {debugln('AddHighlightToken END bCanAppend=',dbgs(bCanAppend),
@ -3279,9 +3281,9 @@ var
procedure DrawHiLightMarkupToken(attr: TSynHighlighterAttributes; procedure DrawHiLightMarkupToken(attr: TSynHighlighterAttributes;
sToken: PChar; nTokenByteLen: integer); sToken: PChar; nTokenByteLen: integer);
var var
DefaultFGCol, DefaultBGCol: TColor; DefaultFGCol, DefaultBGCol, DefaultFCCol: TColor;
DefaultStyle: TFontStyles; DefaultStyle: TFontStyles;
BG, FG : TColor; BG, FG, FC : TColor;
Style: TFontStyles; Style: TFontStyles;
PhysicalStartPos: integer; PhysicalStartPos: integer;
PhysicalEndPos: integer; PhysicalEndPos: integer;
@ -3324,16 +3326,20 @@ var
end; end;
end; end;
if Assigned(attr) then begin if Assigned(attr) then
DefaultFGCol:=attr.Foreground; begin
DefaultBGCol:=attr.Background; DefaultFGCol := attr.Foreground;
DefaultStyle:=attr.Style; DefaultBGCol := attr.Background;
DefaultFCCol := attr.FrameColor;
DefaultStyle := attr.Style;
if DefaultBGCol = clNone then DefaultBGCol := colEditorBG; if DefaultBGCol = clNone then DefaultBGCol := colEditorBG;
if DefaultFGCol = clNone then DefaultFGCol := Font.Color; if DefaultFGCol = clNone then DefaultFGCol := Font.Color;
end else begin end else
DefaultFGCol:=Font.Color; begin
DefaultBGCol:=colEditorBG; DefaultFGCol := Font.Color;
DefaultStyle:=Font.Style; DefaultBGCol := colEditorBG;
DefaultFCCol := clNone;
DefaultStyle := Font.Style;
end; end;
{TODO: cache NextPhysPos, and MarkupInfo between 2 calls } {TODO: cache NextPhysPos, and MarkupInfo between 2 calls }
@ -3360,10 +3366,11 @@ var
// Calculate Markup // Calculate Markup
BG := DefaultBGCol; BG := DefaultBGCol;
FG := DefaultFGCol; FG := DefaultFGCol;
FC := DefaultFCCol;
Style := DefaultStyle; Style := DefaultStyle;
MarkupInfo := fMarkupManager.GetMarkupAttributeAtRowCol(fTextView.TextIndex[CurLine]+1, PhysicalStartPos); MarkupInfo := fMarkupManager.GetMarkupAttributeAtRowCol(fTextView.TextIndex[CurLine]+1, PhysicalStartPos);
if assigned(MarkupInfo) if assigned(MarkupInfo)
then MarkupInfo.ModifyColors(FG, BG, Style); then MarkupInfo.ModifyColors(FG, BG, FC, Style);
// Deal with equal colors // Deal with equal colors
if (BG = FG) then begin // or if diff(gb,fg) < x if (BG = FG) then begin // or if diff(gb,fg) < x
if BG = DefaultBGCol if BG = DefaultBGCol
@ -3373,7 +3380,7 @@ var
// Add to TokenAccu // Add to TokenAccu
AddHighlightToken(sToken, SubTokenByteLen, AddHighlightToken(sToken, SubTokenByteLen,
PhysicalStartPos, PhysicalEndPos, FG, BG, Style); PhysicalStartPos, PhysicalEndPos, FG, BG, FC, Style);
PhysicalStartPos:=PhysicalEndPos + 1; PhysicalStartPos:=PhysicalEndPos + 1;
dec(nTokenByteLen,SubTokenByteLen); dec(nTokenByteLen,SubTokenByteLen);

25
components/synedit/synedithighlighter.pp
View File

@ -70,6 +70,8 @@ type
fBackgroundDefault: TColor; //mh 2000-10-08 fBackgroundDefault: TColor; //mh 2000-10-08
fForeground: TColor; fForeground: TColor;
fForegroundDefault: TColor; //mh 2000-10-08 fForegroundDefault: TColor; //mh 2000-10-08
FFrameColor: TColor;
FFrameColorDefault: TColor;
fName: string; fName: string;
fStyle: TFontStyles; fStyle: TFontStyles;
fStyleDefault: TFontStyles; //mh 2000-10-08 fStyleDefault: TFontStyles; //mh 2000-10-08
@ -83,9 +85,11 @@ type
function GetBackgroundColorStored: boolean; function GetBackgroundColorStored: boolean;
function GetFontStyleMaskStored : boolean; function GetFontStyleMaskStored : boolean;
function GetForegroundColorStored: boolean; function GetForegroundColorStored: boolean;
function GetFrameColorStored: boolean;
{end} //mh 2000-10-08 {end} //mh 2000-10-08
procedure SetBackground(Value: TColor); procedure SetBackground(Value: TColor);
procedure SetForeground(Value: TColor); procedure SetForeground(Value: TColor);
procedure SetFrameColor(const AValue: TColor);
procedure SetStyle(Value: TFontStyles); procedure SetStyle(Value: TFontStyles);
function GetStyleFromInt: integer; function GetStyleFromInt: integer;
procedure SetStyleFromInt(const Value: integer); procedure SetStyleFromInt(const Value: integer);
@ -117,6 +121,8 @@ type
stored GetBackgroundColorStored; //mh 2000-10-08 stored GetBackgroundColorStored; //mh 2000-10-08
property Foreground: TColor read fForeground write SetForeground property Foreground: TColor read fForeground write SetForeground
stored GetForegroundColorStored; //mh 2000-10-08 stored GetForegroundColorStored; //mh 2000-10-08
property FrameColor: TColor read FFrameColor write SetFrameColor
stored GetFrameColorStored;
property Style: TFontStyles read fStyle write SetStyle //default []; property Style: TFontStyles read fStyle write SetStyle //default [];
stored GetFontStyleStored; //mh 2000-10-08 stored GetFontStyleStored; //mh 2000-10-08
{$IFDEF SYN_LAZARUS} {$IFDEF SYN_LAZARUS}
@ -521,6 +527,10 @@ begin
fForeground := src.fForeground; fForeground := src.fForeground;
bChanged := TRUE; bChanged := TRUE;
end; end;
if FFrameColor <> src.FFrameColor then begin
FFrameColor := src.FFrameColor;
bChanged := True;
end;
if fStyle <> src.fStyle then begin if fStyle <> src.fStyle then begin
fStyle := src.fStyle; fStyle := src.fStyle;
bChanged := TRUE; bChanged := TRUE;
@ -548,6 +558,7 @@ begin
inherited Create; inherited Create;
Background := clNone; Background := clNone;
Foreground := clNone; Foreground := clNone;
FFrameColor := clNone;
fName := attribName; fName := attribName;
end; end;
@ -566,6 +577,11 @@ begin
Result := fForeground <> fForegroundDefault; Result := fForeground <> fForegroundDefault;
end; end;
function TSynHighlighterAttributes.GetFrameColorStored: boolean;
begin
Result := FFrameColor <> FFrameColorDefault;
end;
function TSynHighlighterAttributes.GetFontStyleStored: boolean; function TSynHighlighterAttributes.GetFontStyleStored: boolean;
begin begin
Result := fStyle <> fStyleDefault; Result := fStyle <> fStyleDefault;
@ -771,6 +787,15 @@ begin
end; end;
end; end;
procedure TSynHighlighterAttributes.SetFrameColor(const AValue: TColor);
begin
if FFrameColor <> AValue then
begin
FFrameColor := AValue;
Changed;
end;
end;
procedure TSynHighlighterAttributes.SetStyle(Value: TFontStyles); procedure TSynHighlighterAttributes.SetStyle(Value: TFontStyles);
begin begin
if fStyle <> Value then begin if fStyle <> Value then begin

17
components/synedit/syneditmarkup.pp
View File

@ -46,9 +46,11 @@ type
function GetBGColor : TColor; function GetBGColor : TColor;
function GetFGColor : TColor; function GetFGColor : TColor;
function GetFrameColor: TColor;
function GetStyle : TFontStyles; function GetStyle : TFontStyles;
procedure SetBGColor(const AValue : TColor); procedure SetBGColor(const AValue : TColor);
procedure SetFGColor(const AValue : TColor); procedure SetFGColor(const AValue : TColor);
procedure SetFrameColor(const AValue : TColor);
procedure SetStyle(const AValue : TFontStyles); procedure SetStyle(const AValue : TFontStyles);
procedure MarkupChanged(AMarkup: TObject); procedure MarkupChanged(AMarkup: TObject);
@ -83,6 +85,7 @@ type
property MarkupInfo : TSynSelectedColor read fMarkupInfo; property MarkupInfo : TSynSelectedColor read fMarkupInfo;
property FGColor : TColor read GetFGColor; property FGColor : TColor read GetFGColor;
property BGColor : TColor read GetBGColor; property BGColor : TColor read GetBGColor;
property FrameColor: TColor read GetFrameColor;
property Style : TFontStyles read GetStyle; property Style : TFontStyles read GetStyle;
property Lines : TSynEditStrings read fLines write SetLines; property Lines : TSynEditStrings read fLines write SetLines;
property Caret : TPoint read fCaret write SetCaret; property Caret : TPoint read fCaret write SetCaret;
@ -133,9 +136,14 @@ begin
result := fMarkupInfo.Foreground; result := fMarkupInfo.Foreground;
end; end;
function TSynEditMarkup.GetFrameColor: TColor;
begin
Result := fMarkupInfo.FrameColor;
end;
function TSynEditMarkup.GetStyle : TFontStyles; function TSynEditMarkup.GetStyle : TFontStyles;
begin begin
result := fMarkupInfo.Style; Result := fMarkupInfo.Style;
end; end;
procedure TSynEditMarkup.SetBGColor(const AValue : TColor); procedure TSynEditMarkup.SetBGColor(const AValue : TColor);
@ -150,6 +158,12 @@ begin
fMarkupInfo.Foreground := AValue; fMarkupInfo.Foreground := AValue;
end; end;
procedure TSynEditMarkup.SetFrameColor(const AValue: TColor);
begin
if fMarkupInfo.FrameColor = AValue then exit;
fMarkupInfo.FrameColor := AValue;
end;
procedure TSynEditMarkup.SetStyle(const AValue : TFontStyles); procedure TSynEditMarkup.SetStyle(const AValue : TFontStyles);
begin begin
if fMarkupInfo.Style = AValue then exit; if fMarkupInfo.Style = AValue then exit;
@ -335,6 +349,7 @@ begin
end else begin end else begin
if c.Background <> clNone then Result.Background := c.Background; if c.Background <> clNone then Result.Background := c.Background;
if c.Foreground <> clNone then Result.Foreground := c.Foreground; if c.Foreground <> clNone then Result.Foreground := c.Foreground;
if c.FrameColor <> clNone then Result.FrameColor := c.FrameColor;
sMask := c.StyleMask + (fsNot(c.StyleMask) * c.Style); // Styles to be taken from c sMask := c.StyleMask + (fsNot(c.StyleMask) * c.Style); // Styles to be taken from c
Result.Style:= (Result.Style * fsNot(sMask)) + (c.Style * sMask); Result.Style:= (Result.Style * fsNot(sMask)) + (c.Style * sMask);
Result.StyleMask:= (Result.StyleMask * fsNot(sMask)) + (c.StyleMask * sMask); Result.StyleMask:= (Result.StyleMask * fsNot(sMask)) + (c.StyleMask * sMask);

113
components/synedit/syneditmiscclasses.pp
View File

@ -59,35 +59,31 @@ type
TSynSelectedColor = class(TPersistent) TSynSelectedColor = class(TPersistent)
private private
fBG: TColor; FBG: TColor;
fFG: TColor; FFG: TColor;
fStyle: TFontStyles; FFrameColor: TColor;
{$IFDEF SYN_LAZARUS} FStyle: TFontStyles;
// StyleMask = 1 => Copy Style Bits // StyleMask = 1 => Copy Style Bits
// StyleMask = 0 => Invert where Style Bit = 1 // StyleMask = 0 => Invert where Style Bit = 1
fStyleMask: TFontStyles; FStyleMask: TFontStyles;
{$ENDIF} FOnChange: TNotifyEvent;
fOnChange: TNotifyEvent;
procedure SetBG(Value: TColor); procedure SetBG(Value: TColor);
procedure SetFG(Value: TColor); procedure SetFG(Value: TColor);
procedure SetFrameColor(const AValue: TColor);
procedure SetStyle(const AValue : TFontStyles); procedure SetStyle(const AValue : TFontStyles);
{$IFDEF SYN_LAZARUS}
procedure SetStyleMask(const AValue : TFontStyles); procedure SetStyleMask(const AValue : TFontStyles);
{$ENDIF} procedure DoChange;
public public
constructor Create; constructor Create;
procedure Assign(aSource: TPersistent); override; procedure Assign(aSource: TPersistent); override;
published published
{$IFDEF SYN_LAZARUS}
function GetModifiedStyle(aStyle : TFontStyles): TFontStyles; function GetModifiedStyle(aStyle : TFontStyles): TFontStyles;
procedure ModifyColors(var aForeground, aBackground: TColor; var aStyle: TFontStyles); procedure ModifyColors(var AForeground, ABackground, AFrameColor: TColor; var AStyle: TFontStyles);
{$ENDIF} property Background: TColor read FBG write SetBG default clHighLight;
property Background: TColor read fBG write SetBG default clHighLight; property Foreground: TColor read FFG write SetFG default clHighLightText;
property Foreground: TColor read fFG write SetFG default clHighLightText; property FrameColor: TColor read FFrameColor write SetFrameColor default clNone;
property Style: TFontStyles read fStyle write SetStyle default []; property Style: TFontStyles read FStyle write SetStyle default [];
{$IFDEF SYN_LAZARUS}
property StyleMask: TFontStyles read fStyleMask write SetStyleMask default []; property StyleMask: TFontStyles read fStyleMask write SetStyleMask default [];
{$ENDIF}
property OnChange: TNotifyEvent read fOnChange write fOnChange; property OnChange: TNotifyEvent read fOnChange write fOnChange;
end; end;
@ -195,8 +191,6 @@ type
property Options: TSynSearchOptions write SetOptions; property Options: TSynSearchOptions write SetOptions;
end; end;
{$IFDEF SYN_LAZARUS}
{ TSynEditCaret } { TSynEditCaret }
TSynEditCaret = class TSynEditCaret = class
@ -217,7 +211,6 @@ type
property CharPos : Integer read fCharPos write setCharPos; property CharPos : Integer read fCharPos write setCharPos;
property LineCharPos : TPoint read GetLineCharPos write SetLineCharPos; property LineCharPos : TPoint read GetLineCharPos write SetLineCharPos;
end; end;
{$ENDIF}
implementation implementation
@ -231,69 +224,88 @@ begin
inherited Create; inherited Create;
fBG := clHighLight; fBG := clHighLight;
fFG := clHighLightText; fFG := clHighLightText;
FFrameColor:= clNone;
end; end;
{$IFDEF SYN_LAZARUS}
function TSynSelectedColor.GetModifiedStyle(aStyle : TFontStyles) : TFontStyles; function TSynSelectedColor.GetModifiedStyle(aStyle : TFontStyles) : TFontStyles;
begin begin
Result := fsXor(aStyle, fStyle * fsNot(fStyleMask)) // Invert Styles Result := fsXor(aStyle, FStyle * fsNot(FStyleMask)) // Invert Styles
+ (fStyle*fStyleMask) // Set Styles + (FStyle*FStyleMask) // Set Styles
- (fsNot(fStyle)*fStyleMask); // Remove Styles - (fsNot(FStyle)*FStyleMask); // Remove Styles
end; end;
procedure TSynSelectedColor.ModifyColors(var aForeground, aBackground : TColor; var aStyle : TFontStyles); procedure TSynSelectedColor.ModifyColors(var AForeground, ABackground, AFrameColor: TColor; var AStyle: TFontStyles);
begin begin
if Foreground <> clNone then aForeground := Foreground; if Foreground <> clNone then AForeground := Foreground;
if Background <> clNone then aBackground := Background; if Background <> clNone then ABackground := Background;
aStyle := GetModifiedStyle(aStyle); if FrameColor <> clNone then AFrameColor := FrameColor;
AStyle := GetModifiedStyle(AStyle);
end; end;
{$ENDIF}
procedure TSynSelectedColor.SetBG(Value: TColor); procedure TSynSelectedColor.SetBG(Value: TColor);
begin begin
if (fBG <> Value) then begin if (FBG <> Value) then
fBG := Value; begin
if Assigned(fOnChange) then fOnChange(Self); FBG := Value;
DoChange;
end; end;
end; end;
procedure TSynSelectedColor.SetFG(Value: TColor); procedure TSynSelectedColor.SetFG(Value: TColor);
begin begin
if (fFG <> Value) then begin if (FFG <> Value) then
fFG := Value; begin
if Assigned(fOnChange) then fOnChange(Self); FFG := Value;
DoChange;
end;
end;
procedure TSynSelectedColor.SetFrameColor(const AValue: TColor);
begin
if FFrameColor <> AValue then
begin
FFrameColor := AValue;
DoChange;
end; end;
end; end;
procedure TSynSelectedColor.SetStyle(const AValue : TFontStyles); procedure TSynSelectedColor.SetStyle(const AValue : TFontStyles);
begin begin
if (fStyle <> AValue) then begin if (FStyle <> AValue) then
fStyle := AValue; begin
if Assigned(fOnChange) then fOnChange(Self); FStyle := AValue;
DoChange;
end; end;
end; end;
{$IFDEF SYN_LAZARUS}
procedure TSynSelectedColor.SetStyleMask(const AValue : TFontStyles); procedure TSynSelectedColor.SetStyleMask(const AValue : TFontStyles);
begin begin
if (fStyleMask <> AValue) then begin if (FStyleMask <> AValue) then
fStyleMask := AValue; begin
if Assigned(fOnChange) then fOnChange(Self); FStyleMask := AValue;
DoChange;
end; end;
end; end;
{$ENDIF}
procedure TSynSelectedColor.DoChange;
begin
if Assigned(FOnChange) then
OnChange(Self);
end;
procedure TSynSelectedColor.Assign(aSource : TPersistent); procedure TSynSelectedColor.Assign(aSource : TPersistent);
var var
Source : TSynSelectedColor; Source : TSynSelectedColor;
begin begin
if Assigned(aSource) and (aSource is TSynSelectedColor) then begin if Assigned(aSource) and (aSource is TSynSelectedColor) then
begin
Source := TSynSelectedColor(aSource); Source := TSynSelectedColor(aSource);
fBG := Source.fBG; FBG := Source.FBG;
fFG := Source.fFG; FFG := Source.FFG;
fStyle := Source.fStyle; FFrameColor := Source.FFrameColor;
fStyleMask := Source.fStyleMask; FStyle := Source.FStyle;
if Assigned(fOnChange) then fOnChange(Self); {TODO: only if really changed} FStyleMask := Source.FStyleMask;
DoChange; {TODO: only if really changed}
end; end;
end; end;
@ -542,8 +554,6 @@ end;
{ TSynEditCaret } { TSynEditCaret }
{$IFDEF SYN_LAZARUS}
function TSynEditCaret.GetLineCharPos : TPoint; function TSynEditCaret.GetLineCharPos : TPoint;
begin begin
Result := Point(fCharPos, fLinePos); Result := Point(fCharPos, fLinePos);
@ -593,7 +603,6 @@ procedure TSynEditCaret.RemoveChangeHandler(AHandler : TNotifyEvent);
begin begin
fOnChangeList.Remove(TMethod(AHandler)); fOnChangeList.Remove(TMethod(AHandler));
end; end;
{$ENDIF}
end. end.

61
components/synedit/syntextdrawer.pp
View File

@ -194,6 +194,8 @@ type
FSaveDC: Integer; FSaveDC: Integer;
{$IFDEF SYN_LAZARUS} {$IFDEF SYN_LAZARUS}
FSavedFont: HFont; FSavedFont: HFont;
FCrntPen: HPen;
FSavedPen: HPen;
{$ENDIF} {$ENDIF}
// Font information // Font information
@ -210,6 +212,7 @@ type
// current font attributes // current font attributes
FColor: TColor; FColor: TColor;
FBkColor: TColor; FBkColor: TColor;
FFrameColor: TColor;
FCharExtra: Integer; FCharExtra: Integer;
// Begin/EndDrawing calling count // Begin/EndDrawing calling count
@ -244,6 +247,7 @@ type
procedure SetStyle(Value: TFontStyles); virtual; procedure SetStyle(Value: TFontStyles); virtual;
procedure SetForeColor(Value: TColor); virtual; procedure SetForeColor(Value: TColor); virtual;
procedure SetBackColor(Value: TColor); virtual; procedure SetBackColor(Value: TColor); virtual;
procedure SetFrameColor(AValue: TColor); virtual;
procedure SetCharExtra(Value: Integer); virtual; procedure SetCharExtra(Value: Integer); virtual;
procedure ReleaseTemporaryResources; virtual; procedure ReleaseTemporaryResources; virtual;
property CharWidth: Integer read GetCharWidth; property CharWidth: Integer read GetCharWidth;
@ -252,6 +256,7 @@ type
property BaseStyle: TFontStyles write SetBaseStyle; property BaseStyle: TFontStyles write SetBaseStyle;
property ForeColor: TColor write SetForeColor; property ForeColor: TColor write SetForeColor;
property BackColor: TColor write SetBackColor; property BackColor: TColor write SetBackColor;
property FrameColor: TColor write SetFrameColor;
property Style: TFontStyles write SetStyle; property Style: TFontStyles write SetStyle;
property CharExtra: Integer read FCharExtra write SetCharExtra; property CharExtra: Integer read FCharExtra write SetCharExtra;
{$IFDEF SYN_LAZARUS} {$IFDEF SYN_LAZARUS}
@ -962,6 +967,10 @@ begin
SetBaseFont(ABaseFont); SetBaseFont(ABaseFont);
FColor := clWindowText; FColor := clWindowText;
FBkColor := clWindow; FBkColor := clWindow;
FFrameColor := clNone;
FSavedPen := 0;
FCrntPen := 0;
end; end;
destructor TheTextDrawer.Destroy; destructor TheTextDrawer.Destroy;
@ -1014,6 +1023,10 @@ begin
DoSetCharExtra(FCharExtra); DoSetCharExtra(FCharExtra);
{$ELSE} {$ELSE}
FSavedFont := SelectObject(DC, FCrntFont); FSavedFont := SelectObject(DC, FCrntFont);
if FCrntPen <> 0 then
FSavedPen := SelectObject(DC, FCrntPen)
else
FSavedPen := 0;
LCLIntf.SetTextColor(DC, FColor); LCLIntf.SetTextColor(DC, FColor);
LCLIntf.SetBkColor(DC, FBkColor); LCLIntf.SetBkColor(DC, FBkColor);
{$ENDIF} {$ENDIF}
@ -1027,10 +1040,17 @@ begin
Dec(FDrawingCount); Dec(FDrawingCount);
if FDrawingCount <= 0 then if FDrawingCount <= 0 then
begin begin
if FDC <> 0 then begin if FDC <> 0 then
begin
{$IFDEF SYN_LAZARUS} {$IFDEF SYN_LAZARUS}
if FSavedFont <> 0 then if FSavedFont <> 0 then
SelectObject(FDC,FSavedFont); SelectObject(FDC, FSavedFont);
if FSavedPen <> 0 then
begin
DeleteObject(SelectObject(FDC, FSavedPen));
FSavedPen := 0;
FCrntPen := 0;
end;
{$ENDIF} {$ENDIF}
RestoreDC(FDC, FSaveDC); RestoreDC(FDC, FSaveDC);
end; end;
@ -1128,6 +1148,27 @@ begin
end; end;
end; end;
procedure TheTextDrawer.SetFrameColor(AValue: TColor);
var
lp: TLogPen;
begin
if FFrameColor <> AValue then
begin
FFrameColor := AValue;
lp.lopnColor := ColorToRGB(FFrameColor);
lp.lopnWidth := Point(1, 0);
lp.lopnStyle := PS_SOLID;
FCrntPen := CreatePenIndirect(lp);
if FDC <> 0 then
begin
if FSavedPen <> 0 then
DeleteObject(SelectObject(FDC, FSavedPen));
FSavedPen := SelectObject(FDC, FCrntPen);
end;
end;
end;
procedure TheTextDrawer.SetCharExtra(Value: Integer); procedure TheTextDrawer.SetCharExtra(Value: Integer);
begin begin
if FCharExtra <> Value then if FCharExtra <> Value then
@ -1190,6 +1231,7 @@ procedure TheTextDrawer.ExtTextOut(X, Y: Integer; fuOptions: UINT;
var var
NeedDistArray: Boolean; NeedDistArray: Boolean;
DistArray: PInteger; DistArray: PInteger;
Points: array[0..4] of TPoint;
begin begin
{$IFDEF SYN_LAZARUS} {$IFDEF SYN_LAZARUS}
NeedDistArray:= (FCharExtra > 0) or not MonoSpace; NeedDistArray:= (FCharExtra > 0) or not MonoSpace;
@ -1204,13 +1246,26 @@ begin
if UseUTF8 then if UseUTF8 then
LCLIntf.ExtUTF8Out(FDC, X, Y, fuOptions, @ARect, Text, Length, DistArray) LCLIntf.ExtUTF8Out(FDC, X, Y, fuOptions, @ARect, Text, Length, DistArray)
else else
LCLIntf.ExtTextOut(FDC, X, Y, fuOptions, @ARect, Text, Length, DistArray) LCLIntf.ExtTextOut(FDC, X, Y, fuOptions, @ARect, Text, Length, DistArray);
{$ELSE} {$ELSE}
if FETOSizeInChar < Length then if FETOSizeInChar < Length then
InitETODist(GetCharWidth); InitETODist(GetCharWidth);
Windows.ExtTextOut(FDC, X, Y, fuOptions, @ARect, Text, Windows.ExtTextOut(FDC, X, Y, fuOptions, @ARect, Text,
Length, PInteger(FETODist)); Length, PInteger(FETODist));
{$ENDIF} {$ENDIF}
if FFrameColor <> clNone then
begin
with ARect do
begin
Points[0] := TopLeft;
Points[1] := Point(Right - 1, Top);
Points[2] := Point(Right - 1, Bottom - 1);
Points[3] := Point(Left, Bottom - 1);
Points[4] := TopLeft;
end;
Polyline(FDC, @Points, 5);
end;
end; end;
procedure TheTextDrawer.ReleaseTemporaryResources; procedure TheTextDrawer.ReleaseTemporaryResources;