paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-12 02:20:43 +01:00
Code Issues Packages Projects Releases Wiki Activity

fixed hint size and activate

Browse Source 
git-svn-id: trunk@6851 -
This commit is contained in:
mattias 2005-02-26 20:26:03 +00:00
parent 0c22e95d2a
commit 75695b098e
5 changed files with 47 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/forms.pp
View File

@ -653,7 +653,8 @@ type
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
procedure ActivateHint(ARect: TRect; const AHint: String); virtual; procedure ActivateHint(ARect: TRect; const AHint: String); virtual;
function CalcHintRect(MaxWidth: Integer; const AHint: String; AData: Pointer): TRect; virtual; function CalcHintRect(MaxWidth: Integer; const AHint: String;
AData: Pointer): TRect; virtual;
procedure ReleaseHandle; procedure ReleaseHandle;
public public
property AutoHide : Boolean read FAutoHide write SetAutoHide; property AutoHide : Boolean read FAutoHide write SetAutoHide;
@ -872,6 +873,7 @@ type
FHintColor: TColor; FHintColor: TColor;
FHintControl: TControl; FHintControl: TControl;
FHintHidePause: Integer; FHintHidePause: Integer;
FHintHidePausePerChar: Integer;
FHintPause: Integer; FHintPause: Integer;
FHintShortCuts: Boolean; FHintShortCuts: Boolean;
FHintShortPause: Integer; FHintShortPause: Integer;
@ -1003,6 +1005,7 @@ type
property Hint: string read FHint write SetHint; property Hint: string read FHint write SetHint;
property HintColor: TColor read FHintColor write SetHintColor; property HintColor: TColor read FHintColor write SetHintColor;
property HintHidePause: Integer read FHintHidePause write FHintHidePause; property HintHidePause: Integer read FHintHidePause write FHintHidePause;
property HintHidePausePerChar: Integer read FHintHidePausePerChar write FHintHidePausePerChar;
property HintPause: Integer read FHintPause write FHintPause; property HintPause: Integer read FHintPause write FHintPause;
property HintShortCuts: Boolean read FHintShortCuts write FHintShortCuts; property HintShortCuts: Boolean read FHintShortCuts write FHintShortCuts;
property HintShortPause: Integer read FHintShortPause write FHintShortPause; property HintShortPause: Integer read FHintShortPause write FHintShortPause;
@ -1426,6 +1429,7 @@ end;
procedure FreeInterfaceObject; procedure FreeInterfaceObject;
begin begin
//debugln('FreeInterfaceObject');
Application.Free; Application.Free;
Application:=nil; Application:=nil;
FreeAllClipBoards; FreeAllClipBoards;

31
lcl/include/application.inc
View File

