mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-16 05:20:36 +01:00
hint fixes: parentfont, font itself, showing/hiding + more
git-svn-id: trunk@4884 -
This commit is contained in:
micha
parent
364db38a4a
commit
56bdc23a6f
@ -23,7 +23,7 @@
|
||||
*****************************************************************************
|
||||
}
|
||||
unit Controls;
|
||||
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{off $DEFINE BUFFERED_WMPAINT}
|
||||
interface
|
||||
@ -180,7 +180,7 @@ type
|
||||
end;
|
||||
|
||||
TCMHitTest = TLMNCHitTest;
|
||||
|
||||
|
||||
TCMControlChange = record
|
||||
Msg : Cardinal;
|
||||
Control : TControl;
|
||||
@ -211,7 +211,7 @@ type
|
||||
const
|
||||
// Cursor constants
|
||||
crHigh = TCursor(0);
|
||||
|
||||
|
||||
crDefault = TCursor(0);
|
||||
crNone = TCursor(-1);
|
||||
crArrow = TCursor(-2);
|
||||
@ -235,7 +235,7 @@ const
|
||||
crHelp = TCursor(-20);
|
||||
crHandPoint = TCursor(-21);
|
||||
crSizeAll = TCursor(-22);
|
||||
|
||||
|
||||
crLow = TCursor(-22);
|
||||
|
||||
type
|
||||
@ -263,7 +263,7 @@ type
|
||||
csMenuEvents,
|
||||
csNoFocus);
|
||||
TControlStyle = set of TControlStyleType;
|
||||
|
||||
|
||||
const
|
||||
csMultiClicks = [csDoubleClicks,csTripleClicks,csQuadClicks];
|
||||
|
||||
@ -306,7 +306,7 @@ type
|
||||
|
||||
|
||||
{ TDragImageList }
|
||||
|
||||
|
||||
TDragImageList = class(TCustomImageList)
|
||||
end;
|
||||
|
||||
@ -314,7 +314,7 @@ type
|
||||
|
||||
TKeyEvent = procedure(Sender: TObject; var Key: Word; Shift:TShiftState) of Object;
|
||||
TKeyPressEvent = procedure(Sender: TObject; var Key: Char) of Object;
|
||||
|
||||
|
||||
TMouseEvent = Procedure(Sender : TOBject; Button: TMouseButton;
|
||||
Shift : TShiftState; X, Y: Integer) of object;
|
||||
TMouseMoveEvent = Procedure(Sender: TObject; Shift: TShiftState;
|
||||
@ -340,7 +340,7 @@ type
|
||||
TDragDropEvent = Procedure(Sender, Source: TObject; X,Y: Integer) of Object;
|
||||
TStartDragEvent = Procedure(Sender: TObject; DragObject: TDragObject) of Object;
|
||||
TEndDragEvent = Procedure(Sender, Target: TObject; X,Y: Integer) of Object;
|
||||
|
||||
|
||||
|
||||
PDragRec = ^TDragRec;
|
||||
TDragRec = record
|
||||
@ -408,8 +408,8 @@ type
|
||||
procedure Assign(Source: TDragObject); override;
|
||||
property Control: TControl read FControl write FControl;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TDragControlObject }
|
||||
|
||||
TDragControlObject = class(TBaseDragControlObject)
|
||||
@ -420,12 +420,12 @@ type
|
||||
procedure HideDragImage; override;
|
||||
procedure ShowDragImage; override;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TDragDockObject }
|
||||
|
||||
|
||||
TDragDockObject = class;
|
||||
|
||||
|
||||
TDockOrientation = (
|
||||
doNoOrient, // zone contains a TControl and no child zones.
|
||||
doHorizontal, // zone's children are stacked top-to-bottom.
|
||||
@ -492,7 +492,7 @@ type
|
||||
{ TSizeConstraints }
|
||||
|
||||
TConstraintSize = 0..MaxInt;
|
||||
|
||||
|
||||
TSizeConstraints = class(TPersistent)
|
||||
private
|
||||
FControl: TControl;
|
||||
@ -518,7 +518,7 @@ type
|
||||
property MinHeight: TConstraintSize read FMinHeight write SetMinHeight default 0;
|
||||
property MinWidth: TConstraintSize read FMinWidth write SetMinWidth default 0;
|
||||
end;
|
||||
|
||||
|
||||
TConstrainedResizeEvent = procedure(Sender : TObject;
|
||||
var MinWidth, MinHeight, MaxWidth, MaxHeight : TConstraintSize) of object;
|
||||
|
||||
@ -553,7 +553,7 @@ type
|
||||
|
||||
|
||||
{ TControl }
|
||||
|
||||
|
||||
TControlShowHintEvent = procedure(Sender: TObject; HintInfo: Pointer) of object;
|
||||
TContextPopupEvent = procedure(Sender: TObject; MousePos: TPoint; var Handled: Boolean) of object;
|
||||
|
||||
@ -732,6 +732,7 @@ type
|
||||
procedure CMMouseLeave(var Message :TLMessage); message CM_MouseLeave;
|
||||
procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW;
|
||||
procedure CMParentColorChanged(var Message : TLMessage); message CM_PARENTCOLORCHANGED;
|
||||
procedure CMParentShowHintChanged(var Message : TLMessage); message CM_PARENTSHOWHINTCHANGED;
|
||||
procedure CMVisibleChanged(var Message : TLMessage); message CM_VISIBLECHANGED;
|
||||
procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight : TConstraintSize); virtual;
|
||||
function GetPalette: HPalette; virtual;
|
||||
@ -1036,7 +1037,8 @@ type
|
||||
procedure PaintHandler(var TheMessage: TLMPaint);
|
||||
procedure PaintWindow(DC: HDC); virtual;
|
||||
procedure CreateBrush; virtual;
|
||||
procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
|
||||
procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
|
||||
procedure CMShowHintChanged(var Message: TLMessage); message CM_SHOWHINTCHANGED;
|
||||
procedure WMEraseBkgnd(var Message : TLMEraseBkgnd); message LM_ERASEBKGND;
|
||||
procedure WMNotify(var Message: TLMNotify); message LM_NOTIFY;
|
||||
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
|
||||
@ -1195,8 +1197,8 @@ type
|
||||
constructor Create(AOwner: TComponent);override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TGraphicControl }
|
||||
|
||||
TGraphicControl = class(TControl)
|
||||
@ -1227,10 +1229,10 @@ type
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ TImageList }
|
||||
|
||||
|
||||
TImageList = class(TDragImageList)
|
||||
published
|
||||
Property Height;
|
||||
@ -1297,7 +1299,7 @@ type
|
||||
TForEachZoneProc = procedure(Zone: TDockZone) of object;
|
||||
|
||||
TDockTreeClass = class of TDockTree;
|
||||
|
||||
|
||||
TDockTreeFlag = (
|
||||
dtfUpdateAllNeeded
|
||||
);
|
||||
@ -1430,7 +1432,7 @@ uses
|
||||
|
||||
var
|
||||
CaptureControl: TControl;
|
||||
|
||||
|
||||
DragCapture: HWND;
|
||||
DragControl: TControl;
|
||||
DragObjectAutoFree: Boolean;
|
||||
@ -1439,7 +1441,7 @@ var
|
||||
DragStartPos: TPoint;
|
||||
DragThreshold: Integer;
|
||||
ActiveDrag: TDragOperation;
|
||||
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('Common Controls',[TImageList]);
|
||||
@ -1459,7 +1461,7 @@ end;
|
||||
{------------------------------------------------------------------------------}
|
||||
function FindControl(Handle : hwnd) : TWinControl;
|
||||
begin
|
||||
if Handle <> 0
|
||||
if Handle <> 0
|
||||
then Result := TWinControl(GetProp(Handle,'WinControl'))
|
||||
else Result := nil;
|
||||
end;
|
||||
@ -1576,7 +1578,7 @@ Begin
|
||||
and (Abs(DragStartPos.X - P.X) < DragThreshold)
|
||||
and (Abs(DragStartPos.Y - P.Y) > DragThreshold) then
|
||||
exit;
|
||||
|
||||
|
||||
|
||||
end;
|
||||
|
||||
@ -1642,8 +1644,8 @@ end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: FindLCLWindow
|
||||
Params:
|
||||
Returns:
|
||||
Params:
|
||||
Returns:
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
function FindLCLWindow(const ScreenPos : TPoint) : TWinControl;
|
||||
@ -1664,8 +1666,8 @@ end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: FindDragTarget
|
||||
Params:
|
||||
Returns:
|
||||
Params:
|
||||
Returns:
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
function FindDragTarget(const Pos : TPoint; AllowDisabled: Boolean): TControl;
|
||||
@ -1682,25 +1684,25 @@ begin
|
||||
|
||||
Control := Window.ControlAtPos(Window.ScreenToClient(pos), AllowDisabled);
|
||||
|
||||
if Control <> nil
|
||||
if Control <> nil
|
||||
then Assert(False, Format('Trace:[FindDragTarget] Control at pos(%d, %d): %s', [Pos.X,Pos.Y, Control.ClassName]));
|
||||
|
||||
|
||||
if Control <> nil then Result := Control;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: GetCaptureControl
|
||||
Params:
|
||||
Returns:
|
||||
Params:
|
||||
Returns:
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
function GetCaptureControl : TControl;
|
||||
begin
|
||||
Result := FindControl(GetCapture);
|
||||
if (Result <> nil)
|
||||
and (CaptureControl <> nil)
|
||||
and (CaptureControl.Parent = Result)
|
||||
if (Result <> nil)
|
||||
and (CaptureControl <> nil)
|
||||
and (CaptureControl.Parent = Result)
|
||||
then Result := CaptureControl;
|
||||
end;
|
||||
|
||||
@ -1720,12 +1722,12 @@ begin
|
||||
{$ENDIF}
|
||||
ReleaseCapture;
|
||||
CaptureControl := nil;
|
||||
if Control <> nil
|
||||
if Control <> nil
|
||||
then begin
|
||||
if not (Control is TWinControl)
|
||||
then begin
|
||||
if Control.Parent = nil then Exit;
|
||||
|
||||
|
||||
CaptureControl := Control;
|
||||
Control := Control.Parent;
|
||||
end;
|
||||
@ -1839,17 +1841,20 @@ initialization
|
||||
Mouse := TMouse.create;
|
||||
DragControl := nil;
|
||||
CaptureControl := nil;
|
||||
|
||||
|
||||
RegisterIntegerConsts(TypeInfo(TCursor), @IdentToCursor, @CursorToIdent);
|
||||
|
||||
finalization
|
||||
Mouse.Free;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.159 2003/12/14 19:18:03 micha
|
||||
hint fixes: parentfont, font itself, showing/hiding + more
|
||||
|
||||
Revision 1.158 2003/11/22 17:22:14 mattias
|
||||
moved TBevelCut to controls.pp
|
||||
|
||||
|
||||
48
lcl/forms.pp
48
lcl/forms.pp
@ -65,8 +65,8 @@ type
|
||||
TCloseAction = (caNone, caHide, caFree, caMinimize);
|
||||
|
||||
TScrollingWinControl = class;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TControlScrollBar }
|
||||
|
||||
TScrollBarKind = (sbHorizontal, sbVertical);
|
||||
@ -128,8 +128,8 @@ type
|
||||
property Range: Integer read GetRange write SetRange default 0;
|
||||
property Visible: Boolean read GetVisible write SetVisible stored VisibleIsStored;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TScrollingWinControl }
|
||||
|
||||
TScrollingWinControl = class(TWinControl)
|
||||
@ -176,8 +176,8 @@ type
|
||||
property VertScrollBar: TControlScrollBar
|
||||
read FVertScrollBar write SetVertScrollBar stored StoreScrollBars;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TScrollBox }
|
||||
|
||||
TScrollBox = class(TScrollingWinControl)
|
||||
@ -473,8 +473,8 @@ type
|
||||
property WindowState: TWindowState read FWindowState write SetWindowState
|
||||
default wsNormal;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TForm }
|
||||
|
||||
TForm = class(TCustomForm)
|
||||
@ -528,10 +528,10 @@ type
|
||||
end;
|
||||
|
||||
TFormClass = class of TForm;
|
||||
|
||||
|
||||
|
||||
{ THintWindow }
|
||||
|
||||
|
||||
THintWindow = class(TCustomForm)
|
||||
private
|
||||
FActivating: Boolean;
|
||||
@ -565,7 +565,7 @@ type
|
||||
Index: Integer;
|
||||
Handle: HCURSOR;
|
||||
end;
|
||||
|
||||
|
||||
TScreenFormEvent = procedure(Sender: TObject; Form: TCustomForm) of object;
|
||||
TScreenActiveFormChangedEvent = procedure(Sender: TObject;
|
||||
LastForm: TCustomForm) of object;
|
||||
@ -590,11 +590,11 @@ type
|
||||
FCustomForms: TList;
|
||||
FCustomFormsZOrdered: TList;
|
||||
FDefaultCursor: HCURSOR;
|
||||
FHintFont: TFont;
|
||||
FFocusedForm: TCustomForm;
|
||||
FFonts : TStrings;
|
||||
FFormList: TList;
|
||||
FHandlers: array[TScreenNotification] of TMethodList;
|
||||
FHintFont : TFont;
|
||||
FLastActiveControl: TWinControl;
|
||||
FLastActiveCustomForm: TCustomForm;
|
||||
FOnActiveControlChange: TNotifyEvent;
|
||||
@ -625,6 +625,8 @@ type
|
||||
function GetHandlerCount(HandlerType: TScreenNotification): integer;
|
||||
function GetNextHandlerIndex(HandlerType: TScreenNotification;
|
||||
var i: integer): boolean;
|
||||
protected
|
||||
function GetHintFont: TFont; virtual;
|
||||
public
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
destructor Destroy; Override;
|
||||
@ -662,7 +664,7 @@ type
|
||||
property Forms[Index: Integer]: TForm read GetForms;
|
||||
property Fonts : TStrings read GetFonts;
|
||||
property Height : Integer read Getheight;
|
||||
property HintFont : TFont read FHintFont;
|
||||
property HintFont : TFont read GetHintFont;
|
||||
property Width : Integer read GetWidth;
|
||||
property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange
|
||||
write FOnActiveControlChange;
|
||||
@ -677,7 +679,7 @@ type
|
||||
TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;
|
||||
TIdleEvent = procedure (Sender: TObject; var Done: Boolean) of object;
|
||||
TOnUserInputEvent = procedure(Sender: TObject; Msg: Cardinal) of object;
|
||||
|
||||
|
||||
// application hint stuff
|
||||
PHintInfo = ^THintInfo;
|
||||
THintInfo = record
|
||||
@ -845,10 +847,10 @@ type
|
||||
property ShowHint: Boolean read FShowHint write SetShowHint;
|
||||
property Title: String read GetTitle write SetTitle;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TApplicationProperties }
|
||||
|
||||
|
||||
TApplicationProperties = class(TComponent)
|
||||
private
|
||||
FCaptureExceptions: boolean;
|
||||
@ -911,8 +913,8 @@ type
|
||||
property OnShowHint: TShowHintEvent read FOnShowHint write SetOnShowHint;
|
||||
property OnUserInput: TOnUserInputEvent read FOnUserInput write SetOnUserInput;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TIDesigner }
|
||||
|
||||
TIDesigner = class(TObject)
|
||||
@ -1120,8 +1122,8 @@ function GetParentForm(Control:TControl): TCustomForm;
|
||||
begin
|
||||
while Control.Parent <> nil do
|
||||
Control := Control.Parent;
|
||||
if Control is TCustomForm
|
||||
then Result := TCustomForm(Control)
|
||||
if Control is TCustomForm
|
||||
then Result := TCustomForm(Control)
|
||||
else Result := nil;
|
||||
end;
|
||||
|
||||
@ -1157,7 +1159,7 @@ function InitResourceComponent(Instance: TComponent;
|
||||
end;
|
||||
end;
|
||||
end;}
|
||||
|
||||
|
||||
// InitResourceComponent
|
||||
//var LocalizedLoading: Boolean;
|
||||
begin
|
||||
@ -1644,7 +1646,7 @@ initialization
|
||||
LCLProc.OwnerFormDesignerModifiedProc:=@IfOwnerIsFormThenDesignerModified;
|
||||
Screen:= TScreen.Create(nil);
|
||||
Application:= TApplication.Create(nil);
|
||||
|
||||
|
||||
{$IFDEF UseFCLDataModule}
|
||||
RegisterInitComponentHandler(TComponent,@InitResourceComponent);
|
||||
{$ENDIF}
|
||||
|
||||
@ -463,17 +463,22 @@ var
|
||||
begin
|
||||
Info:=GetHintInfoAtMouse;
|
||||
//writeln('TApplication.DoOnMouseMove Info.ControlHasHint=',Info.ControlHasHint,' Type=',ord(FHintTimerType));
|
||||
if Info.ControlHasHint then begin
|
||||
case FHintTimerType of
|
||||
ahtNone,ahtShowHint:
|
||||
StartHintTimer(HintPause,ahtShowHint);
|
||||
ahtHideHint:
|
||||
ShowHintWindow(Info);
|
||||
else
|
||||
if FHintControl <> Info.Control then
|
||||
begin
|
||||
if Info.ControlHasHint then
|
||||
begin
|
||||
FHintControl := Info.Control;
|
||||
case FHintTimerType of
|
||||
ahtNone,ahtShowHint:
|
||||
StartHintTimer(HintPause,ahtShowHint);
|
||||
ahtHideHint:
|
||||
ShowHintWindow(Info);
|
||||
else
|
||||
HideHint;
|
||||
end;
|
||||
end else begin
|
||||
HideHint;
|
||||
end;
|
||||
end else begin
|
||||
HideHint;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -495,7 +500,6 @@ var
|
||||
CurHeight: Integer;
|
||||
begin
|
||||
if not FShowHint then exit;
|
||||
FHintControl:=Info.Control;
|
||||
|
||||
CurHeight:=GetCursorHeightMargin;
|
||||
HintInfo.HintControl := FHintControl;
|
||||
@ -803,7 +807,7 @@ begin
|
||||
HideHint;
|
||||
if FHintControl <> nil then
|
||||
begin
|
||||
FHintControl := nil;
|
||||
//FHintControl := nil;
|
||||
//FHintActive := False;
|
||||
//UnhookHintHooks;
|
||||
//StopHintTimer;
|
||||
@ -1113,6 +1117,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.67 2003/12/14 19:18:04 micha
|
||||
hint fixes: parentfont, font itself, showing/hiding + more
|
||||
|
||||
Revision 1.66 2003/11/17 23:09:39 mattias
|
||||
started PixelsPerInch
|
||||
|
||||
|
||||
@ -54,7 +54,7 @@ begin
|
||||
if (DragControl = nil) or (Pointer(DragControl) = Pointer($FFFFFFFF)) then
|
||||
Begin
|
||||
DragControl := nil;
|
||||
|
||||
|
||||
// if the last mouse down was not followed by a mouse up, simulate a
|
||||
// mouse up. This way applications need only to react to mouse up to
|
||||
// clean up.
|
||||
@ -63,7 +63,7 @@ begin
|
||||
P := ScreenToClient(p);
|
||||
Perform(LM_LBUTTONUP,0,Longint(PointToSmallPoint(p)));
|
||||
end;
|
||||
|
||||
|
||||
if Threshold < 0 then
|
||||
Threshold := Mouse.DragThreshold;
|
||||
if Pointer(DragControl) <> Pointer($FFFFFFFF) then
|
||||
@ -112,14 +112,14 @@ end;
|
||||
function TControl.GetDockEdge(const MousePos: TPoint): TAlign;
|
||||
var
|
||||
BestDistance: Integer;
|
||||
|
||||
|
||||
procedure FindMinDistance(CurAlign: TAlign; CurDistance: integer);
|
||||
begin
|
||||
if CurDistance>=BestDistance then exit;
|
||||
Result:=CurAlign;
|
||||
BestDistance:=CurDistance;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
// check if MousePos outside the control
|
||||
if MousePos.X<=0 then
|
||||
@ -152,7 +152,7 @@ end;
|
||||
procedure TControl.BoundsChanged;
|
||||
begin
|
||||
{ Notifications can be performed here }
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TControl.Bringtofront
|
||||
@ -200,7 +200,7 @@ var
|
||||
PosChanged:= (FLeft <> OldLeft) or (FTop <> OldTop);
|
||||
Result:=(not SizeChanged) and (not PosChanged);
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
{$IFDEF VerboseSizeMsg}
|
||||
writeln('TControl.ChangeBounds A ',Name,':',ClassName,' Old=',Left,',',Top,',',Width,',',Height,' New=',ALeft,',',ATop,',',AWidth,',',AHeight);
|
||||
@ -222,7 +222,7 @@ begin
|
||||
SizeChanged:= (FWidth <> AWidth) or (FHeight <> AHeight);
|
||||
PosChanged:= (FLeft <> ALeft) or (FTop <> ATop);
|
||||
if (not SizeChanged) and (not PosChanged) then exit;
|
||||
|
||||
|
||||
{If AutoSize and not AutoSizing then begin
|
||||
If SizeChanged then begin
|
||||
DoAutoSize;
|
||||
@ -303,7 +303,7 @@ end;
|
||||
{-------------------------------------------------------------------------------
|
||||
TControl.DoSetBounds
|
||||
Params: ALeft, ATop, AWidth, AHeight : integer
|
||||
|
||||
|
||||
store bounds in private variables
|
||||
-------------------------------------------------------------------------------}
|
||||
procedure TControl.DoSetBounds(ALeft, ATop, AWidth, AHeight : integer);
|
||||
@ -342,12 +342,12 @@ var
|
||||
Handled: Boolean;
|
||||
begin
|
||||
if csDesigning in ComponentState then Exit;
|
||||
|
||||
|
||||
P2 := SmallPointToPoint(P);
|
||||
Handled:=false;
|
||||
DoContextPopup(P2,Handled);
|
||||
if Handled then exit;
|
||||
|
||||
|
||||
Control := Self;
|
||||
while Control <> nil do
|
||||
begin
|
||||
@ -385,7 +385,7 @@ procedure TControl.SetTabStop(Value : Boolean);
|
||||
begin
|
||||
If FTabStop = Value then
|
||||
exit;
|
||||
|
||||
|
||||
FTabStop := Value;
|
||||
end;
|
||||
|
||||
@ -601,6 +601,20 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TControl.CMShowHintChanged
|
||||
|
||||
assumes: FParent <> nil
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TControl.CMParentShowHintChanged(var Message: TLMessage);
|
||||
begin
|
||||
if FParentShowHint then
|
||||
begin
|
||||
ShowHint := FParent.ShowHint;
|
||||
FParentShowHint := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TControl.ConstrainedResize }
|
||||
{------------------------------------------------------------------------------}
|
||||
@ -621,7 +635,7 @@ end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure TControl.DoOnResize;
|
||||
|
||||
|
||||
Call events
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TControl.DoOnResize;
|
||||
@ -682,12 +696,12 @@ begin
|
||||
else MaxHeight:= 0;
|
||||
|
||||
ConstrainedResize(MinWidth, MinHeight, MaxWidth, MaxHeight);
|
||||
|
||||
|
||||
if (MinWidth > 0) and (NewWidth < MinWidth) then
|
||||
NewWidth:= MinWidth
|
||||
else if (MaxWidth > 0) and (NewWidth > MaxWidth) then
|
||||
NewWidth:= MaxWidth;
|
||||
|
||||
|
||||
if (MinHeight > 0) and (NewHeight < MinHeight) then
|
||||
NewHeight:= MinHeight
|
||||
else if (MaxHeight > 0) and (NewHeight > MaxHeight) then
|
||||
@ -851,7 +865,7 @@ end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function TControl.ClientToScreen(const Point : TPoint) : TPoint;
|
||||
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
Function TControl.ClientToScreen(const Point : TPoint) : TPoint;
|
||||
var
|
||||
@ -932,7 +946,7 @@ end;
|
||||
Procedure TControl.DragOver(Source: TObject; X,Y : Integer; State : TDragState; var Accept:Boolean);
|
||||
begin
|
||||
Accept := False;
|
||||
if Assigned(FOnDragOver)
|
||||
if Assigned(FOnDragOver)
|
||||
then begin
|
||||
Accept := True;
|
||||
//Do something else yet....
|
||||
@ -1114,7 +1128,7 @@ end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TControl.GetChildsRect(Scrolled: boolean): TRect;
|
||||
|
||||
|
||||
Returns the Client rectangle relative to the controls left, top.
|
||||
If Scrolled is true, the rectangle is moved by the current scrolling values
|
||||
(for an example see TScrollingWincontrol).
|
||||
@ -1202,13 +1216,13 @@ begin
|
||||
end;
|
||||
|
||||
case TheMessage.Msg of
|
||||
|
||||
|
||||
LM_MOUSEMOVE:
|
||||
begin
|
||||
Application.HintMouseMessage(Self, TheMessage);
|
||||
if Dragging then DragObject.MouseMsg(TheMessage);
|
||||
end;
|
||||
|
||||
|
||||
LM_LBUTTONDOWN,
|
||||
LM_LBUTTONDBLCLK:
|
||||
begin
|
||||
@ -1227,7 +1241,7 @@ begin
|
||||
end;
|
||||
Include(FControlState,csLButtonDown);
|
||||
end;
|
||||
|
||||
|
||||
LM_LBUTTONUP:
|
||||
begin
|
||||
Exclude(FControlState, csLButtonDown);
|
||||
@ -1239,7 +1253,7 @@ begin
|
||||
if TheMessage.Msg = CM_VISIBLECHANGED
|
||||
then begin
|
||||
with TheMessage do SendDockNotification(Msg,WParam,LParam);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -1604,7 +1618,7 @@ end;
|
||||
{------------------------------------------------------------------------------}
|
||||
procedure TControl.SetCursor(Value: TCursor);
|
||||
begin
|
||||
if FCursor <> Value
|
||||
if FCursor <> Value
|
||||
then begin
|
||||
FCursor := Value;
|
||||
// This should not be called if it is already set to VALUE but if
|
||||
@ -1626,7 +1640,7 @@ end;
|
||||
{------------------------------------------------------------------------------}
|
||||
procedure TControl.SetEnabled(Value: Boolean);
|
||||
begin
|
||||
if FEnabled <> Value
|
||||
if FEnabled <> Value
|
||||
then begin
|
||||
FEnabled := Value;
|
||||
Perform(CM_ENABLEDCHANGED, 0, 0);
|
||||
@ -1643,8 +1657,8 @@ begin
|
||||
{$IFDEF VerboseMouseCapture}
|
||||
writeln('TControl.SetMouseCapture ',Name,':',ClassName,' NewValue=',Value);
|
||||
{$ENDIF}
|
||||
if Value
|
||||
then SetCaptureControl(Self)
|
||||
if Value
|
||||
then SetCaptureControl(Self)
|
||||
else SetCaptureControl(nil);
|
||||
end
|
||||
end;
|
||||
@ -1653,7 +1667,7 @@ end;
|
||||
Method: TControl.SetHint
|
||||
Params: Value: the text of the hint to be set
|
||||
Returns: Nothing
|
||||
|
||||
|
||||
Sets the hint text of a control
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TControl.SetHint(const Value: String);
|
||||
@ -1761,7 +1775,7 @@ begin
|
||||
or ([csLoading,csDestroying]*Parent.ComponentState<>[])
|
||||
or ([csLoading,csDestroying]*ComponentState<>[])
|
||||
then exit;
|
||||
|
||||
|
||||
if (IsVisible or (csDesigning in ComponentState)
|
||||
and not (csNoDesignVisible in ControlStyle))
|
||||
then begin
|
||||
@ -1825,7 +1839,7 @@ end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TControl Resize
|
||||
|
||||
|
||||
Calls OnResize
|
||||
-------------------------------------------------------------------------------}
|
||||
procedure TControl.Resize;
|
||||
@ -1856,7 +1870,7 @@ begin
|
||||
' CH=',cfClientHeightLoaded in FControlFlags,'=',FLoadedClientSize.Y,
|
||||
'');}
|
||||
UpdateBaseBounds(true,true,true);
|
||||
|
||||
|
||||
// align this control and the brothers
|
||||
if cfRequestAlignNeeded in FControlFlags then
|
||||
RequestAlign;
|
||||
@ -1901,7 +1915,7 @@ end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TControl RequestAlign
|
||||
|
||||
|
||||
Requests the parent to realign all brothers
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TControl.RequestAlign;
|
||||
@ -2093,7 +2107,7 @@ end;
|
||||
{------------------------------------------------------------------------------}
|
||||
Procedure TControl.SetParentShowHint(Value : Boolean);
|
||||
Begin
|
||||
if FParentShowHint <> Value
|
||||
if FParentShowHint <> Value
|
||||
then begin
|
||||
FParentShowHint := Value;
|
||||
//Sendmessage to stop/start hints for parent
|
||||
@ -2234,7 +2248,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2427,7 +2441,7 @@ begin
|
||||
csOpaque];
|
||||
FConstraints:= TSizeConstraints.Create(Self);
|
||||
FConstraints.OnChange:= @DoConstraintsChange;
|
||||
|
||||
|
||||
FAnchors := [akLeft,akTop];
|
||||
FAlign := alNone;
|
||||
FColor := clWindow;
|
||||
@ -2465,7 +2479,7 @@ end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TControl.HasParent
|
||||
Params:
|
||||
Params:
|
||||
Returns: True - the item has a parent responsible for streaming
|
||||
|
||||
This function will be called during streaming to decide if a component has
|
||||
@ -2531,16 +2545,16 @@ end;
|
||||
Returns: nothing
|
||||
|
||||
event handler.
|
||||
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TControl.WMWindowPosChanged(var Message: TLMWindowPosChanged);
|
||||
begin
|
||||
Assert(False, Format('Trace:[TControl.WMWindowPosChanged] %s', [ClassName]));
|
||||
// TODO : Docksites and constraints
|
||||
|
||||
|
||||
{ Do not handle this message and leave it to WMSize and WMMove }
|
||||
Message.Result:= 0;
|
||||
|
||||
|
||||
//if Message.WindowPos <> nil then with Message.WindowPos^ do begin
|
||||
// SetBounds(X, Y, cX, cY);
|
||||
// Message.Result:= 1;
|
||||
@ -2571,7 +2585,7 @@ end;
|
||||
Returns: nothing
|
||||
|
||||
event handler.
|
||||
|
||||
|
||||
Message.MoveType=0 is the default, all other values will force a RequestAlign.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TControl.WMMove(var Message: TLMMove);
|
||||
@ -2593,6 +2607,9 @@ end;
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.158 2003/12/14 19:18:04 micha
|
||||
hint fixes: parentfont, font itself, showing/hiding + more
|
||||
|
||||
Revision 1.157 2003/09/23 17:52:04 mattias
|
||||
added SetAnchors
|
||||
|
||||
|
||||
@ -20,7 +20,7 @@
|
||||
HintWindow := THintWindow.Create(nil);
|
||||
Rect := HintWindow.CalcHintRect(0,'This is the hint',nil);
|
||||
HintWindow.ActivateHint(Rect,'This is the hint');
|
||||
|
||||
|
||||
}
|
||||
|
||||
constructor THintWindow.Create(AOwner: TComponent);
|
||||
@ -79,16 +79,23 @@ var
|
||||
//DefaultDraw: Boolean;
|
||||
begin
|
||||
Rect := ClientRect;
|
||||
Dec(Rect.Right, 1);
|
||||
Dec(Rect.Bottom, 1);
|
||||
Canvas.Brush.Color := Color;
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.Rectangle(Rect);
|
||||
FillChar(TS, SizeOf(TS),0);
|
||||
With TS do
|
||||
Clipping := True;
|
||||
InflateRect(Rect, -1, -1);
|
||||
Canvas.TextRect(Rect, 1, 1, Caption, TS);
|
||||
Canvas.Pen.Width := 1;
|
||||
DrawEdge(Canvas.Handle, Rect, BDR_RAISEDOUTER, BF_RECT);
|
||||
with TS do
|
||||
begin
|
||||
Alignment := taCenter;
|
||||
Layout := tlCenter;
|
||||
SingleLine := false;
|
||||
Clipping := true;
|
||||
ExpandTabs := true;
|
||||
ShowPrefix := false;
|
||||
WordBreak := true;
|
||||
Opaque := true;
|
||||
SystemFont := false;
|
||||
end;
|
||||
Canvas.TextRect(Rect, 0, 0, Caption, TS);
|
||||
end;
|
||||
|
||||
procedure THintWindow.ActivateHint(ARect: TRect; const AHint: String);
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
|
||||
!! In this file only winapi related code as defined in winapih.inc
|
||||
Most routines implement only the default
|
||||
|
||||
|
||||
!! Keep this alphabetical !!
|
||||
******************************************************************************
|
||||
|
||||
@ -935,6 +935,11 @@ begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TInterfaceBase.InitHintFont(HintFont: TObject): Boolean;
|
||||
begin
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
procedure TInterfaceBase.InitializeCriticalSection(var CritSection: TCriticalSection);
|
||||
begin
|
||||
writeln('TInterfaceBase.InitializeCriticalSection Not implemented yet');
|
||||
@ -992,8 +997,8 @@ function TInterfaceBase.MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
//todo: remove
|
||||
|
||||
//todo: remove
|
||||
function TInterfaceBase.MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
|
||||
SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer): Boolean;
|
||||
begin
|
||||
@ -1392,6 +1397,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.2 2003/12/14 19:18:04 micha
|
||||
hint fixes: parentfont, font itself, showing/hiding + more
|
||||
|
||||
Revision 1.1 2003/11/24 11:03:07 marc
|
||||
* Splitted winapi*.inc into a winapi and a lcl interface communication part
|
||||
|
||||
|
||||
@ -35,11 +35,6 @@ begin
|
||||
FFormList := TList.Create;
|
||||
FPixelsPerInch:= ScreenInfo.PixelsPerInchX;
|
||||
FHintFont := TFont.Create;
|
||||
// FHintFont.Name := 'courier';
|
||||
FHintFont.Style := [];
|
||||
FHintFont.Size := 12;
|
||||
FHintFont.Color := clInfoText;
|
||||
FHintFont.Pitch := fpDefault;
|
||||
FSaveFocusedList := TList.Create;
|
||||
end;
|
||||
|
||||
@ -337,6 +332,19 @@ begin
|
||||
Result := GetSystemMetrics(SM_CYSCREEN);
|
||||
end;
|
||||
|
||||
Function TScreen.GetHintFont: TFont;
|
||||
begin
|
||||
if not InterfaceObject.InitHintFont(FHintFont) then
|
||||
begin
|
||||
// FHintFont.Name := 'courier';
|
||||
FHintFont.Style := [];
|
||||
FHintFont.Size := 12;
|
||||
FHintFont.Color := clInfoText;
|
||||
FHintFont.Pitch := fpDefault;
|
||||
end;
|
||||
Result := FHintFont;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
Function: TScreen.RemoveForm
|
||||
|
||||
@ -2338,7 +2338,7 @@ end;
|
||||
|
||||
Called when enabled is changed. Takes action to enable control
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TWinControl.CMEnabledChanged(var Message: TLMEssage);
|
||||
procedure TWinControl.CMEnabledChanged(var Message: TLMessage);
|
||||
begin
|
||||
if not Enabled and (Parent <> nil)
|
||||
then RemoveFocus(False);
|
||||
@ -2348,6 +2348,20 @@ begin
|
||||
then EnableWindow(Handle, Enabled);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TWinControl.CMShowHintChanged
|
||||
Params: Message
|
||||
Returns: Nothing
|
||||
|
||||
Called when showhint is changed. Notifies children
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TWinControl.CMShowHintChanged(var Message: TLMessage);
|
||||
begin
|
||||
NotifyControls(CM_PARENTSHOWHINTCHANGED);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TWinControl.WMSetFocus
|
||||
Params: Message
|
||||
@ -3136,6 +3150,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.181 2003/12/14 19:18:04 micha
|
||||
hint fixes: parentfont, font itself, showing/hiding + more
|
||||
|
||||
Revision 1.180 2003/12/06 19:20:46 mattias
|
||||
codecompletion: forward proc body position now block sensitive
|
||||
|
||||
|
||||
@ -50,7 +50,8 @@ type
|
||||
procedure WaitMessage; virtual; abstract;
|
||||
procedure AppInit; virtual; abstract;
|
||||
procedure AppTerminate; virtual; abstract;
|
||||
function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: pointer): integer; virtual; abstract;
|
||||
function InitHintFont(HintFont: TObject): Boolean; virtual;
|
||||
function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: pointer): integer; virtual; abstract;
|
||||
|
||||
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): integer; virtual; abstract;
|
||||
function DestroyTimer(TimerHandle: integer): boolean; virtual; abstract;
|
||||
@ -108,6 +109,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.39 2003/12/14 19:18:04 micha
|
||||
hint fixes: parentfont, font itself, showing/hiding + more
|
||||
|
||||
Revision 1.38 2003/11/27 23:02:30 mattias
|
||||
removed menutype.pas
|
||||
|
||||
|
||||
@ -124,6 +124,7 @@ Type
|
||||
Procedure HandleEvents; Override;
|
||||
Procedure WaitMessage; Override;
|
||||
Procedure AppTerminate; Override;
|
||||
Function InitHintFont(HintFont: TObject): Boolean; Override;
|
||||
Procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
|
||||
|
||||
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; override;
|
||||
@ -191,6 +192,9 @@ End.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.59 2003/12/14 19:18:04 micha
|
||||
hint fixes: parentfont, font itself, showing/hiding + more
|
||||
|
||||
Revision 1.58 2003/12/13 19:44:42 micha
|
||||
hintwindow, color, rectangle size fixes
|
||||
|
||||
|
||||
@ -33,6 +33,7 @@ Begin
|
||||
Inherited Create;
|
||||
FAccelGroup := 0;
|
||||
FTimerData := TList.Create;
|
||||
FMetrics.cbSize := SizeOf(FMetrics);
|
||||
FMetricsFailed := not Windows.SystemParametersInfo(SPI_GETNONCLIENTMETRICS,
|
||||
SizeOf(FMetrics), @FMetrics, 0);
|
||||
if FMetricsFailed then
|
||||
@ -1077,6 +1078,16 @@ Begin
|
||||
{$ENDIF}
|
||||
End;
|
||||
|
||||
function TWin32Object.InitHintFont(HintFont: TObject): Boolean;
|
||||
begin
|
||||
TFont(HintFont).Name := FMetrics.lfStatusFont.lfFaceName;
|
||||
TFont(HintFont).Style := [];
|
||||
TFont(HintFont).Height := FMetrics.lfStatusFont.lfHeight;
|
||||
TFont(HintFont).Color := clInfoText;
|
||||
TFont(HintFont).Pitch := fpDefault;
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TWin32Object.HandleEvents
|
||||
Params: None
|
||||
@ -2009,7 +2020,7 @@ Begin
|
||||
Begin
|
||||
pClassName := @ClsName;
|
||||
WindowTitle := StrCaption;
|
||||
Flags := WS_POPUP or WS_BORDER;
|
||||
Flags := WS_POPUP;
|
||||
FlagsEx := WS_EX_TOOLWINDOW;
|
||||
Left := LongInt(CW_USEDEFAULT);
|
||||
Top := LongInt(CW_USEDEFAULT);
|
||||
@ -2242,12 +2253,7 @@ Begin
|
||||
begin
|
||||
if DoSubClass then
|
||||
SetProp(Window, 'DefWndProc', Pointer(SetWindowLong(Window, GWL_WNDPROC, LongInt(@WindowProc))));
|
||||
case CompStyle of
|
||||
csHintWindow:
|
||||
SendMessage(Window, WM_SETFONT, FStatusFont, 0);
|
||||
else
|
||||
SendMessage(Window, WM_SETFONT, FMessageFont, 0);
|
||||
end;
|
||||
SendMessage(Window, WM_SETFONT, FMessageFont, 0);
|
||||
end;
|
||||
If Buddy <> HWND(Nil) Then
|
||||
SendMessage(Buddy, WM_SETFONT, FMessageFont, 0);
|
||||
@ -2329,7 +2335,13 @@ Begin
|
||||
If TControl(Sender).HandleObjectShouldBeVisible Then
|
||||
Begin
|
||||
Assert(False, 'Trace: [TWin32Object.ShowHide] Showing the window');
|
||||
ShowWindow(Handle, SW_SHOW);
|
||||
if TControl(Sender).FCompStyle = csHintWindow then
|
||||
begin
|
||||
Windows.SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or
|
||||
SWP_SHOWWINDOW or SWP_NOACTIVATE);
|
||||
end else begin
|
||||
Windows.ShowWindow(Handle, SW_SHOW);
|
||||
end;
|
||||
If (Sender Is TCustomForm) Then
|
||||
SetClassLong(Handle, GCL_HIcon, TCustomForm(Sender).GetIconHandle);
|
||||
End
|
||||
@ -2807,7 +2819,7 @@ var MenuInfo: MENUITEMINFO;
|
||||
Result:=hbmpCheck;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Begin
|
||||
ParentMenuHandle := (Sender as TMenuItem).Parent.Handle;
|
||||
|
||||
@ -2883,6 +2895,9 @@ End;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.139 2003/12/14 19:18:04 micha
|
||||
hint fixes: parentfont, font itself, showing/hiding + more
|
||||
|
||||
Revision 1.138 2003/12/13 19:44:42 micha
|
||||
hintwindow, color, rectangle size fixes
|
||||
|
||||
|
||||
@ -94,7 +94,7 @@ type
|
||||
...
|
||||
end;
|
||||
}
|
||||
|
||||
|
||||
TOnGetLazIntfImagePixel = procedure(x, y: integer; var Color: TFPColor)
|
||||
of object;
|
||||
TOnSetLazIntfImagePixel = procedure(x, y: integer; const Color: TFPColor)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user