summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGraeme Geldenhuys <graeme@mastermaths.co.za>2009-11-27 16:11:31 +0200
committerGraeme Geldenhuys <graeme@mastermaths.co.za>2011-07-23 09:41:00 +0200
commiteb30643705f18067e4e5374fa272c71a604403ab (patch)
treeeffab28fcd34bac5858d31c434aa124c39805da9
parent3ad5f0455a6e61d59968d40c63bd8579e51f0bfb (diff)
downloadfpGUI-eb30643705f18067e4e5374fa272c71a604403ab.tar.xz
Major refactoring in the CanvasFontManager unit. Work-in-Progress!
The CanvasFontManager unit has totally been reworked to use the native TfpgFont class instead of TLogicalFont, TFontFace etc... The code is a lot more simplified now and DocView can actually display content but there are some width wrapping issues and AV's on changing topics. This will be fixed next.
-rw-r--r--docview/components/richtext/CanvasFontManager.pas966
-rw-r--r--docview/components/richtext/RichTextDisplayUnit.pas19
-rw-r--r--docview/components/richtext/RichTextLayoutUnit.pas53
-rw-r--r--docview/components/richtext/RichTextStyleUnit.pas130
-rw-r--r--docview/components/richtext/RichTextView.pas7
-rw-r--r--docview/src/SettingsUnit.pas2
6 files changed, 185 insertions, 992 deletions
diff --git a/docview/components/richtext/CanvasFontManager.pas b/docview/components/richtext/CanvasFontManager.pas
index 063f759b..7024f062 100644
--- a/docview/components/richtext/CanvasFontManager.pas
+++ b/docview/components/richtext/CanvasFontManager.pas
@@ -14,133 +14,54 @@ Uses
Const
// This defines the fraction of a pixel that
// font character widths will be given in
- FontWidthPrecisionFactor = 1; // 256 seems to be specific to OS/2 API
DefaultTopicFontName = 'Arial';
- DefaultTopicFontSize = '10';
+ DefaultTopicFontSize = 10;
DefaultTopicFixedFontName = 'Courier New';
- DefaultTopicFixedFontSize = '10';
+ DefaultTopicFixedFontSize = 10;
DefaultTopicFont = DefaultTopicFontName + '-' + DefaultTopicFontSize;
DefaultTopicFixedFont = DefaultTopicFixedFontName + '-' + DefaultTopicFixedFontSize;
-
-Type
- {Standard Font types}
- TFontType=(ftBitmap,ftOutline);
-
+type
{Standard Font Attributes}
- TFontAttributes=Set Of(faItalic,faUnderScore,faOutline,faStrikeOut,faBold);
+ TFontAttributes = set of (faBold, faItalic, faUnderScore, faOutline, faStrikeOut);
{Standard Font pitches}
TFontPitch=(fpFixed,fpProportional);
- {Standard Font character Set}
- TFontCharSet=(fcsSBCS,fcsDBCS,fcsMBCS); {Single,Double,mixed Byte}
-
- // a user-oriented specification of a font; not an actual structure in the INF file
- TFontSpec = record
- FaceName: string[ 64 ];
- PointSize: integer; // if 0 then use x/y size
- XSize: integer;
- YSize: integer;
- Attributes: TFontAttributes; // set of faBold, faItalic etc
- end;
-
- // NOTE: Char widths are in 1/FontWidthPrecisionFactor units
- TCharWidthArray = array[ #0..#255 ] of longint;
- TPCharWidthArray = ^TCharWidthArray;
-
- // Used internally for storing full info on font
- TLogicalFont = class(TObject)
- public
- FaceName: string; // user-selected name
- UseFaceName: string; // after substitutions.
-
- // Selected bits of FONTMETRICS
- fsSelection: word; //USHORT;
-
- FontType: TFontType;
- FixedWidth: boolean;
- PointSize: integer;
- ID: integer;
- Attributes: TFontAttributes;
-
- // this can be nil if not already fetched
- pCharWidthArray: TPCharWidthArray;
- lMaxbaselineExt: longint; //LONG;
- lAveCharWidth: longint; //LONG;
- lMaxCharInc: longint; //LONG;
- lMaxDescender: longint; //LONG;
- public
- constructor Create;
- destructor Destroy; override;
- end;
-
-
- TFontFace = class(TObject)
- public
- Name: string;
- FixedWidth: boolean;
- FontType: TFontType;
- Sizes: TList; // relevant for bitmap fonts only - contains TLogicalFont objects
- constructor Create;
- destructor Destroy; override;
- end;
-
TCanvasFontManager = class(TObject)
private
FWidget: TfpgWidget;
- protected
FCanvas: TfpgCanvas;
- FLogicalFonts: TList;
- FCurrentFontSpec: TFontSpec;
- FDefaultFontSpec: TFontSpec;
- FCurrentFont: TLogicalFont;
- FAllowBitmapFonts: boolean;
- function CreateFont( const FontSpec: TFontSpec ): TLogicalFont;
- function GetFont( const FontSpec: TFontSpec ): TLogicalFont;
- procedure RegisterFont( Font: TLogicalFont );
- procedure SelectFont( Font: TLogicalFont; Scale: longint );
- // Retrieve character widths for current font
- procedure LoadMetrics;
- // load metrics if needed
- procedure EnsureMetricsLoaded;
+ function GetCurrentFont: TfpgFont;
+ procedure SetDefaultFont(const AValue: TfpgFont);
+ protected
+ FDefaultFont: TfpgFont;
public
- constructor Create(Canvas: TfpgCanvas; AllowBitmapFonts: boolean; AWidget: TfpgWidget); reintroduce;
+ constructor Create(ACanvas: TfpgCanvas; AWidget: TfpgWidget); reintroduce;
destructor Destroy; override;
- // Set the font for the associated canvas.
- procedure SetFont( const FontSpec: TFontSpec );
- // Retrieve the width of the given char, in the current font
- function CharWidth( const C: Char ): longint;
function AverageCharWidth: longint;
- function MaximumCharWidth: longint;
- function IsFixed: boolean;
- function CharHeight: longint;
function CharDescender: longint;
+ function CharHeight: longint;
+ function CharWidth( const C: Char ): longint; // Retrieve the width of the given char, in the current font
+ function IsFixed: boolean;
+ function MaximumCharWidth: longint;
procedure DrawString(var Point: TPoint; const Length: longint; const S: PChar);
+ procedure SetFont(const AFontDesc: TfpgString);
property Canvas: TfpgCanvas read FCanvas;
+ property CurrentFont: TfpgFont read GetCurrentFont;
+ property DefaultFont: TfpgFont read FDefaultFont write SetDefaultFont;
property Widget: TfpgWidget read FWidget;
- property DefaultFontSpec: TFontSpec read FDefaultFontSpec write FDefaultFontSpec;
end;
-// Convert a Sibyl font to a FontSpec (Color is left the same)
-procedure FPGuiFontToFontSpec( Font: TfpgFont; Var FontSpec: TFontSpec );
-
- // Thoughts on how it works....
+// Get the font attributes of a fpGUI font
+function GetFPGuiFontAttributes(const AFont: TfpgFont): TFontAttributes;
+function GetFPGuiFont(const AFontNameSize: string; const Attrs: TFontAttributes): TfpgFont;
+procedure ApplyFontAttributes(var AFontDesc: string; const Attrs: TFontAttributes);
- // SelectFont looks for an existing logical font that
- // matches the request. If found selects that logical font
- // onto the canvas.
-
- // If not found it creates a logical font and selects that onto
- // the canvas.
-
- // For bitmap fonts the logical font definition includes pointsize
- // For outline fonts the defn is only face+attr; in this case
- // selectfont also ses the 'CharBox' according to the point size.
implementation
@@ -153,53 +74,7 @@ uses
;
-var
- FontFaces: TList = nil; // of TFontface
- DefaultOutlineFixedFace: TFontFace;
- DefaultOutlineProportionalFace: TFontFace;
-
-// TFontFace
-//------------------------------------------------------------------------
-
-constructor TFontface.Create;
-begin
- Sizes := TList.Create;
- FontType := ftOutline; // in fpGUI we treat all fonts as scalable (preference)
-end;
-
-destructor TFontface.Destroy;
-begin
- Sizes.Free;
-end;
-
-// TLogicalFont
-//------------------------------------------------------------------------
-
-constructor TLogicalFont.Create;
-begin
- FontType := ftOutline;
- PointSize := 10;
- Attributes := [];
- FixedWidth := False;
- UseFaceName := '';
- FaceName := '';
-end;
-
-// frees allocated memory, if any.
-// Note - does not delete the Gpi Logical Font
-destructor TLogicalFont.Destroy;
-begin
- if pCharWidthArray <> nil then
- FreeMem( pCharWidthArray,
- sizeof( TCharWidthArray ) );
-
- inherited Destroy;
-end;
-
-
-// Convert a fpGUI Toolkit font to a FontSpec
-//------------------------------------------------------------------------
-procedure FPGuiFontToFontSpec( Font: TfpgFont; Var FontSpec: TFontSpec );
+function GetFPGuiFontAttributes(const AFont: TfpgFont): TFontAttributes;
var
s: string;
facename: string;
@@ -207,15 +82,16 @@ var
c: char;
token: string;
prop, propval: string;
- desc: string;
+ lDesc: string;
+ lFontSize: integer;
function NextC: char;
begin
Inc(cp);
- if cp > length(desc) then
+ if cp > length(lDesc) then
c := #0
else
- c := desc[cp];
+ c := lDesc[cp];
Result := c;
end;
@@ -230,22 +106,20 @@ var
end;
begin
+ Result := [];
cp := 0;
- desc := Font.FontDesc;
+ lDesc := AFont.FontDesc;
+
// find fontface
NextC;
NextToken;
- FontSpec.FaceName := token;
- FontSpec.Attributes := [];
- FontSpec.XSize := Font.TextWidth('v');
- FontSpec.YSize := Font.Height;
// find font size
if c = '-' then
begin
NextC;
NextToken;
- FontSpec.PointSize := StrToIntDef(token, 10);
+ lFontSize := StrToIntDef(token, DefaultTopicFontSize);
end;
// find font attributes
@@ -255,207 +129,60 @@ begin
NextToken;
prop := UpperCase(token);
propval := '';
-
if c = '=' then
begin
NextC;
NextToken;
propval := UpperCase(token);
end;
- // convert fontdesc attributes to fontspec attributes
+ // convert fontdesc attributes to standard font attributes
if prop = 'BOLD' then
- include(FontSpec.Attributes, faBold)
+ include(Result, faBold)
else if prop = 'ITALIC' then
- include(FontSpec.Attributes, faItalic)
+ include(Result, faItalic)
else if prop = 'UNDERLINE' then
- include(FontSpec.Attributes, faUnderScore)
- end;
-end;
-
-// Find a font face with the given name
-//------------------------------------------------------------------------
-function FindFaceName( const name: string ): TFontFace;
-Var
- FaceIndex: LongInt;
- Face: TFontFace;
-begin
- for FaceIndex := 0 to FontFaces.Count - 1 do
- begin
- Face := TFontFace(FontFaces[ FaceIndex ]);
-
- if pos(UpperCase(name), UpperCase(Face.Name)) > 0 then
- begin
- Result := Face;
- exit;
- end;
- end;
- Result := nil;
-end;
-
-// Return the first font face of type = Outline (scalable)
-//------------------------------------------------------------------------
-function GetFirstOutlineFace( FixedWidth: boolean ): TFontFace;
-Var
- FaceIndex: LongInt;
- Face: TFontFace;
-begin
- for FaceIndex := 0 to FontFaces.Count - 1 do
- begin
- Face := TFontFace(FontFaces[ FaceIndex ]);
-
- if ( Face.FixedWidth = FixedWidth )
- and ( Face.FontType = ftOutline ) then
- begin
- Result := Face;
- exit;
- end;
+ include(Result, faUnderScore)
+ else if prop = 'OUTLINE' then
+ include(Result, faOutline)
+ else if prop = 'STRIKEOUT' then
+ include(Result, faStrikeOut)
end;
- Result := nil;
end;
-// Find the bitmap font which best matches the given pointsize.
-//------------------------------------------------------------------------
-function GetClosestBitmapFixedFont( const PointSize: longint ): TLogicalFont;
-Var
- FaceIndex: Longint;
- FontIndex: longint;
- Face: TFontFace;
- Font: TLogicalFont;
-begin
- Result := nil;
- for FaceIndex := 0 to FontFaces.Count - 1 do
- begin
- Face := TFontFace(FontFaces[ FaceIndex ]);
-
- if Face.FontType = ftBitmap then
- begin
- for FontIndex := 0 to Face.Sizes.Count - 1 do
- begin
- Font := TLogicalFont(Face.Sizes[ FontIndex ]);
- if Font.FixedWidth then
- begin
- if ( Result = nil )
- or ( Abs( Font.PointSize - PointSize )
- < Abs( Result.PointSize - PointSize ) ) then
- Result := Font;
- end;
- end;
- end;
- end;
-end;
-
-// Pick some nice default fonts.
-//------------------------------------------------------------------------
-procedure GetDefaultFonts;
+function GetFPGuiFont(const AFontNameSize: string; const Attrs: TFontAttributes): TfpgFont;
+var
+ s: string;
begin
- // courier new is common and reasonably nice
- DefaultOutlineFixedFace := FindFaceName( DefaultTopicFixedFontName );
- if DefaultOutlineFixedFace = nil then
- begin
- DefaultOutlineFixedFace := GetFirstOutlineFace( true ); // first fixed outline face
- end;
-
- DefaultOutlineProportionalFace := FindFaceName( DefaultTopicFontName );
- if DefaultOutlineProportionalFace = nil then
- begin
- DefaultOutlineProportionalFace := GetFirstOutlineFace( false ); // first prop outline face
- end;
+ s := AFontNameSize;
+ ApplyFontAttributes(s, Attrs);
+ Result := fpgGetFont(s);
end;
-// Fetch the global list of font faces and sizes
-//------------------------------------------------------------------------
-procedure GetFontList;
-Var
- Count: LongInt;
- T: LongInt;
- Font: TLogicalFont;
- Face: TFontFace;
- FamilyName: string;
- fl: TStringList;
- f: TfpgFont;
+// Add attributes to font name
+procedure ApplyFontAttributes(var AFontDesc: string; const Attrs: TFontAttributes);
begin
- fl := nil;
- FontFaces := TList.Create;
- fl := fpgApplication.GetFontFaceList;
+ if faItalic in Attrs then
+ if Pos(':Italic', AFontDesc) = 0 then
+ AFontDesc := AFontDesc + ':Italic';
- // Get font count
- Count := fl.Count;
- If Count > 0 Then
- Begin
- For T := 0 To Count - 1 Do
- Begin
- Font := TLogicalFont.Create;
- Font.FaceName := fl[T];
- f := fpgGetFont(Font.FaceName + '-10');
- if (pos('COURIER', UpperCase(Font.FaceName)) > 0) or (pos('MONO', UpperCase(Font.FaceName)) > 0) then
- Font.FixedWidth := True;
- Font.lAveCharWidth := f.TextWidth('g');
- Font.lMaxbaselineExt := f.Height;
- //Font.fsSelection := pfm^[ T ].fsSelection;
- //Font.lMaxbaselineExt := pfm^[ T ].lMaxbaselineExt;
- //Font.lAveCharWidth := pfm^[ T ].lAveCharWidth;
- //Font.lMaxCharInc := pfm^[ T ].lMaxCharInc;
- Font.ID := -1; // and always shall be so...
- f.Free;
+ if faBold in Attrs then
+ if Pos(':Bold', AFontDesc) = 0 then
+ AFontDesc := AFontDesc + ':Bold';
- Face := FindFaceName( Font.FaceName );
- if Face = nil then
- begin
- // new face found
- Face := TFontFace.Create;
- Face.Name := Font.FaceName; // point to the actual face name string!
- Face.FixedWidth := Font.FixedWidth;
- Face.FontType := Font.FontType;
- FontFaces.Add( Face );
- end;
- Face.Sizes.Add( Font );
- End;
- End;
+ if faOutline in Attrs Then
+ if Pos(':Outline', AFontDesc) = 0 then
+ AFontDesc := AFontDesc + ':Outline';
- fl.Free;
- // pick some for defaults
- GetDefaultFonts;
-end;
-
-// Add .subscript to font name for attributes
-//------------------------------------------------------------------------
-Function ModifyFontName( const FontName: string;
- const Attrs: TFontAttributes ): String;
-Begin
- Result := FontName;
- If faItalic in Attrs Then
- Result := Result + '.Italic';
- If faBold in Attrs Then
- Result := Result + '.Bold';
- If faOutline in Attrs Then
- Result := Result + '.Outline';
- If faStrikeOut in Attrs Then
- Result := Result + '.Strikeout';
- If faUnderScore in Attrs Then
- Result := Result + '.Underscore';
-End;
+ if faStrikeOut in Attrs Then
+ if Pos(':Strikeout', AFontDesc) = 0 then
+ AFontDesc := AFontDesc + ':Strikeout';
-// Create a font without attributes
-//------------------------------------------------------------------------
-function CreateFontBasic( const FaceName: string; const PointSize: integer ): TLogicalFont;
-var
- PPString: string;
-begin
- Result := TLogicalFont.Create;
- if FindFaceName( FaceName ) = nil then
- Exit; //==>
- Result.PointSize := PointSize; // will use later if the result was an outline font...
- Result.FaceName := FaceName;
-
- // OK now we have found the font face...
- PPString := IntToStr( PointSize) + '.' + FaceName;
-
- PPString := ModifyFontName( PPString, [] );
+ if faUnderScore in Attrs Then
+ if Pos(':Underscore', AFontDesc) = 0 then
+ AFontDesc := AFontDesc + ':Underscore';
end;
-// Provide outline substitutes for some common bitmap fonts
-// From Mozilla/2 source.
-//------------------------------------------------------------------------
+// Provide font name substitutes for some common bitmap fonts found in INF files
function SubstituteBitmapFontToOutline( const FaceName: string ): string;
begin
if StringsSame( FaceName, 'Helv' ) then
@@ -474,597 +201,105 @@ begin
result := FaceName; // no substitution
end;
-// Ask OS/2 dummy font window to convert a font spec
-// into a FONTMETRICS.
-//------------------------------------------------------------------------
-//procedure AskOS2FontDetails( const FaceName: string;
-// const PointSize: longint;
-// const Attributes: TFontAttributes;
-// var FontInfo: FONTMETRICS );
-//var
-// PPString: string;
-// PresSpace: HPS;
-//begin
-// // Hack from Sibyl code - we don't know WTF the algorithm is
-// // for selecting between outline/bitmap and doing substitutions
-// // so send it to a dummy window and find out the resulting details
-// PPString := IntToStr( PointSize )
-// + '.'
-// + FaceName;
-//
-// PPString := ModifyFontName( PPString, Attributes );
-//
-// FontWindow.SetPPFontNameSize( PPString );
-//
-// PresSpace := WinGetPS( FontWindow.Handle );
-// GpiQueryFontMetrics( PresSpace,
-// SizeOf( FontInfo ),
-// FontInfo );
-// WinReleasePS( PresSpace );
-//end;
-
// Look for the best match for the given face, size and attributes.
// If FixedWidth is set then makes sure that the result is fixed
-// (if there is any fixed font on the system at all!)
-// This uses the OS/2 GPI and therefore makes some substitutions,
-// such as Helv 8 (bitmap) for Helvetica 8 (outline)
-//------------------------------------------------------------------------
-procedure FindBestFontMatch( const FaceName: string;
- const PointSize: longint;
- const Attributes: TFontAttributes;
- const FixedWidth: boolean;
- var FontInfo: string );
+procedure FindBestFontMatch( const FaceName: string; const PointSize: longint;
+ const Attributes: TFontAttributes; const FixedWidth: boolean; var FontDesc: string );
var
- BestBitmapFontMatch: TLogicalFont;
- fl: TStringList;
+ sl: TStringList;
i: integer;
begin
- { TODO -oGraeme -cfonts : This hack is very quick and dirty. Needs to be refined a lot }
- fl := fpgApplication.GetFontFaceList;
- for i := 0 to fl.Count-1 do
+ FontDesc := '';
+ sl := fpgApplication.GetFontFaceList;
+ for i := 0 to sl.Count-1 do
begin
- if Pos(FaceName, fl[i]) > 0 then
- FontInfo := fl[i] + '-' + IntToStr(PointSize);
+ if Pos(FaceName, sl[i]) > 0 then
+ FontDesc := sl[i] + '-' + IntToStr(PointSize);
end;
- if Fontinfo = '' then
- // nothing found so use default font of fpGUI
- FontInfo := fpgApplication.DefaultFont.FontDesc;
+ ApplyFontAttributes(FontDesc, Attributes);
+
+ // if nothing found, use default font of fpGUI
+ if FontDesc = '' then
+ FontDesc := fpgApplication.DefaultFont.FontDesc;
end;
-//------------------------------------------------------------------------
-// Font manager
-//------------------------------------------------------------------------
-// constructor
-//------------------------------------------------------------------------
-constructor TCanvasFontManager.Create(Canvas: TfpgCanvas; AllowBitmapFonts: boolean;
- AWidget: TfpgWidget);
+{ TCanvasFontManager }
+
+constructor TCanvasFontManager.Create(ACanvas: TfpgCanvas; AWidget: TfpgWidget);
begin
inherited Create;
- if FontFaces = nil then
- GetFontList;
- FCanvas := Canvas;
+ FCanvas := ACanvas;
FWidget := AWidget;
- FLogicalFonts := TList.Create;
-
- // get system default font spec
- // as default default ;)
- FPGuiFontToFontSpec( fpgApplication.DefaultFont, FDefaultFontSpec );
- if FDefaultFontSpec.FaceName = '' then
- raise Exception.Create('For some reason we could not create a FDefaultFontSpec instance');
-
- // FCurrentFontSpec.FaceName := 'Arial';
- FCurrentFontSpec.FaceName := FDefaultFontSpec.FaceName;
- FCurrentFont := nil;
- FAllowBitmapFonts := AllowBitmapFonts;
+ FDefaultFont := fpgGetFont(Format('%s-%d', [DefaultTopicFont, DefaultTopicFontSize]));
+ FCanvas.Font := FDefaultFont;
end;
-// Destructor
-//------------------------------------------------------------------------
destructor TCanvasFontManager.Destroy;
-var
- i: integer;
- lFont: TLogicalFont;
- lface: TFontFace;
begin
- // select default font so none of our logical fonts are in use
FCanvas.Font := fpgApplication.DefaultFont;
-
- // delete each logical font and our record of it
- for i := FLogicalFonts.Count-1 downto 0 do
- begin
- // TODO: This must be fixed. If we don't use try..except we sometimes get AV's on lFont.Free
- // TODO: TLogicalFont must be totally removed from DocView.
- try
- lFont := TLogicalFont(FLogicalFonts[i]);
- lFont.Free;
- except
- // do nothing
- end;
- end;
- FLogicalFonts.Clear;
- FLogicalFonts.Free;
-
- // TCanvasFontManager asked for FontFaces to be created, so lets take responsibility to destroy it.
- for i := 0 to FontFaces.Count-1 do
- begin
- lface := TFontFace(Fontfaces[i]);
- lface.Free;
- end;
- FontFaces.Clear;
- FontFaces.Free;
+ FDefaultFont.Free;
inherited Destroy;
end;
-// Create a logical font for the given spec
-//------------------------------------------------------------------------
-function TCanvasFontManager.CreateFont( const FontSpec: TFontSpec ): TLogicalFont;
-var
- UseFaceName: string;
- Face: TFontFace;
- RemoveBoldFromSelection: boolean;
- RemoveItalicFromSelection: boolean;
- UseAttributes: TFontAttributes;
- MatchAttributes: TFontAttributes;
- BaseFont: TLogicalFont;
- BaseFontIsBitmapFont: Boolean;
- FontInfo: string;
- FixedWidth: boolean;
+procedure TCanvasFontManager.SetDefaultFont(const AValue: TfpgFont);
begin
-ProfileEvent('>>>> TCanvasFontManager.CreateFont >>>>');
- Face := nil;
- RemoveBoldFromSelection := false;
- RemoveItalicFromSelection := false;
-
- UseAttributes := FontSpec.Attributes;
-
- // see if the originally specified font is a fixed width one.
- FixedWidth := false;
- Face := FindFaceName( FontSpec.FaceName );
- if Face <> nil then
- FixedWidth := Face.FixedWidth;
-
- Face := nil;
-
- if not FAllowBitmapFonts then
- UseFaceName := SubstituteBitmapFontToOutline( FontSpec.FaceName )
- else
- UseFaceName := FontSpec.FaceName;
-ProfileEvent('UseFaceName=' + UseFaceName);
-
- if FontSpec.Attributes <> [] then
- begin
-profileevent('FontSpec.Attributes are not blank');
- BaseFontIsBitmapFont := false;
- if FAllowBitmapFonts then
- begin
- // First see if the base font (without attributes)
- // would be a bitmap font...
- BaseFont := CreateFontBasic( UseFaceName, FontSpec.PointSize );
- if BaseFont <> nil then
- begin
- BaseFontIsBitmapFont := BaseFont.FontType = ftBitmap;
- BaseFont.Destroy;
- end;
- end;
-
- If not BaseFontIsBitmapFont Then
- begin
-profileevent('we seem to be looking for a outline font');
- // Result is an outline font so look for specific bold/italic fonts
- if ( faBold in FontSpec.Attributes )
- and ( faItalic in FontSpec.Attributes ) then
- begin
- Face := FindFaceName( UseFaceName + ' BOLD ITALIC' );
- if Face <> nil then
- begin
- Exclude( UseAttributes, faBold );
- Exclude( UseAttributes, faItalic );
- RemoveBoldFromSelection := true;
- RemoveItalicFromSelection := true;
- end;
- end;
-
- if Face = nil then
- if faBold in FontSpec.Attributes then
- begin
- Face := FindFaceName( UseFaceName + ' BOLD' );
- if Face <> nil then
- begin
- Exclude( UseAttributes, faBold );
- RemoveBoldFromSelection := true;
- end;
- end;
-
- if Face = nil then
- if faItalic in FontSpec.Attributes then
- begin
- Face := FindFaceName( UseFaceName + ' ITALIC' );
- if Face <> nil then
- begin
- Exclude( UseAttributes, faItalic );
- RemoveItalicFromSelection := true;
- end;
- end;
- end;
- end;
-
- if Face <> nil then
- // found a styled face, does it match fixed width?
- if Face.FixedWidth <> FixedWidth then
- // no so we don't want to use it.
- Face := nil;
-
- if Face = nil then
- // didn't find a styled face (or no styles set)
- // so find unmodified, we will use simulation bits
- Face := FindFaceName( UseFaceName );
-
- // Oh shit!
- if Face = nil then
- // didn't find a styled face (or no styles set)
- // so find unmodified, we will use simulation bits
- Face := FindFaceName( 'Sans' ); // something very generic
-
- if not FAllowBitmapFonts then
- if Assigned(Face) and (Face.FontType = ftBitmap) then
- // we aren't allowed bitmaps, but that's what this
- // face is. So use the default outline face of the
- // appropriate width type
- if FixedWidth then
- Face := DefaultOutlineFixedFace
- else
- Face := DefaultOutlineProportionalFace;
-
- if Face = nil then
- begin
-profileevent('Could not find the specified font name. Bummer! + early exit');
- // Could not find the specified font name. Bummer.
- Result := nil;
+ if FDefaultFont = AValue then
exit;
- end;
-
-profileevent('******* Now create the TLogicalFont instance');
- // OK now we have found the font face...
- Result := TLogicalFont.Create;
- Result.PointSize := FontSpec.PointSize; // will use later if the result was an outline font...
- Result.FaceName := FontSpec.FaceName;
- Result.UseFaceName := Face.Name;
- Result.Attributes := FontSpec.Attributes;
- Result.fsSelection := 0;
- Result.FixedWidth := Face.FixedWidth;
-
- if FAllowBitmapFonts then
- begin
- if BaseFontIsBitmapFont then
- MatchAttributes := []
- else
- MatchAttributes := UseAttributes;
- FindBestFontMatch( Face.Name,
- FontSpec.PointSize,
- MatchAttributes,
- FixedWidth,
- FontInfo );
-
- Result.UseFaceName := FontInfo;
- end
- else
- begin
- // no bitmap fonts please.
- Result.FontType := ftOutline
- end;
-
- // store the baseline and average char width.
- // For bitmap fonts, these tell GPI which font we really want
- // For outline fonts, we are just storing them for later ref.
- //Result.lMaxbaseLineExt := FontInfo.lMaxbaselineExt;
- //Result.lAveCharWidth := FontInfo.lAveCharWidth;
- //Result.lMaxCharInc := FontInfo.lMaxCharInc;
- Result.lMaxBaseLineExt := FontSpec.YSize;
- Result.lAveCharWidth := FontSpec.XSize;
- Result.lMaxCharInc := FontSpec.XSize;
-
- // Set style flags
- with Result do
- begin
- //If faBold in UseAttributes Then
- // fsSelection := fsSelection or FM_SEL_BOLD;
- //If faItalic in UseAttributes Then
- // fsSelection := fsSelection or FM_SEL_ITALIC;
- //If faUnderScore in UseAttributes Then
- // fsSelection := fsSelection or FM_SEl_UNDERSCORE;
- //If faStrikeOut in UseAttributes Then
- // fsSelection := fsSelection or FM_SEl_STRIKEOUT;
- //If faOutline in UseAttributes Then
- // fsSelection := fsSelection or FM_SEl_OUTlINE;
- end;
-
-profileevent(' Result.FaceName=' + Result.FaceName);
-profileevent(' Result.PointSize=' + IntToStr(Result.PointSize));
-profileevent(' Result.UseFaceName=' + Result.UseFaceName);
-
- Result.pCharWidthArray := Nil;
- ProfileEvent('<<<< TCanvasFontManager.CreateFont');
+ FDefaultFont.Free;
+ FDefaultFont := AValue;
end;
-// Register the given logical font with GPI and store for later use
-//------------------------------------------------------------------------
-procedure TCanvasFontManager.RegisterFont( Font: TLogicalFont );
-var
-// fa: FATTRS;
- rc: longint;
+function TCanvasFontManager.GetCurrentFont: TfpgFont;
begin
- FLogicalFonts.Add( Font );
- Font.ID := FLogicalFonts.Count + 1; // add 1 to stay out of Sibyl's way
-
- //// Initialise GPI font attributes
- //FillChar( fa, SizeOf( FATTRS ), 0 );
- //fa.usRecordLength := SizeOf( FATTRS );
- //
- //// Copy facename and 'simulation' attributes from what we obtained
- //// earlier
- //fa.szFaceName := Font.pUseFaceName^;
- //fa.fsSelection := Font.fsSelection;
- //
- //fa.lMatch := 0; // please Mr GPI be helpful and do clever stuff for us, we are ignorant
- //
- //fa.idRegistry := 0; // IBM magic number
- //fa.usCodePage := 0; // use current codepage
- //
- //If Font.FontType = ftOutline then
- // // Outline font wanted
- // fa.fsFontUse := FATTR_FONTUSE_OUTLINE Or FATTR_FONTUSE_TRANSFORMABLE
- //else
- // // bitmap font
- // fa.fsFontUse := 0;
- //
- //// don't need mixing with graphics (for now)
- //fa.fsFontUse := fa.fsFontUse or FATTR_FONTUSE_NOMIX;
- //
- //// copy char cell width/height from the (valid) one we
- //// found earlier in GetFont (will be zero for outline)
- //fa.lMaxbaseLineExt := Font.lMaxbaselineExt;
- //fa.lAveCharWidth := Font.lAveCharWidth;
- //
- //fa.fsType := 0;
- //
- //// create logical font
- //rc := GpiCreateLogFont( FCanvas.Handle,
- // nil,
- // Font.ID,
- // fa );
-end;
-
-// Select the given (existing) logical font
-//------------------------------------------------------------------------
-procedure TCanvasFontManager.SelectFont( Font: TLogicalFont;
- Scale: longint );
-var
- f: TfpgFont;
- s: string;
-begin
- // Select the logical font
- s := Font.FaceName + '-' + IntToStr(Font.PointSize);
- if faBold in Font.Attributes then
- s := s + ':bold';
- if faItalic in Font.Attributes then
- s := s + ':italic';
- if faUnderScore in Font.Attributes then
- s := s + ':underline';
-
- f := fpgGetFont(s);
- FCanvas.Font := f;
-end;
-
-// Get a font to match the given spec, creating or re-using an
-// existing font as needed.
-//------------------------------------------------------------------------
-function TCanvasFontManager.GetFont( const FontSpec: TFontSpec ): TLogicalFont;
-var
- AFont: TLogicalFont;
- FontIndex: integer;
- sub: string;
-begin
-ProfileEvent('DEBUG: TCanvasFontManager.GetFont >>>');
-ProfileEvent('Received FontSpec: Facename=' + FontSpec.FaceName);
-ProfileEvent(' PointSize=' + IntToStr(FontSpec.PointSize));
-ProfileEvent('FLogicalFonts.Count=' + intToStr(FLogicalFonts.Count));
-try
- for FontIndex := 0 to FLogicalFonts.Count - 1 do
- begin
- AFont := TLogicalFont(FLogicalFonts[ FontIndex ]);
- if AFont.PointSize = FontSpec.PointSize then
- begin
- if ( AFont.PointSize > 0 )
- or ( ( AFont.lAveCharWidth = FontSpec.XSize )
- and ( AFont.lMaxbaselineExt = FontSpec.YSize ) ) then
- begin
- if AFont.Attributes = FontSpec.Attributes then
- begin
- // search name last since it's the slowest thing
-//ProfileEvent(' AFont.UseFaceName=' + AFont.UseFaceName);
-//ProfileEvent(' FontSpec.FaceName=' + FontSpec.FaceName);
- if AFont.FaceName = FontSpec.FaceName then
- begin
- // Found a logical font already created
- Result := AFont;
- // done
- exit;
- end
- else
- begin
- // Still nothing! Lets try known substitute font names
- sub := SubstituteBitmapFontToOutline(FontSpec.FaceName);
-ProfileEvent(' substitute font=' + sub);
- if AFont.FaceName = sub then
- begin
- // Found a logical font already created
- Result := AFont;
- // done
- profileevent('TCanvasFontManager.GetFont <<<<< exit early we found a font');
- exit;
- end;
- end;
- end;
- end;
- end;
- end;
-except
- { TODO -oGraeme -cknow bug : An Access Violation error occurs often here! No idea why? }
- on E: Exception do
- ProfileEvent('Unexpected error occured. Error: ' + E.Message);
-end;
-
- ProfileEvent('Now we need to create a new logical font');
- // Need to create new logical font
- Result := CreateFont( FontSpec );
- if Result <> nil then
- begin
- RegisterFont( Result );
- end;
-ProfileEvent('DEBUG: TCanvasFontManager.GetFont <<<');
+ Result := FCanvas.Font as TfpgFont;
end;
// Set the current font for the canvas to match the given
// spec, creating or re-using fonts as needed.
-//------------------------------------------------------------------------
-procedure TCanvasFontManager.SetFont( const FontSpec: TFontSpec );
-var
- Font: TLogicalFont;
- lDefaultFontSpec: TFontSpec;
+procedure TCanvasFontManager.SetFont(const AFontDesc: TfpgString);
begin
-ProfileEvent('DEBUG: TCanvasFontManager.SetFont >>>>');
- // we don't need this any more, because we check FCurrentFont <> Font further down
- // We also make sure we always set Canvas.Font - this fixes large display of Grids or Sample Code in Courier New font
- //if (FCurrentFontSpec.FaceName = FontSpec.FaceName) and
- // (FCurrentFontSpec.PointSize = FontSpec.PointSize) and
- // (FCurrentFontSpec.Attributes = FontSpec.Attributes) then
- // //same font
- //begin
- // exit;
- //end;
+ if FCanvas.Font.FontDesc = AFontDesc then
+ Exit; // nothing to do so exit
- Font := GetFont( FontSpec );
-
- if Font = nil then
+ if FDefaultFont.FontDesc = AFontDesc then
begin
- // ack! Pfffbt! Couldn't find the font.
-
- // Try to get the default font
- //writeln('---------- here goes nothing -------------');
- Font := GetFont( FDefaultFontSpec );
- if Font = nil then
- begin
- writeln('******* We should never get here!!!! Defaut font should always exist.');
- writeln('FDefaultFontSpec:');
- writeln(' FaceName=', FDefaultFontSpec.FaceName);
- writeln(' Size=', FDefaultFontSpec.PointSize);
- FPGuiFontToFontSpec( fpgApplication.DefaultFont, lDefaultFontSpec );
- Font := GetFont( lDefaultFontSpec );
- if Font = nil then
- // WTF! We can't even get the default system font
- raise Exception.Create( 'Could not access default font '
- + 'in place of '
- + FontSpec.FaceName
- + ' '
- + IntToStr( FontSpec.PointSize ) );
- end;
-
+ FCanvas.Font := FDefaultFont;
+ Exit;
end;
- SelectFont( Font, 1 );
- FCurrentFontSpec := FontSpec;
- if FCurrentFont <> Font then
- FCurrentFont.Free;
- FCurrentFont := Font;
-ProfileEvent('DEBUG: TCanvasFontManager.SetFont <<<<');
-end;
-
-// Get the widths of all characters for current font
-// and other dimensions
-//------------------------------------------------------------------------
-procedure TCanvasFontManager.LoadMetrics;
-var
- TheChar: Char;
-begin
- // Retrieve all character widths
- if FCurrentFont.FontType = ftOutline then
- begin
- SelectFont( FCurrentFont, FontWidthPrecisionFactor );
- end;
-
- // allocate memory for storing the char widths
- GetMem( FCurrentFont.pCharWidthArray, sizeof( TCharWidthArray ) );
-
- for TheChar := #0 to #255 do
- begin
- FCurrentFont.pCharWidthArray^[ TheChar ] := Abs( FCurrentFont.pCharWidthArray^[ TheChar ] );
- end;
-
- if FCurrentFont.FontType = ftOutline then
- begin
- SelectFont( FCurrentFont, 1 );
- end
- else
- begin
- // For bitmap fonts, multiply by 256 manually
- for TheChar := #0 to #255 do
- begin
- FCurrentFont.pCharWidthArray^[ TheChar ] := FCurrentFont.pCharWidthArray^[ TheChar ];
- end;
- end;
-end;
-
-procedure TCanvasFontManager.EnsureMetricsLoaded;
-begin
- if FCurrentFont = nil then
- raise( Exception.Create( 'No font selected before getting font metrics' ) );
-
- if FCurrentFont.pCharWidthArray = Nil then
- LoadMetrics;
+ FCanvas.Font := fpgGetFont(AFontDesc);
end;
function TCanvasFontManager.CharWidth( const C: Char ): longint;
-var
- f: TfpgFont;
begin
-// EnsureMetricsLoaded;
-// Result := FCurrentFont.pCharWidthArray^[ C ];
-
- { TODO -ograeme : This needs improvement: what about font attributes, and performance. }
- f := fpgGetFont(FCurrentFont.FaceName + '-' + IntToStr(FCurrentFont.PointSize));
- Result := f.TextWidth(C);
- f.Free;
+ Result := FCanvas.Font.TextWidth(C);
end;
function TCanvasFontManager.AverageCharWidth: longint;
begin
- EnsureMetricsLoaded;
- Result := FCurrentFont.lAveCharWidth;
+ Result := FCanvas.Font.TextWidth('c');
end;
function TCanvasFontManager.MaximumCharWidth: longint;
begin
- EnsureMetricsLoaded;
- Result := FCurrentFont.lMaxCharInc;
+ Result := FCanvas.Font.TextWidth('W');
end;
function TCanvasFontManager.CharHeight: longint;
begin
- EnsureMetricsLoaded;
- Result := FCurrentFont.lMaxBaseLineExt;
+ Result := FCanvas.Font.Height;
end;
function TCanvasFontManager.CharDescender: longint;
begin
- EnsureMetricsLoaded;
- Result := FCurrentFont.lMaxDescender;
+ Result := FCanvas.Font.Descent;
end;
function TCanvasFontManager.IsFixed: boolean;
begin
- Result := FCurrentFont.FixedWidth;
+ Result := FCanvas.Font.IsFixedWidth;
end;
procedure TCanvasFontManager.DrawString(var Point: TPoint; const Length: longint; const S: PChar);
@@ -1086,3 +321,4 @@ end;
end.
+
diff --git a/docview/components/richtext/RichTextDisplayUnit.pas b/docview/components/richtext/RichTextDisplayUnit.pas
index b8e18264..5f5f8ac1 100644
--- a/docview/components/richtext/RichTextDisplayUnit.pas
+++ b/docview/components/richtext/RichTextDisplayUnit.pas
@@ -135,6 +135,7 @@ var
Selected: boolean;
NextSelected: boolean;
NewMarginX: longint;
+ fStyle: string;
procedure DrawTextBlock;
begin
@@ -172,7 +173,9 @@ ProfileEvent('DEBUG: DrawRichTextLine >>>');
StringToDraw := '';
Style := Line.Style;
- FontManager.SetFont( Style.Font );
+ fStyle := Style.FontNameSize;
+ ApplyFontAttributes(fStyle, Style.FontAttributes);
+ FontManager.SetFont( fStyle );
StartedDrawing := false;
TextBlockStart := P;
@@ -222,21 +225,17 @@ ProfileEvent('DEBUG: DrawRichTextLine >>>');
begin
Bitmap := Layout.Images.Item[BitmapIndex].Image;
- BitmapRect.Left := X div FontWidthPrecisionFactor;
+ BitmapRect.Left := X;
BitmapRect.Top := Start.Y;
BitmapRect.Right := Trunc(BitmapRect.Left
- + Bitmap.Width
- * Layout.HorizontalImageScale);
+ + Bitmap.Width * Layout.HorizontalImageScale);
BitmapRect.Bottom := Trunc(BitmapRect.Top
- + Bitmap.Height
- * Layout.VerticalImageScale);
+ + Bitmap.Height * Layout.VerticalImageScale);
FontManager.Canvas.StretchDraw(BitmapRect.Left, BitMapRect.Top,
BitmapRect.Right-BitMapRect.Left, BitMapRect.Bottom-BitMapRect.Top, Bitmap);
- inc( X, trunc( Bitmap.Width
- * FontWidthPrecisionFactor
- * Layout.HorizontalImageScale ) );
+ inc( X, trunc( Bitmap.Width * Layout.HorizontalImageScale ) );
end;
end
else
@@ -253,7 +252,7 @@ ProfileEvent('DEBUG: DrawRichTextLine >>>');
TextBlockStart := NextP;
if ( Element.Tag.TagType = ttItalicOff )
- and ( faItalic in Style.Font.Attributes )
+ and ( faItalic in Style.FontAttributes )
and ( not FontManager.IsFixed )
then
// end of italic; add a space
diff --git a/docview/components/richtext/RichTextLayoutUnit.pas b/docview/components/richtext/RichTextLayoutUnit.pas
index 61ce150c..ccfb0ca4 100644
--- a/docview/components/richtext/RichTextLayoutUnit.pas
+++ b/docview/components/richtext/RichTextLayoutUnit.pas
@@ -131,9 +131,7 @@ end;
// Create a layout of the specified rich text.
constructor TRichTextLayout.Create(Text: PChar; Images: TfpgImageList;
RichTextSettings: TRichTextSettings; FontManager: TCanvasFontManager;
- AWidth: longint);
-var
- DefaultFontSpec: TFontSpec;
+ Width: longint);
Begin
ProfileEvent('DEBUG: TRichTextLayout.Create >>>>');
inherited Create;
@@ -156,11 +154,7 @@ ProfileEvent('DEBUG: TRichTextLayout.Create 2');
//FVerticalImageScale := FFontManager.Canvas.VerticalResolution
// / Screen.Canvas.VerticalResolution;
- // use normal font for default font when specified fonts can't be found
- FPGuiFontToFontSpec( RichTextSettings.NormalFont, DefaultFontSpec );
ProfileEvent('DEBUG: TRichTextLayout.Create 3');
- FFontManager.DefaultFontSpec := DefaultFontSpec;
-ProfileEvent('DEBUG: TRichTextLayout.Create 4');
Layout;
ProfileEvent('DEBUG: TRichTextLayout.Create <<<<');
End;
@@ -432,7 +426,7 @@ ProfileEvent('DEBUG: TRichTextLayout.Layout >>>>');
CheckFontHeights( CurrentLine );
if ( CurrentElement.Tag.TagType = ttItalicOff )
- and ( faItalic in Style.Font.Attributes ) then
+ and ( faItalic in Style.FontAttributes ) then
begin
if not FFontManager.IsFixed then
begin
@@ -604,10 +598,8 @@ begin
Result := Style.LeftMargin;
taRight:
- Result := Style.LeftMargin
- + FLayoutWidth
- - Style.RightMargin
- - Line.Width;
+ Result := Style.LeftMargin + FLayoutWidth
+ - Style.RightMargin - Line.Width;
taCenter:
begin
@@ -616,10 +608,8 @@ begin
// |<-lm->[aaaaaaaaaaaaaaa]<-space-><-rm->|
// |<-----line width------> |
// space = layoutw-rm-linew
- SpaceOnLine := FLayoutWidth
- - Style.RightMargin
- - Line.Width; // Note: line width includes left margin
- Result := Style.LeftMargin + (SpaceOnLine div 2);
+ SpaceOnLine := FLayoutWidth - Style.RightMargin - Line.Width; // Note: line width includes left margin
+ Result := Style.LeftMargin + (SpaceOnLine div 2);
end;
end;
end;
@@ -639,15 +629,18 @@ Var
Style: TTextDrawStyle;
NewMarginX: longint;
StartedDrawing: boolean;
+ fstyle: string;
begin
Line := TLayoutLine(FLines[ LineIndex ]);
P := Line.Text;
EndP := Line.Text + Line.Length;
Style := Line.Style;
- FFontManager.SetFont( Style.Font );
- StartedDrawing := false;
+ fStyle := Style.FontNameSize;
+ ApplyFontAttributes(fStyle, Style.FontAttributes);
+ FFontManager.SetFont( fStyle );
+ StartedDrawing := false;
Link := '';
if Line.LinkIndex <> -1 then
CurrentLink := FLinks[ Line.LinkIndex ]
@@ -703,14 +696,12 @@ begin
else
begin
if ( Element.Tag.TagType = ttItalicOff )
- and ( faItalic in Style.Font.Attributes )
+ and ( faItalic in Style.FontAttributes )
and ( not FFontManager.IsFixed ) then
// end of italic; add a space
// inc( X, FFontManager.CharWidth( ' ' ) );
- PerformStyleTag( Element.Tag,
- Style,
- X );
+ PerformStyleTag( Element.Tag, Style, X );
NewMarginX := Style.LeftMargin;
if NewMarginX > X then
begin
@@ -738,13 +729,16 @@ Var
Line: TLayoutLine;
Style: TTextDrawStyle;
NewMarginX: longint;
+ fStyle: string;
begin
Line := TLayoutLine(FLines[ LineIndex ]);
P := Line.Text;
EndP := Line.Text + Line.Length;
Style := Line.Style;
- FFontManager.SetFont( Style.Font );
+ fStyle := Style.FontNameSize;
+ ApplyFontAttributes(fStyle, Style.FontAttributes);
+ FFontManager.SetFont( fStyle );
StartedDrawing := false;
@@ -767,7 +761,6 @@ begin
if GetCharIndex( P ) - GetCharIndex( Line.Text ) >= Offset then
begin
- X := X;
// found
exit;
end;
@@ -780,14 +773,12 @@ begin
teStyle:
begin
if ( Element.Tag.TagType = ttItalicOff )
- and ( faItalic in Style.Font.Attributes )
+ and ( faItalic in Style.FontAttributes )
and ( not FFontManager.IsFixed ) then
// end of italic; add a space
// inc( X, FFontManager.CharWidth( ' ' ) );
- PerformStyleTag( Element.Tag,
- Style,
- X );
+ PerformStyleTag( Element.Tag, Style, X );
NewMarginX := Style.LeftMargin;
if NewMarginX > X then
@@ -803,8 +794,6 @@ begin
// went thru the whole line without finding the point,
if not StartedDrawing then
X := GetStartX( Style, Line );
-
- X := X;
end;
function TRichTextLayout.GetLineFromPosition( YToFind: longint;
@@ -1003,6 +992,6 @@ begin
end;
end;
-Initialization
-End.
+
+end.
diff --git a/docview/components/richtext/RichTextStyleUnit.pas b/docview/components/richtext/RichTextStyleUnit.pas
index cfdde684..ade745e6 100644
--- a/docview/components/richtext/RichTextStyleUnit.pas
+++ b/docview/components/richtext/RichTextStyleUnit.pas
@@ -9,7 +9,8 @@ uses
type
TTextDrawStyle = record
- Font: TFontSpec;
+ FontNameSize: TfpgString;
+ FontAttributes: TFontAttributes;
Color: TfpgColor;
BackgroundColor: TfpgColor;
Alignment: TTextAlignment;
@@ -69,37 +70,23 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
-
procedure BeginUpdate;
procedure EndUpdate;
-
- // Stream in/out
- //Procedure ReadSCUResource( Const ResName: TResourceName;
- // Var Data;
- // DataLen: LongInt ); override;
- //Function WriteSCUResource( Stream: TResourceStream ): boolean; override;
-
property Margins: TRect read FMargins write SetMargins;
-
property Heading1Font: TfpgFont read FHeading1Font write SetHeading1Font;
property Heading2Font: TfpgFont read FHeading2Font write SetHeading2Font;
property Heading3Font: TfpgFont read FHeading3Font write SetHeading3Font;
property FixedFont: TfpgFont read FFixedFont write SetFixedFont;
property NormalFont: TfpgFont read FNormalFont write SetNormalFont;
-
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
-
property DefaultBackgroundColor: TfpgColor read FDefaultBackgroundColor write SetDefaultBackgroundColor;
property DefaultColor: TfpgColor read FDefaultColor write SetDefaultColor;
-
property DefaultAlignment: TTextAlignment read FDefaultAlignment write SetDefaultAlignment;
property DefaultWrap: boolean read FDefaultWrap write SetDefaultWrap default True;
property AtLeastOneWordBeforeWrap: boolean read FAtLeastOneWordBeforeWrap write SetAtLeastOneWordBeforeWrap;
-
property MarginSizeStyle: TMarginSizeStyle read FMarginSizeStyle write SeTMarginSizeStyle;
property MarginChar: longint read FMarginChar write SetMarginChar;
-
// margins are exposed as individual properties here
// since the Sibyl IDE cannot cope with editing a record property
// within a class property (as in RichTextView)
@@ -134,11 +121,15 @@ uses
// , ACLProfile
;
-Procedure ApplyStyle( var Style: TTextDrawStyle; FontManager: TCanvasFontManager );
+Procedure ApplyStyle(var Style: TTextDrawStyle; FontManager: TCanvasFontManager);
+var
+ s: string;
begin
ProfileEvent('DEBUG: ApplyStyle >>>');
assert(FontManager <> nil, 'FontManager should not have been nil');
- FontManager.SetFont( Style.Font );
+ s := Style.FontNameSize;
+ ApplyFontAttributes(s, Style.FontAttributes);
+ FontManager.SetFont(s);
FontManager.Canvas.TextColor := Style.Color;
ProfileEvent('DEBUG: ApplyStyle <<<');
end;
@@ -166,31 +157,31 @@ begin
ProfileEvent('DEBUG: ApplyStyleTag >>>');
case Tag.TagType of
ttBold:
- Include( Style.Font.Attributes, faBold );
+ Include( Style.FontAttributes, faBold );
ttBoldOff:
- Exclude( Style.Font.Attributes, faBold );
+ Exclude( Style.FontAttributes, faBold );
ttItalic:
- Include( Style.Font.Attributes, faItalic );
+ Include( Style.FontAttributes, faItalic );
ttItalicOff:
- Exclude( Style.Font.Attributes, faItalic );
+ Exclude( Style.FontAttributes, faItalic );
ttUnderline:
- Include( Style.Font.Attributes, faUnderscore );
+ Include( Style.FontAttributes, faUnderscore );
ttUnderlineOff:
- Exclude( Style.Font.Attributes, faUnderscore );
+ Exclude( Style.FontAttributes, faUnderscore );
ttFixedWidthOn:
- FPGuiFontToFontSpec( Settings.FFixedFont, Style.Font );
+ Settings.FixedFont := GetFPGuiFont(Style.FontNameSize, Style.FontAttributes);
ttFixedWidthOff:
- FPGuiFontToFontSpec( Settings.FNormalFont, Style.Font );
+ Settings.NormalFont := GetFPGuiFont(Style.FontNameSize, Style.FontAttributes);
ttHeading1:
- FPGuiFontToFontSpec( Settings.FHeading1Font, Style.Font );
+ Settings.Heading1Font := GetFPGuiFont(Style.FontNameSize, Style.FontAttributes);
ttHeading2:
- FPGuiFontToFontSpec( Settings.FHeading2Font, Style.Font );
+ Settings.Heading2Font := GetFPGuiFont(Style.FontNameSize, Style.FontAttributes);
ttHeading3:
- FPGuiFontToFontSpec( Settings.FHeading3Font, Style.Font );
+ Settings.Heading3Font := GetFPGuiFont(Style.FontNameSize, Style.FontAttributes);
ttHeadingOff:
- FPGuiFontToFontSpec( Settings.FNormalFont, Style.Font );
+ Settings.NormalFont := GetFPGuiFont(Style.FontNameSize, Style.FontAttributes);
ttFont:
begin
@@ -201,39 +192,27 @@ ProfileEvent('DEBUG: ApplyStyleTag >>>');
tmpFontParts.Destroy;
NewStyle := Style;
- try
- NewStyle.Font.FaceName := FontFaceName;
-
- if Pos( 'x', FontSizeString ) > 0 then
- begin
- tmpFontParts := TStringList.Create;
- StrExtractStrings(tmpFontParts, FontSizeString, ['x'], #0);
- XSizeStr := tmpFontParts[0];
- YSizeStr := tmpFontParts[1];
- tmpFontParts.Destroy;
-
- NewStyle.Font.XSize := StrToInt( XSizeStr );
- NewStyle.Font.YSize := StrToInt( YSizeStr );
- NewStyle.Font.PointSize := 0;
- end
- else
- begin
- NewStyle.Font.PointSize := StrToInt( FontSizeString );
- end;
+ NewStyle.FontNameSize := FontFaceName;
- if ( NewStyle.Font.FaceName <> '' )
- and ( NewStyle.Font.PointSize >= 1 ) then
- begin
- Style := NewStyle;
- end;
+ if Pos( 'x', FontSizeString ) > 0 then
+ begin
+ tmpFontParts := TStringList.Create;
+ StrExtractStrings(tmpFontParts, FontSizeString, ['x'], #0);
+ XSizeStr := tmpFontParts[0];
+ YSizeStr := tmpFontParts[1];
+ tmpFontParts.Destroy;
+ NewStyle.FontNameSize := NewStyle.FontNameSize + '-' + YSizeStr;
+ end
+ else
+ NewStyle.FontNameSize := NewStyle.FontNameSize + '-' + FontSizeString;
- except
- end;
+ if ( NewStyle.FontNameSize <> '' ) then
+ Style := NewStyle;
end;
ttFontOff:
// restore default
- FPGuiFontToFontSpec( Settings.FNormalFont, Style.Font );
+ Settings.NormalFont := GetFPGuiFont(Style.FontNameSize, Style.FontAttributes);
ttColor:
GetTagColor( Tag.Arguments, Style.Color );
@@ -320,11 +299,12 @@ end;
function GetDefaultStyle( const Settings: TRichTextSettings ): TTextDrawStyle;
begin
FillChar(Result, SizeOf(TTextDrawStyle), 0);
- FPGuiFontToFontSpec( Settings.NormalFont, Result.Font );
- Result.Alignment := Settings.DefaultAlignment;
- Result.Wrap := Settings.DefaultWrap;
- Result.Color := Settings.DefaultColor;
- Result.BackgroundColor := Settings.DefaultBackgroundColor;
+ Result.FontNameSize := DefaultTopicFont + '-10';
+ Result.FontAttributes := [];
+ Result.Alignment := Settings.FDefaultAlignment;
+ Result.Wrap := Settings.FDefaultWrap;
+ Result.Color := Settings.FDefaultColor;
+ Result.BackgroundColor := Settings.FDefaultBackgroundColor;
Result.LeftMargin := Settings.Margins.Left;
Result.RightMargin := Settings.Margins.Right;
end;
@@ -492,14 +472,10 @@ end;
Function FontSame( FontA: TfpgFont; FontB: TfpgFont ): boolean;
begin
- if ( FontA = nil )
- or ( FontB = nil ) then
- begin
- Result := FontA = FontB;
- exit;
- end;
-
- Result := FontA.FontDesc = FontB.FontDesc;
+ if ( FontA = nil ) or ( FontB = nil ) then
+ Result := False
+ else
+ Result := FontA.FontDesc = FontB.FontDesc;
end;
Procedure TRichTextSettings.AssignFont(var AFont: TfpgFont; NewFont: TfpgFont );
@@ -518,12 +494,7 @@ End;
Procedure TRichTextSettings.SetHeading1Font( NewFont: TfpgFont );
begin
-// ProfileEvent( 'TRichTextSettings.SetHeading1Font' );
AssignFont( FHeading1Font, NewFont );
-
-// if FHeading1FOnt = nil then
-// ProfileEvent( ' Set to nil' );
-
end;
Procedure TRichTextSettings.SetHeading2Font( NewFont: TfpgFont );
@@ -631,6 +602,9 @@ begin
end;
end;
-Initialization
- RegisterClasses( [ TRichTextSettings ] );
-End.
+
+initialization
+ RegisterClasses([TRichTextSettings]);
+
+end.
+
diff --git a/docview/components/richtext/RichTextView.pas b/docview/components/richtext/RichTextView.pas
index 799d9f36..06b57dff 100644
--- a/docview/components/richtext/RichTextView.pas
+++ b/docview/components/richtext/RichTextView.pas
@@ -928,12 +928,7 @@ ProfileEvent('DEBUG: TRichTextView.CreateWnd >>>>');
if InDesigner then
exit;
- { TODO -ograeme : I disabled bitmap fonts }
- FFontManager := TCanvasFontManager.Create( Canvas,
- False, // allow bitmap fonts
- Self
- );
-
+ FFontManager := TCanvasFontManager.Create(Canvas, Self);
FLastLinkOver := '';
FSelectionStart := -1;
FSelectionEnd := -1;
diff --git a/docview/src/SettingsUnit.pas b/docview/src/SettingsUnit.pas
index 77c72cce..6b49aee1 100644
--- a/docview/src/SettingsUnit.pas
+++ b/docview/src/SettingsUnit.pas
@@ -55,7 +55,7 @@ Const
NumFontSettings = 1;
-Type
+type
TIndexStyle = ( isAlphabetical, isFileOnly, isFull );
TToolbarStyle = ( tsNone, tsImages, tsText, tsImagesAndText );
TGlobalSearchLocation = ( gsHelpPaths, gsFixedDrives, gsSelectedHelpPaths, gsCustom );