oleregister2.pas

是一个delphi的流程制作软件

//========================= OLE UI UTILITIES ===================================
//
// This is a component editor for the OleUIPasteSpecial dialog
// See also OleRegister3 for a secondary form
//
// Grahame Marsh
// Freeware for UNDU - you get it for free I make no promises
// [e-mail]
//------------------------------------------------------------------------------

{$I OLE.INC}

unit OleRegister2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, StdCtrls, ComCtrls, Buttons, Menus,

  OleDlgs, OleConsts, OleHelpers, OleNames;

type
  TOlePasteSpecialForm = class(TForm)
    PageControl: TPageControl;
    StandardTabSheet: TTabSheet;
    OKBtn: TBitBtn;
    CancelBtn: TBitBtn;
    ExcludeTabSheet: TTabSheet;
    GroupBox2: TGroupBox;
    CaptionEdit: TEdit;
    CentreCheckBox: TCheckBox;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    CLSIDListView: TListView;
    TestBtn: TBitBtn;
    DelBtn: TBitBtn;
    AddBtn: TBitBtn;
    HideIconCheckBox: TCheckBox;
    PasteCheckBox: TCheckBox;
    PasteLinkCheckBox: TCheckBox;
    HelpCheckBox: TCheckBox;
    ChangeCheckBox: TCheckBox;
    NoRefreshCheckBox: TCheckBox;
    Label1: TLabel;
    AsIconCheckBox: TCheckBox;
    LinkTypesTabSheet: TTabSheet;
    GroupBox1: TGroupBox;
    LinkTypesListView: TListView;
    FormatsComboBox: TComboBox;
    AddBtn1: TBitBtn;
    DownBtn: TBitBtn;
    UpBtn: TBitBtn;
    DeleteBtn1: TBitBtn;
    FormatsTabSheet: TTabSheet;
    GroupBox5: TGroupBox;
    FormatsListView: TListView;
    EditBtn: TBitBtn;
    AddBtn2: TBitBtn;
    DeleteBtn2: TBitBtn;
    FormatPopupMenu: TPopupMenu;
    Add1: TMenuItem;
    Delete1: TMenuItem;
    Edit1: TMenuItem;
    LinkTypesPopupMenu: TPopupMenu;
    MoveUp1: TMenuItem;
    MoveDown1: TMenuItem;
    N1: TMenuItem;
    Add2: TMenuItem;
    Delete2: TMenuItem;
    ExcludePopupMenu: TPopupMenu;
    Test1: TMenuItem;
    N2: TMenuItem;
    Add3: TMenuItem;
    Delete3: TMenuItem;
    EditExcludeBitBtn: TBitBtn;
    ExtensionTabSheet: TTabSheet;
    GroupBox6: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    ResultMemo: TMemo;
    SourceEdit: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    ResourceEdit: TEdit;
    BrowseCLSIDBitBtn: TBitBtn;
    Browse1: TMenuItem;
    procedure AddExcludeBtnClick(Sender: TObject);
    procedure DelExcludeBtnClick(Sender: TObject);
    procedure TestExcludeBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AddLinkTypeBtnClick(Sender: TObject);
    procedure DeleteLinkTypeBtnClick(Sender: TObject);
    procedure UpLinkTypeBtnClick(Sender: TObject);
    procedure DownLinkTypeBtnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DeleteFormatBtnClick(Sender: TObject);
    procedure AddFormatBtnClick(Sender: TObject);
    procedure EditFormatBtnClick(Sender: TObject);
    procedure EditExcludeBtnClick(Sender: TObject);
    procedure BrowseCLSIDBitBtnClick(Sender: TObject);
  private
    FCopy : TPasteEntryList;
    FComponent : TComponent;
    procedure Swap (I, D : integer);
    procedure UpdateFormatsListView;
  public
    property Dialog : TComponent read FComponent write FComponent;
    procedure Initialise;
    procedure Finalise;
  end;

implementation

{$R *.DFM}

uses
  OleRegister3, OleRegister8;

procedure TOlePasteSpecialForm.FormCreate(Sender: TObject);
begin
  FormatsComboBox.Items.AddStrings (KnownClipboardFormats);
  FCopy := TPasteEntryList.Create (Application)
end;

procedure TOlePasteSpecialForm.FormDestroy(Sender: TObject);
begin
  FCopy.Free
end;

//--- Copy the data into the controls
procedure TOlePasteSpecialForm.Initialise;
var
  Loop : integer;
