OneKey3.exe for Bricscad V17~V19 Ver.1.24b 2018/12/02~12

・ 2018/12/12 一時Oスナップに「図心 gce」。(OneKey3 Ver.1.24b)
・ 2018/12/08 エラー回避に Bricscad のイベント通知を追加。(OneKey3 Ver.1.24a)

■OneKey2.exe との違い
・OneKey2 の対象は、複数起動された Bricscad のうちアクティブな Bricscad でしたが、最初に見つかった 1つの Bricscad のみにしました。
・OneKey2 では、LISP の読み込みメッセージ等でエラーになることがありましたが、図面 OPEN 中の 0.7 秒程度は何もしないことで、これを回避しました。

■概要
 3つの機能があります。
 ・IME 自動オフ (IME Off)
 ・マウス移動による [Enter] 発行 (OneKey)
 ・座標入力時、[Ctrl] キーによるスナップモード切替(Ver.1.21)

■スクリーンショット
 

■IME Off
 コマンドラインの文字列が ": " だけの時、IME をオフにします。
 ※不要の場合は、「IME Off:Auto」のチェックを外してください。

■OneKey
※不要の場合は、「OneKey : Auto」のチェックを外してください。
・コマンド入力中:
  マウス右上方向で [Enter] キーを発行します。
  例えば、コマンドラインに "z" を入力しマウスを右上に移動すると、ZOOM コマンドが実行されます。
  自動入力候補(コートコンプリート)を使うため、マウス右上以外は無効としています。
  文字数の制限はありません。
・コマンドオプション入力中:
  "["、"]" の文字列がある、または "点"、"ポイント"、"コーナ"、"中心"の文字列があり、"@"、数字入力でない時のみ、マウス方向制限なしで [Enter] キーを発行します。
  また、下記の文字(大/小文字区別なし)の場合は、一時Oスナップに書き換えます。
   M, MI, MD, MM : mid (中点)
   C, CE, CN, CC : cen (中心)
   Q, QU, QA, QQ : qua (四半円点)
   I, IT, II   : int (交点)
   E, EN, ED, EE : end(端点)
   T, TA, TN, TT : tan (接線)
   N, NE, NA   : nea (近接点)
   P, PE, PR, PP : per (垂線)
   S, IN, IS   : ins (挿入基点)
   O, D, ND     : nod (点)
   NN, NO   : non (解除)
   V, M2, MT, MP, MMM : m2p (2点間中点)
   EX, ET   : ext (延長)
   F, FR, FM   : from (基点設定)
   A, AP     : app (仮想交点)
   PA     : par (平行)
   X, XX     : [ESC]キー
   G, GC  :gce (図心) (1.24bより)
  ※コマンドオプションが優先されます。

■[Ctrl]キーによるスナップモード変更
 座標入力中に [Ctrl]キーを押すと、スナップモードが反転します。

■起動と終了
 起動すると、スクリーンの右下にフォームが表示されます。
 Bricscad の サポートフォルダに、on_start.lsp をメモ帳などで作成(すでにある場合は、下記一行を追加)すると、自動で起動されます。
 (startapp "C:\\xxxx\\yyyy\\OneKey3.exe")
 フォルダ(パス)の区切り \\ は¥¥です。
 Bricscad が終了すると、追従して終了します。

■マウス移動量の変更
 OneKey3.exe が起動していない時に、OneKey3.exe と同じフォルダの OneKey3.ini をメモ帳などで編集してください。
 MouseMove=20 ←この数値を変更

■以前 (AutoCAD 用) のバージョンとの違い
・マウス移動で、コマンド発行。名前のとおり OneKey でコマンドオプションを発行するツールでしたが、かなりクセがあり動きが分かりにくいため、
 ほぼマウス移動で [Enter] キーを発行する単純なものに変更しました。
・コマンドラインオプションのリスト表示の機能は、CAD 本体に実装されたため削除しました。
・[Shift] キーによる直交モード反転は、CAD 本体に実装されたため削除しました。
・[Ctrl] キーによるスナップモード反転は、削除しました。
・「アイコントレイに格納」は取りやめました。
・IME の強制オフ(IME Off) を統合しました。

