HINTW

Top  Previous  Next

{Image komponens koordinátákat kijelző mozgó HINT ablakkal}

unit HintW;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes,

Graphics, Controls, Forms, Dialogs, Extctrls;

 

type

 

TSTHintObject = class(TPersistent)

private

  FCaption : string;

  FColor : TColor;

  FFont  : TFont;

  FVisible : boolean;

  FOnChange: TNotifyEvent;

  procedure SetColor(Value:TColor);

  procedure SetFont(Value:TFont);

  procedure SetVisible(Value:boolean);

  procedure Changed; dynamic;

public

  constructor Create;

  destructor Destroy;

published

  property OnChange: TNotifyEvent read FOnChange write FOnChange;

  property Color : TColor read FColor write SetColor;

  property Font  : TFont read FFont write SetFont;

  property Visible : boolean read FVisible write SetVisible;

end;

 

THintImage = class(TImage)

private

  FHintParams : TSTHintObject;

  FHintWindow : THintWindow;

  procedure Change(Sender: TObject);

  procedure CMMouseLeave(var msg: TWMMouse); message CM_MOUSELEAVE;

protected

  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

  procedure DoShowHint(var HintStr:string;var CanShow:boolean;

            var HintInfo:THintInfo);

  Procedure SetHint(hw:THintWindow;ct:TControl;x,y:integer;Caption:String);

public

  HInfo  :THintInfo;

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

published

  Property HintParams : TSTHintObject read FHintParams write FHintParams ;

end;

 

procedure Register;

 

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[THintImage]);

end;

 

  constructor TSTHintObject.Create;

  begin

       FFont:=TFont.Create;

       With FFont do begin

            Name:='Arial';

            Color:=clYellow;

            Style:=[fsBold];

            Size:=8;

       end;

       FColor := clBlack;

       FVisible := True;

  end;

 

  destructor TSTHintObject.Destroy;

  begin

    FFont.Free;

  end;

 

  procedure TSTHintObject.SetColor(Value:TColor);

  begin

    FColor:=Value; Changed;

  end;

 

  procedure TSTHintObject.SetFont(Value:TFont);

  begin FFont.Assign(Value); Changed;end;

 

  procedure TSTHintObject.SetVisible(Value:boolean);

  begin

  If FVisible<>Value then begin

   FVisible:=Value;

   Changed;

  end;

  end;

 

  procedure TSTHintObject.Changed;

  begin if Assigned(FOnChange) then FOnChange(Self); end;

 

constructor THintImage.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   FHintParams := TSTHintObject.Create;

   FHintParams.OnChange := Change;

end;

 

destructor THintImage.Destroy;

begin

   If FHintWindow.ComponentState<>[csDestroying] then FHintWindow.Free;

   FHintParams.Free;

   inherited Destroy;

end;

 

procedure THintImage.Change(Sender: TObject);

begin

If FHintParams.Visible then begin

   FHintWindow:=THintWindow.Create(Self);

   Application.OnShowhint:=DoShowHint;

   Application.HintPause:=0;

end else begin

   FHintWindow.Free;

   Application.OnShowhint:=nil;

end;

invalidate;

end;

 

{Ha a cursor elhagyja a komponenst}

procedure THintImage.CMMouseLeave(var msg: TWMMouse);

begin

 FHintWindow.Visible:=False;

end;

 

Procedure THintImage.SetHint(hw:THintWindow;ct:TControl;x,y:integer;Caption:String);

Var p: TPoint;

  w: integer;

begin

If (hw.ComponentState<>[csDestroying]) and (HInfo.HintControl=ct) then begin

   p:=ct.ClientOrigin;

   hw.Canvas.Font.Assign(HintParams.Font);

   hw.Color:=HintParams.Color;

   w:=hw.Canvas.TextWidth(Caption)+6;

   hw.ActivateHint(Bounds(p.x+x+10,p.y+y+10,w,16),Caption);

 end;

end;

 

procedure THintImage.DoShowHint(var HintStr:string;var CanShow:boolean;

            var HintInfo:THintInfo);

begin

HInfo.HintControl:=HintInfo.HintControl;

CanShow := HintParams.Visible;

end;

 

procedure THintImage.MouseMove(Shift: TShiftState; X, Y: Integer);

begin

If FHintWindow.ComponentState<>[csDestroying] then

   SetHint(FHintWindow,Self,x,y,Inttostr(x)+':'+Inttostr(y));

inherited MouseMove(Shift,x,y);

end;

 

end.