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

📄 umain.~pas

📁 delphi com addin
💻 ~PAS
字号:
unit uMain;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, DiaryAddIn_TLB, StdVcl, AddInDesignerObjects_TLB,
  uCommandBarButton, Office2000, Word2000;

type
  TDiary = class(TAutoObject, _IDTExtensibility2)
  private
    FButtonNewDoc,
    FButtonNextDoc,
    FButtonPriorDoc,
    FButtonSaveDoc,
    FButtonToggleVisible,
    FButtonCancel,
    FButtonFirstDoc,
    FButtonLastDoc : TCommandBarButton;
    procedure FNewDocClick(const Ctrl: OleVariant; var CancelDefault: OleVariant);
    procedure FNextDocClick(const Ctrl: OleVariant; var CancelDefault: OleVariant);
    procedure FPriorDocClick(const Ctrl: OleVariant; var CancelDefault: OleVariant);
    procedure FSaveDocClick(const Ctrl: OleVariant; var CancelDefault: OleVariant);
    procedure FToggleVisibleClick(const Ctrl: OleVariant; var CancelDefault: OleVariant);
    procedure FCancelClick(const Ctrl: OleVariant; var CancelDefault: OleVariant);
    procedure FFirstDocClick(const Ctrl: OleVariant; var CancelDefault: OleVariant);
    procedure FLastDocClick(const Ctrl: OleVariant; var CancelDefault: OleVariant);

    procedure FCopyResBitmapToClipBoard(const Name : String);
    function FCreateButton(aCommandBar : CommandBar) : _CommandBarButton;
  protected
    procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
    procedure OnBeginShutdown(var custom: PSafeArray); safecall;
    procedure OnConnection(const Application: IDispatch;
      ConnectMode: ext_ConnectMode; const AddInInst: IDispatch;
      var custom: PSafeArray); safecall;
    procedure OnDisconnection(RemoveMode: ext_DisconnectMode;
      var custom: PSafeArray); safecall;
    procedure OnStartupComplete(var custom: PSafeArray); safecall;
    { Protected declarations }
  end;

implementation

{$R diary.RES}

uses ComServ, Variants, Classes, Graphics, ClipBrd, Windows;

procedure TDiary.FCancelClick(const Ctrl: OleVariant;
  var CancelDefault: OleVariant);
var
  Diary : Variant;
begin
  Diary := CreateOleObject('WordDiary.DiaryApp');
  Diary.Cancel;
  Diary := Unassigned;
end;

procedure TDiary.FCopyResBitmapToClipBoard(const Name: String);
var
  aStream : TStream;
  aBitMap : Graphics.TBitmap;
begin
  with TClipboard.Create do
  begin
    try
      aStream := TResourceStream.Create(HInstance, Name, RT_RCDATA);
      aBitMap := Graphics.TBitmap.Create;
      aBitMap.LoadFromStream(aStream);
      Assign(aBitMap);
    finally
      aStream.Free;
      aBitMap.Free;
      Free;
    end;
  end;
end;

function TDiary.FCreateButton(aCommandBar: CommandBar): _CommandBarButton;
begin
  Result := aCommandBar.Controls.Add(msoControlButton, EmptyParam, EmptyParam, EmptyParam, True) as _CommandBarButton;
  with Result do
  begin
    Set_Style(msoButtonIcon);
  end;
end;

procedure TDiary.FFirstDocClick(const Ctrl: OleVariant;
  var CancelDefault: OleVariant);
var
  Diary : Variant;
begin
  Diary := CreateOleObject('WordDiary.DiaryApp');
  Diary.FirstDoc;
  Diary := Unassigned;
end;

procedure TDiary.FLastDocClick(const Ctrl: OleVariant;
  var CancelDefault: OleVariant);
var
  Diary : Variant;
begin
  Diary := CreateOleObject('WordDiary.DiaryApp');
  Diary.LastDoc;
  Diary := Unassigned;
end;

procedure TDiary.FNewDocClick(const Ctrl: OleVariant;
  var CancelDefault: OleVariant);
var
  Diary : Variant;
begin
  Diary := CreateOleObject('WordDiary.DiaryApp');
  Diary.NewDoc;
  Diary := Unassigned;
end;

procedure TDiary.FNextDocClick(const Ctrl: OleVariant;
  var CancelDefault: OleVariant);
var
  Diary : Variant;
begin
  Diary := CreateOleObject('WordDiary.DiaryApp');
  Diary.NextDoc;
  Diary := Unassigned;
end;

procedure TDiary.FPriorDocClick(const Ctrl: OleVariant;
  var CancelDefault: OleVariant);
var
  Diary : Variant;
begin
  Diary := CreateOleObject('WordDiary.DiaryApp');
  Diary.PriorDoc;
  Diary := Unassigned;
end;

procedure TDiary.FSaveDocClick(const Ctrl: OleVariant;
  var CancelDefault: OleVariant);
var
  Diary : Variant;
begin
  Diary := CreateOleObject('WordDiary.DiaryApp');
  Diary.SaveDoc;
  Diary := Unassigned;
end;

