📄 zoomer.pas
字号:
///////////////////////////////////////////////////////////////////////////////
// //
// CAD window Zoombox VCL Object //
// ㎎ohn Biddiscombe, 〥ani Andres Izquierdo //
// //
// ㎎ohn Biddiscombe //
// Rutherford Appleton Laboratory, UK //
// j.biddiscombe@rl.ac.uk //
// DXF code release 3.0 - July 1997 //
// //
// Dani Andres Izquierdo //
// email : grandres@ctv.es //
// Improvements + drag rectangle + Better Scroll bar Control //
// //
///////////////////////////////////////////////////////////////////////////////
// //
// Usage : //
// Drag rectangle to zoom in on area //
// Double click to recentre on spot //
// Scroll bars to pan around //
// Buttons to zoom in/out //
// Suggestion : Add Pop up menu with Zoom_Prev call to return to last view //
// //
///////////////////////////////////////////////////////////////////////////////
unit Zoomer;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, Buttons, DXF_Utils;
const
MIN_RECT = 2;
MAX_SCROLL = 1000;
SCROLL_OVERLAPPING = 12;
type
params = record
xscale,yscale : double;
xmin,xmax : double;
ymin,ymax : double;
xmid,ymid : double;
end;
type
Zoom_panel = class(TCustomPanel)
private
{ Private declarations }
FOnPaint : TNotifyEvent;
FOnMouseDown : TMouseEvent;
FOnMouseUp : TMouseEvent;
FOnMouseMove : TMouseMoveEvent;
FOnZoomin : TNotifyEvent;
FOnZoomout : TNotifyEvent;
FOnZoomreset : TNotifyEvent;
// visible things
scrollpanel_ud : TPanel;
scrollpanel_lr : TPanel;
ScrollBar_ud : TScrollBar;
ScrollBar_lr : TScrollBar;
zoom_in_button : TSpeedButton;
zoom_out_button : TSpeedButton;
zoomresetbutton : TSpeedButton;
zoomlastbutton : TSpeedButton;
Coords : TLabel;
Zoomtext : TLabel;
// bookkeeping
original_params : params;
current_params : params;
previous_params : params;
Zooming_in : boolean;
Zooming_out : boolean;
zoomtimer : TTimer;
// Zoom rectangle params
zooming_rect : boolean;
Ini_Point : TPoint;
Old_Point : TPoint;
Old_PenStyle : TPenStyle;
Old_PenMode : TPenMode;
Old_PenWidth : Integer;
Old_PenColor : TColor;
Old_BrushStyle : TBrushStyle;
protected
{ Protected declarations }
procedure ReSet_Parameters(xmn,xmx,ymn,ymx:Double);
procedure Calc_Rect(var xmn,xmx,ymn,ymx:Double);
procedure ReSet_ScrollParams;
procedure save_canvas_stuff;
procedure restore_canvas_stuff;
public
{ Public declarations }
ClientArea : TPaintBox;
initialized : boolean;
zoom_factor : double;
constructor Create(AOwner: TComponent); override;
procedure Resize; override;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure Mouse_Down(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y: Integer);
procedure Mouse_Up (Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Integer);
procedure Mouse_Move(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure DblClick(Sender:TObject);
procedure ScrollBars_Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
procedure ReCentre(mx,my:integer);
procedure Zoom(factor:double);
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);
procedure Zoom_timer_event(Sender:TObject);
procedure Zoom_Prev;
procedure set_parameters(xmn,xmx,ymn,ymx:double; xm,ym:integer);
function real_to_screen(P:Point3D; OCS:pMatrix) : TPoint;
function screen_to_real(P1:TPoint) : Point2D;
published
{ Published declarations }
property Align;
property Alignment;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderWidth;
property BorderStyle;
property DragCursor;
property DragMode;
property Enabled;
property Color;
property Ctl3D;
property Locked;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown : TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp : TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseMove : TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnPaint : TNotifyEvent read FOnPaint write FOnPaint;
property OnResize;
property OnStartDrag;
property OnZoomin : TNotifyEvent read FOnZoomin write FOnZoomin;
property OnZoomout : TNotifyEvent read FOnZoomout write FOnZoomout;
property OnZoomreset : TNotifyEvent read FOnZoomreset write FOnZoomreset;
property ZoomFactor : double read zoom_factor write zoom_factor;
end;
procedure Register;
implementation
{$R images.res}
procedure Register;
begin
RegisterComponents('Custom', [Zoom_panel]);
end;
///////////////////////////////////////////////////////////////////////////////
// Create all the visible items
// Set the Owner and Parent properties so Delphi deletes them all for us.
///////////////////////////////////////////////////////////////////////////////
constructor Zoom_panel.Create(AOwner: TComponent);
var TempBitmap : TBitmap;
begin
inherited;
initialized := false;
ControlStyle := ControlStyle - [csSetCaption];
scrollpanel_ud := TPanel.Create(Self);
scrollpanel_ud.Visible := True;
scrollpanel_ud.Parent := Self;
scrollpanel_ud.Align := AlRight;
scrollpanel_lr := TPanel.Create(Self);
scrollpanel_lr.Visible := True;
scrollpanel_lr.Parent := Self;
scrollpanel_lr.Align := AlBottom;
ScrollBar_ud := TScrollBar.Create(scrollpanel_ud);
ScrollBar_ud.Visible := True;
ScrollBar_ud.Parent := scrollpanel_ud;
ScrollBar_ud.Kind := sbVertical;
ScrollBar_ud.Max := Max_Scroll;
ScrollBar_ud.Position := round(Max_Scroll/2);
ScrollBar_ud.LargeChange := round(Max_Scroll-Max_Scroll/SCROLL_OVERLAPPING);
ScrollBar_ud.OnScroll := ScrollBars_Scroll;
ScrollBar_lr := TScrollBar.Create(scrollpanel_lr);
ScrollBar_lr.Visible := True;
ScrollBar_lr.Parent := scrollpanel_lr;
ScrollBar_lr.Kind := sbHorizontal;
ScrollBar_lr.Max := Max_Scroll;
ScrollBar_lr.Position := round(Max_Scroll/2);
ScrollBar_lr.LargeChange := round(Max_Scroll-Max_Scroll/SCROLL_OVERLAPPING);
ScrollBar_lr.OnScroll := ScrollBars_Scroll;
TempBitmap := TBitmap.Create;
TempBitmap.LoadFromResourceName(HInstance,'Z_RESET');
zoomresetbutton := TSpeedButton.Create(scrollpanel_lr);
zoomresetbutton.Parent := scrollpanel_lr;
zoomresetbutton.Glyph.Assign(TempBitmap);
zoomresetbutton.Onclick := Zoom_in_out;
TempBitmap.LoadFromResourceName(HInstance,'Z_LAST');
zoomlastbutton := TSpeedButton.Create(scrollpanel_lr);
zoomlastbutton.Parent := scrollpanel_lr;
zoomlastbutton.Glyph.Assign(TempBitmap);
zoomlastbutton.Onclick := Zoom_last;
TempBitmap.LoadFromResourceName(HInstance,'Z_PLUS');
zoom_in_button := TSpeedButton.Create(scrollpanel_lr);
zoom_in_button.Parent := scrollpanel_lr;
zoom_in_button.Glyph.Assign(TempBitmap);
zoom_in_button.OnMouseDown := Zoom_mousedown;
zoom_in_button.OnMouseUP := Zoom_mouseup;
TempBitmap.LoadFromResourceName(HInstance,'Z_MINUS');
zoom_out_button := TSpeedButton.Create(scrollpanel_lr);
zoom_out_button.Parent := scrollpanel_lr;
zoom_out_button.Glyph.Assign(TempBitmap);
zoom_out_button.OnMouseDown := Zoom_mousedown;
zoom_out_button.OnMouseUP := Zoom_mouseup;
TempBitmap.Free;
Zooming_in := false;
Zooming_out := false;
Zooming_Rect := false;
zoomtimer := TTimer.Create(scrollpanel_lr);
zoomtimer.OnTimer := Zoom_timer_event;
zoomtimer.Enabled := false;
zoomtimer.Interval := 500;
ClientArea := TPaintbox.Create(Self);
ClientArea.Cursor := crCross;
ClientArea.Visible := True;
ClientArea.Parent := Self;
ClientArea.Align := AlClient;
ClientArea.OnMouseMove := Mouse_Move;
ClientArea.OnMouseDown := Mouse_Down;
ClientArea.OnMouseUp := Mouse_Up;
ClientArea.OnDblClick := DblClick;
Coords := TLabel.Create(scrollpanel_lr);
Coords.Font.Name := 'FF_ARIAL';
Coords.Parent := scrollpanel_lr;
Coords.Font.Color := clNavy;
Coords.Caption := 'X= 0.000 Y= 0.000';
Zoomtext := TLabel.Create(scrollpanel_lr);
Zoomtext.Font.Name := 'FF_ARIAL';
Zoomtext.Parent := scrollpanel_lr;
Zoomtext.Font.Color := clMaroon;
Zoomtext.Caption := '1 : 1';
If Zoom_factor=0 then Zoom_factor := 1.25;
resize;
end;
///////////////////////////////////////////////////////////////////////////////
// Adjust everything after a resize
///////////////////////////////////////////////////////////////////////////////
procedure Zoom_panel.Resize;
begin
inherited;
scrollpanel_lr.height := GetSystemMetrics(SM_CYHSCROLL)*2;
scrollpanel_ud.width := GetSystemMetrics(SM_CXVSCROLL);
scrollbar_lr.left := 0;
scrollbar_lr.top := 0;
scrollbar_lr.height := scrollpanel_lr.height div 2;
scrollbar_lr.width := scrollpanel_lr.width - scrollpanel_ud.width*8;
scrollpanel_lr.BevelInner := bvNone;
scrollpanel_lr.BevelOuter := bvNone;
scrollbar_ud.left := 0;
scrollbar_ud.top := 0;
scrollbar_ud.width := scrollpanel_ud.width;
scrollbar_ud.height := scrollpanel_ud.height;
zoom_out_button.left := scrollbar_lr.width;
zoom_out_button.Width := scrollbar_ud.width*2;
zoom_out_button.height := scrollbar_lr.height*2;
zoom_in_button.left := scrollbar_lr.width + zoom_out_button.width;
zoom_in_button.Width := scrollbar_ud.width*2;
zoom_in_button.height := scrollbar_lr.height*2;
zoomlastbutton.left := scrollbar_lr.width + zoom_out_button.width*2;
zoomlastbutton.width := scrollbar_ud.width*2;
zoomlastbutton.height := scrollbar_lr.height*2;
zoomresetbutton.left := scrollbar_lr.width + zoom_out_button.width*3;
zoomresetbutton.width := scrollbar_ud.width*2;
zoomresetbutton.height := scrollbar_lr.height*2;
zoomresetbutton.Top := 0;
zoom_in_button.Top := 0;
zoom_out_button.Top := 0;
Coords.Font.Height := scrollbar_lr.Height-1;
Coords.Left := 8;
Coords.Top := scrollbar_lr.Height+1;
Zoomtext.Font.Height := scrollbar_lr.Height-1;
Zoomtext.Left := zoom_out_button.left - zoom_out_button.width*2;
Zoomtext.Top := scrollbar_lr.Height+1;
end;
///////////////////////////////////////////////////////////////////////////////
// Events we pass on to user
///////////////////////////////////////////////////////////////////////////////
procedure Zoom_panel.WMPaint(var Message: TWMPaint);
begin
inherited;
if Assigned(FOnPaint) then FOnPaint(Self);
end;
procedure Zoom_panel.Mouse_Down(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Integer);
// extra save/restore canvas stuff, because we may highlight objects
// whilst dragging the rectangle, and we want to preserve colours etc.
begin
if Button=mbLeft then begin // Creating the Zooming Rectangle
zooming_rect := True;
Ini_Point := Point(X,Y);
Old_Point := Ini_Point; // Load the actual Pos.
save_canvas_stuff;
// Draw first rectangle for XOr Mode Init
ClientArea.canvas.pen.style := psDashDotDot;
ClientArea.canvas.pen.mode := pmNotXor;
ClientArea.canvas.pen.width := 1;
ClientArea.canvas.pen.color := clRed;
ClientArea.Canvas.Brush.Style := bsclear;
ClientArea.Canvas.Rectangle(Ini_Point.X,Ini_Point.Y,Ini_Point.X,Ini_Point.Y);
restore_canvas_stuff;
end;
if Assigned(FOnMouseDown) then FOnMouseDown(Sender,Button,Shift,X,Y);
end;
procedure Zoom_panel.Mouse_Up(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Integer);
var ul,lr : TPoint; // UpperLeft and LowerRight zooming rect
uln,lrn : Point2D; // New window parameters
Begin
if (button=mbleft) and Zooming_rect then begin
Zooming_Rect := False;
save_canvas_stuff;
// Draw final rectangle for XOr Mode
ClientArea.canvas.pen.style := psDashDotDot;
ClientArea.canvas.pen.mode := pmNotXor;
ClientArea.canvas.pen.width := 1;
ClientArea.canvas.pen.color := clRed;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -