■IME Off
コマンドラインの文字列が ": " だけの時、IME をオフにします。
※不要の場合は、「IME Off:Auto」のチェックを外してください。
■OneKey
※不要の場合は、「OneKey : Auto」のチェックを外してください。
・コマンド入力中：
マウス右上方向で [Enter] キーを発行します。
例えば、コマンドラインに "z" を入力しマウスを右上に移動すると、ZOOM コマンドが実行されます。
自動入力候補（コートコンプリート）を使うため、マウス右上以外は無効としています。
文字数の制限はありません。
・コマンドオプション入力中：
"["、"]" の文字列がある、または "点"、"ポイント"、"コーナ"、"中心"の文字列があり、"@"、数字入力でない時のみ、マウス方向制限なしで
[Enter] キーを発行します。
また、下記の文字（大／小文字区別なし）の場合は、一時Ｏスナップに書き換えます。
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 (２点間中点)
EX, ET : ext (延長)
F, FR, FM : from (基点設定)
A, AP : app (仮想交点)
PA : par (平行)
X, XX : [ESC]キー
G, GC :gce (図心) (1.24bより)
※コマンドオプションが優先されます。
// 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.
