Class Zoom_panel (unit Zoomer) |
Inherits from
TCustomPanel
constructor Create(AOwner: TComponent);
- ///////////////////////////////////////////////////////////////////////////// Create all the visible items Set the Owner and Parent properties so Delphi deletes them all for us.
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 /////////////////////////////////////////////////////////////////////////////
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
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
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;
constructor Create(AOwner: TComponent);
///////////////////////////////////////////////////////////////////////////// Create all the visible items Set the Owner and Parent properties so Delphi deletes them all for us. /////////////////////////////////////////////////////////////////////////////
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 /////////////////////////////////////////////////////////////////////////////
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
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
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;