@ -22,7 +22,8 @@ const
DefHintColor = clInfoBk; { default hint window color } DefHintColor = clInfoBk; { default hint window color }
DefHintPause = 500; { default pause before hint window displays (ms) } DefHintPause = 500; { default pause before hint window displays (ms) }
DefHintShortPause = 0; { default reshow pause } DefHintShortPause = 0; { default reshow pause }
DefHintHidePause = DefHintPause * 5; { default pause before hint is hidden } DefHintHidePause = 5*DefHintPause; { default pause before hint is hidden (ms) }
DefHintHidePausePerChar = 100; { added to DefHintHidePause (ms) }
function FindApplicationComponent(const ComponentName: string): TComponent; function FindApplicationComponent(const ComponentName: string): TComponent;
begin begin
@ -82,6 +83,7 @@ begin
FHintShortCuts := True; FHintShortCuts := True;
FHintShortPause := DefHintShortPause; FHintShortPause := DefHintShortPause;
FHintHidePause := DefHintHidePause; FHintHidePause := DefHintHidePause;
FHintHidePausePerChar := DefHintHidePausePerChar;
FShowHint := true; FShowHint := true;
FFormList := nil; FFormList := nil;
FOnIdle := nil; FOnIdle := nil;
@ -514,9 +516,9 @@ var
Info: THintInfoAtMouse; Info: THintInfoAtMouse;
begin begin
Info:=GetHintInfoAtMouse; Info:=GetHintInfoAtMouse;
//DebugLn'TApplication.DoOnMouseMove Info.ControlHasHint=',Info.ControlHasHint,' Type=',ord(FHintTimerType)); //DebugLn('TApplication.DoOnMouseMove Info.ControlHasHint=',dbgs(Info.ControlHasHint),' Type=',dbgs(ord(FHintTimerType)),' FHintControl=',DbgSName(FHintControl),' Info.Control=',DbgSName(Info.Control));
if FHintControl <> Info.Control then if (FHintControl <> Info.Control) or (not (FHintTimerType in [ahtShowHint]))
begin then begin
if Info.ControlHasHint then if Info.ControlHasHint then
begin begin
FHintControl := Info.Control; FHintControl := Info.Control;
@ -570,15 +572,13 @@ begin
ParentOrigin.Y := 0; ParentOrigin.Y := 0;
if FHintControl.Parent <> nil then if FHintControl.Parent <> nil then
ParentOrigin := FHintControl.Parent.ClientOrigin; ParentOrigin := FHintControl.Parent.ClientOrigin;
{else if (FHintControl is TWinControl) and
(TWinControl(FHintControl).ParentWindow <> 0) then
Windows.ClientToScreen(TWinControl(FHintControl).ParentWindow, ParentOrigin);}
OffsetRect(HintInfo.CursorRect, ParentOrigin.X - ClientOrigin.X, OffsetRect(HintInfo.CursorRect, ParentOrigin.X - ClientOrigin.X,
ParentOrigin.Y - ClientOrigin.Y); ParentOrigin.Y - ClientOrigin.Y);
HintInfo.CursorPos := FHintControl.ScreenToClient(Info.MousePos); HintInfo.CursorPos := FHintControl.ScreenToClient(Info.MousePos);
HintInfo.HintStr := GetShortHint(Info.Control.Hint); HintInfo.HintStr := GetShortHint(Info.Control.Hint);
HintInfo.ReshowTimeout := 0; HintInfo.ReshowTimeout := 0;
HintInfo.HideTimeout := FHintHidePause; HintInfo.HideTimeout := FHintHidePause
+FHintHidePausePerChar*length(HintInfo.HintStr);
HintInfo.HintWindowClass := HintWindowClass; HintInfo.HintWindowClass := HintWindowClass;
HintInfo.HintData := nil; HintInfo.HintData := nil;
CanShow := FHintControl.Perform(CM_HINTSHOW, 0, LParam(@HintInfo)) = 0; CanShow := FHintControl.Perform(CM_HINTSHOW, 0, LParam(@HintInfo)) = 0;
@ -599,9 +599,9 @@ begin
end; end;
end; end;
{ make the hint have the same BiDiMode as the activating control } // make the hint have the same BiDiMode as the activating control
//FHintWindow.BiDiMode := FHintControl.BiDiMode; //FHintWindow.BiDiMode := FHintControl.BiDiMode;
{ calculate the width of the hint based on HintStr and MaxWidth } // calculate the width of the hint based on HintStr and MaxWidth
with HintInfo do with HintInfo do
HintWinRect := FHintWindow.CalcHintRect(HintMaxWidth, HintStr, HintData); HintWinRect := FHintWindow.CalcHintRect(HintMaxWidth, HintStr, HintData);
OffsetRect(HintWinRect, HintInfo.HintPos.X, HintInfo.HintPos.Y); OffsetRect(HintWinRect, HintInfo.HintPos.X, HintInfo.HintPos.Y);
@ -612,7 +612,7 @@ begin
Dec(Right, FHintWindow.Canvas.TextWidth(HintInfo.HintStr) + 5); Dec(Right, FHintWindow.Canvas.TextWidth(HintInfo.HintStr) + 5);
end;} end;}
{ Convert the client's rect to screen coordinates } // Convert the client's rect to screen coordinates
{with HintInfo do {with HintInfo do
begin begin
FHintCursorRect.TopLeft := FHintCursorRect.TopLeft :=
@ -638,6 +638,7 @@ end;
procedure TApplication.StartHintTimer(Interval: integer; procedure TApplication.StartHintTimer(Interval: integer;
TimerType: TAppHintTimerType); TimerType: TAppHintTimerType);
begin begin
//debugln('TApplication.StartHintTimer ',dbgs(Interval));
StopHintTimer; StopHintTimer;
FHintTimerType:=TimerType; FHintTimerType:=TimerType;
if Interval>0 then begin if Interval>0 then begin
@ -906,7 +907,7 @@ begin
HideHint; HideHint;
if FHintControl <> nil then if FHintControl <> nil then
begin begin
//FHintControl := nil; FHintControl := nil;
//FHintActive := False; //FHintActive := False;
//UnhookHintHooks; //UnhookHintHooks;
//StopHintTimer; //StopHintTimer;
@ -918,8 +919,9 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TApplication.HideHint; procedure TApplication.HideHint;
begin begin
if FHintWindow<>nil then if FHintWindow<>nil then begin
FHintWindow.Visible:=false; FHintWindow.Visible:=false;
end;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1407,6 +1409,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.103 2005/02/26 20:26:03 mattias
fixed hint size and activate
Revision 1.102 2005/02/21 13:54:26 mattias Revision 1.102 2005/02/21 13:54:26 mattias
added navigation key check for up/down already handled added navigation key check for up/down already handled

22
lcl/include/hintwindow.inc
View File

@ -23,6 +23,8 @@
} }
const HintBorderWidth=2;
constructor THintWindow.Create(AOwner: TComponent); constructor THintWindow.Create(AOwner: TComponent);
var var
TheTimer: TCustomTimer; TheTimer: TCustomTimer;
@ -34,7 +36,7 @@ begin
Canvas.Font := Screen.HintFont; Canvas.Font := Screen.HintFont;
BorderStyle := bsNone; BorderStyle := bsNone;
Caption := 'THintWindow'; Caption := 'THintWindow';
SetBounds(1,1,25,25); SetInitialBounds(1,1,25,25);
FHideInterval := 3000; FHideInterval := 3000;
TheTimer := TCustomTimer.Create(self); TheTimer := TCustomTimer.Create(self);
FAutoHideTimer := TheTimer; FAutoHideTimer := TheTimer;
@ -75,13 +77,16 @@ End;
procedure THintWindow.Paint; procedure THintWindow.Paint;
var var
Rect: TRect; ARect: TRect;
TS : TTextStyle; TS : TTextStyle;
begin begin
Rect := ClientRect; ARect := ClientRect;
Canvas.Brush.Color := Color; Canvas.Brush.Color := Color;
Canvas.Pen.Width := 1; Canvas.Pen.Width := 1;
DrawEdge(Canvas.Handle, Rect, BDR_RAISEDOUTER, BF_RECT); //debugln('THintWindow.Paint A ',dbgs(ARect));
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT);
InflateRect(ARect,-2*HintBorderWidth,-2*HintBorderWidth);
//debugln('THintWindow.Paint B ',dbgs(ARect));
with TS do with TS do
begin begin
Alignment := taCenter; Alignment := taCenter;
@ -91,10 +96,10 @@ begin
ExpandTabs := true; ExpandTabs := true;
ShowPrefix := false; ShowPrefix := false;
WordBreak := true; WordBreak := true;
Opaque := true; Opaque := false;
SystemFont := false; SystemFont := false;
end; end;
Canvas.TextRect(Rect, Rect.Left, Rect.Top, Caption, TS); Canvas.TextRect(ARect, ARect.Left, ARect.Top, Caption, TS);
end; end;
procedure THintWindow.ActivateHint(ARect: TRect; const AHint: String); procedure THintWindow.ActivateHint(ARect: TRect; const AHint: String);
@ -132,8 +137,9 @@ begin
if AHint='' then exit; if AHint='' then exit;
DrawText(Canvas.GetUpdatedHandle([csFontValid]), PChar(AHint), Length(AHint), DrawText(Canvas.GetUpdatedHandle([csFontValid]), PChar(AHint), Length(AHint),
Result, DT_CalcRect or DT_NOPREFIX); Result, DT_CalcRect or DT_NOPREFIX);
InflateRect(Result, 2, 2); inc(Result.Right,4*HintBorderWidth);
Inc(Result.Right, 3); inc(Result.Bottom,4*HintBorderWidth);
//debugln('THintWindow.CalcHintRect Result=',dbgs(Result));
end; end;
procedure THintWindow.ReleaseHandle; procedure THintWindow.ReleaseHandle;

