uautoserver.pas

来自「delphi com addin」· PAS 代码 · 共 124 行

unit UAutoServer;

interface

uses
  ComObj, ActiveX, AxCtrls, Classes, WordDiary_TLB, StdVcl;

type
  TDiaryApp = class(TAutoObject, IConnectionPointContainer, IDiaryApp)
  private
    { Private declarations }
    FConnectionPoints: TConnectionPoints;
    FConnectionPoint: TConnectionPoint;
    FSinkList: TList;
    FEvents: IDiaryAppEvents;
  public
    procedure Initialize; override;
  protected
    { Protected declarations }
    property ConnectionPoints: TConnectionPoints read FConnectionPoints
      implements IConnectionPointContainer;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    function NewDoc: HResult; stdcall;
    function NextDoc: HResult; stdcall;
    function PriorDoc: HResult; stdcall;
    function SaveDoc: HResult; stdcall;
    function ToggleVisible: HResult; stdcall;
    function Cancel: HResult; stdcall;
    function FirstDoc: HResult; stdcall;
    function LastDoc: HResult; stdcall;
  end;

implementation

uses ComServ, UDiaryMain, ShellApi, Windows;


procedure TDiaryApp.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IDiaryAppEvents;
  if FConnectionPoint <> nil then
     FSinkList := FConnectionPoint.SinkList;
end;

procedure TDiaryApp.Initialize;
begin
  inherited Initialize;
  FConnectionPoints := TConnectionPoints.Create(Self);
  if AutoFactory.EventTypeInfo <> nil then
    FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
      AutoFactory.EventIID, ckSingle, EventConnect)
  else FConnectionPoint := nil;
end;


function TDiaryApp.NewDoc: HResult;
begin
  if fmDiary.acDiary.Connected and (not fmDiary.NotGood)  then
    fmDiary.NewDocument
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/0', nil, SW_SHOW);
end;

function TDiaryApp.NextDoc: HResult;
begin
  if fmDiary.acDiary.Connected and (not fmDiary.NotGood)  then
    fmDiary.NextDocument
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/2', nil, SW_SHOW);
end;

function TDiaryApp.PriorDoc: HResult;
begin
  if fmDiary.acDiary.Connected and (not fmDiary.NotGood)  then
    fmDiary.PriorDocument
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/2', nil, SW_SHOW);
end;

function TDiaryApp.SaveDoc: HResult;
begin
  if fmDiary.acDiary.Connected and (not fmDiary.NotGood)  then
    fmDiary.SaveDocument
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/2', nil, SW_SHOW);
end;

function TDiaryApp.ToggleVisible: HResult;
begin
  if fmDiary.acDiary.Connected and (not fmDiary.NotGood)  then
    fmDiary.Visible := not fmDiary.Visible
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/2', nil, SW_SHOW);
end;

function TDiaryApp.Cancel: HResult;
begin
  if fmDiary.acDiary.Connected and (not fmDiary.NotGood)  then
    fmDiary.tbDiary.Cancel
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/2', nil, SW_SHOW);
end;

function TDiaryApp.FirstDoc: HResult;
begin
  if fmDiary.acDiary.Connected and (not fmDiary.NotGood)  then
    fmDiary.FirstDocument
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/1', nil, SW_SHOW);
end;

function TDiaryApp.LastDoc: HResult;
begin
  if fmDiary.acDiary.Connected and (not fmDiary.NotGood)  then
    fmDiary.LastDocument
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/2', nil, SW_SHOW);
end;

initialization
  TAutoObjectFactory.Create(ComServer, TDiaryApp, Class_DiaryApp,
    ciMultiInstance, tmApartment);
end.