■著作権、免責事項等
・本ツールの著作権は、作者 f.izawa が所有し、これを主張します。
・本ツールを使用したことによる事故、損害等の一切について作者はその責を負いません。

■開発環境
・Delphi 10.2.3 Tokyo Community Edition
・Bricscad V17 Pro, V19 Pro
・Windows 10 64bit

■作者連絡先
 e-mail: f.izawa@dream.com
 URL: http://www.izawa-web.com/

■ダウンロード

 ・OneKey3.zip (Ver.1.24b EXE 本体 + ReadMe)
 旧バージョン OneKey2 は、動作不安定のため、ダウンロードは中止にしました。
 試してみたい場合は、http://www.izawa-web.com/zip/OneKey2.zip をダウンロードしてください。(Ver.1.23g)


■Delphi ソースコード (Ver.1.24a)
 ※キーフックのコードは、Mr.XRAY 氏のサンプルコードを使用しています。
 ※ BcadCtrl19.pas は不要になりました。
 ※ BricscadApp_TLB, BricscadDb_TLB は、[コンポーネント] - [コンポーネントのインポート...] -「タイプライブラリの取り込み」で作成します。

// 2018/12/09

unit OneKey3Unit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ShellAPI, Vcl.ExtCtrls,
  Vcl.StdCtrls, IMM, System.UITypes, IniFiles, Menus,
  ComObj, ActiveX, BricscadApp_TLB, BricscadDb_TLB;

Type
  // パラメータ付きのイベントをタイプ別に用意
  TParamWideStringEvent  = procedure(ASender: TObject; const Param: WideString) of object;
  TParamVarWordBoolEvent = procedure(ASender: TObject; var Param: WordBool) of object;
type
  TAcadApplicationEventsSink = class(TInterfacedObject, IUnknown, IDispatch)
  private
    FOwner : TObject;

    FOnNewDrawing    : TNotifyEvent;
    FOnBeginOpen : TParamWideStringEvent;
    FOnEndOpen : TParamWideStringEvent;
    FOnUnknownEvent : TNotifyEvent;
    FOnBeginQuit  : TParamVarWordBoolEvent;
  protected
  {
  イベントシンククラスのインスタンスが用意できたら,このイベントシンクの存在を
  サーバーに知らせます。
  これで,サーバーはイベントシンクを呼び出せるようになります。
  サーバーにイベントシンクの存在を知らせるには,グローバル手続き InterfaceConnect
  を呼び出し,以下を渡します。
    ・イベントを生成するサーバーとのインターフェース
    ・イベントシンクが処理するイベントインターフェースの GUID
    ・イベントシンクの IUnknown インターフェース
    ・サーバーとイベントシンクの接続を表す Longint 値を受け取る変数
   }
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { IDispatch }
    function GetTypeInfoCount(out Count: Integer): HRESULT; virtual; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; virtual; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; virtual; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; virtual; stdcall;
  public
    constructor Create(Owner:TObject);
    property OnNewDrawing    : TNotifyEvent read FOnNewDrawing write FOnNewDrawing;
    property OnBeginOpen : TParamWideStringEvent read FOnBeginOpen write FOnBeginOpen;
    property OnEndOpen : TParamWideStringEvent read FOnEndOpen write FOnEndOpen;
    property OnBeginQuit : TParamVarWordBoolEvent read FOnBeginQuit write FOnBeginQuit;
    property OnUnknownEvent : TNotifyEvent read FOnUnknownEvent write FOnUnknownEvent;
  end;

type
  TOneKeyForm = class(TForm)
    Timer1: TTimer;
    CheckBox1: TCheckBox;
    Shape1: TShape;
    Label1: TLabel;
    CheckBox2: TCheckBox;
    Timer2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private 宣言 }

    FAcadApplication : IAcadApplication;
    EventChanel : TAcadApplicationEventsSink;
    CPC: IConnectionPointContainer;
    CP : IConnectionPoint;
    cookie : Integer;
    procedure BcadBeginOpen(Sender: TObject;const FileName: WideString);
    procedure BcadEndOpen(Sender: TObject;const FileName: WideString);
    procedure BcadNewDrawing(Sender: TObject);
    procedure BcadBeginQuit(Sender: TObject; var Cancel: WordBool);
  public
    { Public 宣言 }
  protected
    procedure WMApp110(var Message: TMessage); message WM_APP + 110;
  end;

