unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
MsWord: OLEVariant;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
Uses ActiveX, ComObj;
ResourceString
SNoMethod = '''%s'' not supported by automation object';
Function GetPropDispID (Dispatch: IDispatch;
Const PropName: WideString): Integer;
var
Status: Integer;
PPropName: PWideChar;
begin
PPropName := PWideChar (PropName);
Status := Dispatch.GetIDsOfNames (GUID_NULL, @PPropname, 1,
GetThreadLocale, @Result);
if Status = DISP_E_UNKNOWNNAME then
raise EOleError.CreateFmt(SNoMethod, [PropName])
else
OleCheck(Status);
end;
Function GetAutoObjProp (Obj: IDispatch;
Const PropName: WideString): OLEVariant;
Const
DispParams: TDispParams = (rgvarg: Nil; rgDispIDNamedArgs: Nil;
cArgs: 0; cNamedArgs: 0);
var
Status: Integer;
ExcepInfo: TExcepInfo;
begin
Status := Obj.Invoke (GetPropDispID (Obj, PropName),
GUID_NULL, 0,
DISPATCH_METHOD or DISPATCH_PROPERTYGET,
DispParams, @Result, @ExcepInfo, nil);
if Status <> 0 then
DispatchInvokeError (Status, ExcepInfo);
end;
Procedure SetAutoObjPropValue (Const Obj: IDispatch;
PropName: WideString; Const Value:
Variant);
const
DispIDs: Integer = DispID_PropertyPut;
var
Status: Integer;
ExcepInfo: TExcepInfo;
Arg: TVariantArg;
CValue: Variant;
DispParams: TDispParams;
begin
If VarType (Value) = varString then
VarCast (CValue, Value, varOLEStr)
else
CValue := Value;
Arg.vt := varVariant or varByRef;
Arg.pVarVal := @CValue;
DispParams.rgvarg := @Arg;
DispParams.rgdispidNamedArgs := @DispIDS;
DispParams.cArgs := 1;
DispParams.cNamedArgs := 1;
Status := Obj.Invoke (GetPropDispID (Obj, PropName),
GUID_NULL, 0, DISPATCH_PROPERTYPUT,
DispParams, Nil, @ExcepInfo, Nil);
if Status <> 0 then
DispatchInvokeError(Status, ExcepInfo);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MsWord := CreateOleObject('Word.Application');
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Vis: Boolean;
begin
Vis := GetAutoObjProp (IDispatch(MsWord), 'Visible');
SetAutoObjPropValue (IDispatch(MsWord), 'Visible', Not Vis);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
GetAutoObjProp (IDispatch(MsWord), 'NonsenseProperty');
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MsWord.Quit;
end;
end.