begin
  with FComponent as TOlePasteSpecialDialog do
  begin
    CentreCheckBox.Checked := AutoCentre;
    CaptionEdit.Text := Caption;
    ResourceEdit.Text := Resource;
    for Loop := 0 to Exclude.Count - 1 do
      with CLSIDListView.Items.Add do
        Caption := Exclude[Loop];

    AsIconCheckBox.Checked := DisableDisplayAsIcon;
    HideIconCheckBox.Checked := HideChangeIcon;
    PasteCheckBox.Checked := SelectPaste;
    PasteLinkCheckBox.Checked := SelectPasteLink;
    HelpCheckBox.Checked := ShowHelp;
    ChangeCheckBox.Checked := StayOnClipboardChange;
    NoRefreshCheckBox.Checked := NoRefreshDataObject;

    LinkTypesListView.Items.Clear;
    for Loop := 0 to 7 do
      with LinkTypesListView.Items, Add do
      begin
        Caption := IntToStr (Loop+1);
        if (Loop < LinkTypes.Count) and (LinkTypes [Loop] <> '') then
        begin
          SubItems.Add (IntToStr (GetClipboardFormat (LinkTypes[Loop])));
          SubItems.Add (LinkTypes [Loop])
        end else begin
          SubItems.Add ('');
          SubItems.Add ('')
        end
      end;

    FCopy.Assign (Formats);
    UpdateFormatsListView
  end;

  if FComponent is TOlePasteSpecialDialogEx then
    with FComponent as TOlePasteSpecialDialogEx do
    begin
      ExtensionTabSheet.TabVisible := true;
      ResultMemo.Text := Result;
      SourceEdit.Text := Source
    end
end;

//--- Refresh the Paste Format listview
procedure TOlePasteSpecialForm.UpdateFormatsListView;
var
  Loop : integer;
begin
  with FComponent as TOlePasteSpecialDialog do
  begin
    FormatsListView.Items.Clear;
    for Loop := 0 to FCopy.Count - 1 do
      if Assigned (FCopy.Items[Loop]) then
        with FormatsListView.Items, Add do
        begin
          Caption := FCopy.Items[Loop].Name;
          SubItems.Add (GetAspectName (XlatAspect (FCopy.Items[Loop].Aspect)));
          SubItems.Add (GetMediumName (XlatMediums (FCopy.Items[Loop].Medium)));
          SubItems.Add (FCopy.Items[Loop].Result)
        end
  end
end;

//--- Copy controls back into the data structure
procedure TOlePasteSpecialForm.Finalise;
var
  Loop : integer;
begin
  with FComponent as TOlePasteSpecialDialog do
  begin
    AutoCentre := CentreCheckBox.Checked;
    Caption := CaptionEdit.Text;
    Resource := ResourceEdit.Text;
    Exclude.Clear;
    for Loop := 0 to CLSIDListView.Items.Count - 1 do
      Exclude.Add (CLSIDListView.Items[Loop].Caption);

    DisableDisplayAsIcon := AsIconCheckBox.Checked;
    HideChangeIcon := HideIconCheckBox.Checked;
    SelectPaste := PasteCheckBox.Checked;
    SelectPasteLink := PasteLinkCheckBox.Checked;
    ShowHelp := HelpCheckBox.Checked;
    StayOnClipboardChange := ChangeCheckBox.Checked;
    NoRefreshDataObject := NoRefreshCheckBox.Checked;

    LinkTypes.Clear;
    for Loop := 0 to LinkTypesListView.Items.Count - 1 do
      LinkTypes.Add (LinkTypesListView.Items[Loop].SubItems[1]);

    Formats.Clear;
    Formats.Assign (FCopy)
  end;

  if FComponent is TOlePasteSpecialDialogEx then
    with FComponent as TOlePasteSpecialDialogEx do
  begin
    Result := ResultMemo.Text;
    Source := SourceEdit.Text
  end
end;

//--- Exclude Page -------------------------------------------------------------

// Add a new CLSID - offer a null CLSID to edit
procedure TOlePasteSpecialForm.AddExcludeBtnClick(Sender: TObject);
begin
  with CLSIDListView.Items.Add do
  begin
    Caption := '{00000000-0000-0000-0000-000000000000}';
    EditCaption
  end
end;

//--- Delete the selected CLSID
procedure TOlePasteSpecialForm.DelExcludeBtnClick(Sender: TObject);
begin
  with CLSIDListView do
    if Assigned (Selected) then
      Selected.Delete
end;

//--- Put the listview into edit mode
procedure TOlePasteSpecialForm.EditExcludeBtnClick(Sender: TObject);
begin
  with CLSIDListView do
    if Assigned (Selected) then
      Selected.EditCaption
end;

//--- Test each CLSID for the correct format (doesn't mean they right,
// just in the format like '{69857C20-AA5A-11D2-9803-C65433F0DB60}'
procedure TOlePasteSpecialForm.TestExcludeBtnClick(Sender: TObject);
var
  Loop : integer;
  CLSID : TCLSID;
  Bad : boolean;
