DcadPlot Ver.2015.5.4 for DraftSight / ARES commander

■概要

DraftSight / ARES で開いている図面を一括で印刷ツールです。
図面の取得、印刷には、結構時間がかかります。
図枠に属性として、シート番号、ページ番号が設定されている場合は、その順で出力できます。

※印刷設定ファイル(PrintStyle)の取得は、システム変数 FONTMAP (フォントマップファイル)のフォルダ名から推定しています。
 システム変数 FONTMAP の値が書き変わってしまった場合は、下記を参考に設定しなおして下さい。
 DraftSight
 "C:\Program Files\Dassault Systemes\DraftSight\Fonts\fonts.fmp"
 ARES
 "C:\Program Files\Graebert GmbH\ARES Commander 2015\Fonts\fonts.fmp"
 (32bit版の時は、Program Files (x86) になります)

※印刷時間は、長めに設定して下さい。印刷中にドキュメントが切り替わると、CADがエラーで継続不能になります。
※印刷待ちに、コマンドラインをキャプチャし、画像の変化による監視を追加しました。「設定」タブにて使えるかどうか確認できます。
 コマンドラインが隠れるとうまく動きませんので、注意して下さい。
 こちらの環境では、exe のプロパティ「互換」で、「高解像度DPI...」にチェックを付ける必要がありました。

やはり、「バッチ印刷」を使ったほうが、安全で快適なのだと思います。


■履歴
2015/04/26
・初版作成
2015/04/30
・DXFファイルから属性(シート番号、ページ番号)の取得を追加
2015/05/03
・コマンド送信に、[Enter]、[ESC] を追加。取得を若干高速にした。
2015/05/04
・印刷待ちに、キャプチャ画像によるコマンドライン監視を追加。取得を若干高速にした。
・自動保存を一時的にOFFにするを追加した。



■ダウンロード
 DcadPlot.zip (2015/05/04 exe本体のみ)

■ソースコード


unit DcadPlotUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls, Vcl.CheckLst,Comobj, Vcl.ExtCtrls, Vcl.Grids, IniFiles, System.UITypes,
  Vcl.ComCtrls, Vcl.Buttons, ClipBrd, Imm, Printers, Winspool, System.IOUtils, System.Types;

type
  DcadPoint = array [0..2] of double;

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;
    ProgressBar1: TProgressBar;
    Label6: TLabel;
    ComboBox3: TComboBox;
    Label8: TLabel;
    SpeedButton9: TSpeedButton;
    Label17: TLabel;
    SpeedButton3: TSpeedButton;
    TabSheet2: TTabSheet;
    GroupBox2: TGroupBox;
    Label7: TLabel;
    Edit2: TEdit;
    Label9: TLabel;
    Label10: TLabel;
    Edit3: TEdit;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Edit4: TEdit;
    Label15: TLabel;
    GroupBox3: TGroupBox;
    Label16: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    Label18: TLabel;
    Edit7: TEdit;
    Edit8: TEdit;
    Label19: TLabel;
    Label20: TLabel;
    SpeedButton5: TSpeedButton;
    Image1: TImage;
    SpeedButton6: TSpeedButton;
    Image2: TImage;
    CheckBox1: TCheckBox;
    Label21: TLabel;
    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 StringGrid1Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);

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

    procedure DispCheckedCount;
  end;

var
  Form5: TForm5;


  // メインウィンドウ
  DcadMainWinHandle : HWND;
  DcadMDIClientWinHandle : HWND;
  DcadCommandWinHandle : HWND;
  DcadInputWinHandle : HWND;
  DcadOutputWinHandle : HWND;
  DcadMDIActiveWinHandle : HWND;
  DcadMDIChildWinHandle : HWND;
  DCadProcessID : DWORD;     //プロセスID

  SleepDocChg, SleepPrint, SleepSysVar : integer;

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

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;
//****************************************
// 最後の指定文字列より後を得る
//****************************************
function LastSubstringAfter(const ststr, s: string):String;
var
  st, stlen : integer;
  temp : string;
begin
  Result := '';
  if Pos(ststr, s) > 0 then begin
    temp := s;

    stlen := Length(ststr);
    while Pos(ststr, temp) > 0 do begin
      st := Pos(ststr, temp) + stlen;
      temp := Copy(temp, st, Length(temp) - st + 1);
      if temp = '' then break;
    end;
    Result := Trim(temp);
  end;