23
lcl/propertystorage.pas
View File

@ -697,34 +697,17 @@ end;
function TCustomPropertyStorage.ReadInteger(const Ident: string; Default: Longint): Longint; function TCustomPropertyStorage.ReadInteger(const Ident: string; Default: Longint): Longint;
begin begin
StorageNeeded(True); Result := DoReadInteger(RootSection, Ident, Default);
try
Result := DoReadInteger(RootSection, Ident, Default);
finally
FreeStorage;
end;
end; end;
procedure TCustomPropertyStorage.WriteInteger(const Ident: string; Value: Longint); procedure TCustomPropertyStorage.WriteInteger(const Ident: string; Value: Longint);
begin begin
StorageNeeded(False); DoReadInteger(RootSection, Ident, Value);
try
DoReadInteger(RootSection, Ident, Value);
finally
FreeStorage;
end;
end; end;
procedure TCustomPropertyStorage.EraseSections; procedure TCustomPropertyStorage.EraseSections;
begin begin
StorageNeeded(False); DoEraseSections(RootSection);
try
DoEraseSections(RootSection);
finally
FreeStorage;
end;
end; end;
procedure TCustomPropertyStorage.SetStoredValues(Value: TStoredValues); procedure TCustomPropertyStorage.SetStoredValues(Value: TStoredValues);

