unit1.~pas

电气控制仿真软件

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    Memo1: TMemo;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    Panel2: TPanel;
    ListView1: TListView;
    Splitter1: TSplitter;
    Panel1: TPanel;
    vgctrl1: Tvgctrl;
    vgctrl2: Tvgctrl;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure vgctrl2DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure vgctrl2DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    procedure PaintSheetToBitmap( e : ISheet; Bitmap : TBitmap );
    procedure LoadLib( vgctrl : Tvgctrl; sz : Integer );
  public
    { Public declarations }
  end;
  type TDPoint = record
    x : double;
    y : double;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses HintForm;
procedure TForm1.PaintSheetToBitmap( e : ISheet; Bitmap : TBitmap );
var
  i, n, w, h : Integer;
  r, temp, rect : TRect;
  d : IUnit;
  offset : TPoint;
  bak : TBitmap;
  cl : TColor;
  Brush : HBRUSH;
  sbm : Integer;
  dp : TDPoint;
begin
  n := e.UnitCount;
  offset.x := 0;
  offset.y := 0;
  if n > 0 then
  begin
    for i := 0 to n - 1 do
    begin
      d := IUnit(e.Units[i]);
      temp.left := round(d.Left);
      temp.Top := round(d.Top);
      temp.Right := temp.left + round(d.Width);
      temp.Bottom := temp.Top + round(d.Height);
      if i = 0 then
        r := temp
      else
        UnionRect( r, r, temp );
    end;
    w := round( r.right - r.left ) + 4;
    h := round( r.bottom - r.top ) + 4;
    if( w < Bitmap.Width ) and ( h < Bitmap.Height )then
    begin
      offset.x := round(( Bitmap.Width - w ) / 2);
      offset.y := round(( Bitmap.Height - h ) / 2);
      w := Bitmap.Width;
      h := Bitmap.Height;
    end
    else if( w > h )then
    begin
      offset.y := round(( w - h ) / 2);
      h := w;
    end
    else
    begin
      offset.x := round(( h - w ) / 2);
      w := h;
    end;
  end
  else
  begin
    w := Bitmap.Width;
    h := Bitmap.Height;
  end;
  bak := TBitmap.Create;
  bak.Width := w;
  bak.Height := h;
  rect.left := 0;
  rect.Top := 0;
  rect.Right := w;
  rect.bottom := h;

  cl := vgctrl1.BackColor;
  Brush := CreateSolidBrush( cl );
  FillRect( bak.Canvas.Handle, rect, Brush );
  DeleteObject( Brush );
  dp.x := 0;
  dp.y := 0;
  e.ClientToView( Integer( @dp ) );
  for i := 0 to n - 1 do
  begin
    d := IUnit(e.Units[i]);
    if vgctrl1.Coordinate = 1 then
      d.MoveTo( d.Left - r.Left + dp.x + offset.x, d.Top - r.Bottom + dp.y + offset.y )
    else
      d.MoveTo( d.Left - r.Left + dp.x + offset.x, d.Top - r.Top + dp.y + offset.y );
  end;
  e.PaintTo( Longint(bak.Canvas.Handle) );
  sbm := SetStretchBltMode( Bitmap.Canvas.Handle, HALFTONE );
  StretchBlt( Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, bak.Canvas.Handle, 0, 0, w, h, SRCCOPY );
  SetStretchBltMode( Bitmap.Canvas.Handle, sbm );
  bak.Free;
end;

procedure TForm1.LoadLib( vgctrl : Tvgctrl; sz : Integer );
var
  i, n : Integer;
  e : ISheet;
  Bitmap : TBitmap;
  ListItem : TListItem;
  cl : TColor;
begin
  ImageList1.Clear();
  Bitmap := TBitmap.Create;
  Bitmap.Width := sz;
  Bitmap.Height := sz;
  ImageList1.Width := sz;
  ImageList1.Height := sz;
  if ListView1.ViewStyle = vsIcon then
  begin
    ListView1.LargeImages := ImageList1;
    ListView1.SmallImages := nil;
  end
  else
  begin
    ListView1.LargeImages := nil;
    ListView1.SmallImages := ImageList1;
  end;
  n := vgctrl.SheetCount;
  cl := vgctrl1.BackColor;
  ListView1.Clear;
  for i := 0 to n - 1 do
  begin
    e := ISheet(vgctrl.Sheets[i]);
    if e.UnitCount > 0 then
    begin
      PaintSheetToBitmap( e, Bitmap );
      ImageList1.AddMasked( Bitmap, cl );
      ListItem := ListView1.Items.Add;
      ListItem.Caption := e.Name;
      ListItem.ImageIndex := i;
    end
    else
      ImageList1.AddMasked( Bitmap, cl );
  end;
  Bitmap.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  vgctrl2.Design( '' );
  vgctrl1.Run( '' );
  vgctrl1.Library_ := true;
  vgctrl1.LoadFromBuffer( Memo1.Lines.Text );
  vgctrl1.ScrollBars := 0;
  Windows.SetWindowLong( vgctrl1.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW );
  Windows.SetWindowLong( vgctrl1.Handle, GWL_STYLE, WS_BORDER or WS_CHILD );
  vgctrl1.Zoom := 100;
  LoadLib( vgctrl1, 32 );