type
  LPKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
  tagKBDLLHOOKSTRUCT = record
    vkCode      : DWORD;
    scanCode    : DWORD;
    flags       : DWORD;
    time        : DWORD;
    dwExtraInfo : ULONG_PTR;
  end;
  KBDLLHOOKSTRUCT  = tagKBDLLHOOKSTRUCT;
  PKbDllHookStruct = LPKBDLLHOOKSTRUCT;

var
  OneKeyForm: TOneKeyForm;
  KeyHookHandle   : HHOOK;
  TargetWnd       : HWND;
  BcadHwnd : HWND;
  BcadCmdHwnd: HWND;

  cmdstr : string;
  cmdopt : string;
  TmCnt : integer;
  TmFlag : boolean;

  bcadCaption, oldCaption : string;
  // マウス座標を保持
  mousex, mousey : integer;
  // マウス移動判断の閾値
  mousexy : integer;
  // 前回のコマンドライン文字列
  cmdold : string;
  // Bcad が起動中ON
  bcadflag : boolean;
  tmbusy : boolean;
  pt : TPoint;
  OneKeySleep : boolean;

  function makeCmdOptionList(const cmds: string): string;

implementation

{$R *.dfm}

//-----------------------------------------------------------------------------
//  キーフックのコールバック関数
//-----------------------------------------------------------------------------
function LowLevelKeyProc(Code: Integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
  Lkbdll    : PKBDLLHOOKSTRUCT;
begin
  if Code < 0 then begin
    Result := CallNextHookEx(KeyHookHandle, Code, wPar, lPar);
    exit;
  end;

  Lkbdll := PKBDLLHOOKSTRUCT(lPar);
  if Code = HC_ACTION then begin
    if wPar = WM_KEYDOWN then begin
      PostMessage(OneKeyForm.Handle, WM_APP + 110, wPar, Lkbdll.vkCode);
    end
    else if wPar = WM_KEYUP then begin
      PostMessage(OneKeyForm.Handle, WM_APP + 110, wPar, Lkbdll.vkCode);
    end
  end;
  Result := CallNextHookEx(KeyHookHandle, Code, wPar, lPar);
end;

procedure BcadSendKeys(const keystr: string);
{ Bricscad をアクティブにして、Keyを押す}
var
  i : integer;
  s: string;
begin
  SetForegroundWindow(BcadHwnd);
  s := UpperCase(keystr);
  for i := 1 to Length(s) do begin
    keybd_event(Byte(s[i]), 0, 0, 0);
    keybd_event(Byte(s[i]), 0, KEYEVENTF_KEYUP, 0);
    Sleep(1);
  end;
end;

//-----------------------------------------------------------------------------
//  フックしたキーボード情報を受取る
//  KEYDOWNで送られてくる
//-----------------------------------------------------------------------------

procedure TOneKeyForm.WMApp110(var Message: TMessage);
var
  LKey     : WORD;
  LMsgKind : WORD;
  LhTarget : HWND;
  LMsgStr  : String;
begin
  LKey     := Message.LParam;
  LMsgKind := Message.WParam;
  if LMsgKind = $100 then LMsgStr := 'KeyDown'
  else if LMsgKind = $101 then LMsgStr := 'KeyUp'
  else LMsgStr := 'Key???';
  //最前面のウィンドウのハンドルがTargetWndと同じだったら処理
  //この条件を削除すれば,全てのウィンドウでのキー操作を検出することになる
  LhTarget := GetForegroundWindow;
  if (LhTarget = TargetWnd) and IsWindowEnabled(LhTarget) then begin
    if ShortCutToText(LKey) = 'Ctrl' then begin
      if (cmdstr = '') or
        ((cmdstr <> '') and ((Pos('点', cmdstr) > 0) or (Pos('ポイント', cmdstr) > 0) or
        (cmdstr.IndexOf('コーナ') >= 0) or (cmdstr.IndexOf('中心') >= 0))) then begin
        keybd_event(VK_F9, 0, 0, 0);
        keybd_event(VK_F9, 0, KEYEVENTF_KEYUP, 0);
        Sleep(1);
      end;
    end;
  end;
end;

// -----------------------------------------------------------------------------
{ TAcadApplicationEvents }
// -----------------------------------------------------------------------------
function TAcadApplicationEventsSink.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Result := E_NOTIMPL;
end;

function TAcadApplicationEventsSink.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  Result := E_NOINTERFACE;
  Pointer(Obj) := nil;
  if GetInterface(IID, Obj) then Result := S_OK;
  if IsEqualGUID(IID,_DAcadApplicationEvents) and GetInterface(IDispatch,Obj) then
    Result := S_OK;
end;

function TAcadApplicationEventsSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TAcadApplicationEventsSink._AddRef: Integer;
begin
  Result := 2;
end;
function TAcadApplicationEventsSink.GetTypeInfoCount(out Count: Integer): HRESULT;
begin
  Count := 0;
  Result := S_OK;
end;

function TAcadApplicationEventsSink.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
var
  FParamWideString : Widestring;
  FData : TVariantArg;
  FParamWordBool : WordBool;
begin
  Case DispID of
    2  : if Assigned(FOnNewDrawing) then FOnNewDrawing(FOwner);
    8  : if Assigned(FOnBeginQuit) then begin
           if TDispParams(Params).cArgs = 1 then begin
             FParamWordBool :=false;
             FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
             if FData.vt = VT_BOOL then FParamWordBool := FData.vbool;
             FOnBeginQuit(FOwner, FParamWordBool);
           end;
         end;
    21 : if Assigned(FOnBeginOpen) then begin
           if TDispParams(Params).cArgs = 1 then begin
             FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
             if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
             FOnBeginOpen(FOwner, FParamWideString);
           end;
          end;
    22 : if Assigned(FOnEndOpen) then begin
           if TDispParams(Params).cArgs = 1 then begin
             FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
             if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
             FOnEndOpen(FOwner, FParamWideString);
           end;
         end;
    else if Assigned(FOnUnknownEvent) then FOnUnknownEvent(FOwner);
  end;
  Result := S_OK;
end;

function TAcadApplicationEventsSink._Release: Integer;
begin
  Result := 1;
end;

constructor TAcadApplicationEventsSink.Create(Owner:TObject);
begin
  inherited Create;
  FOwner := Owner;
end;
// -----------------------------------------------------------------------------

// BricsCAD が起動されているか
function IsBcadActive:boolean;
const
  BcadClassName = 'BricscadApp.AcadApplication';
var
  ClassID : TGUID;
  UnKnown : IUnknown;
begin
  ClassID := ProgIDtoClassID(BcadClassName);
  result  := Succeeded(GetActiveObject(ClassID, nil, Unknown));
end;

//******************************************
// 他のプロセス内のコントロールの文字列を得る
//******************************************
function GetWindowString(h: HWND): string;
var
  p : PChar;
  len : LongInt;
begin
  result := '';
  //ウィンドウの文字列のバイト数を取得
  //終端のNULL文字を含まない文字列の長さ(バイト数)
  len := SendMessage(h, WM_GETTEXTLENGTH, 0, 0);
  if len > 0 then begin
    //終端のNULL文字を含むサイズを確保
    GetMem(p, (len + 1) * 2);
    //格納するバッファの最大サイズ(終端のNULL文字を含む長さ)
    //文字列バッファ
    SendMessage(h, WM_GETTEXT, (len + 1) * 2, LongInt(p));
    //文字列がバッファサイズより長いとき、後部がカットされる
    result := string(p);
    FreeMem(p);
  end;
end;

function GetBcadHwndCmdLineHandle(hMain: HWND): HWND;
var
  h, h2 : HWND;
  hCmdBar : HWND;
  hCmdLine : HWND;
  i : integer;
  ClassName : array [0..254] of char;
  PID, MainPID : DWORD;
begin
  FillChar(ClassName[0], 255, #0);
  GetWindowThreadProcessId(hMain, @MainPID);
  hCmdBar := FindWindowEx(hMain, 0, nil, 'コマンドライン');
  h := hCmdBar;
  for i := 1 to 4 do begin
    h2 := GetWindow(h, GW_CHILD);
    if h2 = 0 then break
    else h := h2;
  end;
  hCmdLine := GetWindow(h, GW_HWNDNEXT);
  GetClassName(hCmdLine, ClassName, 255);
  if string(ClassName) <> 'RICHEDIT50W' then hCmdLine := 0;
  if hCmdLine = 0 then begin
    hCmdBar := FindWindow(nil, 'コマンドライン');
    GetWindowThreadProcessId(hMain, @PID);
    if PID = MainPID then begin
      h := hCmdBar;
      for i := 1 to 5 do begin
        h2 := GetWindow(h, GW_CHILD);
        if h2 = 0 then break
        else h := h2;
      end;
      hCmdLine := GetWindow(h, GW_HWNDNEXT);
      GetClassName(hCmdLine, ClassName, 255);
      if string(ClassName) <> 'RICHEDIT50W' then hCmdLine := 0;
    end;
  end;
  result := hCmdLine;
end;

procedure TOneKeyForm.BcadBeginOpen(Sender: TObject; const FileName: WideString);
begin
  OneKeySleep := True;
end;

procedure TOneKeyForm.BcadEndOpen(Sender: TObject; const FileName: WideString);
begin
  OneKeySleep := True;
end;

procedure TOneKeyForm.BcadNewDrawing(Sender: TObject);
begin
  OneKeySleep := True;
end;

procedure TOneKeyForm.BcadBeginQuit(Sender: TObject; var Cancel: WordBool);
begin
end;

procedure TOneKeyForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  ini : TIniFile;
begin
  Timer1.Enabled := False;
  try
    ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
    try
      ini.WriteInteger('OneKey', 'MouseMove', mousexy);
      ini.WriteBool('OneKey','ImeOff', CheckBox1.Checked);
      ini.WriteBool('OneKey','OneKey', CheckBox2.Checked);
    finally
      ini.Free;
    end;
  except
    ;
  end;
end;

procedure TOneKeyForm.FormCreate(Sender: TObject);
var
  ini : TIniFile;
begin
  Label1.Caption := '';
  oldCaption := '';
  // マウス移動判断の閾値の初期値
  mousexy := 20;
  mousex := 0;
  mousey := 0;

  // スクリーンの右下隅に表示
  Left := Screen.Width  - Width  - 10;
  Top  := Screen.Height - Height - 130;

  ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
  try
    mousexy := ini.ReadInteger('OneKey','MouseMove', mousexy);
    CheckBox1.Checked := ini.ReadBool('OneKey','ImeOff', True);
    CheckBox2.Checked := ini.ReadBool('OneKey','OneKey', True);
  finally
    ini.Free;
  end;

  if KeyHookHandle = 0 then
    KeyHookHandle := SetWindowsHookEx(WH_KEYBOARD_LL, @LowLevelKeyProc, hInstance, 0);
end;

procedure TOneKeyForm.FormDestroy(Sender: TObject);
begin
  try
    if KeyHookHandle <> 0 then UnhookWindowsHookEx(KeyHookHandle);
    if Assigned(EventChanel) then FreeAndNil(EventChanel);
  except
    ;
  end;
end;

procedure TOneKeyForm.FormShow(Sender: TObject);
begin
  Timer1.Enabled := True;
end;

function makeObjectSnapStr(const cmdo: string; const optstr: string): string;
begin
  result := '';
  // オプションリストに存在
  if cmdo.IndexOf(',' + optstr + ',') < 0 then begin
    // 一時オブジェクトスナップ
    // 中点:MID
    if optstr = 'M' then result := 'id' + #13
    else if optstr = 'MI' then result := 'd' + #13
    else if optstr = 'MD' then result := #08 + 'id' + #13
    else if optstr = 'MM' then result := #08 + 'id' + #13
    // 中心:CEN
    else if optstr = 'C' then result := 'en' + #13
    else if optstr = 'CE' then result := 'n' + #13
    else if optstr = 'CN' then result := #08+'en' + #13
    else if optstr = 'CC' then result := #08+'en' + #13
    // 四半円点:QUA
    else if optstr = 'Q' then result := 'ua' + #13
    else if optstr = 'QU' then result := 'a' + #13
    else if optstr = 'QA' then result := #08 + 'ua' + #13
    else if optstr = 'QQ' then result := #08 + 'ua' + #13
    // 端点:END
    else if optstr = 'E' then result := 'nd' + #13
    else if optstr = 'EN' then result := 'd' + #13
    else if optstr = 'ED' then result := #08 + 'nd' + #13
    else if optstr = 'EE' then result := #08 + 'nd' + #13
    // 交点:INT
    else if optstr = 'I' then result := 'nt' + #13
    else if optstr = 'IT' then result := #08 + 'nt' + #13
    else if optstr = 'II' then result := #08 + 'nt' + #13
    // 接線:TAN
    else if optstr = 'T' then result := 'an' + #13
    else if optstr = 'TA' then result := 'n' + #13
    else if optstr = 'TN' then result := #08 + 'an' + #13
    else if optstr = 'TT' then result := #08 + 'an' + #13
    // 近接点:NEA
    else if optstr = 'N' then result := 'ea' + #13
    else if optstr = 'NE' then result := 'a' + #13
    else if optstr = 'NA' then result := #08 + 'ea' + #13
    // 垂線:PER
    else if optstr = 'P' then result := 'er' + #13
    else if optstr = 'PE' then result := 'r' + #13
    else if optstr = 'PR' then result := #08 + 'er' + #13
    else if optstr = 'PP' then result := #08 + 'er' + #13
    // 挿入基点:INS
    else if optstr = 'S' then result := #08 + 'ins' + #13
    else if optstr = 'IS' then result := #08 + 'ns' + #13
    else if optstr = 'IN' then result := 's' + #13
    // 点:NOD
    else if optstr = 'D' then result := #08 + 'nod' + #13
    else if optstr = 'O' then result := #08 + 'nod' + #13
    else if optstr = 'ND' then result := #08 + 'od' + #13
    // 解除:NON
    else if optstr = 'NN' then result := #08 + 'on' + #13
    else if optstr = 'NO' then result := 'n' + #13
    // 2点間中点:M2P
    else if optstr = 'V' then result := #08 + 'm2p' + #13
    else if optstr = 'MT' then result := #08 + 'tp' + #13
    else if optstr = 'M2' then result := #08 + '2p' + #13
    else if optstr = 'MP' then result := #08 + '2p' + #13
    else if optstr = 'MMM' then result := #08#08 + '2p' + #13

    // 延長:EXT
    //else if optstr = 'E' then result := 'xt' + #13
    else if optstr = 'EX' then result := 't' + #13
    else if optstr = 'ET' then result := #08 + 'xt' + #13
    // 基点設定:FROM
    else if optstr = 'F' then result := 'rom' + #13
    else if optstr = 'FR' then result := 'om' + #13
    else if optstr = 'FM' then result := #08 + 'rom' + #13
    // 仮想交点:APP
    else if optstr = 'A' then result := 'pp' + #13
    else if optstr = 'AP' then result := 'p' + #13
    // 平行:PAR
    else if optstr = 'PA' then result := 'r' + #13
    //else if optstr = 'PR' then result := #08 + 'ar' + #13
    // [ESC]
    else if optstr = 'X' then result := #27
    else if optstr = 'XX' then result := #27;
  end;
end;

function makeCmdOptionList(const cmds: string): string;
var
  n, m : integer;
  s, s2 : string;
begin
  result := '';
  s := cmds;
  if (s.IndexOf('(') > 0) and (s.IndexOf(')') > 0) then begin
    m := Pos('[', s);
    n := Pos(']', s);
    if (m > 0) and (n > m) then s := Copy(s, m + 1, n-m-1);
    if s <> '' then begin
      while True do begin
        m := Pos('(', s);
        n := Pos(')', s);
        if (m > 0) and (n > m) then begin
          s2 := Copy(s, m + 1, n - m -1);
          if (s2.Length > 0) and (s2.Length <= 5) then result := result + s2 + ',';
          Delete(s, 1, n);
        end
        else break;
      end;
    end;
  end
  else if (s.IndexOf('選択:') > 0) then begin
    result := 'W,L,C,BOX,ALL,F,WP,CP,G,CL,A,R,M,P,U,AU,SI,';
  end;
  // OPT は、','で囲まれている状態にする
  if result <> '' then result := ',' + result;
end;

procedure TOneKeyForm.Timer1Timer(Sender: TObject);
var
  optstr : string; // コマンドオプション
  s : string;
  entflag, posflag : boolean;
  IME: HWND; // uses Imm
  n : integer;
  curFlag : boolean;
begin
  try
    //curFlag := False;
    // 初回起動時は1.5秒程度何もしない
    if not TmFlag then Inc(TmCnt);
    if TmCnt >= 15 then TmFlag := True;

    if TmFlag and not tmbusy then begin
      tmbusy := True;
      // [Enter]キー発行
      entflag := False;
      // コマンドライン取得
      BcadCmdHwnd := GetBcadHwndCmdLineHandle(BcadHwnd);
      if IsWindowEnabled(BcadCmdHwnd) then
        cmdstr := GetWindowString(BcadCmdHwnd)
      else
        cmdstr := '';
      if OneKeySleep then begin
        oldCaption := bcadCaption;
        TmFlag := False;
        // 0.7 秒程度何もしない
        TmCnt := 8;
        tmbusy := False;
        if Shape1.Brush.Color <> clRed then begin
          Shape1.Brush.Color := clRed;
          Shape1.Pen.Color := clRed;
        end;
        OneKeySleep := False;
      end
      else begin
        // キーフックの対象を更新
        TargetWnd := BcadHwnd;
        if (': ' <> cmdstr) then begin
          if Shape1.Brush.Color <> clWhite then begin
            Shape1.Brush.Color := clWhite;
            Shape1.Pen.Color := clWhite;
          end;
        end;
        if IsWindowEnabled(BcadHwnd) and IsWindowEnabled(BcadCmdHwnd) then begin
          posflag := True;  // 基準点を更新
          // マウス座標取得
          curFlag := GetCursorPos(pt) ;
          //curFlag := True;
          //pt := Mouse.CursorPos;
          if curFlag and (GetForegroundWindow = BcadHwnd) then begin
            s := IntToStr(pt.X - mousex) + ', ' + IntToStr(mousey - pt.Y);
            Label1.Caption := s;
          end
          else begin
            if Label1.Caption <> '' then Label1.Caption := '';
            if Shape1.Brush.Color <> clYellow then begin
              Shape1.Brush.Color := clYellow;
              Shape1.Pen.Color := clYellow;
            end;
          end;
          // コマンドオプションを取得
          cmdopt := makeCmdOptionList(cmdstr);
          // コマンド入力待ち
          if (': ' = cmdstr) then begin
            // IME Off
            if CheckBox1.Checked then begin
              if Shape1.Brush.Color <> clLime then begin
                Shape1.Brush.Color := clLime;
                Shape1.Pen.Color := clLime;
              end;
              IME := ImmGetDefaultIMEWnd(BcadCmdHwnd);
              // ON であれば OFF にする
              if Boolean(SendMessage(IME, WM_IME_CONTROL, $0005, 0)) then
                 SendMessage(IME, WM_IME_CONTROL, $0006, 0);
            end;
          end
          // コマンド入力中
          else if (cmdstr.IndexOf(':') = 0) then begin // 先頭の文字が':'
            // オプション入力待ち
            if cmdstr.Length > 2 then begin // ': '=2文字
              // 方向は右上のみ(オートコンプリート対策)
              if curFlag and ((pt.X - mousex) > mousexy) and ((mousey - pt.Y) > mousexy) then
                entflag := True;
            end;
          end
          else begin
            // オプション文字列 ':'以降
            n := LastDelimiter(':', cmdstr);
            if n > 0 then optstr := Trim(Copy(cmdstr, n + 1))
            else optstr := '';
            if optstr <> '' then begin
              optstr := UpperCase(optstr);
              // オプション文字あり
              if ((cmdstr.IndexOf('[') > 0) and (cmdstr.IndexOf(']') > 0)) or
                  (cmdstr.IndexOf('点') >= 0) or (cmdstr.IndexOf('回転') >= 0) or
                  (cmdstr.IndexOf('コーナ') >= 0) or (cmdstr.IndexOf('ポイント') >= 0) then begin
                // 方向制限なし
                if curFlag and ((abs(pt.X - mousex) > mousexy) or (abs(mousey - pt.Y) > mousexy)) then begin
                  s := Copy(optstr, 1, 1);
                  // 数値入力以外 (念のため) '-'~'9'
                  if not ((s = '@') or ((s >= '-') and (s <= '9'))) then begin
                    // 一時オブジェクトスナップ
                    s := makeObjectSnapStr(cmdopt, optstr);
                    if s <> '' then begin
                      if CheckBox2.Checked then begin
                        Timer1.Enabled := False;
                        BcadSendKeys(s);
                        Sleep(100);
                        Timer1.Enabled := True;
                      end;
                    end
                    else
                      entflag := True;
                  end;
                end;
              end;
            end;
          end;
          if curFlag and (posflag or entflag) then begin
            // 基準点を更新
            mousex := pt.X;
            mousey := pt.Y;
          end;
          if CheckBox2.Checked and entFlag then begin
            Timer1.Enabled := False;
            // [Enter] 発行
            BcadSendKeys(#13);
            Sleep(100);
            Timer1.Enabled := True;
          end;
        end;
        cmdold := cmdstr;
        tmbusy := False;

        // 追従して終了
        if not bcadflag then begin
          if IsWindow(BcadHwnd) then begin
            bcadflag := True;
            SetForegroundWindow(BcadHwnd);
          end;
        end
        else begin
          if not IsWindow(BcadHwnd) then begin
            TmFlag := False;
            TmCnt :=0;
            tmbusy := True;
            Timer1.Enabled := False;
            Close;
          end;
        end;
      end;

    end;
  except
    on E: Exception do begin
      s := E.ClassName + sLineBreak + E.Message;
      MessageBox(Handle, PChar(s), '終了します.', MB_ICONINFORMATION);
      TmFlag := False;
      TmCnt :=0;
      tmbusy := True;
      Timer1.Enabled := False;
      Close;
    end;
  end;
end;

procedure TOneKeyForm.Timer2Timer(Sender: TObject);
begin
  if not IsWindow(BcadHwnd) then begin
    if IsBcadActive  then begin
      // 起動中の Bricscad を取得
      FAcadApplication := GetActiveOleObject('BricscadApp.AcadApplication') as IACadApplication;
      if Assigned(FAcadApplication) then begin
        // ウィンドウハンドルを保持
        BcadHwnd := FAcadApplication.HWND_;
        // イベントシンク
        EventChanel := TAcadApplicationEventsSink.Create(self);
        // イベントシンクの存在をBricscad に通知
        FAcadApplication.QueryInterface(IConnectionPointContainer, CPC);
        CPC.FindConnectionPoint(_DAcadApplicationEvents, CP);
        CP.Advise(EventChanel, cookie);

        // イベントを登録
        EventChanel.OnNewDrawing    := BcadNewDrawing;
        EventChanel.OnBeginOpen     := BcadBeginOpen;
        EventChanel.OnEndOpen       := BcadEndOpen;
        EventChanel.OnBeginQuit     := BcadBeginQuit;
        Timer2.Enabled := False;
      end;
    end;
  end;
end;

end.