summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/hintwindow/edittest.lpi2
-rw-r--r--src/corelib/fpgfx.pas9
-rw-r--r--src/corelib/gfx_widget.pas60
-rw-r--r--src/gui/gui_edit.pas23
-rw-r--r--src/gui/messagedialog.inc2
5 files changed, 65 insertions, 31 deletions
diff --git a/examples/gui/hintwindow/edittest.lpi b/examples/gui/hintwindow/edittest.lpi
index e26ec9bc..51bbf198 100644
--- a/examples/gui/hintwindow/edittest.lpi
+++ b/examples/gui/hintwindow/edittest.lpi
@@ -39,7 +39,7 @@
</Units>
</ProjectOptions>
<CompilerOptions>
- <Version Value="5"/>
+ <Version Value="8"/>
<Other>
<CustomOptions Value="-FUunits"/>
<CompilerPath Value="$(CompPath)"/>
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index 934ffe4b..0aa582f3 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -199,6 +199,7 @@ type
TfpgApplication = class(TfpgApplicationImpl)
private
FHintPause: Integer;
+ FShowHint: boolean;
FOnException: TExceptionEvent;
FStopOnException: Boolean;
FHintWindow: TfpgWindow;
@@ -236,6 +237,7 @@ type
property HintWindow: TfpgWindow read FHintWindow;
property ScreenWidth: integer read FScreenWidth;
property ScreenHeight: integer read FScreenHeight;
+ property ShowHint: boolean read FShowHint write FShowHint default True;
property StopOnException: Boolean read FStopOnException write FStopOnException;
property OnException: TExceptionEvent read FOnException write FOnException;
end;
@@ -597,6 +599,7 @@ var
i: integer;
s: string;
begin
+ s := '';
for i := 0 to iCallTrace+1 do
s := s + ' ';
writeln(s + AMessage);
@@ -788,6 +791,7 @@ begin
FStopOnException := False;
FHintWindow := nil;
FHintPause := 1500; // 1.5 seconds
+ FShowHint := True;
try
inherited Create(AParams);
@@ -808,7 +812,6 @@ end;
destructor TfpgApplication.Destroy;
var
i: integer;
- frm: TfpgWindowBase;
begin
if Assigned(FHintWindow) then
begin
@@ -1458,11 +1461,9 @@ end;
procedure TfpgStyle.DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags);
var
r: TfpgRect;
- lDoDraw: Boolean;
begin
r.SetRect(x, y, w, h);
- lDoDraw := False;
-
+
if btfIsDefault in AFlags then
begin
ACanvas.SetColor(clBlack);
diff --git a/src/corelib/gfx_widget.pas b/src/corelib/gfx_widget.pas
index a31815de..898d171c 100644
--- a/src/corelib/gfx_widget.pas
+++ b/src/corelib/gfx_widget.pas
@@ -61,15 +61,20 @@ type
FAlign: TAlign;
FHint: string;
FShowHint: boolean;
+ FParentShowHint: boolean;
+ FHintTimer: TfpgTimer;
FBackgroundColor: TfpgColor;
FTextColor: TfpgColor;
FIsContainer: Boolean;
+ FMousePoint: TPoint;
procedure SetBackgroundColor(const AValue: TfpgColor); virtual;
procedure SetTextColor(const AValue: TfpgColor); virtual;
function GetParent: TfpgWidget; reintroduce;
procedure SetParent(const AValue: TfpgWidget); reintroduce;
procedure SetEnabled(const AValue: boolean); virtual;
procedure SetVisible(const AValue: boolean); virtual;
+ procedure SetShowHint(const AValue: boolean); virtual;
+ procedure SetParentShowHint(const AValue: boolean); virtual;
procedure DoUpdateWindowPosition; override;
procedure DoAlign(AAlign: TAlign);
procedure DoResize;
@@ -95,6 +100,7 @@ type
procedure HandleHide; virtual;
procedure MoveAndResize(ALeft, ATop, AWidth, AHeight: TfpgCoord);
procedure RePaint;
+ procedure HintTimerFired(Sender: TObject);
{ property events }
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDoubleClick: TMouseButtonEvent read FOnDoubleClick write FOnDoubleClick;
@@ -132,7 +138,8 @@ type
property Anchors: TAnchors read FAnchors write FAnchors;
property Align: TAlign read FAlign write FAlign;
property Hint: string read FHint write FHint;
- property ShowHint: boolean read FShowHint write FShowHint default False;
+ property ShowHint: boolean read FShowHint write SetShowHint default False;
+ property ParentShowHint: boolean read FParentShowHint write SetParentShowHint default True;
property BackgroundColor: TfpgColor read FBackgroundColor write SetBackgroundColor default clWindowBackground;
property TextColor: TfpgColor read FTextColor write SetTextColor default clText1;
end;
@@ -208,6 +215,20 @@ begin
end;
end;
+procedure TfpgWidget.SetShowHint(const AValue: boolean);
+begin
+ if FShowHint <> AValue then
+ FShowHint := AValue;
+ if FShowHint then
+ FParentShowHint := False;
+end;
+
+procedure TfpgWidget.SetParentShowHint(const AValue: boolean);
+begin
+ if FParentShowHint <> AValue then
+ FParentShowHint := AValue;
+end;
+
procedure TfpgWidget.DoUpdateWindowPosition;
var
dw: integer;
@@ -298,9 +319,14 @@ begin
FAnchors := [anLeft, anTop];
FAlign := alNone;
FHint := '';
+ FShowHint := False;
+ FParentShowHint := True;
FBackgroundColor := clWindowBackground;
FTextColor := clText1;
+ FHintTimer := TfpgTimer.Create(fpgApplication.HintPause);
+ FHintTimer.OnTimer := @HintTimerFired;
+
if (AOwner <> nil) and (AOwner is TfpgWidget) then
begin
Parent := TfpgWidget(AOwner);
@@ -310,7 +336,10 @@ begin
Parent := nil;
if Parent <> nil then
+ begin
FWindowType := wtChild;
+ FShowHint := Parent.ShowHint;
+ end;
inherited Create(AOwner);
@@ -637,6 +666,12 @@ begin
fpgSendMessage(self, self, FPGM_PAINT);
end;
+procedure TfpgWidget.HintTimerFired(Sender: TObject);
+begin
+ fpgApplication.ActivateHint(WindowToScreen(Self, FMousePoint), FHint);
+ FHintTimer.Enabled := False;
+end;
+
procedure TfpgWidget.SetFocus;
begin
HandleSetFocus;
@@ -819,7 +854,21 @@ end;
procedure TfpgWidget.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState);
begin
- // do nothing yet
+ FMousePoint := Point(x+2, y+2);
+ if Assigned(Parent) then
+ begin
+ if fpgApplication.ShowHint and (FShowHint or (FParentShowHint and Parent.ShowHint)) and (FHint <> '') then
+ if FHintTimer.Enabled then
+ FHintTimer.Reset // keep reseting to prevent hint from showing
+ else
+ fpgApplication.HideHint;
+ end
+ else
+ if fpgApplication.ShowHint and FShowHint and (FHint <> '') then
+ if FHintTimer.Enabled then
+ FHintTimer.Reset // keep reseting to prevent hint from showing
+ else
+ fpgApplication.HideHint;
end;
procedure TfpgWidget.HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState);
@@ -832,7 +881,11 @@ begin
{$IFDEF DEBUG}
writeln('TfpgWidget.HandleMouseEnter: ' + ClassName);
{$ENDIF}
- // do nothing yet
+ if Assigned(Parent) then
+ FHintTimer.Enabled := Enabled and fpgApplication.ShowHint and (FShowHint or (FParentShowHint and Parent.ShowHint)) and (FHint <> '')
+ else
+ FHintTimer.Enabled := Enabled and fpgApplication.ShowHint and FShowHint and (FHint <> '');
+writeln('TfpgWidget.HandleMouseEnter: HintTimer.Enabled=', FHintTimer.Enabled);
end;
procedure TfpgWidget.HandleMouseExit;
@@ -840,6 +893,7 @@ begin
{$IFDEF DEBUG}
writeln('TfpgWidget.HandleMouseExit: ' + ClassName);
{$ENDIF}
+ FHintTimer.Enabled := False;
if FShowHint then
fpgApplication.HideHint;
end;
diff --git a/src/gui/gui_edit.pas b/src/gui/gui_edit.pas
index a00e06f0..09820955 100644
--- a/src/gui/gui_edit.pas
+++ b/src/gui/gui_edit.pas
@@ -65,7 +65,6 @@ type
procedure DefaultPopupPaste(Sender: TObject);
procedure DefaultPopupClearAll(Sender: TObject);
procedure SetDefaultPopupMenuItemsState;
- procedure HintTimerFired(Sender: TObject);
protected
FSideMargin: integer;
FMouseDragPos: integer;
@@ -78,8 +77,6 @@ type
FVisibleText: TfpgString;
FVisSelStartPx: integer;
FVisSelEndPx: integer;
- FHintTimer: TfpgTimer;
- FMousePoint: TPoint;
procedure DoOnChange; virtual;
procedure ShowDefaultPopupMenu(const x, y: integer; const shiftstate: TShiftState); virtual;
procedure HandlePaint; override;
@@ -877,16 +874,9 @@ procedure TfpgBaseEdit.HandleMouseMove(x, y: integer; btnstate: word; shiftstate
var
cp: integer;
begin
- FMousePoint := Point(x+2, y+2);
if (btnstate and MOUSE_LEFT) = 0 then // Left button not down
begin
- if FShowHint then
- begin
- if FHintTimer.Enabled then
- FHintTimer.Reset // keep reseting to prevent hint from showing
- else
- fpgApplication.HideHint;
- end;
+ inherited HandleMouseMove(x, y, btnstate, shiftstate);
Exit; //==>
end;
@@ -912,7 +902,6 @@ end;
procedure TfpgBaseEdit.HandleMouseEnter;
begin
- FHintTimer.Enabled := Enabled and FShowHint;
inherited HandleMouseEnter;
if (csDesigning in ComponentState) then
Exit;
@@ -922,7 +911,6 @@ end;
procedure TfpgBaseEdit.HandleMouseExit;
begin
- FHintTimer.Enabled := False;
inherited HandleMouseExit;
if (csDesigning in ComponentState) then
Exit;
@@ -976,8 +964,6 @@ begin
FDefaultPopupMenu := nil;
FOnChange := nil;
- FHintTimer := TfpgTimer.Create(fpgApplication.HintPause);
- FHintTimer.OnTimer := @HintTimerFired;
end;
destructor TfpgBaseEdit.Destroy;
@@ -1103,13 +1089,6 @@ begin
end;
end;
-procedure TfpgBaseEdit.HintTimerFired(Sender: TObject);
-begin
-// Writeln('TfpgBaseEdit.HintTimerFired');
- fpgApplication.ActivateHint(WindowToScreen(Self, FMousePoint), FHint);
- FHintTimer.Enabled := False;
-end;
-
procedure TfpgBaseEdit.DoOnChange;
begin
if Assigned(FOnChange) then
diff --git a/src/gui/messagedialog.inc b/src/gui/messagedialog.inc
index d72a3de6..da0f453d 100644
--- a/src/gui/messagedialog.inc
+++ b/src/gui/messagedialog.inc
@@ -395,7 +395,7 @@ begin
dlg.WindowTitle := ATitle;
dlg.FDefaultButton := ADefaultButton;
dlg.PrepareLayout;
- dlg.ShowModal;
+ Result := TfpgMsgDlgBtn(dlg.ShowModal);
finally
dlg.Free;
end;
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-17 02:29:39 +0000