summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xcomponents/richtext/ACLStringUtility.pas258
-rwxr-xr-xcomponents/richtext/CanvasFontManager.pas35
-rwxr-xr-xcomponents/richtext/RichTextDisplayUnit.pas16
-rw-r--r--[-rwxr-xr-x]components/richtext/RichTextLayoutUnit.pas64
-rw-r--r--[-rwxr-xr-x]components/richtext/RichTextStyleUnit.pas54
-rwxr-xr-xcomponents/richtext/RichTextView.pas57
-rwxr-xr-xcomponents/richtext/fpgui_richtext.lpk2
-rw-r--r--src/HelpFile.pas2
-rw-r--r--src/docview.lpi55
-rw-r--r--src/docview.lpr9
-rw-r--r--src/frm_main.pas10
11 files changed, 469 insertions, 93 deletions
diff --git a/components/richtext/ACLStringUtility.pas b/components/richtext/ACLStringUtility.pas
index 54282333..898ed19f 100755
--- a/components/richtext/ACLStringUtility.pas
+++ b/components/richtext/ACLStringUtility.pas
@@ -8,10 +8,23 @@ Uses
Classes;
const
- EndLine= chr(13)+chr(10);
- TwoEndLines= chr(13)+chr(10)+chr(13)+chr(10);
- Quote = '''';
- DoubleQuote = '"';
+ CharTAB = chr(9);
+ CharCR = chr(13);
+ CharLF = chr(10);
+ CharSingleQuote = '''';
+ CharDoubleQuote = '"';
+
+ EndLine = CharCR + CharLF;
+
+ StrTAB = CharTAB;
+ StrCR = CharCR;
+ StrLF = CharLF;
+ StrCRLF = StrCR + StrLF;
+ StrSingleQuote = CharSingleQuote;
+ StrDoubleQuote = CharDoubleQuote;
+
+TYPE
+ TSetOfChars = set of char;
// ----------- Character testing functions -----------------------
@@ -84,9 +97,6 @@ Function StrQuote( const s: string ): string;
// Returns S without single quotes
Function StrUnQuote( const s: string ): string;
-// Returns S in double quotes
-Function StrDoubleQuote( const s: string ): string;
-
// Returns S in double quotes,
// with any double quotes in S duplicated
Function StrFullDoubleQuote( const s: string ): string;
@@ -146,6 +156,17 @@ procedure GetNextValue(
var Value: string;
const Seperator: char );
+// Extract all fields in a String delimited by whitespace (blank or tab).
+// use double quotes if you need blanks in the strings
+Procedure StrExtractStringsQuoted(Var aResult: TStrings; const aReceiver: String);
+
+// Extract all fields in a String given a set of delimiter characters and
+// an optional escape character usable to escape field delimits.
+// Example:
+// StrExtractStrings('1x2x3\x4', 'x', '\') ->
+// returns 4 strings: '1', '', '2' and '3x4'
+procedure StrExtractStrings(var aResult : TStrings; const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
+
// Removes and returns the first value in a separated
// value list (removes quotes if found)
Function ExtractNextValue(
@@ -221,8 +242,6 @@ Function PCharDiff( const a: PChar; const b: Pchar ): longword;
// trims spaces and carriage returns of the end of Text
procedure TrimWhitespace( Text: PChar );
-type
- TSetOfChars = set of char;
function TrimChars( const s: string;
chars: TSetOfChars ): string;
@@ -451,7 +470,7 @@ end;
// Returns S in single quotes
Function StrQuote( const s: string ): string;
begin
- Result := Quote + s + Quote;
+ Result := StrSingleQuote + s + StrSingleQuote;
end;
// Returns S without double quotes
@@ -461,26 +480,21 @@ begin
if S = '' then
exit;
- if Result[ 1 ] = Quote then
+ if Result[ 1 ] = StrSingleQuote then
Delete( Result, 1, 1 );
if Result = '' then
exit;
- if Result[ Length( Result ) ] = Quote then
+ if Result[ Length( Result ) ] = StrSingleQuote then
Delete( Result, Length( Result ), 1 );
end;
-Function StrDoubleQuote( const s: string ): string;
-begin
- Result := DoubleQuote + s + DoubleQuote;
-end;
-
Function StrFullDoubleQuote( const s: string ): string;
begin
- Result := DoubleQuote
+ Result := StrDoubleQuote
+ InsertDuplicateChars( s, '"' )
- + DoubleQuote;
+ + StrDoubleQuote;
end;
// Returns S without double quotes
@@ -490,13 +504,13 @@ begin
if S = '' then
exit;
- if Result[ 1 ] = DoubleQuote then
+ if Result[ 1 ] = StrDoubleQuote then
Delete( Result, 1, 1 );
if Result = '' then
exit;
- if Result[ Length( Result ) ] = DoubleQuote then
+ if Result[ Length( Result ) ] = StrDoubleQuote then
Delete( Result, Length( Result ), 1 );
end;
@@ -599,11 +613,11 @@ begin
// Remove quotes if present
if Result <> '' then
- if Result[ 1 ] = DoubleQuote then
+ if Result[ 1 ] = StrDoubleQuote then
Delete( Result, 1, 1 );
if Result <> '' then
- if Result[ length( Result ) ] = DoubleQuote then
+ if Result[ length( Result ) ] = StrDoubleQuote then
Delete( Result, length( Result ), 1 );
end;
@@ -644,6 +658,204 @@ begin
TrimRight( Value );
end;
+Procedure StrExtractStringsQuoted(Var aResult: TStrings; const aReceiver: String);
+Var
+ tmpState : (WHITESPACE, INSIDE, START_QUOTE, INSIDE_QUOTED, INSIDE_QUOTED_START_QUOTE);
+ tmpCurrentParsePosition : Integer;
+ tmpCurrentChar : Char;
+ tmpPart : String;
+
+Begin
+ if (length(aReceiver) < 1) then exit;
+
+ tmpState := WHITESPACE;
+ tmpPart := '';
+
+ tmpCurrentParsePosition := 1;
+
+ for tmpCurrentParsePosition:=1 to length(aReceiver) do
+ begin
+ tmpCurrentChar := aReceiver[tmpCurrentParsePosition];
+
+ Case tmpCurrentChar of
+ ' ', StrTAB :
+ begin
+
+ Case tmpState of
+
+ WHITESPACE :
+ begin
+ // nothing
+ end;
+
+ INSIDE :
+ begin
+ aResult.add(tmpPart);
+ tmpPart := '';
+ tmpState := WHITESPACE;
+ end;
+
+ INSIDE_QUOTED :
+ begin
+ tmpPart := tmpPart + tmpCurrentChar;
+ end;
+
+ START_QUOTE :
+ begin
+ tmpPart := tmpPart + tmpCurrentChar;
+ tmpState := INSIDE_QUOTED;
+ end;
+
+ INSIDE_QUOTED_START_QUOTE :
+ begin
+ aResult.add(tmpPart);
+ tmpPart := '';
+ tmpState := WHITESPACE;
+ end;
+ end;
+ end;
+
+ StrDoubleQuote :
+ begin
+
+ Case tmpState of
+
+ WHITESPACE :
+ begin
+ tmpState := START_QUOTE;
+ end;
+
+ INSIDE :
+ begin
+ aResult.add(tmpPart);
+ tmpPart := '';
+ tmpState := START_QUOTE;
+ end;
+
+ INSIDE_QUOTED :
+ begin
+ tmpState := INSIDE_QUOTED_START_QUOTE;
+ end;
+
+ START_QUOTE :
+ begin
+ tmpState := INSIDE_QUOTED_START_QUOTE;
+ end;
+
+ INSIDE_QUOTED_START_QUOTE :
+ begin
+ tmpPart := tmpPart + tmpCurrentChar;
+ tmpState := INSIDE_QUOTED;
+ end;
+ end;
+ end;
+
+ else
+ begin
+ Case tmpState of
+
+ WHITESPACE :
+ begin
+ tmpPart := tmpPart + tmpCurrentChar;
+ tmpState := INSIDE;
+ end;
+
+ INSIDE, INSIDE_QUOTED :
+ begin
+ tmpPart := tmpPart + tmpCurrentChar;
+ end;
+
+ START_QUOTE :
+ begin
+ tmpPart := tmpPart + tmpCurrentChar;
+ tmpState := INSIDE_QUOTED;
+ end;
+
+ INSIDE_QUOTED_START_QUOTE :
+ begin
+ aResult.add(tmpPart);
+ tmpPart := tmpCurrentChar;
+ tmpState := INSIDE;
+ end;
+ end;
+ end;
+
+ end;
+ end;
+
+ Case tmpState of
+ WHITESPACE, START_QUOTE : {nothing to do};
+
+ INSIDE, INSIDE_QUOTED, INSIDE_QUOTED_START_QUOTE :
+ begin
+ aResult.add(tmpPart);
+ end;
+ end;
+end;
+
+Procedure PrivateStrExtractStrings( Var aResult: TStrings;
+ const aReceiver: String;
+ const aSetOfChars: TSetOfChars;
+ const anEscapeChar: char;
+ const anIgnoreEmptyFlag : boolean);
+Var
+ i : Integer;
+ tmpChar,tmpNextChar : Char;
+ tmpPart: String;
+Begin
+ if (length(aReceiver) < 1) then exit;
+
+ tmpPart := '';
+
+ i := 1;
+ while i <= length(aReceiver) do
+ begin
+ tmpChar := aReceiver[i];
+ if i < length(aReceiver) then
+ tmpNextChar := aReceiver[i+1]
+ else
+ tmpNextChar := #0;
+
+ if (tmpChar = anEscapeChar) and (tmpNextChar = anEscapeChar) then
+ begin
+ tmpPart := tmpPart + anEscapeChar;
+ i := i + 2;
+ end
+ else
+ if (tmpChar = anEscapeChar) and (tmpNextChar IN aSetOfChars) then
+ begin
+ tmpPart := tmpPart + tmpNextChar;
+ i := i + 2;
+ end
+ else
+ if (tmpChar IN aSetOfChars) then
+ begin
+ if (NOT anIgnoreEmptyFlag) OR ('' <> tmpPart) then
+ begin
+ aResult.add(tmpPart);
+ end;
+ tmpPart := '';
+ i := i + 1;
+ end
+ else
+ begin
+ tmpPart := tmpPart + tmpChar;
+ i := i + 1;
+ end;
+ end;
+
+ if (NOT anIgnoreEmptyFlag) OR ('' <> tmpPart) then
+ begin
+ aResult.add(tmpPart);
+ end;
+end;
+
+procedure StrExtractStrings(Var aResult: TStrings; Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
+begin
+ PrivateStrExtractStrings(aResult, aReceiver, aSetOfChars, anEscapeChar, false);
+end;
+
+
Function IsDigit( const c: char ): boolean;
Begin
Result:=( c>='0' ) and ( c<='9' );
diff --git a/components/richtext/CanvasFontManager.pas b/components/richtext/CanvasFontManager.pas
index 7ef21561..e00215d5 100755
--- a/components/richtext/CanvasFontManager.pas
+++ b/components/richtext/CanvasFontManager.pas
@@ -139,6 +139,7 @@ uses
// PMWin, PMGpi, OS2Def, PmDev,
SysUtils
,ACLStringUtility
+ ,nvUtilities
;
{
@@ -325,7 +326,8 @@ begin
begin
Face := TFontFace(FontFaces[ FaceIndex ]);
- if StringsSame( Face.Name, Name ) then
+// if StringsSame( Face.Name, Name ) then
+ if pos(UpperCase(name), UpperCase(Face.Name)) > 0 then
begin
Result := Face;
exit;
@@ -935,8 +937,12 @@ var
AFont: TLogicalFont;
FontIndex: integer;
begin
+ProfileEvent('DEBUG: TCanvasFontManager.GetFont >>>');
+ProfileEvent(' FLogicalFonts.Count=' + intToStr(FLogicalFonts.Count));
+try
for FontIndex := 0 to FLogicalFonts.Count - 1 do
begin
+ProfileEvent('DEBUG: TCanvasFontManager.GetFont 1 of 6');
AFont := TLogicalFont(FLogicalFonts[ FontIndex ]);
if AFont.PointSize = FontSpec.PointSize then
begin
@@ -944,11 +950,16 @@ begin
or ( ( AFont.lAveCharWidth = FontSpec.XSize )
and ( AFont.lMaxbaselineExt = FontSpec.YSize ) ) then
begin
+ProfileEvent('DEBUG: TCanvasFontManager.GetFont 2');
if AFont.Attributes = FontSpec.Attributes then
begin
+ProfileEvent('DEBUG: TCanvasFontManager.GetFont 3');
// search name last since it's the slowest thing
+ProfileEvent(' AFont.FaceName=' + AFont.FaceName);
+ProfileEvent(' FontSpec.FaceName=' + FontSpec.FaceName);
if AFont.FaceName = FontSpec.FaceName then
begin
+ProfileEvent('DEBUG: TCanvasFontManager.GetFont 4');
// Found a logical font already created
Result := AFont;
// done
@@ -959,12 +970,20 @@ begin
end;
end;
+
+except
+ on E: Exception do
+ ProfileEvent('Unexpected error occured. Error: ' + E.Message);
+end;
+ProfileEvent('DEBUG: TCanvasFontManager.GetFont 5');
// Need to create new logical font
Result := CreateFont( FontSpec );
if Result <> nil then
begin
+ProfileEvent('DEBUG: TCanvasFontManager.GetFont 6');
RegisterFont( Result );
end;
+ProfileEvent('DEBUG: TCanvasFontManager.GetFont <<<');
end;
// Set the current font for the canvas to match the given
@@ -975,25 +994,32 @@ var
Font: TLogicalFont;
lDefaultFontSpec: TFontSpec;
begin
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont >>>>');
//if FCurrentFontSpec = FontSpec then
if (FCurrentFontSpec.FaceName = FontSpec.FaceName) and
(FCurrentFontSpec.PointSize = FontSpec.PointSize) and
(FCurrentFontSpec.Attributes = FontSpec.Attributes) then
// same font
exit;
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont 1 of 9');
Font := GetFont( FontSpec );
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont 2');
if Font = nil then
begin
// ack! Pfffbt! Couldn't find the font.
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont 3');
// Try to get the default font
Font := GetFont( FDefaultFontSpec );
if Font = nil then
begin
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont 4');
FPGuiFontToFontSpec( fpgApplication.DefaultFont, lDefaultFontSpec );
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont 5');
Font := GetFont( lDefaultFontSpec );
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont 6');
if Font = nil then
// Jimminy! We can't even get the default system font
raise Exception.Create( 'Could not access default font '
@@ -1005,10 +1031,14 @@ begin
end;
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont 7');
SelectFont( Font, 1 );
FCurrentFontSpec := FontSpec;
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont 8');
FCurrentFont.Free;
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont 9');
FCurrentFont := Font;
+ProfileEvent('DEBUG: TCanvasFontManager.SetFont <<<<');
end;
// Get the widths of all characters for current font
@@ -1080,7 +1110,8 @@ begin
EnsureMetricsLoaded;
Result := FCurrentFont.pCharWidthArray^[ C ];
{ TODO -ograemeg -chard-coded result : This is a temporary hard-code }
- result := fpgApplication.DefaultFont.TextWidth(C);
+// result := fpgApplication.DefaultFont.TextWidth(C);
+ Result := FCurrentFont.lAveCharWidth;
end;
function TCanvasFontManager.AverageCharWidth: longint;
diff --git a/components/richtext/RichTextDisplayUnit.pas b/components/richtext/RichTextDisplayUnit.pas
index 5b802a18..26161ef3 100755
--- a/components/richtext/RichTextDisplayUnit.pas
+++ b/components/richtext/RichTextDisplayUnit.pas
@@ -13,7 +13,7 @@ uses
// Selection start and end should both be nil if no selection is to be applied
Procedure DrawRichTextLayout( var FontManager: TCanvasFontManager;
- var Layout: TRichTextLayout;
+ Layout: TRichTextLayout;
const SelectionStart: PChar;
const SelectionEnd: PChar;
const StartLine: longint;
@@ -39,6 +39,7 @@ uses
,RichTextDocumentUnit
,fpg_base
,fpg_main
+ ,nvUtilities
;
// For the given point in the text, update selected if the point
@@ -85,6 +86,7 @@ procedure DrawRichTextString( var FontManager: TCanvasFontManager; var X: longin
var
Point: TPoint;
begin
+ProfileEvent('DEBUG: DrawRichTextString >>>');
if Len = 0 then
exit;
@@ -103,6 +105,7 @@ begin
end;
FontManager.DrawString( Point, Len, S );
X := Point.X;
+ProfileEvent('DEBUG: DrawRichTextString <<<');
end;
var
@@ -112,7 +115,7 @@ var
// Draw the specified line at the specified
// (physical) location
Procedure DrawRichTextLine( var FontManager: TCanvasFontManager;
- var Layout: TRichTextLayout; SelectionStart: PChar; SelectionEnd: PChar;
+ Layout: TRichTextLayout; SelectionStart: PChar; SelectionEnd: PChar;
Line: TLayoutLine; Start: TPoint );
var
X, Y: longint;
@@ -145,6 +148,7 @@ var
begin
+ProfileEvent('DEBUG: DrawRichTextLine >>>');
P := Line.Text;
EndP := Line.Text + Line.Length;
@@ -203,6 +207,7 @@ begin
// Now do the drawing
if Element.ElementType = teImage then
begin
+ ProfileEvent('DEBUG: DrawRichTextLine - skipping image drawing (not implemented yet)');
DrawTextBlock;
TextBlockStart := NextP;
@@ -253,7 +258,7 @@ begin
inc( X, FontManager.CharWidth( ' ' ) );
Layout.PerformStyleTag( Element.Tag, Style, X );
- NewMarginX := ( Start.X + Style.LeftMargin ) * FontWidthPrecisionFactor;
+ NewMarginX := ( Start.X + Style.LeftMargin ){ * FontWidthPrecisionFactor};
if NewMarginX > X then
begin
//skip across...
@@ -265,10 +270,11 @@ begin
end;
DrawTextBlock;
+ProfileEvent('DEBUG: DrawRichTextLine <<<');
end;
Procedure DrawRichTextLayout( var FontManager: TCanvasFontManager;
- var Layout: TRichTextLayout;
+ Layout: TRichTextLayout;
const SelectionStart: PChar;
const SelectionEnd: PChar;
const StartLine: longint;
@@ -280,6 +286,7 @@ Var
Y: longint;
BottomOfLine: longint;
begin
+ProfileEvent('DEBUG: DrawRichTextLayout >>>');
assert( StartLine >= 0 );
assert( StartLine <= Layout.FNumLines );
assert( EndLine >= 0 );
@@ -329,6 +336,7 @@ begin
break;
until false;
+ProfileEvent('DEBUG: DrawRichTextLayout <<<');
End;
Procedure PrintRichTextLayout( var FontManager: TCanvasFontManager;
diff --git a/components/richtext/RichTextLayoutUnit.pas b/components/richtext/RichTextLayoutUnit.pas
index 13352b7d..2ac7634e 100755..100644
--- a/components/richtext/RichTextLayoutUnit.pas
+++ b/components/richtext/RichTextLayoutUnit.pas
@@ -63,7 +63,7 @@ Type
public
// Internal layout data
FLines: ^TLinesArray;
- FNumLines: longword;
+ FNumLines: longint;
FRichTextSettings: TRichTextSettings;
// Drawing functions
Procedure PerformStyleTag( Const Tag: TTag;
@@ -138,17 +138,20 @@ constructor TRichTextLayout.Create(Text: PChar; Images: TfpgImageList;
var
DefaultFontSpec: TFontSpec;
Begin
+ProfileEvent('DEBUG: TRichTextLayout.Create >>>>');
Inherited Create;
FRichTextSettings := RichTextSettings;
FImages := Images;
FText := Text;
FAllocatedNumLines := 10;
+ProfileEvent('DEBUG: TRichTextLayout.Create 1 of 4');
GetMem( FLines, FAllocatedNumLines * sizeof( TLayoutLine ) );
FNumLines := 0;
FLinks := TStringList.Create;
FLinks.Duplicates := dupIgnore;
FFontManager := FontManager;
FLayoutWidth := Width * FontWidthPrecisionFactor;
+ProfileEvent('DEBUG: TRichTextLayout.Create 2');
FHorizontalImageScale := 1;
FVerticalImageScale := 1;
//FHorizontalImageScale := FFontManager.Canvas.HorizontalResolution
@@ -158,14 +161,16 @@ Begin
// 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;
Destructor TRichTextLayout.Destroy;
Begin
- Finalize(FLines);
- FreeMem( FLines); //, FAllocatedNumLines * sizeof( TLayoutLine ) );
+ FreeMem( Flines, FAllocatedNumLines * sizeof( TLayoutLine ) );
FLines := nil;
FLinks.Free;
Inherited Destroy;
@@ -186,18 +191,20 @@ begin
end;
FLines^[ FNumLines ] := Line;
inc( FNumLines );
- writeln(' DEBUG: TRichTextLayout.AddLineStart: FNumLines =', FNumLines);
+ ProfileEvent(' DEBUG: TRichTextLayout.AddLineStart: FNumLines =' + intToStr(FNumLines));
end;
Procedure TRichTextLayout.PerformStyleTag( Const Tag: TTag;
Var Style: TTextDrawStyle;
const X: longint );
begin
+ProfileEvent('DEBUG: TRichTextLayout.PerformStyleTag >>>');
ApplyStyleTag( Tag,
Style,
FFontManager,
FRichTextSettings,
X );
+ProfileEvent('DEBUG: TRichTextLayout.PerformStyleTag <<<');
end;
// Check the current font specifications and see if the
@@ -288,10 +295,12 @@ Var
end;
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout >>>>');
FNumLines := 0;
FWidth := 0;
FHeight := FRichTextSettings.Margins.Top;
Style := GetDefaultStyle( FRichTextSettings );
+ProfileEvent('DEBUG: TRichTextLayout.Layout 1 of 10');
ApplyStyle( Style, FFontManager );
CurrentLinkIndex := -1;
P := FText; // P is the current search position
@@ -310,19 +319,23 @@ begin
WordStarted := false;
DisplayedCharsSinceFontChange := false;
+ProfileEvent('DEBUG: TRichTextLayout.Layout 2');
repeat
CurrentElement := ExtractNextTextElement( P, NextP );
assert( NextP > P );
OnBreak := false;
+ProfileEvent('DEBUG: TRichTextLayout.Layout 3');
case CurrentElement.ElementType of
teWordBreak:
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout teWordBreak (' + CurrentLine.Text + ')');
CurrentCharWidth := FFontManager.CharWidth( ' ' );
OnBreak := true;
end;
teLineBreak:
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout teLineBreak');
DoLine( P, NextP, WordStartX + WordX );
// remember start of line
@@ -336,6 +349,7 @@ begin
teTextEnd:
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout teTextEnd');
DoLine( P, NextP, WordStartX + WordX );
// end of text, done
@@ -344,6 +358,8 @@ begin
teImage:
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout teImage');
+
BitmapHeight := 0;
try
BitmapIndex := StrToInt( CurrentElement.Tag.Arguments );
@@ -363,6 +379,7 @@ begin
teText:
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout teText');
// Normal (non-leading-space) character
CurrentCharWidth := FFontManager.CharWidth( CurrentElement.Character );
WordStarted := true;
@@ -370,9 +387,11 @@ begin
teStyle:
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout teStyle');
case CurrentElement.Tag.TagType of
ttBeginLink:
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout teStyle.ttBeginLink');
CurrentLinkIndex := FLinks.Add( CurrentElement.Tag.Arguments );
P := NextP;
continue;
@@ -380,6 +399,7 @@ begin
ttEndLink:
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout teStyle.ttEndLink');
CurrentLinkIndex := -1;
P := NextP;
continue;
@@ -387,9 +407,11 @@ begin
ttSetLeftMargin: // SPECIAL CASE... could affect display immediately
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout teStyle.ttSetLeftMargin');
PerformStyleTag( CurrentElement.Tag, Style, WordstartX + WordX );
- if Style.LeftMargin * FontWidthPrecisionFactor < WordStartX then
+ if Style.LeftMargin {* FontWidthPrecisionFactor} < WordStartX then
begin
+ProfileEvent('we are already post the margin being set???? Style.LeftMargin=' + intToStr(Style.LeftMargin));
// we're already past the margin being set
if pos( 'breakifpast', CurrentElement.Tag.Arguments ) > 0 then
begin
@@ -412,31 +434,49 @@ begin
continue;
end;
+ProfileEvent('CurrentCharWidth (margin) before = ' + IntToStr(CurrentCharWidth));
// skip across to the new margin
- CurrentCharWidth := (Style.LeftMargin * FontWidthPrecisionFactor)
+ CurrentCharWidth := (Style.LeftMargin {* FontWidthPrecisionFactor})
- WordStartX - WordX;
+ProfileEvent('CurrentCharWidth (margin) after = ' + IntToStr(CurrentCharWidth));
// BUT! Don't treat it as a space, because you would not
// expect wrapping to take place in a margin change...
- // at least not for IPF (NewView) :)
+ // at least not for IPF :)
- end;
+ end; { teSetLeftMargin }
else
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout teStyle case..else');
+
// before processing the tag see if font height needs updating
if DisplayedCharsSinceFontChange then
CheckFontHeights( CurrentLine );
+ProfileEvent('DEBUG: TRichTextLayout.Layout 3.1 of 5');
if ( CurrentElement.Tag.TagType = ttItalicOff )
and ( faItalic in Style.Font.Attributes ) then
+ begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout 3.2');
if not FFontManager.IsFixed then
+ begin
// end of italic; add a space
+ProfileEvent('DEBUG: TRichTextLayout.Layout 3.3');
inc( WordX, FFontManager.CharWidth( ' ' ) );
+ end;
+ end;
+ProfileEvent('DEBUG: TRichTextLayout.Layout 3.4');
+ProfileEvent('DEBUG: TRichTextLayout.Layout tagtype str=' + TagStr[CurrentElement.Tag.TagType]);
+if CurrentElement.Tag.TagType = ttInvalid then
+ writeln('<' + CurrentElement.Character + '> tagtype = ttInvalid');
+if CurrentElement.Tag.TagType = ttEnd then
+ ProfileEvent(' tagtype = ttEnd');
PerformStyleTag( CurrentElement.Tag,
Style,
WordX );
+ProfileEvent('DEBUG: TRichTextLayout.Layout 3.5');
DisplayedCharsSinceFontChange := false;
P := NextP;
continue; // continue loop
@@ -449,6 +489,7 @@ begin
if OnBreak then
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout 4');
// we just processed a space
if WordStarted then
begin
@@ -476,6 +517,7 @@ begin
// (or leading spaces)
if not Style.Wrap then
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout 5');
// No alignment
// We don't care about how wide it gets
inc( WordX, CurrentCharWidth );
@@ -492,6 +534,7 @@ begin
DoWrap := false;
+ProfileEvent('DEBUG: TRichTextLayout.Layout 6');
// Calculate position of end of character
// see if char would exceed width
if (WordStartX + WordX + CurrentCharWidth) >= WrapX then
@@ -507,6 +550,7 @@ begin
if DoWrap then
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout 7');
if LineWordsCompleted = 0 then
begin
// the first word did not fit on the line. so draw
@@ -549,6 +593,7 @@ begin
end
else
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout 8');
// Normal wrap; at least one word fitted on the line
CurrentLine.Wrapped := true;
@@ -570,6 +615,7 @@ begin
end
else
begin
+ProfileEvent('DEBUG: TRichTextLayout.Layout 9');
// Character fits.
inc( WordX, CurrentCharWidth );
DisplayedCharsSinceFontChange := true;
@@ -581,8 +627,10 @@ begin
P := NextP;
until false; // loop is exited by finding end of text
+ProfileEvent('DEBUG: TRichTextLayout.Layout 10');
inc( FHeight, FRichTextSettings.Margins.Bottom );
+ProfileEvent('DEBUG: TRichTextLayout.Layout <<<<');
End;
Function TRichTextLayout.GetStartX( Style: TTextDrawStyle;
diff --git a/components/richtext/RichTextStyleUnit.pas b/components/richtext/RichTextStyleUnit.pas
index 44044cab..d56e6c07 100755..100644
--- a/components/richtext/RichTextStyleUnit.pas
+++ b/components/richtext/RichTextStyleUnit.pas
@@ -111,7 +111,7 @@ type
end;
// pRichTextSettings = ^TRichTextSettings;
- Procedure ApplyStyle( const Style: TTextDrawStyle;
+ Procedure ApplyStyle( var Style: TTextDrawStyle;
FontManager: TCanvasFontManager );
Procedure ApplyStyleTag( const Tag: TTag;
@@ -134,10 +134,16 @@ uses
// , ACLProfile
;
-Procedure ApplyStyle( const Style: TTextDrawStyle; FontManager: TCanvasFontManager );
+Procedure ApplyStyle( var Style: TTextDrawStyle; FontManager: TCanvasFontManager );
begin
+ProfileEvent('DEBUG: ApplyStyle >>>');
+ assert(FontManager <> nil, 'FontManager should not have been nil');
+ProfileEvent('DEBUG: ApplyStyle - setting font to...');
+ProfileEvent(' ' + Style.Font.FaceName);
FontManager.SetFont( Style.Font );
+ProfileEvent('DEBUG: ApplyStyle - setting text color');
FontManager.Canvas.TextColor := Style.Color;
+ProfileEvent('DEBUG: ApplyStyle <<<');
end;
Procedure ApplyStyleTag( Const Tag: TTag;
@@ -155,10 +161,12 @@ var
ParseIndex: longint;
XSizeStr: string;
YSizeStr: string;
+ tmpFontParts : TStringList;
MarginSize: longint;
ParsePoint: longint;
begin
+ProfileEvent('DEBUG: ApplyStyleTag >>>');
case Tag.TagType of
ttBold:
Include( Style.Font.Attributes, faBold );
@@ -189,17 +197,24 @@ begin
ttFont:
begin
- ParseIndex := 1;
- GetNextQuotedValue( Tag.Arguments, ParseIndex, FontFaceName, DoubleQuote );
- GetNextQuotedValue( Tag.Arguments, ParseIndex, FontSizeString, DoubleQuote );
+ tmpFontParts := TStringList.Create;
+ StrExtractStringsQuoted(tmpFontParts, Tag.Arguments);
+ FontFaceName := tmpFontParts[0];
+ FontSizeString := tmpFontParts[1];
+ tmpFontParts.Destroy;
+
NewStyle := Style;
try
NewStyle.Font.FaceName := FontFaceName;
if Pos( 'x', FontSizeString ) > 0 then
begin
- XSizeStr := ExtractNextValue( FontSizeString, 'x' );
- YSizeStr := FontSizeString;
+ 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;
@@ -251,18 +266,24 @@ begin
ttSetLeftMargin,
ttSetRightMargin:
begin
+ tmpFontParts := TStringList.Create;
+ StrExtractStrings(tmpFontParts, Tag.Arguments, [' '], #0);
+ MarginParam1 := tmpFontParts[0];
+
ParsePoint := 1;
- GetNextValue( Tag.Arguments, ParsePoint, MarginParam1, ' ' );
if ( Tag.TagType = ttSetLeftMargin )
and ( MarginParam1 = 'here' ) then
begin
- Style.LeftMargin := X div FontWidthPrecisionFactor;
+ Style.LeftMargin := X {div FontWidthPrecisionFactor};
end
else
begin
try
MarginSize := StrToInt( MarginParam1 );
- GetNextValue( Tag.Arguments, ParsePoint, MarginParam2, ' ' );
+ if tmpFontParts.Count > 1 then // do we have a second parameter
+ MarginParam2 := tmpFontParts[1]
+ else
+ MarginParam2 := '';
if MarginParam2 = 'pixels' then
NewMargin := MarginSize
@@ -293,12 +314,13 @@ begin
Style.RightMargin := Settings.Margins.Right
+ NewMargin;
end;
- end;
+ tmpFontParts.Free;
+ end; { teSet[left|right]margin }
- end;
+ end; { case Tag.TagType }
ApplyStyle( Style, FontManager );
-
+ProfileEvent('DEBUG: ApplyStyleTag <<<');
end;
function GetDefaultStyle( const Settings: TRichTextSettings ): TTextDrawStyle;
@@ -504,11 +526,11 @@ End;
Procedure TRichTextSettings.SetHeading1Font( NewFont: TfpgFont );
begin
- ProfileEvent( 'TRichTextSettings.SetHeading1Font' );
+// ProfileEvent( 'TRichTextSettings.SetHeading1Font' );
AssignFont( FHeading1Font, NewFont );
- if FHeading1FOnt = nil then
- ProfileEvent( ' Set to nil' );
+// if FHeading1FOnt = nil then
+// ProfileEvent( ' Set to nil' );
end;
diff --git a/components/richtext/RichTextView.pas b/components/richtext/RichTextView.pas
index 3fae141d..dfb21357 100755
--- a/components/richtext/RichTextView.pas
+++ b/components/richtext/RichTextView.pas
@@ -618,7 +618,6 @@ end;
procedure TRichTextView.HandlePaint;
Var
CornerRect: TfpgRect;
- DrawRect: TfpgRect;
TextRect: TfpgRect;
x: integer;
@@ -644,14 +643,15 @@ begin
ProfileEvent('TRichTextView.HandlePaint >>>');
Canvas.ClearClipRect;
DrawBorder;
-
+writeln('DEBUG: TRichTextView.HandlePaint 1');
TextRect := GetTextAreaRect;
- DrawRect := GetDrawRect;
Canvas.SetClipRect(TextRect);
+ProfileEvent('DEBUG: TRichTextView.HandlePaint 2');
Canvas.Color := BackgroundColor;
Canvas.FillRectangle(TextRect);
+ProfileEvent('DEBUG: TRichTextView.HandlePaint 3');
if InDesigner then
begin
Canvas.TextColor := clInactiveWgFrame;
@@ -670,8 +670,11 @@ begin
if Length(FText) = 0 then
exit; // no need to paint anything further.
+ProfileEvent('DEBUG: TRichTextView.HandlePaint 4');
Assert(FLayout <> nil, 'FLayout may not be nil at this point!');
Draw( 0, FLayout.FNumLines );
+// Canvas.DrawText(8, 8, GetTextAreaWidth-FScrollbarWidth, 1000, FText, [txtLeft, txtTop, txtWrap]);
+ProfileEvent('DEBUG: TRichTextView.HandlePaint 5');
Canvas.ClearClipRect;
if FNeedHScroll then
@@ -684,19 +687,19 @@ begin
Canvas.Color := clButtonFace;
Canvas.FillRectangle(CornerRect);
end;
-//writeln('DEBUG: TRichTextView.HandlePaint <<<');
+ProfileEvent('DEBUG: TRichTextView.HandlePaint <<<');
end;
procedure TRichTextView.HandleHide;
begin
- fpgCaret.UnSetCaret (Canvas);
+// fpgCaret.UnSetCaret (Canvas);
inherited HandleHide;
end;
procedure TRichTextView.HandleKeyPress(var keycode: word; var shiftstate: TShiftState;
var consumed: boolean);
begin
-writeln('HandleKeyPress');
+ProfileEvent('HandleKeyPress');
case keycode of
keyPageDown:
begin
@@ -825,7 +828,7 @@ end;
Procedure TRichTextView.CreateWnd;
begin
-writeln('DEBUG: TRichTextView.CreateWnd >>>>');
+ProfileEvent('DEBUG: TRichTextView.CreateWnd >>>>');
if InDesigner then
exit;
@@ -863,7 +866,7 @@ writeln('DEBUG: TRichTextView.CreateWnd >>>>');
if FLayoutRequired then
// we haven't yet done a layout
Layout;
-writeln('DEBUG: TRichTextView.CreateWnd <<<<');
+ProfileEvent('DEBUG: TRichTextView.CreateWnd <<<<');
end;
procedure TRichTextView.HandleResize(AWidth, AHeight: TfpgCoord);
@@ -933,45 +936,50 @@ Procedure TRichTextView.Layout;
Var
DrawWidth: longint;
begin
-writeln('DEBUG: TRichTextView.Layout >>>>');
+ProfileEvent('DEBUG: TRichTextView.Layout >>>>');
FLayoutRequired := true;
if InDesigner then
exit;
if WinHandle = 0 then
exit;
-
+ProfileEvent('DEBUG: TRichTextView.Layout 1 of 6');
FSelectionEnd := -1;
FSelectionStart := -1;
RemoveCursor;
+ProfileEvent('DEBUG: TRichTextView.Layout 2');
DrawWidth := GetTextAreaRect.Width;
try
- FLayout := nil;
if Assigned(FLayout) then
begin
- writeln('DEBUG: Before*** FLayout.FNumLines = ', FLayout.FNumLines);
+ProfileEvent('DEBUG: TRichTextView.Layout 3');
FLayout.Free;
FLayout := nil;
end;
except
+ // this is only every a issue under 64bit. FLayout can suddenly not be referenced anymore
on E: Exception do
- raise Exception.Create('Failed to free FLayout. Error msg: ' + E.Message);
+ ProfileEvent('ERROR: Failed to free FLayout. Error Msg: ' + E.Message);
+// raise Exception.Create('Failed to free FLayout. Error msg: ' + E.Message);
end;
+ProfileEvent('DEBUG: TRichTextView.Layout 4');
FLayout := TRichTextLayout.Create( FText,
FImages,
FRichTextSettings,
FFontManager,
DrawWidth );
-writeln('DEBUG: After*** FLayout.FNumLines = ', FLayout.FNumLines);
+
+ProfileEvent('DEBUG: TRichTextView.Layout 5');
SetupScrollBars;
+ProfileEvent('DEBUG: TRichTextView.Layout 6');
RefreshCursorPosition;
FLayoutRequired := false;
-writeln('DEBUG: TRichTextView.Layout <<<<');
+ProfileEvent('DEBUG: TRichTextView.Layout <<<<');
End;
procedure TRichTextView.GetFirstVisibleLine( Var LineIndex: longint;
@@ -1052,6 +1060,7 @@ Var
SelectionEndP: PChar;
Temp: longint;
begin
+ProfileEvent('DEBUG: TRichTextView.Draw >>>');
DrawRect := GetTextAreaRect;
if StartLine > EndLine then
begin
@@ -1082,6 +1091,7 @@ begin
EndLine,
Point(X, Y)
);
+ProfileEvent('DEBUG: TRichTextView.Draw <<<');
End;
// This gets the area of the control that we can draw on
@@ -1273,12 +1283,12 @@ begin
CursorHeight := DrawHeight - Y + 1;
end;
- fpgCaret.SetCaret(Canvas, TextRect.Left + X, TextRect.Bottom + Y, 2, CursorHeight);
+// fpgCaret.SetCaret(Canvas, TextRect.Left + X, TextRect.Bottom + Y, 2, CursorHeight);
end;
procedure TRichTextView.RemoveCursor;
begin
- fpgCaret.UnSetCaret(Canvas);
+// fpgCaret.UnSetCaret(Canvas);
end;
Function TRichTextView.GetLineDownPosition: longint;
@@ -1409,7 +1419,7 @@ begin
Result := FVScrollBar.Position
- Offset;
- if Offset < FLayout.FLines^[ FirstVisibleLine ].Height div 2 then
+ if Offset < (FLayout.FLines^[ FirstVisibleLine ].Height div 2) then
// more than half the line was already displayed so
if FirstVisibleLine > 0 then
// AND to make next line up visible
@@ -1573,8 +1583,13 @@ end;
// ADelay = True means that we hold off on redoing the Layout and Painting.
Procedure TRichTextView.AddText( Text: PChar; ADelay: boolean );
+var
+ s: string;
begin
- AddAndResize( FText, Text );
+ s := Text;
+ // Warning: Hack Alert! replace some strange Bell character found in some INF files
+ s := SubstituteChar(s, Chr($07), Chr($20) );
+ AddAndResize( FText, PChar(s) );
if not ADelay then
begin
Layout;
@@ -1606,9 +1621,7 @@ begin
ClearSelection;
FText[ 0 ] := #0;
FTopCharIndex := 0;
- if ADestroying then // component is shutting down
- FLayout.Free
- else
+ if not ADestroying then
begin
Layout;
if FLayout.FNumLines > 1 then
diff --git a/components/richtext/fpgui_richtext.lpk b/components/richtext/fpgui_richtext.lpk
index 64a4f50b..4a39379e 100755
--- a/components/richtext/fpgui_richtext.lpk
+++ b/components/richtext/fpgui_richtext.lpk
@@ -19,6 +19,8 @@
</SyntaxOptions>
</Parsing>
<CodeGeneration>
+ <TargetCPU Value="i386"/>
+ <TargetOS Value="Linux"/>
<Optimizations>
<OptimizationLevel Value="0"/>
</Optimizations>
diff --git a/src/HelpFile.pas b/src/HelpFile.pas
index b38e1972..0c6ce12d 100644
--- a/src/HelpFile.pas
+++ b/src/HelpFile.pas
@@ -206,6 +206,7 @@ destructor THelpFile.Destroy;
var
TopicIndex: longint;
begin
+writeln('DEBUG: THelpFile.Destroy >>>>');
FreeMem( HighlightWords, _Dictionary.Count * sizeof( longint ) );
FreeMem( _Data, _DataLen );
for TopicIndex:= 0 to _Topics.Count - 1 do
@@ -214,6 +215,7 @@ begin
_Index.Free;
_Dictionary.Free;
_SearchTable.Free;
+writeln('DEBUG: THelpFile.Destroy <<<<<');
end;
procedure THelpFile.ReadContents;
diff --git a/src/docview.lpi b/src/docview.lpi
index bba79ea4..91cc0e95 100644
--- a/src/docview.lpi
+++ b/src/docview.lpi
@@ -27,15 +27,12 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
- <RequiredPackages Count="2">
+ <RequiredPackages Count="1">
<Item1>
- <PackageName Value="fpgui_richtext"/>
- </Item1>
- <Item2>
<PackageName Value="fpgui_toolkit"/>
- </Item2>
+ </Item1>
</RequiredPackages>
- <Units Count="16">
+ <Units Count="23">
<Unit0>
<Filename Value="docview.lpr"/>
<IsPartOfProject Value="True"/>
@@ -115,17 +112,54 @@
<IsPartOfProject Value="True"/>
<UnitName Value="SearchUnit"/>
</Unit15>
+ <Unit16>
+ <Filename Value="../components/richtext/RichTextStyleUnit.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="RichTextStyleUnit"/>
+ </Unit16>
+ <Unit17>
+ <Filename Value="../components/richtext/CanvasFontManager.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="CanvasFontManager"/>
+ </Unit17>
+ <Unit18>
+ <Filename Value="../components/richtext/ACLStringUtility.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="ACLStringUtility"/>
+ </Unit18>
+ <Unit19>
+ <Filename Value="../components/richtext/RichTextDocumentUnit.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="RichTextDocumentUnit"/>
+ </Unit19>
+ <Unit20>
+ <Filename Value="../components/richtext/RichTextView.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="RichTextView"/>
+ </Unit20>
+ <Unit21>
+ <Filename Value="../components/richtext/RichTextLayoutUnit.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="RichTextLayoutUnit"/>
+ </Unit21>
+ <Unit22>
+ <Filename Value="../components/richtext/RichTextDisplayUnit.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="RichTextDisplayUnit"/>
+ </Unit22>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)/"/>
+ <OtherUnitFiles Value="../components/richtext/"/>
<UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
+ <IncludeAssertionCode Value="True"/>
<AllowLabel Value="False"/>
<CPPInline Value="False"/>
</SyntaxOptions>
@@ -135,15 +169,10 @@
<OptimizationLevel Value="0"/>
</Optimizations>
</CodeGeneration>
- <Linking>
- <Debugging>
- <GenerateDebugInfo Value="True"/>
- <UseHeaptrc Value="True"/>
- </Debugging>
- </Linking>
<Other>
<CustomOptions Value="-O-
--dTimingX"/>
+-dTimingX
+"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
diff --git a/src/docview.lpr b/src/docview.lpr
index 8b001f6a..34e0c34e 100644
--- a/src/docview.lpr
+++ b/src/docview.lpr
@@ -8,10 +8,11 @@ uses
{$ENDIF}{$ENDIF}
Classes,
{$IFDEF Timing}EpikTimer,{$ENDIF}
- fpg_main, frm_main, DataTypes, HelpFileHeader, HelpWindow,
- IPFEscapeCodes, HelpTopic, CompareWordUnit, SearchTable, TextSearchQuery,
- nvUtilities, nvNullObjects, HelpFile, SearchUnit,
- fpg_cmdlineparams, customstyle;
+ fpg_main, frm_main, DataTypes, HelpFileHeader, HelpWindow, IPFEscapeCodes,
+ HelpTopic, CompareWordUnit, SearchTable, TextSearchQuery, nvUtilities,
+ nvNullObjects, HelpFile, SearchUnit, fpg_cmdlineparams, customstyle,
+ RichTextStyleUnit, CanvasFontManager, ACLStringUtility, RichTextDocumentUnit,
+ RichTextView, RichTextLayoutUnit, RichTextDisplayUnit;
procedure MainProc;
diff --git a/src/frm_main.pas b/src/frm_main.pas
index f0aa4462..34a2f73f 100644
--- a/src/frm_main.pas
+++ b/src/frm_main.pas
@@ -165,10 +165,12 @@ end;
procedure TMainForm.MainFormDestroy(Sender: TObject);
begin
+writeln('DEBUG: TMainForm.MainFormDestroy >>>>');
// save splitter position
gINI.WriteInteger('Options', 'SplitterLeft', PageControl1.Width);
// save form size and position
gINI.WriteFormState(self);
+writeln('DEBUG: TMainForm.MainFormDestroy <<<<');
end;
procedure TMainForm.miFileQuitClicked(Sender: TObject);
@@ -260,7 +262,9 @@ end;
procedure TMainForm.MainFormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
+writeln('DEBUG: TMainForm.MainFormCloseQuery >>>>>');
CloseFile(True);
+writeln('DEBUG: TMainForm.MainFormCloseQuery <<<<<');
end;
procedure TMainForm.PageControl1Change(Sender: TObject; NewActiveSheet: TfpgTabSheet);
@@ -713,6 +717,8 @@ Begin
{ TODO -oGraeme : We do not support images yet }
ImageIndices.Free;
+// writeln(lText);
+// writeln('-----------------------------');
RichView.AddText(PChar(lText));
end;
@@ -759,6 +765,7 @@ var
FileIndex: integer;
lHelpFile: THelpFile;
begin
+writeln('DEBUG: TMainForm.Destroy >>>>');
FFileOpenRecent := nil; // it was a reference only
if (Files <> nil) and (Files.Count > 0) then
begin
@@ -771,7 +778,9 @@ begin
end;
Files.Clear;
Files.Free;
+writeln('DEBUG: TMainForm.Destroy 1');
inherited Destroy;
+writeln('DEBUG: TMainForm.Destroy <<<<');
end;
procedure TMainForm.AfterCreate;
@@ -1235,7 +1244,6 @@ begin
mru.MaxItems := gINI.ReadInteger('Options', 'MRUFileCount', 8);
mru.ShowFullPath := gINI.ReadBool('Options', 'ShowFullPath', True);
mru.LoadMRU;
-
end;
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-18 08:45:53 +0000