procedure TDiary.FToggleVisibleClick(const Ctrl: OleVariant;
  var CancelDefault: OleVariant);
var
  Diary : Variant;
begin
  Diary := CreateOleObject('WordDiary.DiaryApp');
  Diary.ToggleVisible;
  Diary := Unassigned;
end;

procedure TDiary.OnAddInsUpdate(var custom: PSafeArray);
begin

end;

procedure TDiary.OnBeginShutdown(var custom: PSafeArray);
begin

end;

procedure TDiary.OnConnection(const Application: IDispatch;
  ConnectMode: ext_ConnectMode; const AddInInst: IDispatch;
  var custom: PSafeArray);
var
  App : WordApplication;
  aCommandBar : CommandBar;
  aButton : _CommandBarButton;
begin
  App := WordApplication(Application);
  aCommandBar := App.CommandBars.Add('Diary', msoBarTop, False, True);
  
  FButtonNewDoc := TCommandBarButton.Create(nil);
  aButton := FCreateButton(aCommandBar);
  aButton.Set_Caption('New Doc');
  aButton.Set_Tag(aButton.Caption);
  FCopyResBitmapToClipBoard('NEWDOC');
  aButton.PasteFace;
  FButtonNewDoc.ConnectTo(aButton);
  FButtonNewDoc.OnClick := FNewDocClick;

  FButtonNextDoc := TCommandBarButton.Create(nil);
  aButton := FCreateButton(aCommandBar);
  aButton.Set_Caption('Next Doc');
  aButton.Set_Tag(aButton.Caption);
  FCopyResBitmapToClipBoard('NEXTDOC');
  aButton.PasteFace;
  FButtonNextDoc.ConnectTo(aButton);
  FButtonNextDoc.OnClick := FNextDocClick;

  FButtonPriorDoc := TCommandBarButton.Create(nil);
  aButton := FCreateButton(aCommandBar);
  aButton.Set_Caption('Prior Doc');
  aButton.Set_Tag(aButton.Caption);
  FCopyResBitmapToClipBoard('PRIORDOC');
  aButton.PasteFace;
  FButtonPriorDoc.ConnectTo(aButton);
  FButtonPriorDoc.OnClick := FPriorDocClick;

  FButtonSaveDoc := TCommandBarButton.Create(nil);
  aButton := FCreateButton(aCommandBar);
  aButton.Set_Caption('Save Doc');
  aButton.Set_Tag(aButton.Caption);
  FCopyResBitmapToClipBoard('SAVEDOC');
  aButton.PasteFace;
  FButtonSaveDoc.ConnectTo(aButton);
  FButtonSaveDoc.OnClick := FSaveDocClick;

  FButtonToggleVisible := TCommandBarButton.Create(nil);
  aButton := FCreateButton(aCommandBar);
  aButton.Set_Caption('Toggle Visible');
  aButton.Set_Tag(aButton.Caption);
  FCopyResBitmapToClipBoard('TOGGLEVISIBLE');
  aButton.PasteFace;
  FButtonToggleVisible.ConnectTo(aButton);
  FButtonToggleVisible.OnClick := FToggleVisibleClick;

  FButtonCancel := TCommandBarButton.Create(nil);
  aButton := FCreateButton(aCommandBar);
  aButton.Set_Caption('Cancel');
  aButton.Set_Tag(aButton.Caption);
  FCopyResBitmapToClipBoard('CANCEL');
  aButton.PasteFace;
  FButtonCancel.ConnectTo(aButton);
  FButtonCancel.OnClick := FCancelClick;

  FButtonFirstDoc := TCommandBarButton.Create(nil);
  aButton := FCreateButton(aCommandBar);
  aButton.Set_Caption('First Doc');
  aButton.Set_Tag(aButton.Caption);
  FCopyResBitmapToClipBoard('FIRSTDOC');
  aButton.PasteFace;
  FButtonFirstDoc.ConnectTo(aButton);
  FButtonFirstDoc.OnClick := FFirstDocClick;

  FButtonLastDoc := TCommandBarButton.Create(nil);
  aButton := FCreateButton(aCommandBar);
  aButton.Set_Caption('Last Doc');
  aButton.Set_Tag(aButton.Caption);
  FCopyResBitmapToClipBoard('LASTDOC');
  aButton.PasteFace;
  FButtonLastDoc.ConnectTo(aButton);
  FButtonLastDoc.OnClick := FLastDocClick;

  aCommandBar.Set_Visible(True);
end;

procedure TDiary.OnDisconnection(RemoveMode: ext_DisconnectMode;
  var custom: PSafeArray);
begin
  FButtonNewDoc.Free;
  FButtonNextDoc.Free;
  FButtonPriorDoc.Free;
  FButtonSaveDoc.Free;
  FButtonToggleVisible.Free;
  FButtonCancel.Free;
  FButtonFirstDoc.Free;
  FButtonLastDoc.Free;
end;

procedure TDiary.OnStartupComplete(var custom: PSafeArray);
begin

end;

initialization
  TAutoObjectFactory.Create(ComServer, TDiary, Class_Diary,
    ciMultiInstance, tmApartment);
end.

⌨️ 快捷键说明

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