STMAGNI

Top  Previous  Next

unit stmagni;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes,

Graphics, Controls, Forms, Dialogs, stdctrls, ExtCtrls;

 

type

TMagnifyWindow = class(TImage)

private

  FSourceControl : TGraphicControl;

  FHairCross : boolean;

  FPixelWidth : integer;

  procedure SetSourceControl(Value:TGraphicControl);

  procedure SetHairCross(Value:boolean);

  procedure SetPixelWidth(Value:integer);

  procedure DoMagnify(Shift: TShiftState; X, Y: Integer);

protected

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

published

  Property SourceControl : TGraphicControl read FSourceControl write SetSourceControl ;

  Property HairCross : boolean read FHairCross write SetHairCross ;

  Property PixelWidth : integer read FPixelWidth write SetPixelWidth ;

end;

 

procedure Register;

 

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[TMagnifyWindow]);

end;

 

constructor TMagnifyWindow.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

end;

 

destructor TMagnifyWindow.Destroy;

begin

   inherited Destroy;

end;

 

 

procedure TMagnifyWindow.SetSourceControl(Value:TGraphicControl);

begin

If FSourceControl<>Value then begin

   FSourceControl:=Value;

   If Value<>nil then

      (FSourceControl as TControl).OnMouseMove:=DoMagnify;

   invalidate;

end

end;

 

 

procedure TMagnifyWindow.SetHairCross(Value:boolean);

begin

If FHairCross<>Value then begin

   FHairCross:=Value;

   invalidate;

end

end;

 

 

procedure TMagnifyWindow.SetPixelWidth(Value:integer);

begin

If FPixelWidth<>Value then begin

   FPixelWidth:=Value;

   invalidate;

end

end;

 

procedure TMagnifyWindow.DoMagnify(Shift: TShiftState; X, Y: Integer);

begin

If SourceControl<>nil then begin

   SourceControl.Canvas.CopyRect(Canvas.Cliprect,

                 SourceControl.Canvas,

                 Rect(x-PixelWidth,y-PixelWidth,x+PixelWidth+1,y+PixelWidth+1));

end

end;

 

end.