summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--docs/xml/corelib/fpg_base.xml2
-rw-r--r--docview/components/richtext/CanvasFontManager.pas23
-rw-r--r--docview/components/richtext/RichTextDisplayUnit.pas1
-rw-r--r--docview/components/richtext/RichTextDocumentUnit.pas1
-rw-r--r--docview/components/richtext/RichTextLayoutUnit.pas7
-rw-r--r--docview/components/richtext/RichTextStyleUnit.pas42
-rw-r--r--docview/components/richtext/RichTextView.pas132
-rw-r--r--docview/docs/docview.ipf39
-rw-r--r--docview/src/SettingsUnit.pas61
-rw-r--r--docview/src/docview.lpi6
-rw-r--r--docview/src/frm_configuration.pas174
-rw-r--r--docview/src/frm_main.pas22
-rw-r--r--src/corelib/fpg_imgfmt_bmp.pas3
-rw-r--r--src/corelib/gdi/fpg_gdi.pas46
-rw-r--r--src/fpmake.pp (renamed from src/fpmake.pas)101
-rw-r--r--src/gui/fpg_form.pas17
16 files changed, 414 insertions, 263 deletions
diff --git a/docs/xml/corelib/fpg_base.xml b/docs/xml/corelib/fpg_base.xml
index 683dd729..84e96c8b 100644
--- a/docs/xml/corelib/fpg_base.xml
+++ b/docs/xml/corelib/fpg_base.xml
@@ -5507,7 +5507,7 @@ Right. And the Top is always smaller than the Bottom.
lies completely outside of the clip boundary, then the Line routine is not
called. This procedure uses the well known Cohen-Sutherland line clipping
algorithm to clip each coordinate.</p>
-<p>Use this if you did not what to change the Canvas.ClipRegion for some reason.
+<p>Use this if you do not want to change the Canvas.ClipRegion for some reason.
For a detailed explanation see: http://www.nondot.org/~sabre/graphpro/line6.html
</p></descr>
</element>
diff --git a/docview/components/richtext/CanvasFontManager.pas b/docview/components/richtext/CanvasFontManager.pas
index cfdb4924..ed3abf08 100644
--- a/docview/components/richtext/CanvasFontManager.pas
+++ b/docview/components/richtext/CanvasFontManager.pas
@@ -15,12 +15,16 @@ 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
- DefaultTopicFont = 'Sans';
+ DefaultTopicFontName = 'Arial';
DefaultTopicFontSize = '10';
- DefaultTopicFixedFont = 'Courier New';
+ DefaultTopicFixedFontName = 'Courier New';
DefaultTopicFixedFontSize = '10';
+ DefaultTopicFont = DefaultTopicFontName + '-' + DefaultTopicFontSize;
+ DefaultTopicFixedFont = DefaultTopicFixedFontName + '-' + DefaultTopicFixedFontSize;
+
+
Type
{Standard Font types}
TFontType=(ftBitmap,ftOutline);
@@ -146,6 +150,7 @@ uses
,ACLStringUtility
,nvUtilities
,fpg_stringutils
+ ,SettingsUnit
;
@@ -345,13 +350,13 @@ end;
procedure GetDefaultFonts;
begin
// courier new is common and reasonably nice
- DefaultOutlineFixedFace := FindFaceName( 'Courier New' );
+ DefaultOutlineFixedFace := FindFaceName( DefaultTopicFixedFontName );
if DefaultOutlineFixedFace = nil then
begin
DefaultOutlineFixedFace := GetFirstOutlineFace( true ); // first fixed outline face
end;
- DefaultOutlineProportionalFace := FindFaceName( DefaultTopicFont );
+ DefaultOutlineProportionalFace := FindFaceName( DefaultTopicFontName );
if DefaultOutlineProportionalFace = nil then
begin
DefaultOutlineProportionalFace := GetFirstOutlineFace( false ); // first prop outline face
@@ -455,17 +460,17 @@ end;
function SubstituteBitmapFontToOutline( const FaceName: string ): string;
begin
if StringsSame( FaceName, 'Helv' ) then
- result := DefaultTopicFont
+ result := DefaultTopicFontName
else if StringsSame( FaceName, 'Helvetica' ) then
- result := DefaultTopicFont
+ result := DefaultTopicFontName
else if StringsSame( FaceName, 'Tms Rmn' ) then
result := 'Times New Roman'
else if StringsSame( FaceName, 'System Proportional' ) then
- result := DefaultTopicFont
+ result := DefaultTopicFontName
else if StringsSame( FaceName, 'System Monospaced' ) then
- result := DefaultTopicFixedFont
+ result := DefaultTopicFixedFontName
else if StringsSame( FaceName, 'System VIO' ) then
- result := DefaultTopicFixedFont
+ result := DefaultTopicFixedFontName
else
result := FaceName; // no substitution
end;
diff --git a/docview/components/richtext/RichTextDisplayUnit.pas b/docview/components/richtext/RichTextDisplayUnit.pas
index 6009e7e2..b8e18264 100644
--- a/docview/components/richtext/RichTextDisplayUnit.pas
+++ b/docview/components/richtext/RichTextDisplayUnit.pas
@@ -35,7 +35,6 @@ Implementation
uses
SysUtils
-// ACLString, ACLUtility,
,RichTextDocumentUnit
,fpg_base
,fpg_main
diff --git a/docview/components/richtext/RichTextDocumentUnit.pas b/docview/components/richtext/RichTextDocumentUnit.pas
index dd2f9a96..a3e951d1 100644
--- a/docview/components/richtext/RichTextDocumentUnit.pas
+++ b/docview/components/richtext/RichTextDocumentUnit.pas
@@ -151,7 +151,6 @@ function CopyPlainTextToBuffer( StartP: PChar;
Implementation
uses
-// BseDOS, // for NLS/case mapping
SysUtils
,ACLStringUtility
;
diff --git a/docview/components/richtext/RichTextLayoutUnit.pas b/docview/components/richtext/RichTextLayoutUnit.pas
index 4c6cf427..bbf60643 100644
--- a/docview/components/richtext/RichTextLayoutUnit.pas
+++ b/docview/components/richtext/RichTextLayoutUnit.pas
@@ -10,7 +10,8 @@ Interface
Uses
Classes,
CanvasFontManager,
- RichTextDocumentUnit, RichTextStyleUnit,
+ RichTextDocumentUnit,
+ RichTextStyleUnit,
fpg_imagelist;
Type
@@ -117,11 +118,7 @@ Implementation
Uses
SysUtils
-// PMWin, BseDos, Dos, ClipBrd, Printers,
-// ACLUtility,
,ACLStringUtility
-// ACLString,
-// ControlScrolling;
,nvUtilities
,fpg_main
;
diff --git a/docview/components/richtext/RichTextStyleUnit.pas b/docview/components/richtext/RichTextStyleUnit.pas
index 782889bd..cfdde684 100644
--- a/docview/components/richtext/RichTextStyleUnit.pas
+++ b/docview/components/richtext/RichTextStyleUnit.pas
@@ -61,8 +61,7 @@ type
function GetMargin_Top: longint;
Procedure SetMargin_Top( NewValue: longint );
Procedure SetupComponent;
- Procedure AssignFont( Var Font: TfpgFont;
- NewFont: TfpgFont );
+ Procedure AssignFont(var AFont: TfpgFont; NewFont: TfpgFont);
// Hide properties...
property Name;
@@ -131,6 +130,7 @@ uses
SysUtils,
ACLStringUtility
,nvUtilities
+ ,SettingsUnit
// , ACLProfile
;
@@ -320,11 +320,11 @@ end;
function GetDefaultStyle( const Settings: TRichTextSettings ): TTextDrawStyle;
begin
FillChar(Result, SizeOf(TTextDrawStyle), 0);
- FPGuiFontToFontSpec( Settings.FNormalFont, Result.Font );
- Result.Alignment := Settings.FDefaultAlignment;
- Result.Wrap := Settings.FDefaultWrap;
- Result.Color := Settings.FDefaultColor;
- Result.BackgroundColor := Settings.FDefaultBackgroundColor;
+ FPGuiFontToFontSpec( Settings.NormalFont, Result.Font );
+ Result.Alignment := Settings.DefaultAlignment;
+ Result.Wrap := Settings.DefaultWrap;
+ Result.Color := Settings.DefaultColor;
+ Result.BackgroundColor := Settings.DefaultBackgroundColor;
Result.LeftMargin := Settings.Margins.Left;
Result.RightMargin := Settings.Margins.Right;
end;
@@ -334,11 +334,11 @@ Procedure TRichTextSettings.SetupComponent;
begin
Name := 'RichTextSettings';
- FNormalFont := fpgGetFont('Arial-10');
- FFixedFont := fpgGetFont('Courier New-10');
- FHeading1Font := fpgGetFont('Arial-20');
- FHeading2Font := fpgGetFont('Arial-14');
- FHeading3Font := fpgGetFont('Arial-10:bold');
+ FNormalFont := fpgGetFont(Settings.NormalFontDesc); // fpgGetFont(DefaultTopicFont);
+ FFixedFont := fpgGetFont(Settings.FixedFontDesc); // fpgGetFont(DefaultTopicFixedFont);
+ FHeading1Font := fpgGetFont(DefaultTopicFontName + '-20');
+ FHeading2Font := fpgGetFont(DefaultTopicFontName + '-14');
+ FHeading3Font := fpgGetFont(DefaultTopicFontName + '-10:bold');
FDefaultColor := clBlack;
FDefaultBackgroundColor := clWhite;
@@ -350,12 +350,12 @@ begin
FMarginSizeStyle := msMaximumCharWidth;
FMarginChar := Ord( ' ' );
- FMargins.Left := 0;
- FMargins.Right := 0;
- FMargins.Top := 0;
+ FMargins.Left := 0;
+ FMargins.Right := 0;
+ FMargins.Top := 0;
FMargins.Bottom := 0;
- FUpdateCount := 0;
+ FUpdateCount := 0;
FChangesPending := false;
end;
@@ -502,18 +502,16 @@ begin
Result := FontA.FontDesc = FontB.FontDesc;
end;
-Procedure TRichTextSettings.AssignFont( Var Font: TfpgFont;
- NewFont: TfpgFont );
+Procedure TRichTextSettings.AssignFont(var AFont: TfpgFont; NewFont: TfpgFont );
begin
If NewFont = Nil Then
NewFont := fpgApplication.DefaultFont;
- if FontSame( NewFont, Font ) then
+ if FontSame( NewFont, AFont ) then
exit; // no change
- Font.Free;
- Font := NewFont;
-// Font.Free;
+ AFont.Free;
+ AFont := NewFont;
Change;
End;
diff --git a/docview/components/richtext/RichTextView.pas b/docview/components/richtext/RichTextView.pas
index 49ea97c4..f611ab2f 100644
--- a/docview/components/richtext/RichTextView.pas
+++ b/docview/components/richtext/RichTextView.pas
@@ -14,7 +14,6 @@ Uses
fpg_imagelist,
RichTextStyleUnit,
RichTextLayoutUnit,
-// RichTextDocumentUnit,
CanvasFontManager;
{
@@ -50,9 +49,10 @@ Type
TLinkEvent = procedure( Sender: TRichTextView; Link: string ) of object;
- TRichTextView = Class( TfpgWidget )
+ TRichTextView = class(TfpgWidget)
private
FPopupMenu: TfpgPopupMenu;
+ FScrollDistance: integer;
procedure FVScrollbarScroll(Sender: TObject; position: integer);
procedure FHScrollbarScroll(Sender: TObject; position: integer);
procedure ShowDefaultPopupMenu(const x, y: integer; const shiftstate: TShiftState); virtual;
@@ -64,6 +64,7 @@ Type
Procedure SmoothScrollMIClick( Sender: TObject );
Procedure DebugMIClick( Sender: TObject );
Procedure DefaultMenuPopup( Sender: TObject );
+ procedure SetScrollDistance(const AValue: integer);
protected
FFontManager: TCanvasFontManager;
FRichTextSettings: TRichTextSettings;
@@ -80,12 +81,12 @@ Type
FOnClickLink: TLinkEvent;
FDefaultMenu: TfpgPopupMenu;
- FSelectAllMI: TfpgMenuItem;
- FCopyMI: TfpgMenuItem;
- FRefreshMI: TfpgMenuItem;
- FWordWrapMI: TfpgMenuItem;
- FSmoothScrollMI: TfpgMenuItem;
- FDebugMI: TfpgMenuItem;
+ FSelectAllMI: TfpgMenuItem;
+ FCopyMI: TfpgMenuItem;
+ FRefreshMI: TfpgMenuItem;
+ FWordWrapMI: TfpgMenuItem;
+ FSmoothScrollMI: TfpgMenuItem;
+ FDebugMI: TfpgMenuItem;
// Internal layout data
FNeedVScroll, FNeedHScroll: boolean;
@@ -138,6 +139,7 @@ Type
procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override;
procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
+ procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
//procedure ScanEvent( Var KeyCode: TKeyCode;
// RepeatCount: Byte ); override;
@@ -367,6 +369,7 @@ Type
property RichTextSettings: TRichTextSettings read FRichTextSettings;
property ScrollBarWidth: longint read FScrollBarWidth write SetScrollBarWidth default 15;
property SmoothScroll: boolean read FSmoothScroll write FSmoothScroll;
+ property ScrollDistance: integer read FScrollDistance write SetScrollDistance default 75;
property UseDefaultMenu: boolean read FUseDefaultMenu write FUseDefaultMenu default True;
property Debug: boolean read FDebug write SetDebug default False;
property Images: TfpgImageList read FImages write SetImages;
@@ -395,9 +398,6 @@ Type
//Property OnSetupShow;
//Property OnScan;
- Protected
- //Property Font;
-
End;
@@ -407,7 +407,6 @@ uses
SysUtils
,ACLStringUtility
,nvUtilities
-// ControlScrolling, ControlsUtility,
,RichTextDocumentUnit
,RichTextDisplayUnit
;
@@ -586,6 +585,17 @@ begin
FDebugMI.Checked := Debug;
end;
+procedure TRichTextView.SetScrollDistance(const AValue: integer);
+begin
+ if FScrollDistance = AValue then
+ exit;
+ FScrollDistance := AValue;
+ if Assigned(FVScrollBar) then
+ FVScrollBar.ScrollStep := FScrollDistance;
+ if Assigned(FHScrollBar) then
+ FHScrollBar.ScrollStep := FScrollDistance;
+end;
+
constructor TRichTextView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@@ -753,7 +763,7 @@ procedure TRichTextView.HandleLMouseDown(x, y: integer; shiftstate: TShiftState)
var
Line: longint;
Offset: longint;
- Link: string;
+ Link: TfpgString;
Position: TTextPosition;
Shift: boolean;
begin
@@ -772,6 +782,41 @@ begin
FClickedLink := ''; // reset link
end;
+procedure TRichTextView.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState);
+var
+ Line: longint;
+ Offset: longint;
+ Link: TfpgString;
+ Position: TTextPosition;
+begin
+ inherited HandleMouseMove(x, y, btnstate, shiftstate);
+ Position := FindPoint(X, Y, Line, Offset, Link);
+
+// if not MouseCapture then // TODO: Introduce a IsMouseCaptured in TfpgWindow
+ begin
+ if Link <> FLastLinkOver then
+ begin
+ if Link <> '' then
+ begin
+ if Assigned(FOnOverLink) then
+ FOnOverLink(Self, Link)
+ end
+ else
+ begin
+ if Assigned(FOnNotOverLink) then
+ FOnNotOverLink(Self, FLastLinkOver);
+ end;
+ FLastLinkOver := Link;
+ end;
+
+ if Link <> '' then
+ MouseCursor := mcHand
+ else
+ MouseCursor := mcDefault; // TODO: later this should be IBeam when RichView supports editing
+ exit;
+ end;
+end;
+
Destructor TRichTextView.Destroy;
Begin
FDefaultMenu.Free;
@@ -1052,13 +1097,9 @@ begin
TextHeight := GetTextAreaHeight;
-// YToFind := Height - YToFind;
-
- //if FBorderStyle = bsSingle then
- //begin
- // dec( YToFind, 2 );
- // dec( XToFind, 2 );
- //end;
+ // Should we take into account Border Styles?
+ XToFind := XToFind - FRichTextSettings.Margins.Left;
+ YToFind := YToFind - FRichTextSettings.Margins.Top;
if YToFind < 3 then
begin
@@ -1210,12 +1251,12 @@ begin
FVScrollBar.Max := 0;
end;
- FHScrollBar.ScrollStep := 25; // pixels
- FHScrollBar.PageSize := AvailableWidth - FHScrollbar.ScrollStep; // slightly less than width
- FHScrollBar.SliderSize := AvailableWidth / MaxDisplayWidth;
- FVScrollBar.ScrollStep := 25; // not used (line up/down calculated explicitly)
- FVScrollBar.PageSize := AvailableHeight - FVScrollBar.ScrollStep;
- FVScrollBar.SliderSize := AvailableHeight / FLayout.Height;
+ FHScrollBar.ScrollStep := FScrollDistance; // pixels
+ FHScrollBar.PageSize := AvailableWidth - FHScrollbar.ScrollStep; // slightly less than width
+ FHScrollBar.SliderSize := AvailableWidth / MaxDisplayWidth;
+ FVScrollBar.ScrollStep := FScrollDistance; // pixels
+ FVScrollBar.PageSize := AvailableHeight - FVScrollBar.ScrollStep;
+ FVScrollBar.SliderSize := AvailableHeight / FLayout.Height;
// Physical horizontal scroll setup
FHScrollbar.Visible := FNeedHScroll;
@@ -1427,7 +1468,7 @@ begin
Result := 0;
end;
-Function TRichTextView.GetLineUpPosition: longint;
+function TRichTextView.GetLineUpPosition: longint;
var
FirstVisibleLine: longint;
Offset: longint;
@@ -1436,8 +1477,7 @@ begin
Result := GetLineUpPositionFrom( FirstVisibleLine, Offset );
end;
-Function TRichTextView.GetLineUpPositionFrom( FirstVisibleLine: longint;
- Offset: longint ): longint;
+function TRichTextView.GetLineUpPositionFrom( FirstVisibleLine: longint; Offset: longint ): longint;
begin
// we should never have scrolled all lines off the top!!
assert( FirstVisibleLine <> -1 );
@@ -1454,15 +1494,13 @@ begin
end;
// scroll so that top line is fully visible...
- Result := FVScrollBar.Position
- - Offset;
+ Result := FVScrollBar.Position - Offset;
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
dec( Result, FLayout.FLines^[ FirstVisibleLine - 1 ].Height );
-
end;
Function Sign( arg: longint ): longint;
@@ -1531,54 +1569,26 @@ end;
*)
Procedure TRichTextView.DoVerticalScroll( NewY: longint );
-//var
-// ScrollDistance: longint;
begin
FYScroll := 0 - NewY;
-
if not Visible then
begin
FLastYScroll := FYScroll;
exit;
end;
-
-// ScrollDistance := FYScroll - FLastYScroll;
-
- { TODO -ograeme -cscrolling : Implement vertical scrolling here }
- //ScrollControlRect( Self,
- // GetTextAreaRect,
- // 0,
- // ScrollDistance,
- // Color,
- // FSmoothScroll );
-
FLastYScroll := FYScroll;
RePaint;
SetupCursor;
end;
Procedure TRichTextView.DoHorizontalScroll( NewX: longint );
-var
- ScrollDistance: longint;
begin
FXScroll := NewX;
-
if not Visible then
begin
FLastXScroll := FXScroll;
exit;
end;
-
-// ScrollDistance := FXScroll - FLastXScroll;
-
- { TODO -ograemeg -cscrolling : Implement horizontal scrolling }
- //ScrollControlRect( Self,
- // GetTextAreaRect,
- // - ScrollDistance,
- // 0,
- // Color,
- // FSmoothScroll );
-
FLastXScroll := FXScroll;
RePaint;
SetupCursor;
@@ -1629,7 +1639,7 @@ begin
s := Text;
// Warning: Hack Alert! replace some strange Bell character found in some INF files
// s := SubstituteChar(s, Chr($07), Chr($20) );
- s := StringReplace(s, Chr($07), '•', [rfReplaceAll, rfIgnoreCase]);
+ s := StringReplace(s, Chr($07), #$E2#$80#$A2, [rfReplaceAll, rfIgnoreCase]); // u+2022 small bullet
//// Hack Alert #2: replace strange table chars with something we can actually see
// s := SubstituteChar(s, Chr(218), Char('+') ); // top-left corner
diff --git a/docview/docs/docview.ipf b/docview/docs/docview.ipf
index 2c876ecb..e21490e4 100644
--- a/docview/docs/docview.ipf
+++ b/docview/docs/docview.ipf
@@ -107,6 +107,33 @@ text wrapping and font substitution support.
environment variables BOOKSHELF or HELP.
:eul.
+.* ----------------------------------------------------------------------
+:h2.Disclaimers
+:p.
+Since this program is free, it is supplied with no warranty, either expressed or
+implied.
+:p.
+I disclaim all warranties for any damages, including, but not limited to, incidental
+or consequential damage caused directly or indirectly by this software.
+:p.
+All software is supplied AS IS. You may use the program package only at your own
+risk.
+:p.
+This program must not be used in states that do not allow the above limitation of
+liability.
+
+
+.* ----------------------------------------------------------------------
+:h2.Trademarks
+:p.
+The following trademarks are used in this online help file:
+:ul compact.
+:li.OS/2 is a registered trademark of IBM Corporation.
+:li.eComStation is a registered trademark of Serenity Systems, Inc.
+:li.Windows is a registered trademark of Microsoft Corporation
+:li.Linux is a registered trademark of Linus Torvalds
+:li.FreeBSD is a registered trademark of The FreeBSD Foundation
+:eul.
.* ************************************************************
.* Using DocView
@@ -178,6 +205,7 @@ For example, on my system I can do the following:
:xmp.
docview FPCHELP
:exmp.
+:p.
which loads the whole Free Pascal help library on my system. FPCHELP is an environment
variable set in ~/.profile (Linux) or config.sys (Windows) consisting of "rtl+fcl+ref"
which tells DocView to load the help files rtl.inf, fcl.inf and ref.inf. The
@@ -622,7 +650,8 @@ parameters. None of them are required. For a quick summary, select
docview [<filename>] [[option] [option parameter]]
:exmp.
-:link reftype=hd refid='CommandLineExamples'.Examples:elink.
+:p.
+:link reftype=hd refid='CommandLineExamples'.:hp2.Examples:ehp2.:elink.
:p.
:hp2.<filename>:ehp2.
:p.
@@ -652,19 +681,26 @@ Example:
.br
:lm margin=8.
To search for TfpgApplication in the whole fpGUI Toolkit class document you can call
+
:xmp.
docview fpgui.inf -k TfpgApplication
:exmp.
+
+:p.
DocView is clever enough to handle multiple words (like the :link reftype=hd
refid='search'.search panel:elink.). This is a OR search.
+
:xmp.
docview fpgui.inf -k net access
:exmp.
+
+:p.
To perform an AND search enclose the search phrase in double quotes.
:xmp.
docview fpgui.inf -k "net access"
:exmp.
:lm margin=1.
+
:pt.-n <id>
:pd.Open a topic with the numeric ID equal to <id>.
:pt.-s <id>
@@ -952,6 +988,7 @@ our help file!
wipfc -i sample.ipf
:exmp.
+:p.
If you typed the document correctly, you should now have
a :hp2.sample.inf:ehp2. file in the current directory. Now you simply
run DocView and open your first INF help file. Well done!
diff --git a/docview/src/SettingsUnit.pas b/docview/src/SettingsUnit.pas
index 903e9fe7..e100b1b1 100644
--- a/docview/src/SettingsUnit.pas
+++ b/docview/src/SettingsUnit.pas
@@ -36,20 +36,6 @@ Const
//clLightCyan = $c0ffff;
//clLightGreen = $e0ffe0;
- VGADefaultColors: array[ 0 .. NumColorSettings - 1 ] of TfpgColor
- = ( clBoxColor,
- clText1,
- clText1,
- clBoxColor,
- clText1,
- clBoxColor,
- clText1,
- clBoxColor,
- clText1,
- clBoxColor,
- clGreen,
- clYellow );
-
DefaultColors: array[ 0 .. NumColorSettings - 1 ] of TfpgColor
= ( clLightCyan,
clBlack,
@@ -67,9 +53,6 @@ Const
ApplicationFontIndex = 0;
NumFontSettings = 1;
- DefaultTopicFont = DefaultTopicFont + '-' + DefaultTopicFontSize;
- DefaultTopicFixedFont = DefaultTopicFixedFont + '-10' + DefaultTopicFixedFontSize;
-
Type
TIndexStyle = ( isAlphabetical, isFileOnly, isFull );
@@ -93,10 +76,11 @@ Type
StartupHelp: boolean;
LeftPanelWidth: longint;
ShowLeftPanel: boolean;
+ ScrollDistance: integer;
FileDialogSplit: Double;
Colors: array[ 0..NumColorSettings - 1 ] of TfpgColor;
- NormalFont: TfpgFont;
- FixedFont: TfpgFont;
+ NormalFontDesc: TfpgString;
+ FixedFontDesc: TfpgString;
Fonts: array[ 0..NumFontSettings - 1 ] of TfpgFont;
FixedFontSubstitution: boolean;
FixedFontSubstitutes: string;
@@ -116,7 +100,7 @@ Type
// global procs
procedure LoadSettings;
procedure SaveSettings;
-procedure writeSettingsDetailsTo(aStrings : TStrings);
+procedure WriteSettingsDetailsTo(aStrings : TStrings);
procedure AddToMRUList( const Title: string; Filenames: TStrings );
var
@@ -186,13 +170,12 @@ begin
ShowLeftPanel := ReadBool( GeneralSection, 'ShowLeftPanel', true );
+ ScrollDistance := ReadInteger(GeneralSection, 'ScrollDistance', 75);
+
// Colours
for ColorIndex := 0 to High( Colors ) do
begin
- //if GetScreenColorDepth > 8 then
- DefaultColor := DefaultColors[ ColorIndex ];
- //else
- // DefaultColor := VGADefaultColors[ ColorIndex ];
+ DefaultColor := DefaultColors[ ColorIndex ];
Colors[ ColorIndex ] := ReadInteger( ColoursSection,
'Color' + IntToStr( ColorIndex ),
DefaultColor );
@@ -226,13 +209,8 @@ begin
end;
// Fonts
- NormalFont := fpgGetFont(ReadString(FontsSection, 'NormalFont', DefaultTopicFont));
- if NormalFont = nil then
- NormalFont := fpgStyle.DefaultFont;
-
- FixedFont := fpgGetFont(ReadString(FontsSection, 'FixedFont', DefaultTopicFixedFont));
- if FixedFont = nil then
- FixedFont := fpgStyle.FixedFont;
+ NormalFontDesc := ReadString(FontsSection, 'NormalFont', DefaultTopicFont);
+ FixedFontDesc := ReadString(FontsSection, 'FixedFont', DefaultTopicFixedFont);
for i := 0 to NumFontSettings - 1 do
begin
@@ -243,7 +221,7 @@ begin
end;
FixedFontSubstitution := ReadBool( FontsSection, 'FixedFontSubstitution', true );
- FixedFontSubstitutes := ReadString( FontsSection, 'FixedFontSubstitutes', 'Mono-10' );
+ FixedFontSubstitutes := ReadString( FontsSection, 'FixedFontSubstitutes', DefaultTopicFixedFont );
// Index style
SettingString := ReadString( GeneralSection, 'IndexStyle', 'Full' );
@@ -327,6 +305,7 @@ begin
WriteInteger( GeneralSection, 'FileDialogSplit', Round( FileDialogSplit * 1000 ) );
WriteBool( GeneralSection, 'ShowLeftPanel', ShowLeftPanel);
+ WriteInteger(GeneralSection, 'ScrollDistance', ScrollDistance);
// Colours
for ColorIndex := 0 to High( Colors ) do
@@ -357,8 +336,8 @@ begin
end;
// Fonts
- WriteString( FontsSection, 'NormalFont', NormalFont.FontDesc );
- WriteString( FontsSection, 'FixedFont', FixedFont.FontDesc );
+ WriteString( FontsSection, 'NormalFont', NormalFontDesc );
+ WriteString( FontsSection, 'FixedFont', FixedFontDesc );
for FontIndex := 0 to NumFontSettings - 1 do
begin
FontName := 'Font' + IntToStr( FontIndex );
@@ -473,7 +452,7 @@ begin
end;
end;
-procedure writeSettingsDetailsTo(aStrings : TStrings);
+procedure WriteSettingsDetailsTo(aStrings : TStrings);
Begin
aStrings.Add('');
aStrings.Add('---- Settings ----');
@@ -486,10 +465,11 @@ Begin
aStrings.Add('StartupHelp: ' + boolToStr(Settings.StartupHelp));
// LeftPanelWidth: longint;
aStrings.Add('ShowLeftPanel: ' + boolToStr(Settings.ShowLeftPanel));
+ aStrings.Add('ScrollDistance: ' + IntToStr(Settings.ScrollDistance));
// FileDialogSplit: real;
// Colors: array[ 0..NumColorSettings - 1 ] of TColor;
- // NormalFont: TFont;
- // FixedFont: TFont;
+ aStrings.Add('NormalFont: ' + Settings.NormalFontDesc);
+ aStrings.Add('FixedFont: ' + Settings.FixedFontDesc);
// Fonts: array[ 0..NumFontSettings - 1 ] of TFont;
aStrings.Add('FixedFontSubstitution: ' + boolToStr(Settings.FixedFontSubstitution));
aStrings.Add('FixedFontSubstitutes: ' + Settings.FixedFontSubstitutes);
@@ -508,14 +488,9 @@ end;
Initialization
Settings.MRUList := TObjectList.Create;
-
- //Settings.NormalFont := fpgStyle.DefaultFont;
- //Settings.FixedFont := fpgStyle.FixedFont;
- //Settings.SearchDirectories := TStringList.Create;
+ Settings.SearchDirectories := TStringList.Create;
Finalization
- Settings.NormalFont.Free;
- Settings.FixedFont.Free;
Settings.SearchDirectories.Free;
Settings.MRUList.Free;
diff --git a/docview/src/docview.lpi b/docview/src/docview.lpi
index 5e71947c..9b5c71a8 100644
--- a/docview/src/docview.lpi
+++ b/docview/src/docview.lpi
@@ -28,7 +28,7 @@
<PackageName Value="fpgui_toolkit"/>
</Item1>
</RequiredPackages>
- <Units Count="32">
+ <Units Count="33">
<Unit0>
<Filename Value="docview.lpr"/>
<IsPartOfProject Value="True"/>
@@ -184,6 +184,10 @@
<Filename Value="docview.rc"/>
<IsPartOfProject Value="True"/>
</Unit31>
+ <Unit32>
+ <Filename Value="../docs/docview.ipf"/>
+ <IsPartOfProject Value="True"/>
+ </Unit32>
</Units>
</ProjectOptions>
<CompilerOptions>
diff --git a/docview/src/frm_configuration.pas b/docview/src/frm_configuration.pas
index 9d63db94..10ea5616 100644
--- a/docview/src/frm_configuration.pas
+++ b/docview/src/frm_configuration.pas
@@ -7,22 +7,22 @@ interface
uses
SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_tab, fpg_button,
fpg_label, fpg_edit, fpg_panel, fpg_combobox, fpg_listbox, fpg_checkbox,
- fpg_editbtn;
+ fpg_editbtn, fpg_radiobutton;
type
TConfigurationForm = class(TfpgForm)
private
{@VFD_HEAD_BEGIN: ConfigurationForm}
- PageControl1: TfpgPageControl;
+ pcSettings: TfpgPageControl;
btnSave: TfpgButton;
btnCancel: TfpgButton;
tsGeneral: TfpgTabSheet;
tsFontsColor: TfpgTabSheet;
+ tsIndex: TfpgTabSheet;
Label1: TfpgLabel;
Label2: TfpgLabel;
pnlSearchHighlight: TfpgPanel;
- cbIndexStyle: TfpgComboBox;
lblIndexStyle: TfpgLabel;
lblSearchDirs: TfpgLabel;
btnSearchDirAdd: TfpgButton;
@@ -35,6 +35,12 @@ type
btnResetColors: TfpgButton;
edtFixedFont: TfpgFontEdit;
edtNormalFont: TfpgFontEdit;
+ rbIndexOrig: TfpgRadioButton;
+ rbIndexAlpha: TfpgRadioButton;
+ rbIndexBoth: TfpgRadioButton;
+ lblScrollDistance: TfpgLabel;
+ edtScrollDistance: TfpgEditInteger;
+ lblPixels: TfpgLabel;
{@VFD_HEAD_END: ConfigurationForm}
btnHelp: TfpgButton;
procedure ConfigurationFormShow(Sender: TObject);
@@ -79,7 +85,7 @@ end;
procedure TConfigurationForm.ConfigurationFormShow(Sender: TObject);
begin
SettingsToGui;
- PageControl1.ActivePage := tsGeneral;
+ pcSettings.ActivePage := tsGeneral;
// programatically seting a tab does not fire OnChange event, so we do it mantually
PageControl1Change(self, tsGeneral);
end;
@@ -143,31 +149,44 @@ End;
procedure TConfigurationForm.SettingsToGui;
begin
// General
- cbIndexStyle.FocusItem := Ord(Settings.IndexStyle);
+ edtScrollDistance.Value := Settings.ScrollDistance;
lbSearchDirs.Items.Assign(Settings.SearchDirectories);
chkEscapeIPFSymbols.Checked := Settings.IPFTopicSaveAsEscaped;
chkStartupHelp.Checked := Settings.StartupHelp;
chkOpenTOC.Checked := Settings.OpenWithExpandedContents;
// Fonts & Color
- edtNormalFont.FontDesc := Settings.NormalFont.FontDesc;
- edtFixedFont.FontDesc := Settings.FixedFont.FontDesc;
+ edtNormalFont.FontDesc := Settings.NormalFontDesc;
+ edtFixedFont.FontDesc := Settings.FixedFontDesc;
UpdateColorPanels;
+ // Index
+ rbIndexOrig.Checked := Settings.IndexStyle = isFileOnly;
+ rbIndexAlpha.Checked := Settings.IndexStyle = isAlphabetical;
+ rbIndexBoth.Checked := Settings.IndexStyle = isFull;
end;
procedure TConfigurationForm.GuiToSettings;
begin
// General
- Settings.IndexStyle := TIndexStyle(cbIndexStyle.FocusItem);
+ if edtScrollDistance.Value < 1 then
+ edtScrollDistance.Value := 75; // default
+ if edtScrollDistance.Value > 400 then
+ edtScrollDistance.Value := 400;
+ Settings.ScrollDistance := edtScrollDistance.Value;
Settings.SearchDirectories.Assign(lbSearchDirs.Items);
Settings.IPFTopicSaveAsEscaped := chkEscapeIPFSymbols.Checked;
Settings.StartupHelp := chkStartupHelp.Checked;
Settings.OpenWithExpandedContents := chkOpenTOC.Checked;
// Fonts & Color
- Settings.NormalFont.Free;
- Settings.NormalFont := fpgGetFont(edtNormalFont.FontDesc);
- Settings.FixedFont.Free;
- Settings.FixedFont := fpgGetFont(edtFixedFont.FontDesc);
+ Settings.NormalFontDesc := edtNormalFont.FontDesc;
+ Settings.FixedFontDesc := edtFixedFont.FontDesc;
Settings.Colors[SearchHighlightTextColorIndex] := pnlSearchHighlight.BackgroundColor;
+ // Index
+ if rbIndexOrig.Checked then
+ Settings.IndexStyle := isFileOnly
+ else if rbIndexAlpha.Checked then
+ Settings.IndexStyle := isAlphabetical
+ else if rbIndexBoth.Checked then
+ Settings.IndexStyle := isFull;
end;
procedure TConfigurationForm.UpdateColorPanels;
@@ -189,12 +208,13 @@ begin
SetPosition(402, 189, 515, 439);
WindowTitle := 'Configuration';
Hint := '';
+ ShowHint := True;
WindowPosition := wpOneThirdDown;
- PageControl1 := TfpgPageControl.Create(self);
- with PageControl1 do
+ pcSettings := TfpgPageControl.Create(self);
+ with pcSettings do
begin
- Name := 'PageControl1';
+ Name := 'pcSettings';
SetPosition(4, 4, 506, 388);
Anchors := [anLeft,anRight,anTop,anBottom];
ActivePageIndex := 0;
@@ -212,7 +232,7 @@ begin
FontDesc := '#Label1';
Hint := '';
ImageName := '';
- TabOrder := 19;
+ TabOrder := 25;
OnClick := @btnSaveClick;
end;
@@ -225,11 +245,11 @@ begin
FontDesc := '#Label1';
Hint := '';
ImageName := '';
- TabOrder := 20;
+ TabOrder := 26;
OnClick := @btnCancelClick;
end;
- tsGeneral := TfpgTabSheet.Create(PageControl1);
+ tsGeneral := TfpgTabSheet.Create(pcSettings);
with tsGeneral do
begin
Name := 'tsGeneral';
@@ -237,7 +257,7 @@ begin
Text := 'General';
end;
- tsFontsColor := TfpgTabSheet.Create(PageControl1);
+ tsFontsColor := TfpgTabSheet.Create(pcSettings);
with tsFontsColor do
begin
Name := 'tsFontsColor';
@@ -245,6 +265,14 @@ begin
Text := 'Fonts & Color';
end;
+ tsIndex := TfpgTabSheet.Create(pcSettings);
+ with tsIndex do
+ begin
+ Name := 'tsIndex';
+ SetPosition(3, 24, 500, 361);
+ Text := 'Index';
+ end;
+
Label1 := TfpgLabel.Create(tsFontsColor);
with Label1 do
begin
@@ -278,25 +306,12 @@ begin
Text := 'Search Highlight Color';
end;
- cbIndexStyle := TfpgComboBox.Create(tsGeneral);
- with cbIndexStyle do
- begin
- Name := 'cbIndexStyle';
- SetPosition(12, 32, 160, 25);
- FontDesc := '#List';
- Hint := '';
- Items.Add('Alphabetical');
- Items.Add('FileOnly');
- Items.Add('Full');
- TabOrder := 2;
- end;
-
- lblIndexStyle := TfpgLabel.Create(tsGeneral);
+ lblIndexStyle := TfpgLabel.Create(tsIndex);
with lblIndexStyle do
begin
Name := 'lblIndexStyle';
- SetPosition(12, 13, 296, 17);
- FontDesc := '#Label1';
+ SetPosition(12, 12, 224, 17);
+ FontDesc := '#Label2';
Hint := '';
Text := 'Index style';
end;
@@ -320,7 +335,7 @@ begin
FontDesc := '#Label1';
Hint := '';
ImageName := '';
- TabOrder := 5;
+ TabOrder := 3;
OnClick :=@btnSearchDirAddClicked;
end;
@@ -333,7 +348,7 @@ begin
Hint := '';
HotTrack := False;
PopupFrame := False;
- TabOrder := 7;
+ TabOrder := 5;
Items.Duplicates := dupIgnore;
end;
@@ -346,7 +361,7 @@ begin
FontDesc := '#Label1';
Hint := '';
ImageName := '';
- TabOrder := 6;
+ TabOrder := 4;
end;
chkEscapeIPFSymbols := TfpgCheckBox.Create(tsGeneral);
@@ -357,7 +372,7 @@ begin
Anchors := [anLeft,anRight,anTop];
FontDesc := '#Label1';
Hint := '';
- TabOrder := 8;
+ TabOrder := 6;
Text := 'Escape symbols when saving topics as IPF text';
end;
@@ -370,7 +385,7 @@ begin
Checked := True;
FontDesc := '#Label1';
Hint := '';
- TabOrder := 9;
+ TabOrder := 7;
Text := 'Show DocView help at startup if no files opened';
end;
@@ -382,7 +397,7 @@ begin
Anchors := [anLeft,anRight,anTop];
FontDesc := '#Label1';
Hint := '';
- TabOrder := 10;
+ TabOrder := 8;
Text := 'Open files with contents expanded';
end;
@@ -395,7 +410,7 @@ begin
FontDesc := '#Label1';
Hint := '';
ImageName := '';
- TabOrder := 17;
+ TabOrder := 15;
OnClick := @btnSearchHighlightClicked;
end;
@@ -408,7 +423,7 @@ begin
FontDesc := '#Label1';
Hint := '';
ImageName := '';
- TabOrder := 18;
+ TabOrder := 16;
OnClick := @ResetColorsButtonOnClick;
end;
@@ -419,7 +434,7 @@ begin
SetPosition(124, 48, 340, 24);
Anchors := [anLeft,anRight,anTop];
FontDesc := '';
- TabOrder := 15;
+ TabOrder := 14;
end;
edtNormalFont := TfpgFontEdit.Create(tsFontsColor);
@@ -429,14 +444,81 @@ begin
SetPosition(124, 16, 340, 24);
Anchors := [anLeft,anRight,anTop];
FontDesc := '';
- TabOrder := 14;
+ TabOrder := 13;
+ end;
+
+ rbIndexOrig := TfpgRadioButton.Create(tsIndex);
+ with rbIndexOrig do
+ begin
+ Name := 'rbIndexOrig';
+ SetPosition(24, 28, 280, 20);
+ FontDesc := '#Label1';
+ GroupIndex := 1;
+ Hint := '';
+ TabOrder := 21;
+ Text := 'File Only (only entries specified in file)';
+ end;
+
+ rbIndexAlpha := TfpgRadioButton.Create(tsIndex);
+ with rbIndexAlpha do
+ begin
+ Name := 'rbIndexAlpha';
+ SetPosition(24, 48, 280, 20);
+ FontDesc := '#Label1';
+ GroupIndex := 1;
+ Hint := '';
+ TabOrder := 22;
+ Text := 'Alphabetical listing of topics';
+ end;
+
+ rbIndexBoth := TfpgRadioButton.Create(tsIndex);
+ with rbIndexBoth do
+ begin
+ Name := 'rbIndexBoth';
+ SetPosition(24, 68, 280, 20);
+ FontDesc := '#Label1';
+ GroupIndex := 1;
+ Hint := '';
+ TabOrder := 23;
+ Text := 'Both';
+ end;
+
+ lblScrollDistance := TfpgLabel.Create(tsGeneral);
+ with lblScrollDistance do
+ begin
+ Name := 'lblScrollDistance';
+ SetPosition(12, 12, 280, 17);
+ FontDesc := '#Label1';
+ Hint := '';
+ Text := 'Mouse Wheel Scroll Distance';
+ end;
+
+ edtScrollDistance := TfpgEditInteger.Create(tsGeneral);
+ with edtScrollDistance do
+ begin
+ Name := 'edtScrollDistance';
+ SetPosition(12, 32, 72, 24);
+ Hint := '';
+ TabOrder := 2;
+ FontDesc := '#Edit1';
+ Value := 0;
+ end;
+
+ lblPixels := TfpgLabel.Create(tsGeneral);
+ with lblPixels do
+ begin
+ Name := 'lblPixels';
+ SetPosition(88, 36, 80, 17);
+ FontDesc := '#Label1';
+ Hint := '';
+ Text := '(pixels)';
end;
{@VFD_BODY_END: ConfigurationForm}
{%endregion}
// always reset pagecotrol
- PageControl1.ActivePageIndex := 0;
+ pcSettings.ActivePageIndex := 0;
//btnHelp := TfpgButton.Create(self);
//with btnHelp do
diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas
index 4f040105..4cc0abfa 100644
--- a/docview/src/frm_main.pas
+++ b/docview/src/frm_main.pas
@@ -95,6 +95,7 @@ type
CurrentHistoryIndex: integer;
OpenAdditionalFile: boolean;
+ procedure UpdateRichViewFromSettings;
procedure btnBackHistClick(Sender: TObject);
procedure btnFwdHistClick(Sender: TObject);
procedure btnPrevClick(Sender: TObject);
@@ -210,6 +211,7 @@ uses
,frm_configuration
,frm_text
,NewViewConstantsUnit
+ ,CanvasFontManager
;
const
@@ -237,6 +239,13 @@ begin
end
end;
+procedure TMainForm.UpdateRichViewFromSettings;
+begin
+ RichView.RichTextSettings.NormalFont := fpgGetFont(Settings.NormalFontDesc);
+ RichView.RichTextSettings.FixedFont := fpgGetFont(Settings.FixedFontDesc);
+ RichView.ScrollDistance := Settings.ScrollDistance;
+end;
+
procedure TMainForm.btnBackHistClick(Sender: TObject);
begin
if CurrentHistoryIndex > 0 then
@@ -359,16 +368,11 @@ begin
PageControl1.Width := gINI.ReadInteger('Options', 'SplitterLeft', 260);
UpdateWindowPosition;
- Settings.NormalFont := fpgStyle.DefaultFont;
- Settings.FixedFont := fpgStyle.FixedFont;
- Settings.SearchDirectories := TStringList.Create;
-
- LogEvent(LogSettings, 'Loading settings');
- LoadSettings;
CreateMRUMenuItems;
ProcessCommandLineParams;
RichView.Images := FImages;
+ UpdateRichViewFromSettings;
if ParamCount = 0 then
begin
@@ -382,7 +386,6 @@ begin
OpenFile(lFilename, '', true);
end;
end;
-
end;
procedure TMainForm.MainFormDestroy(Sender: TObject);
@@ -436,6 +439,7 @@ end;
procedure TMainForm.miConfigureClicked(Sender: TObject);
begin
ShowConfigForm;
+ UpdateRichViewFromSettings;
end;
procedure TMainForm.miViewExpandAllClicked(Sender: TObject);
@@ -1934,6 +1938,8 @@ begin
'dv.arrowdown', @usr_arrow_down,
sizeof(usr_arrow_down), 0, 0);
+ // load custom user settings like Fonts, Search Highlight Color etc.
+ LoadSettings;
end;
destructor TMainForm.Destroy;
@@ -2745,7 +2751,7 @@ const
var
s: string;
begin
- s := '<font "Arial" 12><b>' + cLongName + '</b></font>' + le
+ s := '<font "' + DefaultTopicFontName + '" 12><b>' + cLongName + '</b></font>' + le
+ cVersion + le + le
+ 'Supported command line parameters:' + le + le
+ '<tt>'
diff --git a/src/corelib/fpg_imgfmt_bmp.pas b/src/corelib/fpg_imgfmt_bmp.pas
index 48b25d5b..1ea61551 100644
--- a/src/corelib/fpg_imgfmt_bmp.pas
+++ b/src/corelib/fpg_imgfmt_bmp.pas
@@ -25,8 +25,7 @@ interface
uses
Classes,
SysUtils,
- fpg_main,
- fpg_base;
+ fpg_main;
procedure ReadImage_BMP(img: TfpgImage; bmp: Pointer; bmpsize: longword);
function LoadImage_BMP(const AFileName: String): TfpgImage;
diff --git a/src/corelib/gdi/fpg_gdi.pas b/src/corelib/gdi/fpg_gdi.pas
index 26abf534..9851ebb7 100644
--- a/src/corelib/gdi/fpg_gdi.pas
+++ b/src/corelib/gdi/fpg_gdi.pas
@@ -32,7 +32,11 @@ uses
Classes,
SysUtils,
fpg_base,
- fpg_impl;
+ fpg_impl
+ {$IFDEF DEBUG}
+ ,dbugintf
+ {$ENDIF DEBUG}
+ ;
{ Constants missing on windows unit }
const
@@ -631,7 +635,7 @@ begin
if not (w is TfpgGDIWindow) then
begin
- {$IFDEF DEBUG} writeln('fpGFX/GDI: Unable to detect Window - using DefWindowProc'); {$ENDIF}
+ {$IFDEF DEBUG} SendDebug('fpGFX/GDI: Unable to detect Window - using DefWindowProc'); {$ENDIF}
Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
Exit; //==>
end;
@@ -646,8 +650,7 @@ begin
WM_KEYDOWN,
WM_SYSKEYDOWN:
begin
- {$IFDEF DEBUG} write(w.ClassName + ': '); {$ENDIF}
- {$IFDEF DEBUG} writeln('wm_char, wm_keyup, wm_keydown'); {$ENDIF}
+ {$IFDEF DEBUG} SendDebug(w.ClassName + ': wm_char, wm_keyup, wm_keydown'); {$ENDIF}
kwg := FindKeyboardFocus;
if kwg <> nil then
w := kwg;
@@ -715,7 +718,7 @@ begin
begin
{$IFDEF DEBUG}
if uMsg <> WM_MOUSEMOVE then
- writeln('fpGFX/GDI: Found a mouse button event');
+ SendDebug('fpGFX/GDI: Found a mouse button event');
{$ENDIF}
// msgp.mouse.x := smallint(lParam and $FFFF);
// msgp.mouse.y := smallint((lParam and $FFFF0000) shr 16);
@@ -725,16 +728,15 @@ begin
if uMsg = WM_MOUSEMOVE then
begin
{$IFDEF DEBUG}
- Writeln('old x=', OldMousePos.x, ' y=', OldMousePos.y);
- writeln('new x=', msgp.mouse.x, ' y=', msgp.mouse.y);
- writeln('---');
+ SendDebugFmt('old x=%d y=%d', [OldMousePos.x, OldMousePos.y]);
+ SendDebugFmt('new x=%d y=%d', [msgp.mouse.x, msgp.mouse.y]);
{$ENDIF}
// Check for fake MouseMove messages - Windows sucks!
if (OldMousePos.x = msgp.mouse.x) and
(OldMousePos.y = msgp.mouse.y) then
begin
{$IFDEF DEBUG}
- writeln('We received fake MouseMove messages');
+ SendDebug('We received fake MouseMove messages');
{$ENDIF}
Exit; //==>
end
@@ -790,7 +792,7 @@ begin
WM_RBUTTONDOWN:
begin
{$IFDEF DEBUG}
- writeln('fpGUI/GDI:', w.ClassName + ': MouseButtonDown event');
+ SendDebug('fpGUI/GDI: ' + w.ClassName + ': MouseButtonDown event');
{$ENDIF}
// This is temporary and we should try and move it to
// the UI Designer code instead.
@@ -807,7 +809,7 @@ begin
WM_RBUTTONUP:
begin
{$IFDEF DEBUG}
- writeln('fpGFX/GDI:', w.ClassName + ': MouseButtonUp event');
+ SendDebug('fpGFX/GDI: '+ w.ClassName + ': MouseButtonUp event');
{$ENDIF}
// This is temporary and we should try and move it to
// the UI Designer code instead.
@@ -875,8 +877,7 @@ begin
msgp.rect.Height := smallint((lParam and $FFFF0000) shr 16);
{$IFDEF DEBUG}
- write(w.ClassName + ': ');
- writeln('WM_SIZE: width=',msgp.rect.width, ' height=',msgp.rect.height);
+ SendDebugFmt('%s: WM_SIZE w=%d h=%d', [w.ClassName, msgp.rect.width, msgp.rect.Height]);
{$ENDIF}
// skip minimize...
if lparam <> 0 then
@@ -886,8 +887,7 @@ begin
WM_MOVE:
begin
{$IFDEF DEBUG}
- write(w.ClassName + ': ');
- writeln('WM_MOVE');
+ SendDebug(w.ClassName + ': WM_MOVE');
{$ENDIF}
// window decoration correction ...
if (GetWindowLong(w.WinHandle, GWL_STYLE) and WS_CHILD) = 0 then
@@ -908,8 +908,7 @@ begin
WM_MOUSEWHEEL:
begin
{$IFDEF DEBUG}
- write(w.ClassName + ': ');
- writeln('WM_MOUSEWHEEL: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8));
+ SendDebugFmt('%s: WM_MOUSEWHEEL: wp=%s lp=%s', [w.ClassName, IntToHex(wparam,8), IntToHex(lparam,8)]);
{$ENDIF}
pt.x := GET_X_LPARAM(lParam);
pt.y := GET_Y_LPARAM(lParam);
@@ -941,7 +940,7 @@ begin
WM_ACTIVATE: // We currently use WM_NCACTIVATE instead!
begin
{$IFDEF DEBUG}
- writeln(w.ClassName + ': WM_ACTIVATE');
+ SendDebug(w.ClassName + ': WM_ACTIVATE');
{$ENDIF}
if (Lo(wParam) = WA_INACTIVE) then
fpgSendMessage(nil, w, FPGM_DEACTIVATE)
@@ -958,8 +957,7 @@ begin
WM_NCACTIVATE:
begin
{$IFDEF DEBUG}
- write(w.ClassName + ': WM_NCACTIVATE ');
- writeln(wParam);
+ SendDebugFmt('%s: WM_NCACTIVATE wparam=%d', [w.ClassName, wParam]);
{$ENDIF}
if (wParam = 0) then
fpgSendMessage(nil, w, FPGM_DEACTIVATE)
@@ -969,7 +967,7 @@ begin
if (PopupListFirst <> nil) and (PopupListFirst.Visible) then
begin
{$IFDEF DEBUG}
- writeln(' Blockmsg = True (part 1) : ' + PopupListFirst.ClassName);
+ SendDebug(' Blockmsg = True (part 1) : ' + PopupListFirst.ClassName);
{$ENDIF}
// This is ugly but needed for now to get TfpgCombobox to work
if (PopupListFirst.ClassName <> 'TDropDownWindow') then
@@ -1002,8 +1000,7 @@ begin
WM_CLOSE:
begin
{$IFDEF DEBUG}
- write(w.ClassName + ': ');
- writeln('WM_Close');
+ SendDebug(w.ClassName + ': WM_Close');
{$ENDIF}
fpgSendMessage(nil, w, FPGM_CLOSE, msgp);
end;
@@ -1011,8 +1008,7 @@ begin
WM_PAINT:
begin
{$IFDEF DEBUG}
- write(w.ClassName + ': ');
- writeln('WM_PAINT');
+ SendDebug(w.ClassName + ': WM_PAINT');
{$ENDIF}
Windows.BeginPaint(w.WinHandle, @PaintStruct);
fpgSendMessage(nil, w, FPGM_PAINT, msgp);
diff --git a/src/fpmake.pas b/src/fpmake.pp
index 5afc82ea..a99975a0 100644
--- a/src/fpmake.pas
+++ b/src/fpmake.pp
@@ -42,13 +42,16 @@ program fpmake;
uses sysutils, fpmkunit;
+const
+ {$I VERSION_FILE.inc}
+
var
T: TTarget;
P: TPackage;
begin
with Installer do begin
P := AddPackage('fpgui');
- P.Version := '0.6.3';
+ P.Version := FPGUI_VERSION;
P.Author := 'Graeme Geldenhuys';
P.Email := 'graemeg@gmail.com';
P.License := 'Modified LGPL';
@@ -62,7 +65,7 @@ begin
if we set the package name to fpgui as above. This base install dir
can be overridden by passing -B to fpmake. The line below will cause
the units to be output in ../lib/<cpu-os>/fpgui }
- Defaults.UnitInstallDir := Format('../lib/%s-%s/', [CurrentCPU, CurrentOS]);
+// Defaults.UnitInstallDir := Format('../lib/%s-%s/', [CurrentCPU, CurrentOS]);
{ If you installed FPC to a non-standard location, you need to specify
where fpmake can find the compiler and RTL units. You can pass that
@@ -72,9 +75,10 @@ begin
// else
// Defaults.GlobalUnitDir := Format('c:\fpc\2.2.3\units\%s-%s', [CurrentCPU, CurrentOS]);
- if Defaults.OS in AllUnixOSes
- then Defaults.Options := Defaults.Options + '-dX11'
- else Defaults.Options := Defaults.Options + '-dGDI';
+ if Defaults.OS in AllUnixOSes then
+ Defaults.Options.Add('-dX11')
+ else
+ Defaults.Options.Add('-dGDI');
P.SourcePath.Add('corelib');
P.SourcePath.Add('corelib/x11', AllUnixOSes);
@@ -88,64 +92,81 @@ begin
P.UnitPath.Add('gui');
P.UnitPath.Add('gui/db');
+ P.IncludePath.Add('.');
P.IncludePath.Add('corelib');
P.IncludePath.Add('corelib/x11', AllUnixOSes);
P.IncludePath.Add('corelib/gdi', AllWindowsOSes);
P.IncludePath.Add('gui');
{ todo: add unit and include dependency for all }
+{
P.Sources.AddSrcFiles('corelib/*.pas');
P.Sources.AddSrcFiles('gui/*.pas');
- if Defaults.OS in AllUnixOSes
- then P.Sources.AddSrcFiles('corelib/x11/*.pas')
- else P.Sources.AddSrcFiles('corelib/gdi/*.pas');
-
- { x11 and gdi common }
-// if Defaults.OS in AllUnixOSes
-// then
- P.Targets.AddUnit('corelib/x11/fpg_impl.pas', AllWindowsOSes);
-// else
- P.Targets.AddUnit('corelib/gdi/fpg_impl.pas', AllUnixOSes);
-// T := P.Targets.AddUnit('fpg_impl.pas');
-
- { corelib/x11 }
- T := P.Targets.AddUnit('fpg_keyconv_x11.pas', AllUnixOSes);
- T := P.Targets.AddUnit('fpg_netlayer_x11.pas', AllUnixOSes);
- T := P.Targets.AddUnit('fpg_x11.pas', AllUnixOSes);
-{ with T.Dependencies do begin
- AddUnit('fpg_xft_x11');
- AddUnit('fpg_netlayer_x11');
- AddUnit('fpg_base');
- AddUnit('fpg_impl');
- end; }
- T := P.Targets.AddUnit('fpg_xft_x11.pas', AllUnixOSes);
-
- { corelib/gdi }
- T := P.Targets.AddUnit('fpg_gdi.pas', AllWindowsOSes);
+ if Defaults.OS in AllUnixOSes then
+ P.Sources.AddSrcFiles('corelib/x11/*.pas')
+ else
+ P.Sources.AddSrcFiles('corelib/gdi/*.pas');
+}
{ corelib }
T := P.Targets.AddUnit('fpg_base.pas');
+ T.Dependencies.AddInclude('keys.inc');
+ T.Dependencies.AddInclude('predefinedcolors.inc');
T := P.Targets.AddUnit('fpg_imagelist.pas');
T := P.Targets.AddUnit('fpg_popupwindow.pas');
T := P.Targets.AddUnit('fpg_translations.pas');
T := P.Targets.AddUnit('fpg_cmdlineparams.pas');
T := P.Targets.AddUnit('fpg_imgfmt_bmp.pas');
+ T := P.Targets.AddUnit('fpg_imgfmt_jpg.pas');
T := P.Targets.AddUnit('fpg_stdimages.pas');
+ T.Dependencies.AddInclude('stdimages.inc');
T := P.Targets.AddUnit('fpg_utils.pas');
+ T.Dependencies.AddInclude('fpg_utils_impl.inc', AllUnixOSes);
+ T.Dependencies.AddInclude('fpg_utils_impl.inc', AllWindowsOSes);
+ T := P.Targets.AddUnit('fpg_imgutils.pas');
T := P.Targets.AddUnit('fpg_command_intf.pas');
T := P.Targets.AddUnit('fpg_main.pas');
+ T.Dependencies.AddInclude('VERSION_FILE.inc');
+ T.Dependencies.AddInclude('fpg_msgqueue.inc');
T := P.Targets.AddUnit('fpg_stringhashlist.pas');
T := P.Targets.AddUnit('fpg_widget.pas');
T := P.Targets.AddUnit('fpg_constants.pas');
+ T.Dependencies.AddInclude('lang_en.inc');
+ T.Dependencies.AddInclude('lang_af.inc');
+ T.Dependencies.AddInclude('lang_de.inc');
+ T.Dependencies.AddInclude('lang_es.inc');
+ T.Dependencies.AddInclude('lang_fr.inc');
+ T.Dependencies.AddInclude('lang_it.inc');
+ T.Dependencies.AddInclude('lang_pt.inc');
+ T.Dependencies.AddInclude('lang_ru.inc');
T.ResourceStrings := True;
- T := P.Targets.AddUnit('fpg_strings.pas');
+// T := P.Targets.AddUnit('fpg_strings.pas'); // this unit is not used in fpGUI
T := P.Targets.AddUnit('fpg_wuline.pas');
T := P.Targets.AddUnit('fpg_extinterpolation.pas');
T := P.Targets.AddUnit('fpg_pofiles.pas');
T := P.Targets.AddUnit('fpg_stringutils.pas');
+ T := P.Targets.AddUnit('fpg_extgraphics.pas');
+
+
+ { corelib/x11 }
+ T := P.Targets.AddUnit('fpg_keyconv_x11.pas', AllUnixOSes);
+ T := P.Targets.AddUnit('fpg_netlayer_x11.pas', AllUnixOSes);
+ T := P.Targets.AddUnit('fpg_xft_x11.pas', AllUnixOSes);
+ T := P.Targets.AddUnit('fpg_impl.pas', AllUnixOSes);
+ T := P.Targets.AddUnit('fpg_x11.pas', AllUnixOSes);
+ T.Dependencies.AddUnit('fpg_xft_x11');
+ T.Dependencies.AddUnit('fpg_netlayer_x11');
+ T.Dependencies.AddUnit('fpg_base');
+ T.Dependencies.AddUnit('fpg_impl');
+ T := P.Targets.AddUnit('fpg_interface.pas', AllUnixOSes);
+
+
+ { corelib/gdi }
+ T := P.Targets.AddUnit('fpg_impl.pas', AllWindowsOSes);
+ T := P.Targets.AddUnit('fpg_gdi.pas', AllWindowsOSes);
+ T.Dependencies.AddInclude('fpg_keys_gdi.inc', AllWindowsOSes);
+ T := P.Targets.AddUnit('fpg_interface.pas', AllWindowsOSes);
- { corelib include files }
-// T := P.Sources.AddSrc('keys.inc');
{ gui/db }
T := P.Targets.AddUnit('fpgui_db.pas');
@@ -169,6 +190,14 @@ begin
T := P.Targets.AddUnit('fpg_trackbar.pas');
T := P.Targets.AddUnit('fpg_button.pas');
T := P.Targets.AddUnit('fpg_dialogs.pas');
+ T.Dependencies.AddInclude('charmapdialog.inc');
+ T.Dependencies.AddInclude('colordialog.inc');
+ T.Dependencies.AddInclude('inputquerydialog.inc');
+ T.Dependencies.AddInclude('messagedialog.inc');
+ T.Dependencies.AddInclude('newdirdialog.inc');
+ T.Dependencies.AddInclude('promptuserdialog.inc');
+ T.Dependencies.AddInclude('selectdirdialog.inc');
+ T.Dependencies.AddInclude('logo.inc');
T := P.Targets.AddUnit('fpg_gauge.pas');
T := P.Targets.AddUnit('fpg_iniutils.pas');
T := P.Targets.AddUnit('fpg_memo.pas');
@@ -182,6 +211,10 @@ begin
T := P.Targets.AddUnit('fpg_menu.pas');
T := P.Targets.AddUnit('fpg_progressbar.pas');
T := P.Targets.AddUnit('fpg_style.pas');
+ T := P.Targets.AddUnit('fpg_spinedit.pas');
+ T := P.Targets.AddUnit('fpg_colorwheel.pas');
+ T := P.Targets.AddUnit('fpg_colormapping.pas');
+ T := P.Targets.AddUnit('fpg_editbtn.pas');
Run;
end;
diff --git a/src/gui/fpg_form.pas b/src/gui/fpg_form.pas
index 57c156a6..19f8c3e6 100644
--- a/src/gui/fpg_form.pas
+++ b/src/gui/fpg_form.pas
@@ -153,7 +153,11 @@ implementation
uses
fpg_main,
fpg_popupwindow,
- fpg_menu;
+ fpg_menu
+ {$IFDEF DEBUG}
+ ,dbugintf
+ {$ENDIF}
+ ;
type
// to access protected methods
@@ -188,9 +192,14 @@ end;
procedure TfpgBaseForm.MsgActivate(var msg: TfpgMessageRec);
begin
-// writeln('BaseForm - MsgActivate');
+ {$IFDEF DEBUG}
+ SendDebug(Classname + ' ' + Name + '.BaseForm - MsgActivate');
+ {$ENDIF}
if (fpgApplication.TopModalForm = nil) or (fpgApplication.TopModalForm = self) then
begin
+ {$IFDEF DEBUG}
+ SendDebug('Inside if block');
+ {$ENDIF}
FocusRootWidget := self;
if FFormDesigner <> nil then
@@ -386,7 +395,9 @@ var
i: integer;
wg: TfpgWidget;
begin
-// writeln(Classname, '.Keypress');
+ {$IFDEF DEBUG}
+ SendDebug(Classname + '.Keypress');
+ {$ENDIF}
// find the TfpgMenuBar
if not consumed then
begin
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-16 21:37:12 +0000