begin
  Bad := false;
  with CLSIDListView do
    for Loop := 0 to Items.Count - 1 do
      if CLSIDFromString (PWideChar(WideString(Items[Loop].Caption)), CLSID) <> NOERROR then
      begin
        ShowMessage (Items[Loop].Caption + ' is invalid');
        Bad := true
      end;

  if not Bad then
    ShowMessage ('All CLSIDs are valid')
end;

//--- read the registry to pick a CLSID
procedure TOlePasteSpecialForm.BrowseCLSIDBitBtnClick(Sender: TObject);
begin
  with TBrowseCLSIDForm2.Create (Application) do
  try
    ExcludeMode;
    if Assigned (CLSIDListView.Selected) then
      SelectedCLSID := CLSIDListView.Selected.Caption;
    if ShowModal = mrOk then
      if Assigned (CLSIDListView.Selected) then
        CLSIDListView.Selected.Caption := SelectedCLSID
      else
        CLSIDListView.Items.Add.Caption := SelectedCLSID
  finally
    Free
  end
end;

//--- Link Type Page -----------------------------------------------------------

//--- Add a new link type, of the name in the selected combobox, in the first
// free slot in the listview.  Does nothing if list view is full (8).
procedure TOlePasteSpecialForm.AddLinkTypeBtnClick(Sender: TObject);
var
  Loop : integer;
begin
  with LinkTypesListView do
    for Loop := 0 to 7 do
      with Items [Loop] do
        if SubItems [1] = '' then
        begin
          SubItems [1] := FormatsComboBox.Text;
          SubItems [0] := IntToStr (GetClipboardFormat (FormatsComboBox.Text));
          exit
        end
end;

//--- Delete the selected link type
procedure TOlePasteSpecialForm.DeleteLinkTypeBtnClick(Sender: TObject);
begin
  with LinkTypesListView do
    if Assigned (Selected) then
      with Selected do
      begin
        SubItems[0] := '';
        SubItems[1] := ''
      end
end;

//--- untility to swap two list view entries.  Entry in I, direction in D
procedure TOlePasteSpecialForm.Swap (I, D : integer);
var
  S : string;
  U : integer;
begin
  with LinkTypesListView do
  for U := 0 to 1 do
  begin
    S := Items [I-D].SubItems[U];
    Items [I-D].SubItems[U] := Items [I].SubItems[U];
    Items [I].SubItems[U] := S
  end
end;

//--- Promote an entry up the listview
procedure TOlePasteSpecialForm.UpLinkTypeBtnClick(Sender: TObject);
begin
  with LinkTypesListView do
    if Assigned (Selected) then
      with Selected do
        if Index > 0 then
        begin
          Swap (Index, 1);
          Items [Index-1].Selected := true
        end
end;

//--- Demote an entry in the listview
procedure TOlePasteSpecialForm.DownLinkTypeBtnClick(Sender: TObject);
begin
  with LinkTypesListView do
    if Assigned (Selected) then
      with Selected do
        if Index < 7 then
        begin
          Swap (Index, -1);
          Items [Index+1].Selected := true
        end
end;

//--- Format page --------------------------------------------------------------

// Add a new accept (paste ok) entry, and open the format entry editor
procedure TOlePasteSpecialForm.AddFormatBtnClick(Sender: TObject);
var
  FF : TFormatForm;
begin
  FF := TFormatForm.Create (Application);
  try
    FF.Item := TPasteEntryItem.Create (FCopy);
    with FF.Item do
    begin
      Aspect := caContent;
      Name := 'Text';
      Medium := [cmGlobal];
      Result := '%s';
      Text := '%s'
    end;
    FF.Caption := 'Add new format to list';
    FF.Info := LinkTypesListView.Items;
    FF.Initialise;
    FF.ShowModal;
    FF.Finalise;
    UpdateFormatsListView
  finally
    FF.Free
  end
end;

//--- Delete the selected entry
procedure TOlePasteSpecialForm.DeleteFormatBtnClick(Sender: TObject);
begin
  with FormatsListView do
    if Assigned (Selected) then
      FCopy.Items [Selected.Index].Free;

  UpdateFormatsListView
end;

//--- Edit the selected entry
procedure TOlePasteSpecialForm.EditFormatBtnClick(Sender: TObject);
var
  FF : TFormatForm;
begin
  with FormatsListView do
    if Assigned (Selected) then
    begin
      FF := TFormatForm.Create (Application);
      try
        FF.Item := FCopy.Items [Selected.Index];
        FF.Caption := 'Edit paste format';
        FF.Info := LinkTypesListView.Items;
        FF.Initialise;
        FF.ShowModal;
        FF.Finalise;
        UpdateFormatsListView
      finally
        FF.Free
      end
    end
end;


end.