mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-17 22:41:42 +02:00
fixed hint size and activate
git-svn-id: trunk@6851 -
This commit is contained in:
mattias
parent
0c22e95d2a
commit
75695b098e
@ -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;
|
||||
|
||||
@ -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,9 +919,10 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TApplication.HideHint;
|
||||
begin
|
||||
if FHintWindow<>nil then
|
||||
if FHintWindow<>nil then begin
|
||||
FHintWindow.Visible:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TApplication Run
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
end;
|
||||
|
||||
procedure TCustomPropertyStorage.WriteInteger(const Ident: string; Value: Longint);
|
||||
begin
|
||||
StorageNeeded(False);
|
||||
try
|
||||
DoReadInteger(RootSection, Ident, Value);
|
||||
finally
|
||||
FreeStorage;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCustomPropertyStorage.EraseSections;
|
||||
|
||||
begin
|
||||
StorageNeeded(False);
|
||||
try
|
||||
DoEraseSections(RootSection);
|
||||
finally
|
||||
FreeStorage;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomPropertyStorage.SetStoredValues(Value: TStoredValues);
|
||||
|
||||
@ -118,10 +118,10 @@ begin
|
||||
{$else}
|
||||
Result:=ChangeFileExt(Application.ExeName,'.xml');
|
||||
{$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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user