BcadPlot.exe for Bricscad V13~V17

2017/08/19 印刷スタイル一覧の最後が取得できないのを手直ししました。
2017/08/19 V17 の doc.Plot.PlotToDevicePLOT() で尺度が反映されるのを確認しました。

■概要
Bricscad で編集中の図面を連続で印刷します。

 印刷対象は、現在の図面と同じフォルダ名(システム変数:DWGPREFIX)の図面になります。
 印刷尺度は、システム変数 LIMMAX、LIMMIN から、A3横またはA4横サイズを基準として計算されます。
 シート番号またはページ番号の属性が設定してある場合は、その順番での出力が可能です。

・Bricscad で編集中の図面情報(属性)を一括で変更します。

■情報取得・印刷画面
 ※シート番号順、ページ番号順を使用するには、あらかじめ、ブロック名、属性名を設定しておいて下さい。


■図面情報画面
 ※あらかじめ、ブロック名、属性名を設定しておいて下さい。


■設定画面
 ※設定ファイルは、タブ区切りのテキストファイルです。
  エクセルで作成し、対象のセルを選択し、クリップボードにコピー。
  エディター、メモ帳等にペーストすれば、簡単に作成できます。


■制限事項、注意事項等
・Bricscad のバージョン、OS環境(32bit/64bit)等により、動かない場合があります。

■ダウンロード
 BcadPlot.zip (Ver.0.98 EXE本体+サンプル設定ファイル、サンプルLISPのみ)

■ソースコード


// 2017/08/19 プロットスタイル CTB, STB 一覧で最後が取得できないのを手直し

unit BcadPlotUnit;

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.CheckLst,Comobj, Vcl.ExtCtrls, Vcl.Grids, IniFiles, System.UITypes,
  Vcl.ComCtrls, Vcl.Buttons, ClipBrd, Imm, Printers, Winspool;

type
  //BcadPt = array [0..2] of double;

  TBcadAtt = record
    BlkName : string;
    TagName : string;
    TxtStr : string;
    colwidth : integer;
    ImeFlag : boolean;
    chkFlag : boolean;
  end;

type
  TForm5 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Button1: TButton;
    SpeedButton4: TSpeedButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Button2: TButton;
    Button4: TButton;
    Label3: TLabel;
    Edit1: TEdit;
    StringGrid1: TStringGrid;
    TabSheet2: TTabSheet;
    StringGrid2: TStringGrid;
    ProgressBar1: TProgressBar;
    Button7: TButton;
    Label6: TLabel;
    Edit2: TEdit;
    SpeedButton5: TSpeedButton;
    Label7: TLabel;
    ComboBox3: TComboBox;
    Label8: TLabel;
    CheckBox1: TCheckBox;
    TabSheet4: TTabSheet;
    StringGrid4: TStringGrid;
    GroupBox2: TGroupBox;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit3: TEdit;
    GroupBox3: TGroupBox;
    Label13: TLabel;
    Label14: TLabel;
    Edit7: TEdit;
    Edit8: TEdit;
    Label15: TLabel;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    Label16: TLabel;
    Label17: TLabel;
    SpeedButton13: TSpeedButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure StringGrid2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure StringGrid2Click(Sender: TObject);
    procedure StringGrid1Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);

  private
    { Private 宣言 }
    LastPrinter, LastCtbStb :string;
    MbRow, MbCol : integer;
  public
    { Public 宣言 }
    RunFlag : boolean;
    procedure DispCheckedCount;
  end;

var
  Form5: TForm5;

  BcadAttAry : array of TBcadAtt;

  // *****************************
// プリンター用紙名を取得
// *****************************
procedure GetPrinterPaperNames(iIndex :integer; sl: TStrings);

implementation

{$R *.dfm}

// *****************************
// 印刷チェック数をカウント
// *****************************
procedure TForm5.DispCheckedCount;
var
  i, cnt : integer;
begin
  cnt := 0;
  with StringGrid1 do begin
    for i := 1 to RowCount - 1 do begin
      if (Cells[1, i] <> '') and Bool(Objects[1, i]) then Inc(cnt);
    end;
  end;

  // 印刷ボタン
  Button2.Enabled := cnt > 0;

  Label5.Caption := IntToStr(cnt);
end;
// *****************************
// StringGrid でのキー操作
// *****************************
procedure SgKeyDown(SG: TSTringGrid; var Key: Word; Shift:TShiftState);
var
  i, j, k, n : integer;
  sl : TStringList;
  s, s1 : string;
  xflag : boolean;
