Class Zoom_panel (unit Zoomer)

Inherits from

TCustomPanel

Constructors


constructor Create(AOwner: TComponent);

///////////////////////////////////////////////////////////////////////////// Create all the visible items Set the Owner and Parent properties so Delphi deletes them all for us.


Functions

procedure DblClick(Sender:TObject);


procedure Mouse_Down(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y: Integer);


procedure Mouse_Move(Sender: TObject; Shift: TShiftState; X, Y: Integer);

Look for the correct rectangle!!!!

procedure Mouse_Up (Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Integer);

Draw first rectangle for XOr Mode Init

function real_to_screen(P:Point3D; OCS:pMatrix) : TPoint;

///////////////////////////////////////////////////////////////////////////// Coordinate transformations ///////////////////////////////////////////////////////////////////////////// When drawing Blocks - all the coordinates have to have the Base point of the block subtracted before being drawn, and a scaling factor and a rotation applied.

procedure ReCentre(mx,my:integer);


procedure Resize;

///////////////////////////////////////////////////////////////////////////// Adjust everything after a resize /////////////////////////////////////////////////////////////////////////////

function screen_to_real(P1:TPoint) : Point2D;


procedure ScrollBars_Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);

///////////////////////////////////////////////////////////////////////////// Scrolling and recentring /////////////////////////////////////////////////////////////////////////////

procedure set_parameters(xmn,xmx,ymn,ymx:double; xm,ym:integer);

///////////////////////////////////////////////////////////////////////////// Initialization of window, scaling etc.

procedure WMPaint(var Message: TWMPaint);

///////////////////////////////////////////////////////////////////////////// Events we pass on to user /////////////////////////////////////////////////////////////////////////////

procedure Zoom(factor:double);

///////////////////////////////////////////////////////////////////////////// Section dealing with Zooming in/out /////////////////////////////////////////////////////////////////////////////

procedure Zoom_in_out(Sender:TObject);


procedure Zoom_last(Sender:TObject);


procedure Zoom_mousedown(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Integer);


procedure Zoom_mouseup(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Integer);

initial pause of 0.

procedure Zoom_Prev;

Update position label

procedure Zoom_timer_event(Sender:TObject);


procedure Calc_Rect(var xmn,xmx,ymn,ymx:Double);


procedure ReSet_Parameters(xmn,xmx,ymn,ymx:Double);

Protected declarations

Used when zooming by rectangle.


procedure ReSet_ScrollParams;

Xscale is the good one

procedure restore_canvas_stuff;


procedure save_canvas_stuff;

///////////////////////////////////////////////////////////////////////////// save/restore canvas properties /////////////////////////////////////////////////////////////////////////////

Properties

property Align :

Published declarations

property Alignment :


property BevelInner :


property BevelOuter :


property BevelWidth :


property BorderStyle :


property BorderWidth :


property Color :


property Ctl3D :


property DragCursor :


property DragMode :


property Enabled :


property Locked :


property ParentColor :


property ParentCtl3D :


property ParentFont :


property ParentShowHint :


property PopupMenu :


property ShowHint :


property TabOrder :


property TabStop :


property Visible :


property ZoomFactor : double


Events

event OnClick :


event OnDblClick :


event OnDragDrop :


event OnDragOver :


event OnEndDrag :


event OnEnter :


event OnExit :


event OnMouseDown : TMouseEvent


event OnMouseMove : TMouseMoveEvent


event OnMouseUp : TMouseEvent


event OnPaint : TNotifyEvent


event OnResize :


event OnStartDrag :


event OnZoomin : TNotifyEvent


event OnZoomout : TNotifyEvent


event OnZoomreset : TNotifyEvent


Variables

ClientArea : TPaintBox;

Public declarations

initialized : boolean;


zoom_factor : double;


Coords : TLabel;


current_params : params;


FOnMouseDown : TMouseEvent;


FOnMouseMove : TMouseMoveEvent;


FOnMouseUp : TMouseEvent;


FOnPaint : TNotifyEvent;

Private declarations

FOnZoomin : TNotifyEvent;


FOnZoomout : TNotifyEvent;


FOnZoomreset : TNotifyEvent;


Ini_Point : TPoint;


Old_BrushStyle : TBrushStyle;


Old_PenColor : TColor;


Old_PenMode : TPenMode;


Old_PenStyle : TPenStyle;


Old_PenWidth : Integer;


Old_Point : TPoint;


original_params : params;

bookkeeping

previous_params : params;


ScrollBar_lr : TScrollBar;


ScrollBar_ud : TScrollBar;


scrollpanel_lr : TPanel;


scrollpanel_ud : TPanel;

visible things

Zooming_in : boolean;


Zooming_out : boolean;


zooming_rect : boolean;

Zoom rectangle params

zoomlastbutton : TSpeedButton;


zoomresetbutton : TSpeedButton;


Zoomtext : TLabel;


zoomtimer : TTimer;


zoom_in_button : TSpeedButton;


zoom_out_button : TSpeedButton;



Constructors


constructor Create(AOwner: TComponent);

