Delphi で Bricscad のイベントを取得 （2017/08/15）
Delphi からでも Bricscad のイベントが使えるというサンプルです。
Bricscad V17(x86) + Delphi 10.2 Tokyo で動作を確認しました。
参照しているユニット（ BricscadApp_TLB, BricscadDb_TLB ）は、タイプライブラリの取り込みで作成して下さい。
// ---------------------------------------------
// BcadAppEvents.pas
// ---------------------------------------------
unit BcadAppEvents;
interface
Uses
ComObj, BricscadApp_TLB, Classes,
Windows, ActiveX, BricscadDb_TLB;
Type
// パラメータ付きのイベント
TParamWideStringEvent = procedure(ASender: TObject; const Param: WideString) of object;
TParamVarWideStringEvent = procedure(ASender: TObject; var Param: WideString) of object;
TSysVarChangedEvent = procedure (ASender: TObject;const SysvarName: WideString; newVal: OleVariant) of object;
TWindowMovedOrResizedEvent = procedure(ASender: TObject; HWNDFrame: Integer; bMoved: WordBool) of object;
TWindowChangedEvent = procedure (ASender: TObject;WindowState: AcWindowState) of object;
TBeginQuitEvent = procedure(ASender: TObject; var Cancel: WordBool) of object;
TBeginFileDropEvent = procedure(ASender: TObject; const FileName: WideString; var Cancel: WordBool) of object;
Type
{
イベントを処理できるようにするには，まずイベントシンクを定義しなければなりません。
イベントシンクとは，サーバーのタイプライブラリで定義されるイベントディスパッチ
インターフェースを実装するクラスです。
}
TAcadApplicationEventsSink = class(TInterfacedObject, IUnknown, IDispatch)
private
FOwner : TObject;
FOnSysVarChanged : TSysVarChangedEvent;
FOnNewDrawing : TNotifyEvent;
FOnAppActivate : TNotifyEvent;
FOnAppDeactivate : TNotifyEvent;
FOnWindowMovedOrResized : TWindowMovedOrResizedEvent;
FOnBeginModal : TNotifyEvent;
FOnEndModal : TNotifyEvent;
FOnBeginQuit : TBeginQuitEvent;
FOnBeginFileDrop : TBeginFileDropEvent;
FOnARXLoaded : TParamWideStringEvent;
FOnARXUnloaded : TParamWideStringEvent;
FOnBeginPlot : TParamWideStringEvent;
FOnEndPlot : TParamWideStringEvent;
FOnBeginLisp : TParamWideStringEvent;
FOnEndLisp : TNotifyEvent;
FOnBeginCommand : TParamWideStringEvent;
FOnEndCommand : TParamWideStringEvent;
FOnBeginSave : TParamWideStringEvent;
FOnEndSave : TParamWideStringEvent;
FOnBeginOpen : TParamVarWideStringEvent;
FOnEndOpen : TParamWideStringEvent;
FOnLispCancelled : TNotifyEvent;
FOnWindowChanged : TWindowChangedEvent;
FOnUnknownEvent : TNotifyEvent;
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 OnSysVarChanged : TSysVarChangedEvent read FOnSysVarChanged write FOnSysVarChanged;
property OnNewDrawing : TNotifyEvent read FOnNewDrawing write FOnNewDrawing;
property OnAppActivate : TNotifyEvent read FOnAppActivate write FOnAppActivate;
property OnAppDeactivate : TNotifyEvent read FOnAppDeactivate write FOnAppDeactivate;
property OnWindowMovedOrResized : TWindowMovedOrResizedEvent read FOnWindowMovedOrResized write FOnWindowMovedOrResized;
property OnBeginModal : TNotifyEvent read FOnBeginModal write FOnBeginModal;
property OnEndModal : TNotifyEvent read FOnEndModal write FOnEndModal;
property OnBeginQuit : TBeginQuitEvent read FOnBeginQuit write FOnBeginQuit;
property OnBeginFileDrop : TBeginFileDropEvent read FOnBeginFileDrop write FOnBeginFileDrop;
property OnARXLoaded : TParamWideStringEvent read FOnARXLoaded write FOnARXLoaded;
property OnARXUnloaded : TParamWideStringEvent read FOnARXUnloaded write FOnARXUnloaded;
property OnBeginPlot : TParamWideStringEvent read FOnBeginPlot write FOnBeginPlot;
property OnEndPlot : TParamWideStringEvent read FOnEndPlot write FOnEndPlot;
property OnBeginLisp : TParamWideStringEvent read FOnBeginLisp write FOnBeginLisp ;
property OnEndLisp : TNotifyEvent read FOnEndLisp write FOnEndLisp;
property OnBeginCommand : TParamWideStringEvent read FOnBeginCommand write FOnBeginCommand;
property OnEndCommand : TParamWideStringEvent read FOnEndCommand write FOnEndCommand ;
property OnBeginSave : TParamWideStringEvent read FOnBeginSave write FOnBeginSave ;
property OnEndSave : TParamWideStringEvent read FOnEndSave write FOnEndSave ;
property OnBeginOpen : TParamVarWideStringEvent read FOnBeginOpen write FOnBeginOpen;
property OnEndOpen : TParamWideStringEvent read FOnEndOpen write FOnEndOpen;
property OnLispCancelled : TNotifyEvent read FOnLispCancelled write FOnLispCancelled;
property OnWindowChanged : TWindowChangedEvent read FOnWindowChanged write FOnWindowChanged;
property OnUnknownEvent : TNotifyEvent read FOnUnknownEvent write FOnUnknownEvent;
end;
implementation
{ 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;
FVariant : OleVariant;
FParamInteger : Integer;
FParamWordBool : WordBool;
FAcWindowState : integer;
begin
Case DispID of
1 : if Assigned(FOnSysVarChanged) then begin
if TDispParams(Params).cArgs = 2 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[1];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
FVariant := OleVariant(FData);
FOnSysVarChanged(FOwner,FParamWideString, FVariant);
end;
end;
2 : if Assigned(FOnNewDrawing) then FOnNewDrawing(FOwner);
3 : if Assigned(FOnAppActivate) then FOnAppActivate(FOwner);
4 : if Assigned(FOnAppDeactivate) then FOnAppDeactivate(FOwner);
5 : if Assigned(FOnWindowMovedOrResized) then begin
if TDispParams(Params).cArgs = 2 then begin
FParamInteger :=0; FParamWordBool :=false;
FData := PVariantArgList(TDispParams(Params).rgvarg)^[1];
if FData.vt = VT_I4 then FParamInteger := FData.lVal;
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BOOL then FParamWordBool := FData.vbool;
FOnWindowMovedOrResized(FOwner, FParamInteger, FParamWordBool);
end;
end;
6 : if Assigned(FOnBeginModal) then FOnBeginModal(FOwner);
7 : if Assigned(FOnEndModal) then FOnEndModal(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;
10 : if Assigned(FOnBeginFileDrop) then begin
if TDispParams(Params).cArgs = 2 then begin
FParamWordBool :=false;
FData := PVariantArgList(TDispParams(Params).rgvarg)^[1];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BOOL then FParamWordBool := FData.vbool;
FOnBeginFileDrop(FOwner,FParamWideString,FParamWordBool);
end;
end;
11 : if Assigned(FOnARXLoaded) then begin
if TDispParams(Params).cArgs = 1 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FOnARXLoaded(FOwner,FParamWideString);
end;
end;
12 : if Assigned(FOnARXUnloaded) then begin
if TDispParams(Params).cArgs = 1 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FOnARXUnloaded(FOwner,FParamWidestring);
end;
end;
13 : if Assigned(FOnBeginPlot) then begin
if TDispParams(Params).cArgs = 1 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FOnBeginPlot(FOwner,FParamWideString);
end;
end;
14 : if Assigned(FOnEndPlot) then begin
if TDispParams(Params).cArgs = 1 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FOnEndPlot(FOwner,FParamWideString);
end;
end;
15 : if Assigned(FOnBeginLisp) then begin
if TDispParams(Params).cArgs = 1 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FOnBeginLisp(FOwner,FParamWideString);
end;
end;
16 : if Assigned(FOnEndLisp) then FOnEndLisp(FOwner);
17 : if Assigned(FOnBeginCommand) then begin
if TDispParams(Params).cArgs = 1 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FOnBeginCommand(FOwner,FParamWideString);
end;
end;
18 : if Assigned(FOnEndCommand) then begin
if TDispParams(Params).cArgs = 1 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FOnEndCommand(FOwner, FParamWideString);
end;
end;
19 : if Assigned(FOnBeginSave) then begin
if TDispParams(Params).cArgs = 1 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FOnBeginSave(FOwner,FParamWideString);
end;
end;
20 : if Assigned(FOnEndSave) then begin
if TDispParams(Params).cArgs = 1 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_BSTR then FParamWideString := FData.bstrVal;
FOnEndSave(FOwner,FParamWideString);
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;
24 : if Assigned(FOnLispCancelled) then FOnLispCancelled(FOwner);
25 : if Assigned(FOnWindowChanged) then begin
FAcWindowState := 0;
if TDispParams(Params).cArgs = 1 then begin
FData := PVariantArgList(TDispParams(Params).rgvarg)^[0];
if FData.vt = VT_I4 then FAcWindowState := FData.lVal;
FOnWindowChanged(FOwner,FAcWindowState);
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;
end.
// ---------------------------------------------
// BcadEventsMain.pas （メインフォーム）
// ---------------------------------------------
unit BcadEventsMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Comobj, BricscadApp_TLB, BcadAppEvents,ActiveX, BricscadDb_TLB, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
private
{ Private 宣言 }
FAcadApplication : IAcadApplication;
EventChanel : TAcadApplicationEventsSink;
CPC: IConnectionPointContainer;
CP : IConnectionPoint;
cookie : Integer;
procedure BcadBeginCommand(Sender: TObject;const CommandName: WideString);
procedure BcadBeginOpen(Sender: TObject;var FileName: WideString);
procedure BcadEndOpen(Sender: TObject;const FileName: WideString);
procedure BcadBeginSave(Sender: TObject;const FileName: WideString);
procedure BcadEndSave(Sender: TObject;const FileName: WideString);
procedure BcadEndCommand(Sender: TObject;const CommandName: WideString);
procedure BcadNewDrawing(Sender: TObject);
procedure BcadAppActivate(Sender: TObject);
procedure BcadAppDeactivate(Sender: TObject);
procedure BcadBeginModal(Sender: TObject);
procedure BcadEndModal(Sender: TObject);
procedure BcadSysVarChanged(Sender: TObject;const SysvarName: WideString; newVal: OleVariant);
procedure BcadWindowMovedOrResized(Sender: TObject;HWNDFrame: Integer; bMoved: WordBool);
procedure BcadWindowChanged(Sender: TObject; WindowState: AcWindowState);
procedure BcadBeginQuit(Sender: TObject; var Cancel: WordBool);
procedure BcadBeginFileDrop(Sender: TObject; const FileName: WideString; var Cancel: WordBool);
procedure BcadARXLoaded(Sender: TObject; const AppName: WideString);
procedure BcadARXUnloaded(Sender: TObject; const AppName: WideString);
procedure BcadBeginPlot(Sender: TObject; const DrawingName: WideString);
procedure BcadEndPlot(Sender: TObject; const DrawingName: WideString);
procedure BcadBeginLisp(Sender: TObject; const FirstLine: WideString);
procedure BcadEndLisp(Sender: TObject);
procedure BcadLispCancelled(Sender: TObject);
public
{ Public 宣言 }
end;
var
Form1 : TForm1;
BeCreateFlag : boolean;
ActiveFlag : boolean;
function IsBcadActive : boolean;
implementation
{$R *.dfm}
// BricsCAD が起動されているか
function IsBcadActive:boolean;
const
BcadClassName = 'BricscadApp.AcadApplication';
var
ClassID : TGUID;
UnKnown : IUnknown;
begin
ClassID := ProgIDtoClassID(BcadClassName);
result := Succeeded(GetActiveObject(ClassID, nil, Unknown));
end;
// BricsCAD Events
procedure TForm1.BcadARXLoaded(Sender: TObject; const AppName: WideString);
begin
Memo1.Lines.Add('ARXLoaded : ' + AppName);
end;
procedure TForm1.BcadARXUnloaded(Sender: TObject; const AppName: WideString);
begin
Memo1.Lines.Add('ARXUnloaded : '+ AppName);
end;
procedure TForm1.BcadBeginPlot(Sender: TObject; const DrawingName: WideString);
begin
Memo1.Lines.Add('BeginPlot : ' + DrawingName);
end;
procedure TForm1.BcadEndPlot(Sender: TObject; const DrawingName: WideString);
begin
Memo1.Lines.Add('EndPlot : ' + DrawingName);
end;
procedure TForm1.BcadBeginLisp(Sender: TObject; const FirstLine: WideString);
begin
Memo1.Lines.Add('BeginLisp : '+ FirstLine);
end;
procedure TForm1.BcadEndLisp(Sender: TObject);
begin
Memo1.Lines.Add('EndLisp');
end;
procedure TForm1.BcadLispCancelled(Sender: TObject);
begin
Memo1.Lines.Add('LispCancelled');
end;
procedure TForm1.BcadBeginFileDrop(Sender: TObject; const FileName: WideString; var Cancel: WordBool);
begin
Memo1.Lines.Add('BeginFileDrop : ' + FileName);
end;
procedure TForm1.BcadBeginQuit(Sender: TObject; var Cancel: WordBool);
begin
Memo1.Lines.Add('BeginQuit');
end;
procedure TForm1.BcadWindowChanged(Sender: TObject; WindowState: AcWindowState);
var
s:string;
begin
case WindowState of
acNorm : s := 'acNorm';
acMin : s := 'acMin';
acMax : s := 'acMax';
else s := '';
end;
Memo1.Lines.Add('WindowChanged : ' + s);
end;
procedure TForm1.BcadWindowMovedOrResized(Sender: TObject;HWNDFrame: Integer; bMoved: WordBool);
begin
Memo1.Lines.Add('WindowMovedOrResized : HWND = ' + IntToHex(HWNDFrame,8));
end;
procedure TForm1.BcadSysVarChanged(Sender: TObject;const SysvarName: WideString; newVal: OleVariant);
var
vtype : TVarType;
s : string;
m : integer;
begin
vtype := VarType(newVal);
case vtype of
//SNAPMODE,GRIDMODE...
varSmallint : s := '= '+ IntToStr(newVal) + ' > (varSmallInt)';
//DIMSCALE...
//明示的にキャストする必要がある
varDouble : s := '= ' + Format('%.3f', [Double(newVal)]) + ' > (varDouble)';
varString : s := '> (varString)';
varEmpty : s := '> (varEmpty)';
varNull : s := '> (varNull)';
varInteger : s := '> (varInteger)';
varSingle : s := '> (varSingle)';
varCurrency : s := '> (varCurrency)';
varDate : s := '> (varDate)';
//文字列
varOleStr : s := '= ' + newVal + ' > (varOleStr)';
varDispatch : s := '> (varDispatch)';
varError : s := '> (varError)';
varBoolean : s := '> (varBoolean)';
varVariant : s := '> (varVariant)';
varUnknown : s := '> (varUnknown)';
varShortInt : s := '> (varShortInt)';
varByte : s := '> (varByte)';
varWord : s := '> (varWord)';
varLongWord : s := '> (varLongWord)';
varInt64 : s := '> (varInt64)';
varStrArg : s := '> (varStrArg)';
else begin
//座標はこれ
if vtype = varArray or varDouble then begin
m := VarArrayHighBound(newVal,1);
//すべて 3D 座標
if m = 2 then
s := Format('= %.3f, %.3f, %.3f > (varArrayDouble)', [Double(newVal[0]), Double(newVal[1]), Double(newVal[2])]);
end
else
s := '> (vtype = ' + IntToHex(vtype, 8) + ' )';
end;
end;
Memo1.Lines.Add('SysVarChanged : < ' + SysvarName + ' ' + s);
end;
procedure TForm1.BcadBeginOpen(Sender: TObject;var FileName: WideString);
begin
Memo1.Lines.Add('BeginOpen : ' + FileName);
end;
procedure TForm1.BcadEndOpen(Sender: TObject;const FileName: WideString);
begin
Memo1.Lines.Add('EndOpen : ' + FileName);
end;
procedure TForm1.BcadBeginSave(Sender: TObject;const FileName: WideString);
begin
Memo1.Lines.Add('BeginSave : ' + FileName);
end;
procedure TForm1.BcadEndSave(Sender: TObject;const FileName: WideString);
begin
Memo1.Lines.Add('EndSave : ' + FileName);
end;
procedure TForm1.BcadBeginCommand(Sender: TObject;const CommandName: WideString);
begin
Form1.Memo1.Lines.Add('BeginCommand : ' + CommandName);
end;
procedure TForm1.BcadEndCommand(Sender: TObject;const CommandName: WideString);
begin
Memo1.Lines.Add('EndCommand : ' + CommandName);
end;
procedure TForm1.BcadNewDrawing(Sender: TObject);
begin
Memo1.Lines.Add('NewDrawing');
end;
procedure TForm1.BcadAppActivate(Sender: TObject);
begin
Memo1.Lines.Add('AppActivate');
end;
procedure TForm1.BcadAppDeactivate(Sender: TObject);
begin
Memo1.Lines.Add('AppDeactivate');
end;
procedure TForm1.BcadBeginModal(Sender: TObject);
begin
Memo1.Lines.Add('BeginModal');
end;
procedure TForm1.BcadEndModal(Sender: TObject);
begin
Memo1.Lines.Add('EndModal');
end;
// フォームイベント
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
InterfaceDisconnect(FAcadApplication, _DAcadApplicationEvents, cookie);
EventChanel.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Lines.Clear;
BeCreateFlag := False;
ActiveFlag := True; // 起動中の Bricscad を取得
{
if IsBcadActive then begin
FAcadApplication := GetActiveOleObject('BricscadApp.AcadApplication') as IACadApplication;
end
else begin
MessageBox(Handle,PChar('BricsCADが起動されていません.'+#13+'起動しますか？'),'BcadAppEvents',MB_YESNO);
end;
}
if BeCreateFlag then begin
// Bricscad を新規に起動
FAcadApplication := CoAcadApplication.Create;
FAcadApplication.Visible := true;
//SetForegroundWindow(FAcadApplication.HWND);
end;
if ActiveFlag then begin
// 起動中の Bricscad を取得
FAcadApplication := GetActiveOleObject('BricscadApp.AcadApplication') as IACadApplication;
Memo1.Lines.Add('GetActiveOleObject: BricscadApp.AcadApplication');
end;
if IsBcadActive and Assigned(FAcadApplication) then begin
EventChanel := TAcadApplicationEventsSink.Create(self);
FAcadApplication.QueryInterface(IConnectionPointContainer, CPC);
CPC.FindConnectionPoint(_DAcadApplicationEvents, CP);
CP.Advise(EventChanel, cookie);
EventChanel.OnEndCommand := BcadEndCommand;
EventChanel.OnBeginCommand := BcadBeginCommand;
EventChanel.OnNewDrawing := BcadNewDrawing;
EventChanel.OnBeginSave := BcadBeginSave;
EventChanel.OnEndSave := BcadEndSave;
EventChanel.OnBeginOpen := BcadBeginOpen;
EventChanel.OnEndOpen := BcadEndOpen;
EventChanel.OnAppActivate := BcadAppActivate;
EventChanel.OnAppDeactivate := BcadAppDeactivate;
EventChanel.OnBeginModal := BcadBeginModal;
EventChanel.OnEndModal := BcadEndModal;
EventChanel.OnSysVarChanged := BcadSysVarChanged;
EventChanel.OnWindowMovedOrResized := BcadWindowMovedOrResized;
EventChanel.OnWindowChanged := BcadWindowChanged;
EventChanel.OnBeginQuit := BcadBeginQuit;
EventChanel.OnBeginFileDrop := BcadBeginFileDrop;
EventChanel.OnARXLoaded := BcadARXLoaded;
EventChanel.OnARXUnloaded := BcadARXUnloaded;
EventChanel.OnBeginPlot := BcadBeginPlot;
EventChanel.OnEndPlot := BcadEndPlot;
EventChanel.OnBeginLisp := BcadBeginLisp;
EventChanel.OnEndLisp := BcadEndLisp;
EventChanel.OnLispCancelled := BcadLispCancelled;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
if Assigned(FAcadApplication) then
SetForegroundWindow(FAcadApplication.HWND);
end;
end.