unit1.pas

电气控制仿真软件

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    vgctrl1: Tvgctrl;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure vgctrl1LButtonDown(Sender: TObject; X, Y: Double);
  private
    function CreateDianGan( x, y : double ) : IUnit;
  public
    procedure DrawGanTa( x, y : double );
    { Public declarations }
  end;

  TDPoint = record
    x, y : double;
  end;

  PDPoint = ^ADPoint;
  ADPoint = array[0..100000] of TDPoint;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  FDrawGanTa : Boolean;
  ss : WideString;
procedure TForm1.Button1Click(Sender: TObject);
begin
  FDrawGanTa := True;
end;

function TForm1.CreateDianGan( x, y : double ) : IUnit;
var
  Sheet1 : ISheet;
begin
  Sheet1 := ISheet( vgctrl1.ActiveSheet );
  Result := IUnit( Sheet1.AddUnit( 'Shape', x - 10, y - 10, 20, 20 ) );
end;

procedure TForm1.DrawGanTa( x, y : double );
var
  msg : TMsg;
  LastUnit : IUnit;
  TempLine : ILine;
  Sheet1 : ISheet;
  Points : PDPoint;
  dp : TDPoint;
begin
  Sheet1 := ISheet( vgctrl1.ActiveSheet );
  SetCapture( vgctrl1.Handle );
  LastUnit := CreateDianGan( x, y );
  TempLine := ILine( Sheet1.AddUnit( 'Line', x, y, 0, 0 ) );
  TempLine.SetPropertyValue('LinkMode', 1);
  TempLine.Locked := true;
  while( GetMessage( msg, 0, 0, 0 ) ) do
  begin
    if ( msg.message = WM_LBUTTONDOWN ) then
    begin
      TempLine.SetLink( LastUnit, 'P0', 'Center' );
      dp.x := short( LOWORD( msg.lparam ) );
      dp.y := short(HIWORD( msg.lparam ) );
      Sheet1.ClientToView( Integer( @dp ) );
      LastUnit := CreateDianGan( dp.x, dp.y );
      TempLine.SetLink( LastUnit, 'P1', 'Center' );
      TempLine := ILine( Sheet1.AddUnit( 'Line', dp.x, dp.y, 0, 0 ) );
      TempLine.SetPropertyValue('LinkMode', 1);
      TempLine.Locked := true;
    end
    else if( msg.message = WM_MOUSEMOVE )then
    begin
      dp.x := short( LOWORD( msg.lparam ) );
      dp.y := short(HIWORD( msg.lparam ) );
      Sheet1.ClientToView( Integer( @dp ) );
      Points := PDPoint( TempLine.Points );
      Points^[1].x := dp.x;
      Points^[1].y := dp.y;
      TempLine.Refresh;
    end
    else if( msg.message = WM_RBUTTONDOWN )then
    begin
      Sheet1.DeleteUnit( TempLine );
      break;
    end
    else
    begin
      TranslateMessage( msg );
      DispatchMessage( msg );
    end;
  end;
  ReleaseCapture;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  vgctrl1.Design('');
  vgctrl1.ShowRuler := true;
  vgctrl1.Execute('SystemParams.ScrollBarMode=1');
  vgctrl1.Execute('SystemParams.CenterLink=true');
end;

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

procedure TForm1.vgctrl1LButtonDown(Sender: TObject; X, Y: Double);
var
  dp : TDPoint;
  Sheet1 : ISheet;
begin
  if FDrawGanta then
  begin
    Sheet1 := vgctrl1.ActiveSheet;
    dp.x := X;
    dp.y := Y;
    sheet1.ClientToView(Integer(@dp));
    Sheet1.Cursor := 23;
    DrawGanTa(dp.x, dp.y);
    FDrawGanTa := false;
    Sheet1.Cursor := 0;
  end;
end;

end.