end;

//****************************************
//最初に現れたststrからedstrまでを返す
//****************************************
function StrAfterStrBefore(const ststr, edstr, s:string):String;
var
  st, ed:integer;
  temp : string;
begin
  Result:='';
  st:=Pos(ststr,s);
  if st > 0 then begin
    temp := s;
    Delete(temp,1,st + Length(ststr)-1);
    ed := Pos(edstr, temp)-1;
    if ed >= 0 then
      Result := Trim(Copy(temp, 1, ed));
  end;
end;

//****************************************
// 実際には、MDIClientではない
//****************************************
function EnumCWinProc_MDIClient(h:HWND;lparam:Integer):Bool;stdcall;
var
  Title : array [0..255] of char;
begin
  Result:=True;
  if GetWindowText(h, Title, 255) <> 0 then begin
    if 'CFxWorkspaceImplClassWindow' = Title then begin
      DcadMDIClientWinHandle := GetWindow(h, GW_CHILD);
      DcadMDIChildWinHandle := GetWindow(DcadMDIClientWinHandle, GW_CHILD);
      Result := False;
    end;
  end;
end;

//****************************************
// 実際には、MDIClientではない
//****************************************
function GetDcadMDIClientHandle:HWND;
begin
  EnumChildWindows(DcadMainWinHandle,@EnumCwinProc_MDIClient, 0);
  result:=DcadMDIClientWinHandle;
end;
//****************************************
// コマンドウィンドウ
//****************************************
function EnumCWinProc_CommandWinHandle(h: HWND; lparam: Integer):Bool;stdcall;
var
  Title : array [0..255] of char;
begin
  Result:=True;
  if GetWindowText(h, Title, 255) <> 0 then begin
    if 'CFxCommandWindowWindow' = Title then begin
      DcadCommandWinHandle := h;
      Result:=False;
    end;
  end;
end;

//****************************************
// コマンドウィンドウ Input/OutputWindow
//****************************************
function GetDcadCommandWinHandle:HWND;
begin
  EnumChildWindows(DcadMainWinHandle, @EnumCwinProc_CommandWinHandle, 0);
  result := DcadCommandWinHandle;
  if result <> 0 then begin
    DcadOutputWinHandle := GetWindow(DcadCommandWinHandle, GW_CHILD);
    DcadInputWinHandle  := GetWindow(DcadOutputWinHandle, GW_HWNDNEXT);
  end;
end;

//****************************************
// メインウィンドウ
//****************************************
function EnumWindowProcMainWin(h: HWND; lp: LParam): BOOL; stdcall;
var
  Title : array [0..255] of char;
  ClassName : array [0..255] of char;
begin
  Result := true;
  GetClassName(h, ClassName, 255);
  if 'Qt5QWindowIcon' = ClassName then begin
    // タイトルを得る
    if GetWindowText(h, Title, 255) <> 0 then begin
      if (Pos('DraftSight - [', Title) = 1) or
        (Pos('ARES Commander 2015 - [', Title) = 1) then begin
        DCadMainWinHandle := h;
        GetWindowThreadProcessId(h, @DCadProcessID);
        Result := false;
      end;
    end;
  end;
end;

//****************************************
// メインウィンドウのハンドルを得る
//****************************************
function GetDCadMainWinHandle : HWND;
begin

  EnumWindows(@EnumWindowProcMainWin, 0);
  Result := DCadMainWinHandle;
end;
//****************************************
// 文字列送信
//****************************************
function SendHwndCmdLine(hCmdLine: HWND; const cmd : string):boolean;
var
  i : integer;
