From 75695b098ec0920b74d59b44167b70f573d41ed7 Mon Sep 17 00:00:00 2001 From: mattias Date: Sat, 26 Feb 2005 20:26:03 +0000 Subject: [PATCH] fixed hint size and activate git-svn-id: trunk@6851 - --- lcl/forms.pp | 6 +++++- lcl/include/application.inc | 31 ++++++++++++++++++------------- lcl/include/hintwindow.inc | 22 ++++++++++++++-------- lcl/propertystorage.pas | 23 +++-------------------- lcl/xmlpropstorage.pas | 14 +++++++------- 5 files changed, 47 insertions(+), 49 deletions(-) diff --git a/lcl/forms.pp b/lcl/forms.pp index bb114c4c18..c36550b241 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -653,7 +653,8 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; 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; public property AutoHide : Boolean read FAutoHide write SetAutoHide; @@ -872,6 +873,7 @@ type FHintColor: TColor; FHintControl: TControl; FHintHidePause: Integer; + FHintHidePausePerChar: Integer; FHintPause: Integer; FHintShortCuts: Boolean; FHintShortPause: Integer; @@ -1003,6 +1005,7 @@ type property Hint: string read FHint write SetHint; property HintColor: TColor read FHintColor write SetHintColor; property HintHidePause: Integer read FHintHidePause write FHintHidePause; + property HintHidePausePerChar: Integer read FHintHidePausePerChar write FHintHidePausePerChar; property HintPause: Integer read FHintPause write FHintPause; property HintShortCuts: Boolean read FHintShortCuts write FHintShortCuts; property HintShortPause: Integer read FHintShortPause write FHintShortPause; @@ -1426,6 +1429,7 @@ end; procedure FreeInterfaceObject; begin + //debugln('FreeInterfaceObject'); Application.Free; Application:=nil; FreeAllClipBoards; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index 2f0c5633d1..240aa03201 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -22,7 +22,8 @@ const DefHintColor = clInfoBk; { default hint window color } DefHintPause = 500; { default pause before hint window displays (ms) } 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; begin @@ -82,6 +83,7 @@ begin FHintShortCuts := True; FHintShortPause := DefHintShortPause; FHintHidePause := DefHintHidePause; + FHintHidePausePerChar := DefHintHidePausePerChar; FShowHint := true; FFormList := nil; FOnIdle := nil; @@ -514,9 +516,9 @@ var Info: THintInfoAtMouse; begin Info:=GetHintInfoAtMouse; - //DebugLn'TApplication.DoOnMouseMove Info.ControlHasHint=',Info.ControlHasHint,' Type=',ord(FHintTimerType)); - if FHintControl <> Info.Control then - begin + //DebugLn('TApplication.DoOnMouseMove Info.ControlHasHint=',dbgs(Info.ControlHasHint),' Type=',dbgs(ord(FHintTimerType)),' FHintControl=',DbgSName(FHintControl),' Info.Control=',DbgSName(Info.Control)); + if (FHintControl <> Info.Control) or (not (FHintTimerType in [ahtShowHint])) + then begin if Info.ControlHasHint then begin FHintControl := Info.Control; @@ -570,15 +572,13 @@ begin ParentOrigin.Y := 0; if FHintControl.Parent <> nil then 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, ParentOrigin.Y - ClientOrigin.Y); HintInfo.CursorPos := FHintControl.ScreenToClient(Info.MousePos); HintInfo.HintStr := GetShortHint(Info.Control.Hint); HintInfo.ReshowTimeout := 0; - HintInfo.HideTimeout := FHintHidePause; + HintInfo.HideTimeout := FHintHidePause + +FHintHidePausePerChar*length(HintInfo.HintStr); HintInfo.HintWindowClass := HintWindowClass; HintInfo.HintData := nil; CanShow := FHintControl.Perform(CM_HINTSHOW, 0, LParam(@HintInfo)) = 0; @@ -599,9 +599,9 @@ begin 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; - { 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 HintWinRect := FHintWindow.CalcHintRect(HintMaxWidth, HintStr, HintData); OffsetRect(HintWinRect, HintInfo.HintPos.X, HintInfo.HintPos.Y); @@ -612,7 +612,7 @@ begin Dec(Right, FHintWindow.Canvas.TextWidth(HintInfo.HintStr) + 5); end;} - { Convert the client's rect to screen coordinates } + // Convert the client's rect to screen coordinates {with HintInfo do begin FHintCursorRect.TopLeft := @@ -638,6 +638,7 @@ end; procedure TApplication.StartHintTimer(Interval: integer; TimerType: TAppHintTimerType); begin + //debugln('TApplication.StartHintTimer ',dbgs(Interval)); StopHintTimer; FHintTimerType:=TimerType; if Interval>0 then begin @@ -906,7 +907,7 @@ begin HideHint; if FHintControl <> nil then begin - //FHintControl := nil; + FHintControl := nil; //FHintActive := False; //UnhookHintHooks; //StopHintTimer; @@ -918,8 +919,9 @@ end; ------------------------------------------------------------------------------} procedure TApplication.HideHint; begin - if FHintWindow<>nil then + if FHintWindow<>nil then begin FHintWindow.Visible:=false; + end; end; {------------------------------------------------------------------------------ @@ -1407,6 +1409,9 @@ end; { ============================================================================= $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 added navigation key check for up/down already handled diff --git a/lcl/include/hintwindow.inc b/lcl/include/hintwindow.inc index 6a6fa69281..0d7b06ad5c 100644 --- a/lcl/include/hintwindow.inc +++ b/lcl/include/hintwindow.inc @@ -23,6 +23,8 @@ } +const HintBorderWidth=2; + constructor THintWindow.Create(AOwner: TComponent); var TheTimer: TCustomTimer; @@ -34,7 +36,7 @@ begin Canvas.Font := Screen.HintFont; BorderStyle := bsNone; Caption := 'THintWindow'; - SetBounds(1,1,25,25); + SetInitialBounds(1,1,25,25); FHideInterval := 3000; TheTimer := TCustomTimer.Create(self); FAutoHideTimer := TheTimer; @@ -75,13 +77,16 @@ End; procedure THintWindow.Paint; var - Rect: TRect; + ARect: TRect; TS : TTextStyle; begin - Rect := ClientRect; + ARect := ClientRect; Canvas.Brush.Color := Color; 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 begin Alignment := taCenter; @@ -91,10 +96,10 @@ begin ExpandTabs := true; ShowPrefix := false; WordBreak := true; - Opaque := true; + Opaque := false; SystemFont := false; end; - Canvas.TextRect(Rect, Rect.Left, Rect.Top, Caption, TS); + Canvas.TextRect(ARect, ARect.Left, ARect.Top, Caption, TS); end; procedure THintWindow.ActivateHint(ARect: TRect; const AHint: String); @@ -132,8 +137,9 @@ begin if AHint='' then exit; DrawText(Canvas.GetUpdatedHandle([csFontValid]), PChar(AHint), Length(AHint), Result, DT_CalcRect or DT_NOPREFIX); - InflateRect(Result, 2, 2); - Inc(Result.Right, 3); + inc(Result.Right,4*HintBorderWidth); + inc(Result.Bottom,4*HintBorderWidth); + //debugln('THintWindow.CalcHintRect Result=',dbgs(Result)); end; procedure THintWindow.ReleaseHandle; diff --git a/lcl/propertystorage.pas b/lcl/propertystorage.pas index 91ba6b4903..62e90ccec5 100644 --- a/lcl/propertystorage.pas +++ b/lcl/propertystorage.pas @@ -697,34 +697,17 @@ end; function TCustomPropertyStorage.ReadInteger(const Ident: string; Default: Longint): Longint; begin - StorageNeeded(True); - try - Result := DoReadInteger(RootSection, Ident, Default); - finally - FreeStorage; - end; + Result := DoReadInteger(RootSection, Ident, Default); end; procedure TCustomPropertyStorage.WriteInteger(const Ident: string; Value: Longint); begin - StorageNeeded(False); - try - DoReadInteger(RootSection, Ident, Value); - finally - FreeStorage; - end; + DoReadInteger(RootSection, Ident, Value); end; - procedure TCustomPropertyStorage.EraseSections; - begin - StorageNeeded(False); - try - DoEraseSections(RootSection); - finally - FreeStorage; - end; + DoEraseSections(RootSection); end; procedure TCustomPropertyStorage.SetStoredValues(Value: TStoredValues); diff --git a/lcl/xmlpropstorage.pas b/lcl/xmlpropstorage.pas index 478606a160..ab213fe758 100644 --- a/lcl/xmlpropstorage.pas +++ b/lcl/xmlpropstorage.pas @@ -111,17 +111,17 @@ begin if (FFileName<>'') then Result:=FFIleName else -{$ifdef unix} + {$ifdef unix} Result:=IncludeTrailingPathDelimiter(GetEnvironmentVariable('HOME')) +'.'+ExtractFileName(Application.ExeName); -{$else} + {$else} Result:=ChangeFileExt(Application.ExeName,'.xml'); -{$endif} + {$endif} + //debugln('TCustomXMLPropStorage.GetXMLFileName "',Result,'"'); end; function TCustomXMLPropStorage.FixPath(const APath: String): String; - begin Result:=StringReplace(APath,'.','/',[rfReplaceAll]); end; @@ -139,25 +139,25 @@ function TCustomXMLPropStorage.DoReadString(const Section, Ident, TheDefault: string): string; begin 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; procedure TCustomXMLPropStorage.DoWriteString(const Section, Ident, Value: string); 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); end; procedure TCustomXMLPropStorage.DoEraseSections(const ARootSection: String); begin + //debugln('TCustomXMLPropStorage.DoEraseSections ARootSection="',ARootSection,'"'); FXML.DeleteSubNodes(FixPath(ARootSection)); end; { TPropStorageXMLConfig } procedure TPropStorageXMLConfig.DeleteSubNodes(const ARootNode: String); - var Node, Child: TDOMNode; i: Integer;