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 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.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
      e.PaintIn( Bitmap.Canvas.Handle, sz, sz );
      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;
  sheet.PaintIn( HintGraphicForm.Image1.Picture.Bitmap.Canvas.Handle, 100, 100 );
  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.