14
lcl/xmlpropstorage.pas
View File

@ -111,17 +111,17 @@ begin
if (FFileName<>'') then if (FFileName<>'') then
Result:=FFIleName Result:=FFIleName
else else
{$ifdef unix} {$ifdef unix}
Result:=IncludeTrailingPathDelimiter(GetEnvironmentVariable('HOME')) Result:=IncludeTrailingPathDelimiter(GetEnvironmentVariable('HOME'))
+'.'+ExtractFileName(Application.ExeName); +'.'+ExtractFileName(Application.ExeName);
{$else} {$else}
Result:=ChangeFileExt(Application.ExeName,'.xml'); Result:=ChangeFileExt(Application.ExeName,'.xml');
{$endif} {$endif}
//debugln('TCustomXMLPropStorage.GetXMLFileName "',Result,'"');
end; end;
function TCustomXMLPropStorage.FixPath(const APath: String): String; function TCustomXMLPropStorage.FixPath(const APath: String): String;
begin begin
Result:=StringReplace(APath,'.','/',[rfReplaceAll]); Result:=StringReplace(APath,'.','/',[rfReplaceAll]);
end; end;
@ -139,25 +139,25 @@ function TCustomXMLPropStorage.DoReadString(const Section, Ident,
TheDefault: string): string; TheDefault: string): string;
begin begin
Result:=FXML.GetValue(FixPath(Section)+'/'+Ident, TheDefault); Result:=FXML.GetValue(FixPath(Section)+'/'+Ident, TheDefault);
//debugln('TCustomXMLPropStorage.DoReadString Section=',Section,' Ident=',Ident,' Result=',Result); //debugln('TCustomXMLPropStorage.DoReadString Section="',Section,'" Ident="',Ident,'" Result=',Result);
end; end;
procedure TCustomXMLPropStorage.DoWriteString(const Section, Ident, procedure TCustomXMLPropStorage.DoWriteString(const Section, Ident,
Value: string); Value: string);
begin begin
//debugln('TCustomXMLPropStorage.DoWriteString Section=',Section,' Ident=',Ident,' Value=',Value); //debugln('TCustomXMLPropStorage.DoWriteString Section="',Section,'" Ident="',Ident,'" Value="',Value,'"');
FXML.SetValue(FixPath(Section)+'/'+Ident, Value); FXML.SetValue(FixPath(Section)+'/'+Ident, Value);
end; end;
procedure TCustomXMLPropStorage.DoEraseSections(const ARootSection: String); procedure TCustomXMLPropStorage.DoEraseSections(const ARootSection: String);
begin begin
//debugln('TCustomXMLPropStorage.DoEraseSections ARootSection="',ARootSection,'"');
FXML.DeleteSubNodes(FixPath(ARootSection)); FXML.DeleteSubNodes(FixPath(ARootSection));
end; end;
{ TPropStorageXMLConfig } { TPropStorageXMLConfig }
procedure TPropStorageXMLConfig.DeleteSubNodes(const ARootNode: String); procedure TPropStorageXMLConfig.DeleteSubNodes(const ARootNode: String);
var var
Node, Child: TDOMNode; Node, Child: TDOMNode;
i: Integer; i: Integer;