ページを更新する

Delphi で Bricscad 画面キャプチャ

Delphi で　Bricscad の画面をキャプチャし、EXE と同じフォルダにビットマップファイルを作成するサンプルです。
応用すれば、LayerView（画層一覧）とか、ドキュメント切り替えに使えます。

BricscadApp_TLB, BricscadDb_TLB　は、タイプライブラリの取り込みが必要です。
メニューから「コンポーネント」－「コンポーネントのインポート」を選択します。



「タイプライブラリの取り込み」にチェックを付け、[ 次へ ]をクリック。


BricscadApp Type Library ... を選択し、[ 次へ ] ボタンをクリック。


そのままで、[ 次へ ] ボタンをクリック。


「ユニットの作成」にチェックを付け、[ 完了 ]をクリック。


同じように、BricscadDb Type Library ... も、取り込みを行います。

unit BcadCaptureUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, BricscadApp_TLB, BricscadDb_TLB,
  Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Grids, ComObj ;

type
  TForm2 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
//****************************************
//画面の指定位置をBitmapに変換
//****************************************
procedure CaptureToBmp(Lf, Tp, W, H: Integer; bmp: TBitmap);
const
  CAPTUREBLT = $40000000;
var
  hdcScreen : HDC;
begin
  bmp.Width := W;
  bmp.Height := H;
  hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
  try
    BitBlt( bmp.Canvas.Handle, 0, 0, W, H, hdcScreen, Lf, Tp, SRCCOPY or CAPTUREBLT);
  finally
    DeleteDC(hdcScreen);
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  app : IAcadApplication;
  //docs : IAcadDocuments;
  doc : IAcadDocument;
  limmax, limmin : OleVariant;
  scrsize : OleVariant;
  scrH, scrW : integer;
  bmp : TBitmap;
  hnd : THandle;
  ARect : TRect;
  ALeft, ATop : integer;
  gridMode : Integer;
  ucsIcon : integer;
  dwgName : TFileName;
begin
  // Bricscad を見つける
  try
    if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
      ShowMessage('サポートされていません.');
      exit;
    end;
  except
    ShowMessage('有効な BricsCAD が見つかりません．');
    Exit;
  end;

  // 自フォームを最小に
  WindowState := wsMinimized;

  try
    //docs := app.Documents;

    // アクティブドキュメントを取得
    doc := app.ActiveDocument;

    // ファイル名を表示
    Caption := doc.Name;
    dwgName := doc.Name;

    // Bricscad をアクティブに
    SetForegroundWindow(doc.HWND);

    // 図面範囲を取得
    limmax := doc.GetVariable('LIMMAX');
    limmin := doc.GetVariable('LIMMIN');
    // 図面範囲をズーム
    app.ZoomWindow(limmin, limmax);

    // グラフィック画面のサイズを取得
    scrsize := doc.GetVariable('SCREENSIZE');
    scrW := scrsize[0];
    scrH := scrsize[1];

    // グリッドの表示モードを取得
    gridMode := doc.GetVariable('GRIDMODE');
    // UCSアイコンの表示モードを取得
    ucsICon := doc.GetVariable('UCSICON');
    // グリッドを非表示に
    if gridMode > 0 then
      doc.SetVariable('GRIDMODE', 0);
    // UCSアイコンを非表示に
    if ucsIcon > 0 then
      doc.SetVariable('UCSICON', 0);

    // キャプチャするビットマップの大きさに縮小
    app.ZoomScaled(168 / scrH, 0);

    // グラフィックウィンドウのハンドルを取得
    hnd := FindWindowEx(app.ActiveDocument.HWND, 0, 'AfxFrameOrView100u', nil);
    // ウィンドウの位置と大きさを取得
    GetWindowRect(hnd, ARect);
    // グラフィックウィンドウの左上座標
    ALeft := ARect.Left;
    ATop := ARect.Top;

    // キャプチャ用ビットマップを作成
    bmp := TBitmap.Create;
    try
      bmp.PixelFormat := pf32bit;
      // ビットマップの大きさ
      bmp.Width := 240;
      bmp.Height := 168;
      // キャプチャ
      CaptureToBmp(
        ALeft + (scrW - 240) div 2,
        ATop + (scrH - 168) div 2,
        bmp.Width, bmp.Height, bmp);

      // Image に表示
      Image1.Picture.Bitmap.Assign(bmp);
      // EXE と同じフォルダにビットマップを保存
      bmp.SaveToFile(ExtractFilePath(ParamStr(0)) + ChangeFileExt(dwgName, '.bmp'));

    finally
      bmp.Free;
    end;

    // ズームを元に戻す
    app.ZoomWindow(limmin, limmax);
    // グリッドの表示を戻す
    if gridMode > 0 then
      doc.SetVariable('GRIDMODE', gridMode);
    // UCSアイコンの表示を戻す
    if ucsIcon > 0 then
      doc.SetVariable('UCSICON', ucsIcon);
  except
    ;
  end;
  // 自フォームを戻す
  WindowState := wsNormal;

  // 自フォームをアクティブに
  SetForegroundWindow(Handle);
end;

end.