end;

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

procedure TForm1.RadioButton4Click(Sender: TObject);
begin
  ListView1.ViewStyle := vsList;
  LoadLib( vgctrl1, 16 );
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  ListView1.ViewStyle := vsIcon;
  LoadLib( vgctrl1, 64 );
end;

procedure TForm1.RadioButton3Click(Sender: TObject);
begin
  ListView1.ViewStyle := vsSmallIcon;
  LoadLib( vgctrl1, 16 );
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  ListView1.ViewStyle := vsIcon;
  LoadLib( vgctrl1, 32 );
end;

procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if( ListView1.ItemIndex = -1 )then
    Exit;
  if( Button <> mbLeft )then
    Exit;
  ListView1.BeginDrag( false );
end;

procedure TForm1.vgctrl2DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  ListView1.EndDrag( true );
end;

procedure TForm1.vgctrl2DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  Windows.SetFocus( vgctrl2.Handle );
  vgctrl2.NewUnit( ListView1.Selected.Caption, 1 );
end;

procedure TForm1.ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Item : TListItem;
  Accept : Boolean;
  message : MSG;
  p : TPoint;
  rect : TRect;
  sheet : ISheet;
  HintGraphicForm : THintForm;
begin
  if( ssLeft in Shift ) or ( ssRight in Shift )then
    Exit;
  Item := ListView1.GetItemAt( X, Y );
  if( Item = nil )then
    Exit;

  Accept := false;
  SetTimer( ListView1.Handle, 1, 500, nil );
  while ( GetMessage( message, 0, 0, 0 ) )do
  begin
    if( message.message = WM_QUIT )then
    begin
      PostQuitMessage( 0 );
      break;
    end else if( message.message = WM_TIMER ) and ( message.hwnd = ListView1.Handle )then
    begin
      Accept := true;
      break;
    end else if( message.message >= WM_MOUSEFIRST ) and ( message.message <= WM_MOUSELAST )then
    begin
      PostMessage( message.hwnd, message.message, message.wParam, message.lParam );
      break;
    end else
    begin
      TranslateMessage( message );
      DispatchMessage( message );
    end ;
  end ;
  KillTimer( ListView1.Handle, 1 );
  if( not Accept )then
    Exit;
  p.x := x;
  p.y := y;

  rect := Item.DisplayRect( drBounds );
  p := ListView1.ClientToScreen( p );
  vgctrl1.ActiveSheetIndex := Item.Index;
  sheet := ISheet(vgctrl1.ActiveSheet);
  HintGraphicForm := THintForm.Create( nil );
  Windows.SetParent( HintGraphicForm.Handle, GetDesktopWindow() );
  HintGraphicForm.Image1.Picture.Bitmap.Width := 100;
  HintGraphicForm.Image1.Picture.Bitmap.Height := 100;
  PaintSheetToBitmap( sheet, HintGraphicForm.Image1.Picture.Bitmap );
  Windows.SetWindowLong( HintGraphicForm.Handle, GWL_STYLE, WS_VISIBLE or WS_CHILD or WS_BORDER );
  ShowWindow( HintGraphicForm.Handle, SW_SHOW );
  Windows.MoveWindow( HintGraphicForm.Handle, p.x, p.y, 102, 102, true );
  SetCapture( ListView1.Handle );
  while ( GetMessage( message, 0, 0, 0 ) )do
  begin
    if( message.message = WM_QUIT )then
    begin
      PostQuitMessage( 0 );
      break;
    end else if( message.message = WM_MOUSEMOVE )then
    begin
      if( message.hwnd = ListView1.Handle )then
      begin
        if( ListView1.GetItemAt( LOWORD( message.lParam ), HIWORD( message.lParam ) ) <> Item )then
          break;
      end else
        break;
    end else if( message.message = WM_LBUTTONDOWN ) or ( message.message = WM_RBUTTONDOWN )then
    begin
      PostMessage( message.hwnd, message.message, message.wParam, message.lParam );
      break;
    end else
    begin
      TranslateMessage( message );
      DispatchMessage( message );
    end;
  end;
  ReleaseCapture();
  HintGraphicForm.Free;
end;

end.