begin
  Result := False;
  if hCmdLine <> 0 then begin
    // 文字列を送信
    for i := 1 to Length(cmd) do begin
      if cmd[i] = #13 then begin
        SendMessage(hCmdLine,WM_KEYDOWN,VK_RETURN,0);
        SendMessage(hCmdLine,WM_KEYUP,VK_RETURN,0);
        Sleep(1);
      end
      else if (cmd[i] = #27) or (cmd[i] = #3) then begin
        SendMessage(hCmdLine,WM_KEYDOWN,VK_ESCAPE,0);
        SendMessage(hCmdLine,WM_KEYUP,VK_ESCAPE,0);
        Sleep(1);
      end
      else begin
        SendMessage(hCmdLine, WM_CHAR, Word(cmd[i]), 0);
        if cmd[i] = #20 then Sleep(1);
      end;
    end;
    result := true;
  end;
end;

//******************************************
// ウィンドウのタイトル(キャプション)を得る
//******************************************
function GetWindowCaption(h : HWND) : string;
var
  Title : array [0..255] of char;
begin
  result := '';
  if GetWindowText(h, Title, 255) <> 0 then
    result := Title;
end;

//****************************************
// コマンド送信
//****************************************
function SendDcadCommand(const cmd: string): boolean;
begin
  GetDcadCommandWinHandle;
  Result := SendHwndCmdLine(DcadInputWinHandle, cmd);
end;

//****************************************
// システム変数取得
//****************************************
function GetDcadVariable(const SysVar: string): string;
var
  s : string;
begin
  Result := '';

  GetDCadMainWinHandle;

  SetForegroundWindow(DcadMainWinHandle);
  SendDcadCommand(SysVar + #13#3);

  Sleep(10);

  SendDcadCommand('COPYHISTORY'#13);
  Sleep(200);
  s := '';
  try
    s := ClipBoard.AsText;
    s := LastSubstringAfter(': ' + SysVar, s);

    Result := '';
    if (Pos('=', s) > 0) and (Pos('(', s) > 1) then
      Result := Trim(StrAfterStrBefore('=', '(', s));
    if (Result = '') and (Pos('(', s) > 0) and (Pos(')', s) > 1) then
      Result := Trim(StrAfterStrBefore('(', ')', s));
    if (Result = '') and (Pos('デフォルト:', s)>0) then begin
      Result := Trim(StrAfterStrBefore('デフォルト:', #13, s));
    end;
  except
    ;
  end;
end;

//****************************************
// DraftSight / ARES commander をアクティブに
//****************************************
function SetDcadActive: boolean;
begin
  Result := False;
  if GetDCadMainWinHandle <> 0 then begin
    SetForegroundWindow(DcadMainWinHandle);
    Result := True;
  end;
end;
function WaitForDcadCommandReady(timeout: integer): boolean;
var
  cnt : integer;
  ARect : TRect;
  AHeight,ATop : integer;
  Bmp : TBitMap;
  co : Integer;
  i,j: integer;
  pByte :PByteArray;
  Flag : Boolean;
  msec : integer;
  n : integer;
begin
  Result := False;
  msec := 10;

  GetDcadMainWinHandle;
  GetDcadCommandWinHandle;
  //Form5.Caption := IntToHex(DcadInputWinHandle, 8);
  GetWindowRect(DcadInputWinHandle, ARect);
  ATop := ARect.Top;

  AHeight := ARect.Bottom - ARect.Top;
  ATop := ATop+ AHeight -20;

  //AWidth := ARect.Right - Arect.Left;
  //Form5.Caption := IntToStr(AHeight);
  Bmp := TBitmap.Create;
  try
    Bmp.Width := 100;
    Bmp.Height := 20;
    Bmp.PixelFormat :=pf24bit;

    n := 0;
    cnt := 0;
    while True do begin
      Sleep(msec);
      Application.ProcessMessages;
      CaptureToBmp(Arect.Left + 18, ATop, Bmp.Width, Bmp.Height, bmp);
      Form5.Image1.Picture.Assign(bmp);
      pByte := Bmp.ScanLine[0];
      co := pByte[0];
      Flag := True;
      for i := 1 to Bmp.Height - 1 do begin
        pByte := Bmp.ScanLine[i];
        for j := 0 to Bmp.Width -1 do begin
          if co <> pByte[j] then begin
            Flag := False;
            n := 0;
            Break;
          end;
        end;
      end;
      if Flag then Inc(n);
      if n > 3 then begin
        Result := True;
        Break;
      end;

      Inc(cnt);
      if cnt * msec > timeout then Break;
    end;
  finally
    Bmp.Free;
  end;

end;

//****************************************
// 座標文字列を3D座標に
//****************************************
procedure StrPointToDcadPoint(const StrPoint: string; var pt: DcadPoint);
var
  n : integer;
  s: string;
begin
  s := StrPoint;
  n := Pos(',', s);
  pt[0] := StrToFloatDef(Copy(s, 1, n - 1), 0);

  s := Copy(s, n + 1);

  n := Pos(',', s);
  if n > 0 then begin
    pt[1] := StrToFloatDef(Copy(s, 1, n - 1), 0);
    pt[2] := StrToFloatDef(Copy(s, n + 1), 0);
  end
  else begin
    pt[1] := StrToFloatDef(s, 0);
    pt[2] := 0;
  end;
end;
// ************************************
// DXFファイルからシステム変数(2D座標)を取得する
// ************************************
function ReadDxfVariablePoint2DString(dxfSl: TStrings; const sysName: string):string;
var
  idx, i : integer;
  code : integer;
  s : string;
  dxfSys : string;
begin
  Result := '';

  dxfSys := '$' + Uppercase(sysName);

  idx := dxfSL.IndexOf('ENTITIES');
  for i := 0 to idx div 2 do begin
    code := StrToInt(dxfSl[i *2]);
    s := dxfSl[i * 2 + 1];
    if (code = 9) and (s = dxfSys) then begin
      result := dxfSl[(i + 1) * 2 + 1]  + ',' +  dxfSl[(i + 2) * 2 + 1];
      break;
    end;
  end;
end;

// ************************************
// DXFファイルから属性を取得する
// ************************************
function ReadDxfAttRib(dxfSl: TStrings; const InsertName: string; const AttRibName: string): string;
var
  i : integer;
  insFlag, attFlag, hasAtt : boolean;
  s : string;
  AblkName , AattName, AattString : string;
  code, idx : integer;
begin
  Result := '';
  insFlag := False;
  hasAtt  := False;
  attFlag := False;

  // ENTITIESセクションを探す
  idx := dxfsl.IndexOf('ENTITIES');

  for i := idx div 2 + 1 to dxfsl.Count div 2 - 1 do begin
    // DXFコード
    code := StrToInt(dxfsl[i * 2]);
    // その値
    s := dxfsl[i * 2 + 1];

    if insFlag then begin

      // 属性取得終了
      if hasAtt and (code = 0) and (s = 'SEQEND') then begin
        insFlag := False;
        hasAtt  := False;
        attFlag := false;
      end;

      if hasAtt and (AblkName = '') and (code = 2) then
        AblkName := s;

      if attFlag then begin
        // 属性の値を保持
        if code = 1 then
          AattString := s;
        // 属性名
        if code = 2 then begin
          AattName := s;
          // ブロック名、属性名が同じ
          if (InsertName = ABlkName) and (AttRibName = AattName) then begin
            Result := AattString;
            Break;
          end;
        end;
      end;
      if hasAtt and (code = 0) and (s = 'ATTRIB') then
        attFlag := True;
    end;

    if (code = 0) and (s = 'INSERT') then begin
      insFlag := True;
      hasAtt  := False;
      attFlag := False;
      AblkName := '';
    end;
    // 属性有
    if (code = 66) and (Trim(s) = '1') then
      hasAtt := True;
    // ENTITIES セクション終わり
    if (code = 0) and (s = 'ENDSEC') then
      Break;
  end;

end;

// ************************************
// DXFファイルを作成する
// ************************************
function SaveDxfSl(dxfsl : TStringList):boolean;
var
  fname : TFileName;
  cnt : integer;
begin
  Result := False;
  fname := ChangeFileExt(ParamStr(0), '.dxf');

  DeleteFile(fname);

  cnt := 0;
  while True do begin
    Sleep(10);
    if not FileExists(fname) then begin
      Break;
    end;
    Inc(cnt);
    if cnt > 5 then Break;
  end;

  if SetDcadActive then begin
    SendDcadCommand('FILEDIA'#13'0'#13);
    Sleep(10);

    SendDcadCommand('DXFOUT'#13 + fname +#13'Vesion'#13'R18'#13'16'#13);
    Sleep(10);
    SendDcadCommand('''FILEDIA'#13'1'#13);
    cnt := 0;

    // ファイル作成待ち
    while True do begin
      Sleep(10);
      if FileExists(fname) then begin
        Sleep(10);
        Break;
      end;
      Inc(cnt);
      if cnt > 50 then Break;
    end;
    if FileExists(fname) then begin
      dxfsl.LoadFromFile(fname);
      Result := dxfsl.Count > 0;
    end;
  end;
end;

// *****************************
// 印刷チェック数をカウント
// *****************************
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;


// *****************************
// 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;

// *****************************
// 取得
// *****************************
procedure TForm5.Button1Click(Sender: TObject);
var
  i : integer;
  sdir : string;
  cnt : integer;

  j : integer;
  s :string;
  arycnt : integer;
  dwgname , dwgprefix :string;
  limmax, limmin : DcadPoint;
  h, hdwg : HWND;
  dwgTitle, ext : string;

  fnames: TStringDynArray;
  fpath, fname : TFileName;
  sl : TStringList;
  Title : string;
  count : integer;
begin
  Title := '';
  // メニューを操作して図面を切り替えるため、
  // 一度図面を切り替えて、そのファイル名を取得して記憶する

  // メインウィンドウのハンドルを取得
  if GetDCadMainWinHandle = 0 then Exit;

  // 最小化されていれば戻す
  if isIconic(DcadMainWinHandle) then begin
    OpenIcon(DcadMainWinHandle);
    // 画面描画待ち
    Sleep(SleepDocChg);
  end;

  // MDI のウィンドウを探す
  GetDcadMDIClientHandle;
  h := DcadMDIChildWinHandle;
  cnt := 0;

  // ここでは、ドキュメントの数を数えるだけ
  while h <> 0 do begin
    hdwg := GetWindow(h, GW_CHILD);
    dwgTitle := GetWindowCaption(hdwg);
    // ファイル名を取得
    ext := Uppercase(ExtRactFileExt(dwgTitle));

    // 念のため、拡張子を比較
    if (ext = '.DWG') or (ext = '.DWG*') then
      Inc(cnt);

    // 次のウィンドウを探す
    h := GetWindow(h, GW_HWNDNEXT);
  end;
  if cnt = 0 then Exit;

  SendDcadCommand(#3'SAVETIME'#13'0'#13);

  sdir := GetDcadVariable('DWGPREFIX');
  Edit1.Text := sdir;

  arycnt := cnt;

  if arycnt > 0 then begin
    with Progressbar1 do begin
      Max := arycnt;
      Position := 0;
    end;

    with StringGrid1 do begin
      RowCount := arycnt + 1;

      for i := 1 to RowCount -1 do
        for j := 0 to ColCount -1 do
          Cells[j, i] := '';
    end;

    cnt := 0;
    sl := TStringList.Create;
    try

      // メニューを操作
      for i := 0 to arycnt - 1 do begin
        // CADをアクティブに
        SetForegroundWindow(DcadMainWinHandle);

        keybd_event(VK_MENU, 0, 0, 0);
        keybd_event(Ord('W'), 0, 0, 0);
        keybd_event(Ord('W'), 0, KEYEVENTF_KEYUP, 0);
        keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);

        for j := 0 to i + 4 do begin
          keybd_event(VK_DOWN, 0 ,0 ,0);
          keybd_event(VK_DOWN, 0, KEYEVENTF_KEYUP, 0);
        end;

        keybd_event(VK_RETURN, 0, 0, 0);
        keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);

        count := 0;
        while True do begin
          Sleep(10);
          if Title <> GetWindowCaption(DcadMainWinHandle) then begin
            Break;
          end;
          Inc(count);
          if Count > 60 then Break;
        end;

        // 図面切り替わり待ち
        Sleep((count + 2) * 50);

        // 編集の図面名を取得
        s := GetWindowCaption(DcadMainWinHandle);
        Title := s;

        dwgname := StrAfterStrBefore('[', ']', s);
        dwgprefix := GetDcadVariable('DWGPREFIX');

        // 同じフォルダ名の図面のみを取得
        if sdir = dwgprefix then begin
          with StringGrid1 do begin
            Cells[0, cnt + 1] := IntToStr(i + 1);
            Cells[1, cnt + 1] := dwgname;
            if SaveDxfSL(sl) then begin

              // シート番号を取得
              s := ReadDxfAttRib(sl, Edit5.Text, Edit6.Text);
              Cells[7, cnt + 1] := s;
              //ページ番号を取得
              s := ReadDxfAttRib(sl, Edit7.Text, Edit8.Text);
              Cells[8, cnt + 1] := s;
              s := ReadDxfVariablePoint2DString(sl, 'LIMMAX');
              Cells[9, cnt + 1] := s;
              StrPointToDcadPoint(s, limmax);

              s := ReadDxfVariablePoint2DString(sl, 'LIMMIN');
              Cells[10, cnt + 1] := s;
              StrPointToDcadPoint(s, limmin);

              Cells[2, cnt + 1] := Format('%.1f',[limmax[0] - limmin[0]]);
              Cells[3, cnt + 1] := Format('%.1f',[limmax[1] - limmin[1]]);
              // ScaleA3
              Cells[4, cnt + 1] := Format('%.3f',[limmax[0] / 420]);
              // ScaleA4
              Cells[5, cnt + 1] := Format('%.3f',[limmax[0] / 297]);
              Objects[1, cnt + 1] := TObject(True);
            end;
          end;
          with Progressbar1 do Position := Position + 1;
          Inc(cnt);
        end;
      end;
    finally
      sl.Free;
    end;

    with StringGrid1 do begin
      RowCount := cnt + 1;
      Row := 1;
      Col := 2;
      SetFocus;
    end;

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

    // プリンター名一覧を 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;

    // 用紙名一覧を Windows から取得
    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;

    Sleep(SleepSysVar);

    // PrintStyle をDraftShight / ARES commander のインストールフォルダから取得
    // フォントマップファイルの保存先を取得
    s := GetDcadVariable('FONTMAP');
    fpath := ExtractFilePath(ExtractFileDir(s)) + 'Default Files\Print Styles\';
    if DirectoryExists(fpath) then begin
      fnames := TDirectory.GetFiles(fpath, '*.?tb', TSearchOption.soTopDirectoryOnly);
      with ComboBox2 do begin
        Items.Clear;
        for fname in fnames do
          Items.Add(ExtractFileName(fname));
        ItemIndex := Items.IndexOf(LastCtbStb);
        if (ItemIndex < 0) and (Items.Count > 0) then
          ItemIndex := 0;
      end;
    end;
  end;
  SendDcadCommand(#3'SAVETIME'#13'10'#13);

  DispCheckedCount;
  // シート番号順
  SpeedButton3Click(self);
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
  i, j : integer;
  scale : string;
  papersize: string;
  idx : integer;
  devname : string;
  sl : TStringList;
  fname : TFileName;
begin
  fname := ChangeFileExt(ParamStr(0), '.scr');
  LastCtbStb := 'monochrome.ctb';

  if MessageDlg('選択ファイルを印刷しますか?', mtInformation,mbYesNo,0) = mrYes then begin
    // 自動保存をOFF
    SendDcadCommand(#3'SAVETIME'#13'0'#13);

    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
      sl := TStringList.Create;
      try

        devname := LastPrinter;

        RunFlag := True;

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

        if True then begin

          with StringGrid1 do begin
            ProgressBar1.Max := RowCount - 1;
            ProgressBar1.Position := 0;
            for i := 1 to RowCount - 1 do begin
              // A3 -> A4 縮小
              if Pos('A4', papersize) > 0 then
                scale := '1=' + Format('%.3f',[StrToFloat(Cells[5, i])])
              // A3 -> A3
              else
                // papersize := 'A3';
                scale := '1=' + Format('%.3f',[StrToFloat(Cells[4, i])]);

              with Progressbar1 do Position  := Position + 1;

              Application.ProcessMessages;

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

                if GetDCadMainWinHandle <> 0 then begin

                  SetForegroundWindow(DcadMainWinHandle);

                  // メニュー操作
                  keybd_event(VK_MENU, 0, 0, 0);
                  keybd_event(Ord('W'), 0, 0, 0);
                  keybd_event(Ord('W'), 0, KEYEVENTF_KEYUP, 0);
                  keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);

                  for j := 0 to idx + 4 do begin
                    keybd_event(VK_DOWN, 0 ,0 ,0);
                    keybd_event(VK_DOWN, 0, KEYEVENTF_KEYUP, 0);
                  end;

                  keybd_event(VK_RETURN, 0, 0, 0);
                  keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);

                  // 図面切り替わり待ち
                  Sleep(SleepDocChg);

                  // スクリプトファイル作成
                  with sl do begin
                    Clear;

                    // コマンドラインプロット
                    Add('-PLOT');
                    // 印刷オプションの詳細設定?
                    Add('Y');
                    // シート名を指定»
                    Add('Model');
                    // プリンタ名を指定»
                    Add(devname);
                    Sleep(SleepSysVar);
                    // ペーパー サイズを指定»
                    Add(papersize);
                    //  単位を指定» インチ(I) または ミリメートル(M)
                    Add('M');
                    // 方向を指定>>縦(P) または 横(L)
                    Add('L');
                    // 上下を逆にして印刷しますか?
                    Add('Y');
                    // 印刷範囲を指定»
                    Add('S');
                    // 始点コーナーを指定»
                    Add(Cells[10, i]);
                    // 反対側のコーナーを指定»
                    Add(Cells[9, i]);
                    // 印刷尺度を指定»
                    Add(scale);
                    // 印刷 X,Y オフセットを指定»
                    Add('C');
                    // 印刷スタイル テーブルを使用?
                    Add('Y');
                    // 印刷スタイル名»
                    Add(LastCtbStb);
                    // 割り当てられた線幅を使用?
                    Add('Y');
                    // オプション指定»
                    // 表示どおり(D), 隠線(H), レンダリング(R) または ワイヤフレーム(W)
                    Add('D');
                    // ファイルに出力?
                    Add('N');
                    // 印刷設定をシートに適用?
                    Add('Y');
                    // 今すぐ印刷しますか?
                    Add('Y');
                    Add('FILEDIA 1');

                    SaveToFile(fname);
                    if FileExists(fname) then begin
                      SendDcadCommand('FILEDIA'#13'0'#13);
                      Sleep(10);
                      // スクリプト読込
                      SendDcadCommand('LOADSCRIPT'#13 + fname + #13);
                    end;
                    SetForeGroundWindow(DcadMainWinHandle);
                    // 印刷終了待ち
                    if SleepPrint < 5000 then SleepPrint := 5000;
                    if CheckBox1.Checked then begin
                      WaitForDcadCommandReady(SleepPrint);
                      Sleep(100);
                    end
                    else
                      Sleep(SleepPrint);
                  end;
                end;
              end;
            end;
          end;
        end;

        ProgressBar1.Position := 0;
        if RunFlag then
          ShowMessage('印刷が終了しました.')
        else
          ShowMessage('印刷を中止しました.');

        Button2.Enabled := True;
        Button4.Enabled := False;
      finally
        sl.Free;
      end;
    end;
    SendDcadCommand(#3'SAVETIME'#13'10'#13);
  end;
end;

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


// *****************************
// プリンター変更
// *****************************
procedure TForm5.ComboBox1Change(Sender: TObject);
var
  i : integer;
begin
  with ComboBox1 do begin
    if ItemIndex >= 0 then
      LastPrinter := Items[ItemIndex];
  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;

// *****************************
// 印刷設定変更
// *****************************
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;
begin
  PageControl1.ActivePageIndex := 0;

  Edit1.Text := '';
  //Caption := Application.Title;

  with StringGrid1 do begin
    RowCount := 2;
    ColCount := 11;

    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;
    ColWidths[9] := -1;
    ColWidths[10] := -1;

    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';
    Cells[9, 0] := 'LimMax';
    Cells[10, 0] := 'LimMin';

  end;

  SleepDocChg := 500;
  SleepPrint := 5000;
  SleepSysVar := 100;

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

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

      SleepDocChg := ReadInteger('Timer', 'SleepDocChg', SleepDocChg);
      SleepPrint := ReadInteger('Timer', 'SleepPrint', SleepPrint);
      SleepSysVar := ReadInteger('Timer', 'SleepSysVar', SleepSysVar);

      Edit5.Text := ReadString('SheetAttRib', 'BlockName', Edit5.Text);
      Edit6.Text := ReadString('SheetAttRib', 'AttName',   Edit6.Text);

      Edit7.Text := ReadString('PageNoAttRib', 'BlockName', Edit7.Text);
      Edit8.Text := ReadString('PageNoAttRib', 'AttName',   Edit8.Text);
      CheckBox1.Checked := ReadBool('CheckBox', 'Uses CmdCapt', CheckBox1.Checked);


    finally
      Free;
    end;
  end;

  // 待ちタイマー設定
  Edit2.Text := SleepDocChg.ToString;
  Edit3.Text := SleepPrint.ToString;
  Edit4.Text := SleepSysVar.ToString;

end;

// *****************************
// フォーム破棄
// *****************************
procedure TForm5.FormDestroy(Sender: TObject);
var
  ini : TIniFile;
begin
  ini := TIniFile.Create(ChangeFileExt(ParamStr(0), 'ini'));
  with ini do begin
    try
      WriteString('Plot', 'LastPrinter', LastPrinter);
      WriteString('Plot', 'LastCtbStb',  LastCtbStb);

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

      WriteInteger('Timer', 'SleepDocChg', SleepDocChg);
      WriteInteger('Timer', 'SleepPrint',  SleepPrint);
      WriteInteger('Timer', 'SleepSysVar', SleepSysVar);
      WriteBool('CheckBox', 'Uses CmdCapt', CheckBox1.Checked);


      WriteString('SheetAttRib', 'BlockName', Edit5.Text);
      WriteString('SheetAttRib', 'AttName',   Edit6.Text);

      WriteString('PageNoAttRib', 'BlockName', Edit7.Text);
      WriteString('PageNoAttRib', 'AttName',   Edit8.Text);

    finally
      Free;
    end;
  end;
end;

// 待機タイマー設定
procedure TForm5.PageControl1Change(Sender: TObject);
begin
  if PageControl1.ActivePageIndex = 0 then begin
    SleepDocChg := StrToIntDef(Edit2.Text, SleepDocChg);
    SleepPrint  := StrToIntDef(Edit3.Text, SleepPrint );
    SleepSysVar := StrToIntDef(Edit4.Text, SleepSysVar);
  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.SpeedButton3Click(Sender: TObject);
begin
  // シート番号順
  SgSortByCol2(StringGrid1, 7, -11, False);
end;

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

procedure TForm5.SpeedButton5Click(Sender: TObject);
begin
  // ページ番号順ソート
  SgSortByCol2(StringGrid1, 8, -1, True);

end;

procedure TForm5.SpeedButton6Click(Sender: TObject);
var
  ARect : TREct;
  ATop, AHeight: integer;
  Bmp : TBitmap;
begin
  GetDcadMainWinHandle;
  GetDcadCommandWinHandle;
  //Form5.Caption := IntToHex(DcadInputWinHandle, 8);
  GetWindowRect(DcadInputWinHandle, ARect);
  ATop := ARect.Top;

  AHeight := ARect.Bottom - ARect.Top;
  ATop := ATop+ AHeight -20;

  Bmp := TBitmap.Create;
  try
    Bmp.Width := 100;
    Bmp.Height := 20;
    Bmp.PixelFormat :=pf24bit;
    CaptureToBmp(Arect.Left, ATop, Bmp.Width, Bmp.Height, bmp);
    Image2.Picture.Assign(Bmp);
  finally
    Bmp.Free;
  end;

end;

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

// *****************************
// 印刷用StringGridクリック
// *****************************
procedure TForm5.StringGrid1Click(Sender: TObject);
var
  idx ,j  : integer;
begin
  with StringGrid1 do begin
    if Row > 0 then begin
      idx := StrToIntDef(Cells[0, Row], - 1) - 1;

      if GetDCadMainWinHandle <> 0 then begin

        SetForegroundWindow(DcadMainWinHandle);

        // メニュー操作
        keybd_event(VK_MENU, 0, 0, 0);
        keybd_event(Ord('W'), 0, 0, 0);
        keybd_event(Ord('W'), 0, KEYEVENTF_KEYUP, 0);
        keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);

        for j := 0 to idx + 4 do begin
          keybd_event(VK_DOWN, 0 ,0 ,0);
          keybd_event(VK_DOWN, 0, KEYEVENTF_KEYUP, 0);
        end;
        keybd_event(VK_RETURN, 0, 0, 0);
        keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);
      end;
    end;
  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;

end.