smallviewwin.pas

电气控制仿真软件

unit smallviewwin;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, OleCtrls, vgctrl40_TLB, StdCtrls, Buttons;

type
  TMyPanel = class( TPanel )
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure Paint; override;
  public
    constructor Create( AOwner : TComponent ); override;
  end;
  TForm1 = class(TForm)
    Panel2: TPanel;
    Panel1: TPanel;
    Memo1: TMemo;
    vgctrl1: Tvgctrl;
    procedure FormCreate(Sender: TObject);
    procedure vgctrl1ZoomChange(Sender: TObject; Zoom: Integer);
    procedure vgctrl1OrgChanged(Sender: TObject);
    procedure MyPanel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MyPanel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MyPanel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    MyPanel1 : TMyPanel;
    MemoryImage : TBitmap;
    PrevPoint : TPoint;
    procedure PaintRect;
  public
    { Public declarations }
  end;
  TDPoint = record
    x, y : double;
  end;
  PDRect = ^TDRect;
  TDRect = record
    left, top, right, bottom : double;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TMyPanel.Create( AOwner : TComponent );
begin
  Inherited Create( AOwner );
end;

procedure TMyPanel.Paint;
begin
  Form1.PaintRect;
end;

procedure TMyPanel.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
//避免闪烁。
  Message.Result := 1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyPanel1 := TMyPanel.Create( Panel1 );
  MyPanel1.Parent := Panel1;
  MyPanel1.Align := alClient;
  MyPanel1.OnMouseDown := MyPanel1MouseDown;
  MyPanel1.OnMouseMove := MyPanel1MouseMove;
  MyPanel1.OnMouseUp := MyPanel1MouseUp;
end;

procedure TForm1.PaintRect();
var
  r : TRect;
  fp : TDPoint;
  Sheet1 : ISheet;
  dr : PDRect;
begin
  if MemoryImage = nil then
    Exit;
  BitBlt( MyPanel1.Canvas.Handle, 0, 0, MemoryImage.Width, MemoryImage.Height, MemoryImage.Canvas.Handle, 0, 0, SRCCOPY );
  if( MemoryImage.Width < MyPanel1.ClientWidth ) then
  begin
    r := MyPanel1.ClientRect;
    r.left := MemoryImage.Width;
    MyPanel1.Canvas.Brush.Color := clWhite;
    MyPanel1.Canvas.FillRect( r );
  end;
  if( MemoryImage.Height < MyPanel1.ClientHeight ) then
  begin
    r := MyPanel1.ClientRect;
    r.top := MemoryImage.Height;
    MyPanel1.Canvas.Brush.Color := clWhite;
    MyPanel1.Canvas.FillRect( r );
  end;
  dr := PDRect( vgctrl1.Range );
  Windows.GetClientRect( vgctrl1.Handle, r );
  Sheet1 := vgctrl1.ActiveSheet;
  fp.x := r.left;
  fp.y := r.top;
  Sheet1.ClientToView( Integer( @fp ) );
  fp.x := ( fp.x - dr^.Left ) * MemoryImage.Width / ( dr^.Right - dr^.left );
  fp.y := ( fp.y - dr^.Top ) * MemoryImage.Height / ( dr^.Bottom - dr^.Top );
  r.Left := round( fp.x );
  r.top := round( fp.y );

  fp.x := r.Right;
  fp.y := r.Bottom;
  Sheet1.ClientToView( Integer( @fp ) );
  fp.x := ( fp.x - dr^.Left ) * MemoryImage.Width / ( dr^.Right - dr^.left );
  fp.y := ( fp.y - dr^.Top ) * MemoryImage.Height / ( dr^.Bottom - dr^.Top );
  r.Right := round( fp.x );
  r.Bottom := round( fp.y );

  MoveToEx( MyPanel1.Canvas.Handle, r.left, r.top, nil );
  LineTo( MyPanel1.Canvas.Handle, r.right, r.top );
  LineTo( MyPanel1.Canvas.Handle, r.right, r.bottom );
  LineTo( MyPanel1.Canvas.Handle, r.left, r.bottom );
  LineTo( MyPanel1.Canvas.Handle, r.left, r.top );

end;

procedure TForm1.vgctrl1ZoomChange(Sender: TObject; Zoom: Integer);
begin
  MyPanel1.Repaint;
end;

procedure TForm1.vgctrl1OrgChanged(Sender: TObject);
begin
  MyPanel1.Repaint;
end;

procedure TForm1.MyPanel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if MemoryImage = nil then
    Exit;
  MyPanel1.Tag := 1;
  PrevPoint.x := X;
  PrevPoint.y := Y;
end;

procedure TForm1.MyPanel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MyPanel1.Tag := 0;
end;

procedure TForm1.MyPanel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  r : TRect;
  fp1, fp2 : TDPoint;
  Sheet1 : ISheet;
  dr : PDRect;
  n : double;
  dx, dy : Integer;
begin
  if MyPanel1.Tag = 1 then
  begin
    dr := PDRect( vgctrl1.Range );
    Windows.GetClientRect( vgctrl1.Handle, r );
    Sheet1 := ISheet( vgctrl1.ActiveSheet );
    fp1.x := r.left;
    fp1.y := r.Top;
    Sheet1.ClientToView( Integer( @fp1 ) );
    fp2.x := r.Right;
    fp2.y := r.Bottom;
    Sheet1.ClientToView( Integer( @fp2 ) );
    n := ( fp2.x - fp1.x ) * MemoryImage.Width / ( dr^.Right - dr^.left );
    dx := round( ( X - PrevPoint.x ) * ( r.right - r.left ) / n );
    n := ( fp2.y - fp1.y ) * MemoryImage.Height / ( dr^.Bottom - dr^.top );
    dy := round( ( Y - PrevPoint.y ) * ( r.bottom - r.top ) / n );
    vgctrl1.ScrollBy( dx, dy );
    PrevPoint.x := X;
    PrevPoint.y := Y;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  Sheet1 : ISheet;
  dr : PDRect;
  bmp : TBitmap;
  sbm : Integer;
  n : Integer;
begin
  vgctrl1.Run( '' );
  vgctrl1.LoadFromBuffer( Memo1.Lines.Text );
  vgctrl1.Zoom := 100;
  dr := PDRect( vgctrl1.Range );
  Sheet1 := vgctrl1.ActiveSheet;
  bmp := TBitmap.Create;
  bmp.Width := round( dr^.right - dr^.left );
  bmp.Height := round( dr^.bottom - dr^.top );
  MemoryImage := TBitmap.Create;
  n := MulDiv( MyPanel1.Width, bmp.Height, bmp.Width );
  if n <= MyPanel1.Height then
  begin
    MemoryImage.Width := MyPanel1.Width;
    MemoryImage.Height := n;
  end
  else
  begin
    n := MulDiv( MyPanel1.Height, bmp.Width, bmp.Height );
    MemoryImage.Width := n;
    MemoryImage.Height := MyPanel1.Height;
  end;
  Sheet1.PaintTo( bmp.Canvas.Handle );
  sbm := SetStretchBltMode( MemoryImage.Canvas.Handle, HALFTONE );
  StretchBlt( MemoryImage.Canvas.Handle, 0, 0, MemoryImage.Width, MemoryImage.Height, bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, SRCCOPY );
  SetStretchBltMode( MemoryImage.Canvas.Handle, sbm );
  bmp.Free;
  vgctrl1.Page.Visible := false;
  vgctrl1.MoveSheet;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  PaintRect;
end;

end.