begin
  if Key = VK_DELETE then begin
    with SG do begin
      if (Selection.Top <> Selection.Bottom) or
         (Selection.Left <> Selection.Right) then begin
        Key := 0;
        for i := Selection.Top to Selection.Bottom do begin
          for j := Selection.Left to Selection.Right do begin
            Cells[j, i] := '';
          end;
        end;
      end;
    end;
  end;
  if ssCtrl in Shift then begin

    if true then begin
      xflag := (Key = Ord('X')) or (Key = Ord('x'));
      if (Key = Ord('C')) or (Key = Ord('c')) or xflag then begin

        Key := 0;
        Clipboard.AsText := '';
        with SG do begin
          for i := Selection.Top to Selection.Bottom do begin
            for j := Selection.Left to Selection.Right do begin
              Clipboard.AsText := Clipboard.AsText + Cells[j, i];
              if j < Selection.Right then Clipboard.AsText := Clipboard.AsText + #9
              else Clipboard.AsText := Clipboard.AsText + #13#10;
            end;
          end;
          if xflag then begin
            for i := Selection.Top to Selection.Bottom do begin
              for j := Selection.Left to Selection.Right do begin
                Cells[j, i] := '';
              end;
            end;
          end;
        end;
      end
      else if (Key = Ord('V')) or (Key = Ord('v')) then begin
        //with SG do
        //  if EditorMode then EditorMode := false;
        Key := 0;
        with SG do begin
          sl := TStringList.Create;
          try
            s := Clipboard.AsText;
            while true do begin
              k := Pos(#13#10, s);
              if k = 0 then break
              else begin
                sl.Add(Copy(s, 1, k - 1));
                Delete(s, 1, k + 1);
              end;
            end;
            for i := 0 to sl.Count-1 do begin
              s := SL[i];
              j := 0;
              while true do begin
                k := Pos(#9, s);
                if k = 0 then begin
                  s1 := Copy(s, 1, Length(s));
                end
                else begin
                  s1 := Copy(s, 1, k - 1);
                  Delete(s, 1, k);
                end;
                Cells[Selection.Left + j,Selection.Top + i] := s1;
                n := 1;
                while true do begin
                  if Selection.Bottom < Selection.Top + i + (sl.Count * n) then
                    break
                  else begin
                    Cells[Selection.Left + j, Selection.Top + i + (sl.Count * n)] := s1;
                  end;
                  Inc(n);
                end;
                if k = 0 then break;
                Inc(j);
              end;
            end;
          finally
            sl.Free;
          end;
        end;
      end;
    end;
  end;
end;

// *****************************
// Bricscad のドキュメントから属性を取得
// *****************************
function GetAttString(doc : AcadDocument; const BlkName : string; const TagName : string): string;
var
  mspc   : AcadModelSpace;
  ent    : AcadEntity;
  blkref : AcadBlockReference;
  attr   : OleVariant;
  att    : AcadAttributeReference;
  idisp  : IDispatch;
  j , n, m, k : integer;
begin
  Result := '';
  mspc := doc.ModelSpace;

  if mspc.Count > 0 then begin
    for j := 0 to mspc.Count - 1 do begin
      ent := mspc.Item(j);
      if 'AcDbBlockReference' = ent.EntityName then begin
        blkref := ent as AcadBlockReference;
        if blkref.HasAttributes then begin
          if blkname = blkref.Name then begin
            attr := blkref.GetAttributes;
            n := VarArrayLowBound(attr, 1);
            m := VarArrayHighBound(attr, 1);
            for k := n to m do begin
              // 個々の属性を取得
              idisp :=   attr[k];
              att := idisp as AcadAttributeReference;
              if TagName = att.TagString then begin
                Result := att.TextString;
                Break;
              end;
            end;
            break;
          end;
        end;
      end;
    end;
  end;
end;

// *****************************
// StringGrid の Col の値でソート
// *****************************
procedure SgSortByCol2(sg : TStringGrid; col1, col2 :integer; NumFlag:boolean);
var
  i, j : integer;
  sl, sltemp : TStringList;
  s1, s0 : string;
begin
  // ソート
  sl := TStringList.Create;
  try
    sltemp := TStringList.Create;
    try
      with sg do begin
        for i := 1 to RowCount -2 do begin
          s0 := '';
          if col1 >= 0 then s0 := s0 + Cells[col1, i];
          if col2 >= 0 then s0 := s0 + Cells[col2, i];
          for j := i + 1 to RowCount -1 do begin
            s1 := '';
            if col1 >= 0 then s1 := s1 + Cells[col1, j];
            if col2 >= 0 then s1 := s1 + Cells[col2, j];

            if (not NumFlag and (s0 > s1)) or
               (NumFlag and (StrToIntDef(s0, 0) > StrToIntDef(s1, 0))) then begin
              slTemp.Assign(Rows[i]);
              Rows[i] := Rows[j];
              Rows[j] := slTemp;
              s0 := s1;
            end;
          end;
        end;
      end;
    finally
      slTemp.Free;
    end;
  finally
    sl.Free;
  end;
end;

// *****************************
// タブ区切り設定ファイルを読込
// *****************************
function ReadTsv:integer;
var
  sl, sltemp : TStringList;
  i, cnt : integer;
  tsvname : TFileName;
begin
  result := 0;
  cnt := 0;

  tsvname := ChangeFileExt(ParamStr(0), '.tsv');
  if FileExists(tsvName) then begin
    sl := TStringList.Create;
    try
      sltemp := TStringList.Create;
      try
        // スペースは区切りとしない
        sltemp.StrictDelimiter := True;
        // 区切り文字を TAB に
        sltemp.Delimiter := #09; // TAB
        sl.LoadFromFile(tsvname);
        SetLength(BcadAttAry, sl.Count + 2);

        for i := 0 to sl.Count - 1 do begin
          sltemp.DelimitedText := sl[i];
          if sltemp.Count >= 4 then begin
            with BcadAttAry[cnt + 2] do begin
              TxtStr := sltemp[0];
              BlkName := sltemp[1];
              TagName := sltemp[2];
              colwidth := StrToIntDef(sltemp[3], 0);
              if sltemp.Count >= 5 then
                ImeFlag := UpperCase(sltemp[4]) = 'ON'
              else
                ImeFlag := False;
              chkFlag := false;
            end;
            Inc(cnt);
          end;
        end;
        SetLength(BcadAttAry, cnt + 2);
        // 取得数
        result := cnt;
      finally
        sltemp.Free;
      end;
    finally
      sl.Free;
    end;
  end;
end;

// *****************************
// 内部データをStringGridに
// *****************************
procedure BcadAttAryToSettingSg(sg : TStringGrid);
var
  i, cnt : integer;
begin
  cnt := Length(BcadAttAry);
  with sg do begin
    RowCount := cnt -1;
    ColCount := 6;
    for i := 2 to cnt -1 do begin
      with BCadAttAry[i] do begin
        Cells[0, i-1] := IntToStr(i-1);
        Cells[1, i-1] := TxtStr;
        Cells[2, i-1] := BlkName;
        Cells[3, i-1] := TagName;
        Cells[4, i-1] := colwidth.ToString;
        if ImeFlag then Cells[5, i-1]:= 'ON'
        else Cells[5, i-1]:= '';

      end;
    end;
  end;
end;

// *****************************
// 内部データをStringGridに
// *****************************
procedure BcadAttAryToDispSg(sg : TStringGrid; stIndex: integer);
var
  i, cnt : integer;
begin
  cnt := Length(BcadAttAry);
  with sg do begin
    ColCount := cnt + 3;
    // 最後は非表示
    ColWidths[cnt-1] := 0;

    for i := 2 to cnt -1 do begin
      with BCadAttAry[i] do begin
        Cells[stIndex + i-2, 0] := TxtStr;
        ColWidths[stIndex + i -2] := colwidth;
      end;
    end;
  end;
end;

// *****************************
// 印刷:BricsCAD より取得
// *****************************
procedure TForm5.Button1Click(Sender: TObject);
var
  app : IAcadApplication;
  docs : IAcadDocuments;
  doc : IAcadDocument;
  i , idx : integer;
  limmax, limmin : OleVariant;
  cfg : IAcadPlotConfiguration;
  tablenames : OleVariant;
  n : integer;
  sdir : string;
  cnt : integer;
  mspc   : AcadModelSpace;
  ent    : AcadEntity;
  blkref : AcadBlockReference;
  att    : AcadAttributeReference;

  j, k : integer;
  attr : OleVariant;
  l, m, a: integer;
  idisp : IDispatch;
  s :string;
  arycnt : integer;
  dwgname , dwgprefix :string;
  chkcnt : integer;
begin
  try
    if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
      ShowMessage('サポートされていません.');
      exit;
    end;
  except
    ShowMessage('有効な BricsCAD が見つかりません.');
    Exit;
  end;

  try
    docs := app.Documents;
    doc := app.ActiveDocument;
    sdir := doc.GetVariable('DWGPREFIX');
    Edit1.Text := sdir;
    Edit2.Text := sdir;

    cnt := 0;
    arycnt := Length(BcadAttAry);

    if docs.Count > 0 then begin
      with Progressbar1 do begin
        Max := docs.Count;
        Position := 0;
      end;

      with StringGrid1 do begin
        RowCount := docs.Count + 1;

        for i := 1 to RowCount -1 do
          for j := 0 to ColCount -1 do
            Cells[j, i] := '';
      end;
      with StringGrid2 do begin
        RowCount := docs.Count + 1;
        for i := 1 to RowCount -1 do
          for j := 0 to ColCount -1 do
            Cells[j, i] := '';
      end;

      for i := 0 to docs.Count - 1 do begin
        doc := docs.Item(i);
        dwgname := doc.GetVariable('DWGNAME');
        dwgprefix := doc.GetVariable('DWGPREFIX');
        if sdir = dwgprefix then begin
          with StringGrid1 do begin
            Cells[0, cnt + 1] := IntToStr(i + 1);
            Cells[1, cnt + 1] := dwgname;

            limmax := doc.GetVariable('LIMMAX');
            limmin := doc.GetVariable('LIMMIN');

            Cells[2, cnt + 1] := Format('%.1f',[Double(limmax[0] - limmin[0])]);
            Cells[3, cnt + 1] := Format('%.1f',[Double(limmax[1] - limmin[1])]);
            // ScaleA3
            Cells[4, cnt + 1] := Format('%.3f',[Double(limmax[0]) / 420]);
            // ScaleA4
            Cells[5, cnt + 1] := Format('%.3f',[Double(limmax[0]) / 297]);
            Objects[1, cnt + 1] := TObject(True);
          end;
          with StringGrid2 do begin
            Cells[0, cnt + 1] := IntToStr(i + 1);
            Cells[1, cnt + 1] := dwgname;
            Cells[ColCount - 1, cnt + 1] := dwgprefix;
          end;

          mspc := doc.ModelSpace;
          if mspc.Count > 0 then begin
            // 検索済フラグを初期化
            for k := 0 to arycnt-1 do
              BcadAttAry[k].chkFlag := False;

            for j := 0 to mspc.Count - 1 do begin
              ent := mspc.Item(j);
              if 'AcDbBlockReference' = ent.EntityName then begin
                blkref := ent as IAcadBlockReference;
                if blkref.HasAttributes then begin
                  for k := 0 to arycnt - 1 do begin
                    if not BcadAttAry[k].chkFlag then begin
                      if BcadAttAry[k].BlkName = blkref.Name then begin

                        attr := blkref.GetAttributes;
                        n := VarArrayLowBound(attr, 1);
                        m := VarArrayHighBound(attr, 1);
                        for l := n to m do begin
                          // 個々の属性を取得
                          idisp :=   attr[l];
                          att := idisp as IAcadAttributeReference;
                          s := att.TagString;
                          // 登録の属性のすべてを確認する
                          for a := 0 to arycnt -1 do begin
                            if not BcadAttAry[a].chkFlag then begin
                              if (BcadAttAry[a].BlkName = blkref.Name) and (s = BcadAttAry[a].TagName) then begin
                                if a < 2 then
                                  StringGrid1.Cells[a + 7, cnt + 1] := att.TextString
                                else
                                  StringGrid2.Cells[a , cnt + 1] := att.TextString;
                                BcadAttAry[a].chkFlag := True;
                              end;
                            end;
                          end;
                        end;
                        // 最終まで検索済
                        BcadAttAry[k].chkFlag := True;
                      end;
                    end;
                  end;
                end;
              end;
              // 検索終了の確認
              chkcnt := 0;
              for k := 0 to arycnt -1 do
                if BcadAttAry[k].chkFlag then Inc(chkcnt);
              if chkcnt = arycnt then break;

            end;
          end;

          with Progressbar1 do Position := Position + 1;
          Inc(cnt);
        end;
      end;
      with StringGrid1 do begin
        RowCount := cnt + 1;
        Row := 1;
        Col := 2;
        SetFocus;
      end;
      with StringGrid2 do begin
        RowCount := cnt + 1;
        Row := 1;
        Col := 2;
        //SetFocus;
      end;

      label6.Caption := '/' + cnt.ToString;
      Progressbar1.Position := 0;
    end;

    if doc.PlotConfigurations.Count = 0 then
      doc.PlotConfigurations.Add('TEST', 0);

    cfg := doc.PlotConfigurations.Item(0);
    cfg.RefreshPlotDeviceInfo;

    if Assigned(cfg) then begin

      // プリンター名一覧をBricsCADから取得
      {
      devnames := cfg.GetPlotDeviceNames;
      n := VarArrayHighBound(devnames, 1);
      if n > 0 then begin

        idx := -1;
        with ComboBox1 do begin
          Items.Clear;
          for i := 0 to n - 1  do begin
            Items.Add(devnames[i]);
            if (LastPrinter <> '') and (LastPrinter = devnames[i]) then
              idx := i;
          end;
          if idx >= 0 then
            ItemIndex := idx
          else
            ItemIndex := Items.Count -1;
          // プリンター名をセット
          cfg.ConfigName := Items[ItemIndex];
        end;
      end;
      }

      // プリンター名一覧をWindows から取得
      ComboBox1.Items.Assign(Printer.Printers);
      with ComboBox1 do begin
        if LastPrinter <> '' then begin
          for i := 0 to Items.Count - 1  do begin
            if Items[i] = LastPrinter then begin
              ItemIndex := i;
              Break;
            end;
          end;
        end
        else begin
          if Items.Count > 0 then
            ItemIndex := 0
          else
            ItemIndex := - 1;
        end;
      end;

      // ここでセットしたプリンターの用紙サイズ一覧をBricsCADから取得

      cfg.RefreshPlotDeviceInfo;
      // 用紙サイズ一覧をBricsCADから取得
      {
      papernames := cfg.GetCanonicalMediaNames;
      n := VarArrayHighBound(papernames, 1);
      if n > 0 then begin

        with ComboBox3 do begin
          Items.Clear;
          for i := 0 to n - 1  do
            Items.Add(papernames[i]);
          Sorted := True;
          idx := Items.IndexOf('A4');
          if idx >= 0 then
            ItemIndex := idx
          else
            ItemIndex := Items.Count -1;
        end;
      end;
      }

      GetPrinterPaperNames(ComboBox1.ItemIndex, ComboBox3.Items);
      with ComboBox3 do begin
        for i := 0 to Items.Count - 1 do begin
          if Pos('A4', Items[i]) > 0 then begin
            ItemIndex := i;
            break;
          end;
        end;
      end;


      tablenames := cfg.GetPlotStyleTableNames;
      // CTB,STB 一覧
      n := VarArrayLowBound(tablenames, 1);
      m := VarArrayHighBound(tablenames, 1);
      if m > 0 then begin
        idx := -1;
        with ComboBox2 do begin
          Items.Clear;
          for i := n to m do begin // 2017/08/19 修正
            Items.Add(tablenames[i]);
            if (LastCtbStb <> '') and (LastCtbStb = tablenames[i]) then
              idx := i;
          end;
          if idx >= 0 then
            ItemIndex := idx
          else
            ItemIndex := Items.Count - 1;
        end;
      end;
    end;

    DispCheckedCount;
    // シート番号順
    SpeedButton7Click(self);
    SpeedButton11Click(self);

  except
    ;
  end;
end;


// *****************************
// プリンター用紙名を取得
// *****************************
procedure GetPrinterPaperNames(iIndex :integer; sl: TStrings);
type
  //用紙名リスト用.用紙名の文字数の最大は64
  TPaperName = array [0..63] of Char;
var
  ADevice      : array [0..MAX_PATH-1] of Char;
  ADriver      : array [0..MAX_PATH-1] of Char;
  APort        : array [0..MAX_PATH-1] of Char;
  ADeviceMode  : THandle;
  Count        : Integer;
  PaperNames   : array of TPaperName;
  i            : Integer;
begin

  sl.Clear;

  //選択したプリンタを現在のプリンタとする
  Printer.PrinterIndex := iIndex;

  //現在のプリンタに関する情報を取り出す
  Printer.GetPrinter(ADevice, ADriver, APort, ADeviceMode);

  //そのプリンタADeviceのAPortの用紙名の数を取得
  Count := Winspool.DeviceCapabilities(ADevice, APort, DC_PAPERNAMES, nil, nil);

  //その分だけ用紙名配列の長さと用紙番号の配列の長さを確保
  SetLength(PaperNames, Count);

  //その配列に用紙名と用紙番号を取得
  Winspool.DeviceCapabilities(ADevice, APort, DC_PAPERNAMES, PChar(PaperNames), nil);

  //用紙名
  for i := 0 to Count - 1 do sl.Add(String(PaperNames[i]));

end;

// *****************************
// 印刷実行
// *****************************
procedure TForm5.Button2Click(Sender: TObject);
var
  app: IAcadApplication;
  docs: IAcadDocuments;
  doc: IAcadDocument;
  i : integer;
  scale : string;
  papersize, plotcmd : string;
  idx : integer;
  devname : string;
  fname : TFileName;
  cfg : IAcadPlotConfiguration;
  docOrg : IAcadDocument;

begin
  try
    if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
      ShowMessage('not Supports');
      exit;
    end;
  except
    ShowMessage('有効な BricsCAD が見つかりません.');
    exit;
  end;

  fname := ExtractFilePath(ParamStr(0)) + Edit7.Text;
  if (Edit7.Text <> '') and FileExists(fname) then
    fname := StringReplace(fname, '\', '\\', [rfReplaceAll])
  else
    fname := '';

  try
    if MessageDlg('選択ファイルを印刷しますか?', mtInformation,mbYesNo,0) = mrYes then begin

      with ComboBox1 do begin
        if ItemIndex >= 0 then
          LastPrinter := Items[ItemIndex]
        else
          LastPrinter := '';
      end;

      with ComboBox3 do begin
        if ItemIndex >= 0 then
          papersize := Items[ItemIndex]
        else
          papersize := 'A4';
      end;

      with ComboBox2 do begin
        if ItemIndex >= 0 then
          LastCtbStb := Items[ItemIndex]
        else
          LastCtbStb := '';
      end;

      if (LastPrinter <> '') and (LastCtbStb <> '') then begin
        devname := LastPrinter;

        RunFlag := True;

        Button2.Enabled := False;
        Button4.Enabled := True;

        // 現在の図面
        docOrg := app.ActiveDocument;

        docs := app.Documents;
        if (docs.Count > 0) then begin
          with StringGrid1 do begin
            ProgressBar1.Max := RowCount - 1;
            ProgressBar1.Position := 0;
            for i := 1 to RowCount - 1 do begin
              with Progressbar1 do Position  := Position + 1;

              Application.ProcessMessages;

              if RunFlag and Bool(Objects[1, i]) then begin
                idx := StrToInt(Cells[0, i])-1;

                doc := docs.Item(idx);
                app.ActiveDocument := doc;

                if doc.PlotConfigurations.Count = 0 then
                  doc.PlotConfigurations.Add('TEST', 0);

                cfg := doc.PlotConfigurations.Item(0);
                cfg.RefreshPlotDeviceInfo;

                with ComboBox1 do
                  // プリンター名をセット
                  cfg.ConfigName := Items[ItemIndex];

                with ComboBox3 do
                  // 用紙サイズ名
                  cfg.CanonicalMediaName := Items[ItemIndex];

                with ComboBox2 do
                  // 印刷スタイル名
                  cfg.StyleSheet := Items[ItemIndex];


                cfg.PlotType := acExtents;
                cfg.CenterPlot := True;

                cfg.UseStandardScale := False;

                // A3 -> A4 縮小
                if Pos('A4', papersize) > 0 then begin
                  scale := '1:' + Format('%.3f',[StrToFloat(Cells[5, i])]);
                  // 尺度設定
                  cfg.SetCustomScale(1.0, StrToFloat(Cells[5, i]));
                end
                // A3 -> A3
                else begin
                  // papersize := 'A3';
                  scale := '1:'+Format('%.3f',[StrToFloat(Cells[4, i])]);
                  // 尺度設定(分子,分母)

                  cfg.SetCustomScale(1.0, StrToFloat(Cells[4, i]));

                end;
                // 必要?
                // cfg.RefreshPlotDeviceInfo;

                // 尺度変更のため再作図が必要
                doc.Regen(acAllViewports);

                // 端子シンボルを最前面にするLISPを発行
                if fname <> '' then
                  doc.SendCommand('(load "' + fname + '")' + #13);
                if Edit8.Text <> '' then
                  doc.SendCommand(Edit8.Text + #13);


                if CheckBox1.Checked then
                  // 尺度設定が出来ないため保留
                  doc.Plot.PlotToDevice(cfg.ConfigName)
                else begin
                  {
                  // RunCommandでは、'\' 文字が使えないため、コメントアウト
                  plotcmd := 'PLOT;Y;model'+#13 + devname +#13 + papersize +
                    ';M;L;N;L;' + scale + ';C;Y;'+
                    LastCtbStb + ';Y;N;N;N;Y';
                  //app.RunCommand(plotcmd);
                  }

                  // コマンドライン版(実績有り)
                  plotcmd := 'PLOT' + #13 + 'Y' + #13 + 'model' + #13 + devname + #13 +
                    papersize + #13 + 'M' + #13 + 'L' + #13 + 'N' + #13 + 'L' + #13 +
                    scale + #13 + 'C' + #13 + 'Y' + #13 + LastCtbStb + #13 + 'Y' + #13 +
                    'N' + #13 + 'N' + #13 + 'N' + #13 + 'Y' + #13;
                  doc.SendCommand(plotcmd);
                end;
              end;
            end;
          end;
          ProgressBar1.Position := 0;
          if RunFlag then
            ShowMessage('印刷が終了しました.')
          else
            ShowMessage('印刷を中止しました.');

          Button2.Enabled := True;
          Button4.Enabled := False;
          // 最初の図面に戻す
          docOrg.Activate;

        end;
      end;
    end;
  except
    ;
  end;
  {
  : PLOT
  詳細な印刷構成? はい(Y)/<いいえ(N)>: y
  レイアウト名を入力 または [?] <Model>: model
  出力デバイス名を入力 または [?] <pdfFactory>:
  用紙サイズを入力 または [?] <A4>:
  用紙単位 インチ(I)/<ミリ(M)>:
  図面の向き 縦(P)/<横(L)>: l
  上下を反転して印刷? はい(Y)/<いいえ(N)>: n
  印刷範囲を指定 表示(D)/図形範囲(E)/<図面範囲(L)>/ビュー(V)/窓(W): l
  印刷尺度を入力 (印刷 ミリ = 作図単位) または フィット(F) <1:7.07>:
  印刷オフセットを入力 (x,y) または 中心(C) <Center>: c
  印刷スタイルを使用? <はい(Y)>/いいえ(N): y
  印刷スタイルテーブル名 または [?] (無しのときは . を入力) <monochrome018.ctb>:
  線の太さを印刷? <はい(Y)>/いいえ(N): y
  隠れ線を除外? はい(Y)/<いいえ(N)>: n
  印刷データをファイルへ出力? はい(Y)/<いいえ(N)>: n
  レイアウトへ変更を保存しますか? はい(Y)/<いいえ(N)>: n
  印刷を続行? <はい(Y)>/いいえ(N): y
  }
end;

// *****************************
// 中止ボタン
// *****************************
procedure TForm5.Button4Click(Sender: TObject);
begin
  RunFlag := False;
  Application.ProcessMessages;
end;

// *****************************
// 図面情報を更新
// *****************************
procedure TForm5.Button7Click(Sender: TObject);
var
  app    : AcadApplication;
  docs   : AcadDocuments;
  doc    : AcadDocument;
  mspc   : AcadModelSpace;
  ent    : AcadEntity;
  blkref : AcadBlockReference;
  att    : AcadAttributeReference;
  attr : OleVariant;
  idisp : IDispatch;

  i, j, k, kk, a ,l: integer;
  n, m : integer;
  s : string;
  dwgname, dwgprefix : string;
  arycnt : integer;
  chkcnt : integer;
begin
  try
    if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
      ShowMessage('サポートされていない');
      exit;
    end;
  except
    ShowMessage('有効な BricsCAD が見つかりません.');
    exit;
  end;
  try
    arycnt := Length(BcadAttAry);

    docs := app.Documents;
    if docs.Count > 0 then begin
      RunFlag := True;

      Button7.Enabled := False;
      Button3.Enabled := True;

      ProgressBar1.Max := docs.Count;
      with StringGrid2 do begin
        for i := 0 to docs.Count - 1 do begin

          with ProgressBar1 do Position := Position + 1;
          Application.ProcessMessages;
          if not RunFlag then break
          else begin

            doc := docs.Item(i);
            dwgname := doc.GetVariable('DWGNAME');
            dwgprefix := doc.GetVariable('DWGPREFIX');

            for kk := 1 to RowCount -1 do begin
              if (dwgname = Cells[1, kk]) and (dwgprefix = Cells[ColCount - 1, kk]) then begin
                mspc := doc.ModelSpace;
                if mspc.Count > 0 then begin
                  // 検索済フラグを初期化
                  for k := 0 to arycnt-1 do
                    BcadAttAry[k].chkFlag := False;

                  for j := 0 to mspc.Count - 1 do begin
                    ent := mspc.Item(j);
                    if 'AcDbBlockReference' = ent.EntityName then begin
                      blkref := ent as IAcadBlockReference;
                      if blkref.HasAttributes then begin
                        for k := 2 to arycnt-1 do begin
                          if not BcadAttAry[k].chkFlag then begin
                            if BcadAttAry[k].BlkName = blkref.Name then begin
                              attr := blkref.GetAttributes;
                              n := VarArrayLowBound(attr, 1);
                              m := VarArrayHighBound(attr, 1);
                              for l := n to m do begin
                                // 個々の属性を取得
                                idisp :=   attr[l];
                                att := idisp as IAcadAttributeReference;
                                s := att.TagString;
                                for a := 2 to arycnt - 1 do begin
                                  if not BcadAttAry[a].chkFlag then begin
                                    if (BcadAttAry[a].BlkName = blkref.Name) and (s = BcadAttAry[a].TagName) then begin
                                      if Cells[a , kk] <> att.TextString then begin
                                        att.TextString := Cells[a, kk];
                                        att.Update;
                                      end;
                                      BcadAttAry[a].chkFlag := True;
                                    end;
                                  end;
                                end;
                              end;
                            end;
                          end;
                          // 最終まで検索済
                          BcadAttAry[k].chkFlag := True;
                        end;
                      end;
                    end;
                    // 検索終了の確認
                    chkcnt := 0;
                    for k := 0 to arycnt -1 do
                      if BcadAttAry[k].chkFlag then Inc(chkcnt);
                    if chkcnt = arycnt then Break;
                  end;
                end;
                Break;
              end;
            end;
          end;
        end;
      end;
      ProgressBar1.Position := 0;
    end;
    if RunFlag then
      ShowMessage('更新が終了しました.')
    else
      ShowMessage('更新を中止しました.');

    Button7.Enabled := True;
    Button3.Enabled := False;

  except
    ;
  end;
end;

// *****************************
// プリンター変更
// *****************************
procedure TForm5.ComboBox1Change(Sender: TObject);
var
  app  : AcadApplication;
  docs : AcadDocuments;
  doc  : AcadDocument;
  cfg  : AcadPlotConfiguration;
  i : integer;
begin
  with ComboBox1 do begin
    if ItemIndex >= 0 then
      LastPrinter := Items[ItemIndex];
  end;
  try
    if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
      ShowMessage('サポートされていません.');
      exit;
    end;
  except
    ShowMessage('有効な BricsCAD が見つかりません.');
    exit;
  end;

  try
    docs := app.Documents;
    doc := app.ActiveDocument;
    if doc.PlotConfigurations.Count = 0 then
      doc.PlotConfigurations.Add('TEST', 0);

    cfg := doc.PlotConfigurations.Item(0);

    if Assigned(cfg) then begin
      with ComboBox1 do
        // プリンター名をセット
        cfg.ConfigName := Items[ItemIndex];
      // ここでセットしたプリンターの用紙サイズ一覧
      {
      papernames := cfg.GetCanonicalMediaNames;
      n := VarArrayHighBound(papernames, 1);
      if n > 0 then begin

        with ComboBox3 do begin
          Items.Clear;
          for i := 0 to n - 1  do
            Items.Add(papernames[i]);
          Sorted := True;
          idx := Items.IndexOf('A4');
          if idx >= 0 then
            ItemIndex := idx
          else
            ItemIndex := Items.Count -1;
        end;
      end;
      }
      GetPrinterPaperNames(ComboBox1.ItemIndex, ComboBox3.Items);
      ComboBox3.Sorted := True;

      with ComboBox3 do begin
        for i := 0 to Items.Count - 1 do begin
          if Pos('A4', Items[i]) > 0 then begin
            ItemIndex := i;
            break;
          end;
        end;
      end;
    end;
  except
    ;

  end;
end;

// *****************************
// 印刷設定変更
// *****************************
procedure TForm5.ComboBox2Change(Sender: TObject);
begin
  with ComboBox2 do begin
    if ItemIndex >= 0 then
      LastCtbStb := Items[ItemIndex];
  end;
end;


// *****************************
// フォーム作成
// *****************************
procedure TForm5.FormCreate(Sender: TObject);
var
  ini : TIniFile;
  i : integer;
begin
  PageControl1.ActivePageIndex := 0;

  Edit1.Text := '';
  Edit2.Text := '';
  Edit3.Text := 'TITLE';
  Edit4.Text := 'ZSHEET';
  Edit5.Text := 'TITLE';
  Edit6.Text := 'ZITEM9';

  Edit7.Text := 'TBTOTOP.lsp';
  Edit8.Text := 'TBTOTOP';

  Caption := Application.Title;


  with StringGrid1 do begin
    RowCount := 2;

    ColWidths[0] := 30;
    ColWidths[1] := 230;
    ColWidths[2] := 50;
    ColWidths[3] := 50;
    ColWidths[4] := 50;
    ColWidths[5] := 50;
    ColWidths[6] := 0;
    ColWidths[7] := 50;
    ColWidths[8] := 50;

    Cells[0, 0] := 'No.';
    Cells[1, 0] := 'ファイル名';
    Cells[2, 0] := 'Lim W';
    Cells[3, 0] := 'Lim H';
    Cells[4, 0] := 'at A3';
    Cells[5, 0] := 'at A4';
    Cells[6, 0] := 'FilePath';
    Cells[7, 0] := 'SHEET';
    Cells[8, 0] := 'PAGE';
  end;


  with StringGrid2 do begin
    RowCount := 2;
    // 初期値
    ColWidths[0] := 30;
    ColWidths[1] := 160;
    ColWidths[6] := 80;
    ColWidths[7] := 50;

    for i := 8 to 10 do ColWidths[i] := 40;
    for i := 11 to 16 do ColWidths[i] := 50;

    Cells[0, 0] := 'No.';
    Cells[1, 0] := 'ファイル名';
  end;

  with StringGrid4 do begin
    Options := Options + [goThumbTracking,goEditing];
    DefaultColWidth := 60;
    ColWidths[0] := 30;
    ColWidths[1] := 80;

    Cells[0, 0] := 'No.';
    Cells[1, 0] := '表示名称';
    Cells[2, 0] := 'ブロック名';
    Cells[3, 0] := '属性名';
    Cells[4, 0] := '表示幅';
    Cells[5, 0] := 'IME';
  end;

  // 図形情報の設定ファイルを読込
  ReadTsv;
  // 検索用に追加
  BcadAttAry[0].BlkName := Edit3.Text;
  BcadAttAry[0].TagName := Edit4.Text;
  BcadAttAry[0].chkFlag := False;

  BcadAttAry[1].BlkName := Edit5.Text;
  BcadAttAry[1].TagName := Edit6.Text;
  BcadAttAry[1].chkFlag := False;

  BcadAttAryToSettingSg(StringGrid4);
  BcadAttAryToDispSg(StringGrid2, 2);

  with StringGrid2 do
    ColWidths[ColCount -1] := 0;

  ini := TIniFile.Create(ChangeFileExt(ParamStr(0), 'ini'));
  with ini do begin
    try
      LastPrinter := ReadString('Plot', 'LastPrinter', '');
      LastCtbStb  := ReadString('Plot', 'LastCtbStb', '');

      Edit3.Text := ReadString('BlkAtt', 'BlkName1', Edit3.Text);
      Edit4.Text := ReadString('BlkAtt', 'AttName1', Edit4.Text);

      Edit5.Text := ReadString('BlkAtt', 'BlkName2', Edit5.Text);
      Edit6.Text := ReadString('BlkAtt', 'AttName2', Edit6.Text);

      Edit7.Text := ReadString('RunLisp', 'FileName', Edit7.Text);
      Edit8.Text := ReadString('RunLisp', 'Command', Edit8.Text);

      with StringGrid1 do
        ColWidths[1] := ReadInteger('Form', 'FNameWidth', ColWidths[1] );

    finally
      Free;
    end;
  end;

end;

// *****************************
// フォーム破棄
// *****************************
procedure TForm5.FormDestroy(Sender: TObject);
var
  ini : TIniFile;
begin
  // 設定ファイルを保存
  SpeedButton6Click(self);

  ini := TIniFile.Create(ChangeFileExt(ParamStr(0), 'ini'));
  with ini do begin
    try
      WriteString('Plot','LastPrinter', LastPrinter);
      WriteString('Plot','LastCtbStb', LastCtbStb);
      WriteString('BlkAtt', 'BlkName1', Edit3.Text);
      WriteString('BlkAtt', 'AttName1', Edit4.Text);

      WriteString('BlkAtt', 'BlkName2', Edit5.Text);
      WriteString('BlkAtt', 'AttName2', Edit6.Text);

      WriteString('RunLisp', 'FileName', Edit7.Text);
      WriteString('RunLisp', 'Command', Edit8.Text);

      WriteInteger('Form', 'FNameWidth', StringGrid1.ColWidths[1] );

    finally
      Free;
    end;
  end;
end;

// *****************************
// ファイル名の表示幅を合わせる
// *****************************
procedure TForm5.PageControl1Change(Sender: TObject);
begin
  if PageControl1.ActivePageIndex = 1 then
    StringGrid2.ColWidths[1] := StringGrid1.ColWidths[1];
end;

// *****************************
// 図面情報:ファイル名順
// *****************************
procedure TForm5.SpeedButton10Click(Sender: TObject);
begin
  SgSortByCol2(StringGrid2, StringGrid2.ColCount -1, 1, False);
end;

// *****************************
// 図面情報:シート名順ソート
// *****************************
procedure TForm5.SpeedButton11Click(Sender: TObject);
var
  i : integer;
  n : integer;
begin
  n := Length(BcadAttAry);
  if n > 0 then begin
    for i := 2 to n - 1 do begin
      with BcadAttAry[i] do begin
        if (BlkName = Edit3.Text) and (TagName = Edit4.Text) then begin
          SgSortByCol2(StringGrid2, i, - 1, False);
          Break;
        end;
      end;
    end;
  end;
end;


// *****************************
// 図面情報:取得順ソート
// *****************************
procedure TForm5.SpeedButton12Click(Sender: TObject);
begin
  SgSortByCol2(StringGrid2, 0, - 1, True);
end;

procedure TForm5.SpeedButton13Click(Sender: TObject);
var
  i : integer;
begin
  with StringGrid4 do begin
    for i := 1 to RowCount - 1 do begin
      Cells[4, i] := IntToStr(StringGrid2.ColWidths[i + 1]);
    end;
  end;
end;

// *****************************
// 印刷チェック「すべてON」
// *****************************
procedure TForm5.SpeedButton1Click(Sender: TObject);
var
  i : integer;
begin
  with StringGrid1 do begin
    for i := 1 to RowCount -1 do
      Objects[1, i] := TObject(True);
  end;
  DispCheckedCount;

end;
// *****************************
// 印刷チェック「すべてOFF」
// *****************************
procedure TForm5.SpeedButton2Click(Sender: TObject);
var
  i : integer;
begin
  with StringGrid1 do begin
    for i := 1 to RowCount - 1 do
      Objects[1, i] := TObject(False);
  end;
  DispCheckedCount;
end;

// *****************************
// 印刷「ファイル名順」
// *****************************
procedure TForm5.SpeedButton4Click(Sender: TObject);
begin
  // ソート
  SgSortByCol2(StringGrid1, 6, 1, False);
end;

// *****************************
// 印刷「ページNo順」
// *****************************
procedure TForm5.SpeedButton5Click(Sender: TObject);
var
  i : integer;
  n : integer;
begin
  n := Length(BcadAttAry);
  if n > 2 then begin
    for i := 2 to n - 1 do begin
      with BcadAttAry[i] do begin
        if (BlkName = Edit5.Text) and (TagName = Edit6.Text) then begin
          // ページNo順ソート
          SgSortByCol2(StringGrid2, i, - 1, True);
          Break;
        end;
      end;
    end;
  end;
end;

// *****************************
// 設定ファイルを保存
// *****************************
procedure TForm5.SpeedButton6Click(Sender: TObject);
var
  sl : TStringList;
  i, j : integer;
  tsvname : TFileName;
  s : string;
begin
  tsvname := ChangeFileExt(ParamStr(0), '.tsv');
  sl := TStringList.Create;
  try
    with StringGrid4 do begin
      for i := 1 to RowCount - 1 do begin
        with BcadAttAry[i + 1] do begin
          TxtStr := Cells[1, i];
          BlkName := Cells[2, i];
          TagName := Cells[3, i];
          colwidth := StrToIntDef(Cells[4, i], 0);
          ImeFlag := UpperCase(Cells[5, i]) = 'ON';
        end;
        s := '';
        for j := 1 to 5 do begin
          s := s + Cells[j, i];
          // タブを追加
          if j < 5 then s := s + #9;
        end;
        sl.Add(s);
      end;
    end;
    sl.SaveToFile(tsvname);
  finally
    sl.Free;
  end;
end;

// *****************************
// 印刷:シート名順ソート
// *****************************
procedure TForm5.SpeedButton7Click(Sender: TObject);
begin
  SgSortByCol2(StringGrid1, 7, - 1, False);
end;

// *****************************
// 図面情報:ページ番号順ソート
// *****************************
procedure TForm5.SpeedButton8Click(Sender: TObject);
begin
  SgSortByCol2(StringGrid1, 8, - 1, True);
end;

// *****************************
// 印刷:取得順ソート
// *****************************
procedure TForm5.SpeedButton9Click(Sender: TObject);
begin
  SgSortByCol2(StringGrid1, 0, - 1, True);
end;

// *****************************
// 印刷用StringGridクリック
// *****************************
procedure TForm5.StringGrid1Click(Sender: TObject);
var
  app  : AcadApplication;
  docs : AcadDocuments;
  doc  : AcadDocument;
  idx  : integer;
  limmax, limmin : OleVariant;
begin
  try
    if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
      ShowMessage('サポートされていない');
      exit;
    end;
  except
    ShowMessage('有効な BricsCAD が見つかりません.');
    exit;
  end;

  try
    with StringGrid1 do begin
      if Row > 0 then begin
        idx := StrToIntDef(Cells[0, Row], - 1) - 1;
        docs := app.Documents;
        if (idx >= 0) and (idx < docs.Count) then begin
          // 図面を切換え
          app.ActiveDocument := docs.Item(idx);
          doc := app.ActiveDocument;

          limmax := doc.GetVariable('LIMMAX');
          limmin := doc.GetVariable('LIMMIN');

          //SetForegroundWindow(App.HWND);
          // ズームする
          app.ZoomWindow(limmin, limmax);

        end;
      end;
    end;
  except
    ;
  end;
end;

// *****************************
// 印刷用StringGrid描画
// *****************************
procedure TForm5.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  TempRect : TRect;
  BoxRect  : TRect;
  uState   : Cardinal;
  sg : TStringGrid;
begin
  sg := TStringGrid(Sender);
  TempRect := Rect;

  if (ARow > (sg.FixedRows - 1)) and (ACol = 1) then begin
    // 背景を消す
    sg.Canvas.FillRect(Rect);

    //チェックボックスのサイズを設定
    BoxRect.Left   := Rect.Left + 5;
    BoxRect.Top    := Rect.Top + 3;
    BoxRect.Bottom := Rect.Bottom - 3;
    BoxRect.Right  := BoxRect.Left + (BoxRect.Bottom - BoxRect.Top);
    Rect.Right     := Rect.Bottom - Rect.Top;

    TempRect.Left := TempRect.Left + (BoxRect.Right - BoxRect.Left) + 8;
    TempRect.Top  := TempRect.Top + 3;

    //Objectsプロパティの値に応じてチェック状態を描画
    if Bool(sg.Objects[ACol, ARow]) then begin
      sg.Canvas.Font.Color := clWindowText;
      uState := DFCS_BUTTONCHECK or DFCS_CHECKED;
    end else begin
      sg.Canvas.Font.Color := clRed;
      uState := DFCS_BUTTONCHECK;
    end;

    DrawText(sg.Canvas.Handle,
             PChar(sg.Cells[ACol,ARow]), - 1, TempRect, DT_LEFT or DT_SINGLELINE);
    DrawFrameControl(sg.Canvas.Handle, BoxRect, DFC_BUTTON, uState);
  end;
end;

// *****************************
// 印刷用StringGrid キー操作
// *****************************
procedure TForm5.StringGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  AColLeft   : Integer;
  ARowTop    : Integer;
  ARowBottom : Integer;
  i          : Integer;
  ABool      : Boolean;
  sg : TStringGrid;
begin
  sg := TStringGrid(Sender);
  with sg do begin
    if Key = VK_SPACE then begin
      //選択中のセルの範囲を調査
      AColLeft   := Selection.Left;
      ARowTop    := Selection.Top;
      ARowBottom := Selection.Bottom;

      //複数行選択に対応
      if AColLeft = 1 then begin
        for i := ARowTop to ARowBottom do begin
          if Cells[AColLeft, i] <> '' then begin
            ABool :=  Bool(Objects[AColLeft, i]);
            Objects[AColLeft, i] := TObject(not ABool);
          end;
        end;
        DispCheckedCount;
      end;
    end;
  end;
end;

// *****************************
// 印刷用StringGrid マウス操作
// *****************************
procedure TForm5.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ACol  : Integer;
  ARow  : Integer;
  ABool : Boolean;
  sg : TStringGrid;
begin
  sg := TStringGrid(Sender);
  with sg do begin
    if Button = mbLeft then begin
      MouseToCell(X, Y, ACol, ARow);
      // ダブルクリックのために記憶
      MbRow := ARow;
      MbCol := ACol;

      if (ARow > (FixedRows - 1)) and (ACol = 1) then begin
        if Cells[ACol,ARow] <> '' then begin
          ABool   :=  Bool(Objects[ACol, ARow]);
          Objects[ACol, ARow] := TObject(not ABool);
          DispCheckedCount;
        end;
      end;
    end;
  end;
end;

// *****************************
// 図面情報StringGrid クリック
// *****************************
procedure TForm5.StringGrid2Click(Sender: TObject);
var
  app  : AcadApplication;
  docs : AcadDocuments;
  doc  : AcadDocument;
  idx  : integer;
  limmax, limmin : OleVariant;
  i , n: integer;
begin
  n := Length(BcadAttAry);
  with StringGrid2 do begin
    if (Col < 2) or (Col >= n) then
      ImmSetOpenStatus(ImmGetContext(Handle), False)
    else
      for i := 2 to n - 1 do begin
        if Col = i then begin
          ImmSetOpenStatus(ImmGetContext(Handle), BcadAttAry[i].ImeFlag);
          Break;
        end;
      end;
    // ファイル名は変更不可
    if Col = 1 then
      Options := Options - [goEditing]
    else
      Options := Options + [goEditing];
  end;

  try
    if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
      ShowMessage('サポートされていない');
      exit;
    end;
  except
    ShowMessage('有効な BricsCAD が見つかりません.');
    exit;
  end;

  try
    with StringGrid2 do begin
      if Row > 0 then begin
        idx := StrToIntDef(Cells[0, Row], - 1) - 1;
        docs := app.Documents;
        if (idx >= 0) and (idx < docs.Count) then begin
          app.ActiveDocument := docs.Item(idx);
          doc := app.ActiveDocument;

          limmax := doc.GetVariable('LIMMAX');
          limmin := doc.GetVariable('LIMMIN');

          //SetForegroundWindow(App.HWND);
          app.ZoomWindow(limmin, limmax);

        end;
      end;
    end;
  except
    ;
  end;
end;

// *****************************
// 図面情報StringGrid キー操作
// *****************************
procedure TForm5.StringGrid2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  SgKeyDown(StringGrid2, Key, Shift);
end;

end.