unit1.pas

电气控制仿真软件

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Panel4: TPanel;
    Panel7: TPanel;
    PaintBox2: TPaintBox;
    Panel6: TPanel;
    PaintBox1: TPaintBox;
    CmWV: TComboBox;
    Panel1: TPanel;
    Panel5: TPanel;
    Shape1: TShape;
    SpeedButton1: TSpeedButton;
    vgctrl1: Tvgctrl;
    procedure Button1Click(Sender: TObject);
    procedure vgctrl1OrgChanged(Sender: TObject);
    procedure vgctrl1ZoomChange(Sender: TObject; Zoom: Integer);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CmWVClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    Base1, Base2 : Integer;
    LDelta1, LDelta2 : Integer;
    PDelta1, PDelta2 : Integer;
  public
    { Public declarations }
  end;
  type TDPoint = record
    x : double;
    y : double;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function fround( d : double ) : Integer;
begin
  if( d < 0 )then
    Result := Trunc( d - 0.5 )
  else
    Result := Trunc( d + 0.5 );
end;

function GetNextConst( c : Integer ) : Integer;
var
  s : AnsiString;
  ch : Char;
begin
  s := IntToStr( c );
  ch := s[1];
  s := Copy( s, 2, Length( s ) - 1 );
  if( ch = '2' )then
    s := '5' + s
  else if( ch = '5' )then
    s := '10' + s
  else
    s := '2' + s;
  Result := StrToIntDef( s, 0 );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.vgctrl1OrgChanged(Sender: TObject);
var
  fp : TDPoint;
  p, sp : TPoint;
  sheet : ISheet;
begin
  sheet := ISheet( vgctrl1.ActiveSheet );
  fp.x := 0;
  fp.y := 0;
  sheet.ViewToClient( Longint( @fp ) );
  vgctrl1.ClientToScreen( Longint( @fp ) );
  p.x := fround( fp.x );
  p.y := fround( fp.y );
  sp := p;
  p := PaintBox1.ScreenToClient( p );
  Base1 := p.x;
  p := sp;
  p := PaintBox2.ScreenToClient( p );
  if( vgctrl1.Coordinate = 0 )then
    Base2 := p.y
  else
    Base2 := vgctrl1.ClientHeight - p.y;
  PaintBox1.Invalidate;
  PaintBox1.Update;
  PaintBox2.Invalidate;
  PaintBox2.Update;
end;

procedure TForm1.vgctrl1ZoomChange(Sender: TObject; Zoom: Integer);
var
  dbl : double;
  c, sc : Integer;
begin
  CmWV.Text := IntToStr( Zoom ) + '%';
  dbl := 10000 / Zoom;
  LDelta1 := fround( dbl );
  c := 2;
  sc := 2;
  if( LDelta1 < 1 )then
    LDelta1 := 1;
  while( LDelta1 > c )do
  begin
    sc := c;
    c := GetNextConst( c );
  end;
  if( LDelta1 - sc < c - LDelta1 ) and ( sc >= 10 ) then
    c := sc;
  LDelta1 := c;
  PDelta1 := MulDiv( c, Zoom, 100 );
  LDelta2 := LDelta1;
  PDelta2 := PDelta1;
  PaintBox1.Invalidate;
  PaintBox1.Update;
  PaintBox2.Invalidate;
  PaintBox2.Update;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  bmp : TBitmap;
  PaintBox : TPaintBox;
  dc : HDC;
  r : TRect;
  i, j, k, y, al, o, n, max, mode : Integer;
  f : double;
  str : array[0..20] of char;
  Base, LDelta, PDelta : Integer;
begin
  PaintBox := TPaintBox( Sender );
  if ( vgctrl1.ActiveSheet = nil ) then
    Exit;
  bmp := TBitmap.Create;
  bmp.Width := PaintBox.Width;
  bmp.Height := PaintBox.Height;
  bmp.Canvas.FillRect( PaintBox.ClientRect );
  bmp.Canvas.Font := PaintBox.Font;
  dc := bmp.Canvas.Handle;
  r := PaintBox.ClientRect;
  if( PaintBox = PaintBox1 ) then
  begin
    Base := Base1;
    LDelta := LDelta1;
    PDelta := PDelta1;
  end
  else
  begin
    Base := Base2;
    LDelta := LDelta2;
    PDelta := PDelta2;
  end;
  n := Base mod PDelta;
  if( n > 0 )then
    n := n - PDelta;
  o := ( ( n - Base ) div PDelta ) * LDelta;
  f := PDelta / 10.0;
  if( PaintBox = PaintBox1 ) then
    max := r.right
  else
    max := r.bottom;
  mode := SetBkMode( dc, TRANSPARENT );
  al := SetTextAlign( dc, TA_BOTTOM );
  bmp.Canvas.Pen.Color := clGray;
  i := n;
  while i < max do
  begin
    for j := 0 to 9 do
    begin
      if( j = 0 )then
        k := 20
      else if( j = 5 )then
        k := 12
      else if( ( j mod 2 ) = 0 )then
        k := 8
      else
        k := 5;
      if( PaintBox = PaintBox1 ) then
      begin
        MoveToEx( dc, fround( i + j * f ), r.bottom, nil );
        LineTo( dc, fround( i + j * f ), r.bottom - k );
      end
      else
      begin
        y := fround( i + j * f );
        if( vgctrl1.Coordinate = 1 )then
          y := vgctrl1.ClientHeight - y;
        MoveToEx( dc, r.right, y, nil );
        LineTo( dc, r.right - k, y );
      end;
    end;
    if( PaintBox = PaintBox1 ) then
    begin
      StrPCopy( @str, IntToStr( o ) );
      TextOut( dc, i + 1, 14, str, lstrlen( str ) );
    end
    else
    begin
      y := i;
      if( vgctrl1.Coordinate = 1 )then
        y := vgctrl1.ClientHeight - y;
      StrPCopy( @str, IntToStr( o ) );
      TextOut( dc, 14, y, str, lstrlen( str ) );
    end;
    o := o + LDelta;
    i := i + PDelta;
  end;
  SetTextAlign( dc, al );
  if( PaintBox = PaintBox1 ) then
  begin
    MoveToEx( dc, 0, PaintBox.Height, nil );
    LineTo( dc, PaintBox.ClientWidth, PaintBox.Height );
  end
  else
  begin
    MoveToEx( dc, PaintBox.Height, 0, nil );
    LineTo( dc, PaintBox.Height, PaintBox.ClientHeight );
  end;
  SetBkMode( dc, mode );
  BitBlt( PaintBox.Canvas.Handle, 0, 0, Width, Height, bmp.Canvas.Handle, 0, 0, SRCCOPY );
  bmp.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  lf : LOGFONT;
begin
  GetObject( PaintBox1.Font.Handle, sizeof( lf ), @lf );
  lf.lfEscapement := 900;
  lf.lfOrientation := 900;
  PaintBox2.Font.Handle := CreateFontIndirect( lf );
  vgctrl1.Design( '' );
end;

procedure TForm1.CmWVClick(Sender: TObject);
var
  n, d : Integer;
  s : String;
begin
  s := TComboBox( Sender ).Text;
  n := Length( s );
  if( n > 0 ) and ( s[n] = '%' )then
    s[n] := #0;
  d := StrToIntDef( s, 100 );
  if( d < 10 )then
    d := 10;
  if( d > 10000 )then
    d := 10000;
  vgctrl1.Zoom := d;
  Windows.SetFocus( vgctrl1.Handle );
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  vgctrl1.MoveSheet;
end;

end.