⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uautoserver.pas

📁 delphi com addin
💻 PAS
字号:
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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -