pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

richmemo:

Browse Source 
* introduced GetFontParams(TFont) to convert TFont to TFontParams (resolving font data). Using GetFontData(AFont.Reference.Handle) to resolve the passed font information (to handle uninitialized fonts). TFont.Handle is deprecated.
* corrected the TFontParams parameter passing in InsertFontText function

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4001 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2015-03-06 16:41:17 +00:00
parent 115e6a7557
commit 6d2e993c22
2 changed files with 28 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
components/richmemo/richmemo.pas
View File

@@ -245,6 +245,7 @@ function GetFontParams(styles: TFontStyles): TFontParams; overload;
function GetFontParams(color: TColor; styles: TFontStyles): TFontParams; overload;
function GetFontParams(const Name: String; color: TColor; styles: TFontStyles): TFontParams; overload;
function GetFontParams(const Name: String; Size: Integer; color: TColor; styles: TFontStyles): TFontParams; overload;
function GetFontParams(AFont: TFont): TFontParams; overload;
procedure InitParaMetric(var m: TParaMetric);
procedure InitParaNumbering(var n: TParaNumbering);
@@ -289,6 +290,29 @@ begin
Result.Style := styles;
end;
function GetFontParams(AFont: TFont): TFontParams; overload;
var
data : TFontData;
begin
InitFontParams(Result);
if not Assigned(AFont) then Exit;
if AFont.Reference.Handle <> 0 then begin
data:=GetFontData(AFont.Reference.Handle);
if data.Height<0
then Result.Size:=round(abs(data.Height)/ScreenInfo.PixelsPerInchY*72)
else Result.Size:=data.Height;
Result.Name:=data.Name;
Result.Color:=AFont.Color;
Result.Style:=data.Style;
end else begin
Result.Name := AFont.Name;
Result.Color := AFont.Color;
Result.Size := AFont.Size;
Result.Style := AFont.Style;
end;
end;
procedure InitParaMetric(var m: TParaMetric);
begin
FillChar(m, sizeof(m), 0);
@@ -441,15 +465,9 @@ end;
procedure TCustomRichMemo.SetTextAttributes(TextStart, TextLen: Integer;
AFont: TFont);
var
params : TFontParams;
begin
InitFontParams(params);
params.Name := AFont.Name;
params.Color := AFont.Color;
params.Size := AFont.Size;
params.Style := AFont.Style;
SetTextAttributes(TextStart, TextLen, {TextStyleAll,} params);
if not Assigned(AFont) then Exit;
SetTextAttributes(TextStart, TextLen, GetFontParams(AFont));
end;
procedure TCustomRichMemo.SetTextAttributes(TextStart, TextLen: Integer;

4
components/richmemo/richmemoutils.pas
View File

@@ -54,12 +54,12 @@ procedure InsertStyledText(const ARichMemo: TCustomRichMemo; const TextUTF8: Str
InsPos : Integer = -1 );
procedure InsertColorStyledText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; AColor: TColor; AStyle: TFontStyles;
InsPos : Integer = -1 );
procedure InsertFontText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; prms: TFontParams;
procedure InsertFontText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; const prms: TFontParams;
InsPos : Integer = -1 );
implementation
procedure InsertFontText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; prms: TFontParams;
procedure InsertFontText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; const prms: TFontParams;
InsPos : Integer = -1 );
var
len : Integer;