///////////////////////////////////////////////////////////////////////////// Create all the visible items Set the Owner and Parent properties so Delphi deletes them all for us. /////////////////////////////////////////////////////////////////////////////


Functions


procedure DblClick(Sender:TObject);


procedure Mouse_Down(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y: Integer);


procedure Mouse_Move(Sender: TObject; Shift: TShiftState; X, Y: Integer);

Look for the correct rectangle!!!!


procedure Mouse_Up (Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Integer);

Draw first rectangle for XOr Mode Init


function real_to_screen(P:Point3D; OCS:pMatrix) : TPoint;

///////////////////////////////////////////////////////////////////////////// Coordinate transformations ///////////////////////////////////////////////////////////////////////////// When drawing Blocks - all the coordinates have to have the Base point of the block subtracted before being drawn, and a scaling factor and a rotation applied. To make life easier, I've simply added the extras into my original coordinate routine...here. It's a little wasteful when drawing normal entities, but it was the easiest way of adding in blocks without doing extra draw routines


procedure ReCentre(mx,my:integer);


procedure Resize;

///////////////////////////////////////////////////////////////////////////// Adjust everything after a resize /////////////////////////////////////////////////////////////////////////////


function screen_to_real(P1:TPoint) : Point2D;


procedure ScrollBars_Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);

///////////////////////////////////////////////////////////////////////////// Scrolling and recentring /////////////////////////////////////////////////////////////////////////////


procedure set_parameters(xmn,xmx,ymn,ymx:double; xm,ym:integer);

///////////////////////////////////////////////////////////////////////////// Initialization of window, scaling etc. /////////////////////////////////////////////////////////////////////////////


procedure WMPaint(var Message: TWMPaint);

///////////////////////////////////////////////////////////////////////////// Events we pass on to user /////////////////////////////////////////////////////////////////////////////


procedure Zoom(factor:double);

///////////////////////////////////////////////////////////////////////////// Section dealing with Zooming in/out /////////////////////////////////////////////////////////////////////////////


procedure Zoom_in_out(Sender:TObject);


procedure Zoom_last(Sender:TObject);


procedure Zoom_mousedown(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Integer);


procedure Zoom_mouseup(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Integer);

initial pause of 0.5 seconds


procedure Zoom_Prev;

Update position label


procedure Zoom_timer_event(Sender:TObject);


procedure Calc_Rect(var xmn,xmx,ymn,ymx:Double);


procedure ReSet_Parameters(xmn,xmx,ymn,ymx:Double);

Protected declarations

Used when zooming by rectangle.


procedure ReSet_ScrollParams;

Xscale is the good one


procedure restore_canvas_stuff;


procedure save_canvas_stuff;

///////////////////////////////////////////////////////////////////////////// save/restore canvas properties /////////////////////////////////////////////////////////////////////////////


Properties


property Align :

Published declarations


property Alignment :


property BevelInner :


property BevelOuter :


property BevelWidth :


property BorderStyle :


property BorderWidth :


property Color :


property Ctl3D :


property DragCursor :


property DragMode :


property Enabled :


property Locked :


property ParentColor :


property ParentCtl3D :


property ParentFont :


property ParentShowHint :


property PopupMenu :


property ShowHint :


property TabOrder :


property TabStop :


property Visible :


property ZoomFactor : double


Events


event OnClick :


event OnDblClick :


event OnDragDrop :


event OnDragOver :


event OnEndDrag :


event OnEnter :


event OnExit :


event OnMouseDown : TMouseEvent


event OnMouseMove : TMouseMoveEvent


event OnMouseUp : TMouseEvent


event OnPaint : TNotifyEvent


event OnResize :


event OnStartDrag :


event OnZoomin : TNotifyEvent


event OnZoomout : TNotifyEvent


event OnZoomreset : TNotifyEvent


Variables


ClientArea : TPaintBox;

Public declarations


initialized : boolean;


zoom_factor : double;


Coords : TLabel;


current_params : params;


FOnMouseDown : TMouseEvent;


FOnMouseMove : TMouseMoveEvent;


FOnMouseUp : TMouseEvent;


FOnPaint : TNotifyEvent;

Private declarations


FOnZoomin : TNotifyEvent;


FOnZoomout : TNotifyEvent;


FOnZoomreset : TNotifyEvent;


Ini_Point : TPoint;


Old_BrushStyle : TBrushStyle;


Old_PenColor : TColor;


Old_PenMode : TPenMode;


Old_PenStyle : TPenStyle;


Old_PenWidth : Integer;


Old_Point : TPoint;


original_params : params;

bookkeeping


previous_params : params;


ScrollBar_lr : TScrollBar;


ScrollBar_ud : TScrollBar;


scrollpanel_lr : TPanel;


scrollpanel_ud : TPanel;

visible things


Zooming_in : boolean;


Zooming_out : boolean;


zooming_rect : boolean;

Zoom rectangle params


zoomlastbutton : TSpeedButton;


zoomresetbutton : TSpeedButton;


Zoomtext : TLabel;


zoomtimer : TTimer;


zoom_in_button : TSpeedButton;


zoom_out_button : TSpeedButton;