extactns.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 1995-2001 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit ExtActns;

interface

uses SysUtils, Windows, Controls, Classes, ComCtrls, Graphics, ActnList, StdActns,
  StdCtrls, ShellAPI, Dialogs, ExtDlgs, Registry, ImgList 
{$IFDEF MSWINDOWS} , UrlMon, ActiveX {$ENDIF}
;

type

{ TFileRun }

  TShowCmd = (scHide, scMaximize, scMinimize, scRestore, scShow, scShowDefault,
    scShowMaximized, scShowMinimized, scShowMinNoActive, scShowNA,
    scShowNoActivate, scShowNormal);

  TCustomFileRun = class(TCustomAction)
  private
    FBrowse: Boolean;
    FDirectory: TFileName;
    FFile: TFileName;
    FHInst: HInst;
    FParentHWnd: THandle;
    FParameters: String;
    FOperation: String;
    FShowCmd: TShowCmd;
    FBrowseDlg: TOpenDialog;
    FParentControl: TWinControl;
    procedure SetBrowseDlg(const Value: TOpenDialog);
    procedure SetParentControl(const Value: TWinControl);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ExecuteTarget(Target: TObject); override;
    function HandlesTarget(Target: TObject): Boolean; override;
    procedure SetupBrowseDialog;
    property HInst: HInst read FHInst;
    procedure UpdateTarget(Target: TObject); override;
    property Browse: Boolean read FBrowse write FBrowse;
    property BrowseDlg: TOpenDialog read FBrowseDlg write SetBrowseDlg;
    property Directory: TFileName read FDirectory write FDirectory;
    property FileName: TFileName read FFile write FFile;
    property Operation: String read FOperation write FOperation;
    property ParentControl: TWinControl read FParentControl write SetParentControl;
    property Parameters: String read FParameters write FParameters;
    property ShowCmd: TShowCmd read FShowCmd write FShowCmd;
  end;

  TFileRun = class(TCustomFileRun)
  published
    property Browse;
    property BrowseDlg;
    property Caption;
    property Directory;
    property Enabled;
    property FileName;
    property HelpContext;
    property Hint;
    property ImageIndex;
    property Operation;
    property ParentControl;
    property Parameters;
    property ShowCmd;
    property ShortCut;
    property SecondaryShortCuts;
    property Visible;
    property OnHint;
  end;

{ TRichEditAction }

  TRichEditAction = class(TEditAction)
  protected
    function CurrText(Edit: TCustomRichEdit): TTextAttributes;
    procedure SetFontStyle(Edit: TCustomRichEdit; Style: TFontStyle);
  public
    constructor Create(AOwner: TComponent); override;
    function HandlesTarget(Target: TObject): Boolean; override;
  end;

{ TRichEditBold }

  TRichEditBold = class(TRichEditAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  end;

{ TRichEditItalic }

  TRichEditItalic = class(TRichEditAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  end;

{ TRichEditUnderline }

  TRichEditUnderline = class(TRichEditAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  end;

{ TRichEditStrikeOut }

  TRichEditStrikeOut = class(TRichEditAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  end;

{ TRichEditBullets }

  TRichEditBullets = class(TRichEditAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  end;

{ TRichEditAlignLeft }

  TRichEditAlignLeft = class(TRichEditAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  end;

{ TRichEditAlignRight }

  TRichEditAlignRight = class(TRichEditAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  end;

{ TRichEditAlignCenter }

  TRichEditAlignCenter = class(TRichEditAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  end;

{ TTabAction }

  TTabAction = class;
  TValidateTabEvent = procedure(Sender: TTabAction; TabControl: TCustomTabControl;
    var Enabled: Boolean) of object;

  TTabAction = class(TCustomAction)
  private
    FAfterTabChange: TNotifyEvent;
    FBeforeTabChange: TNotifyEvent;
    FEnabled: Boolean;    
    FOnValidateTab: TValidateTabEvent;
    FSkipHiddenTabs: Boolean;
    FTabControl: TCustomTabControl;
    FWrap: Boolean;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SelectNextTab(GoForward: Boolean = True);
  public
    constructor Create(AOwner: TComponent); override;
    function HandlesTarget(Target: TObject): Boolean; override;
    procedure UpdateTarget(Target: TObject); override;
    property SkipHiddenTabs :Boolean read FSkipHiddenTabs write FSkipHiddenTabs default True;
    property TabControl: TCustomTabControl read FTabControl write FTabControl;
    property Wrap: Boolean read FWrap write FWrap default False;
    property BeforeTabChange: TNotifyEvent read FBeforeTabChange write FBeforeTabChange;
    property AfterTabChange: TNotifyEvent read FAfterTabChange write FAfterTabChange;
    property OnValidateTab: TValidateTabEvent read FOnValidateTab write FOnValidateTab;
  end;

{ TPreviousTab }

  TPreviousTab = class(TTabAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  published
    property TabControl;
    property Caption;
    property Enabled;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SkipHiddenTabs;
    property Visible;
    property Wrap;
    property AfterTabChange;
    property BeforeTabChange;
    property OnHint;
    property OnValidateTab;
  end;

{ TNextTab }

  TNextTab = class(TTabAction)
  private
    FOldCaption: String;
    FLastTabCaption: String;
    FOnFinish: TNotifyEvent;
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  published
    property LastTabCaption: String read FLastTabCaption write FLastTabCaption;
    property TabControl;
    property Caption;
    property Enabled;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SkipHiddenTabs;
    property Visible;
    property Wrap;
    property AfterTabChange;
    property BeforeTabChange;
    property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
    property OnHint;
    property OnValidateTab;
  end;

{ TOpenPicture }

  TOpenPicture = class(TCommonDialogAction)
  private
    function GetDialog: TOpenPictureDialog;
  protected
    function Getdialogclass: TCommonDialogClass; override;
  published
    property Dialog: TOpenPictureDialog read GetDialog;
    property Caption;
    property Enabled;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SecondaryShortCuts;
    property Visible;
    property OnHint;
    property OnUpdate;
    property OnAccept;
    property OnCancel;
  end;

{ TSavePicture }

  TSavePicture = class(TCommonDialogAction)
  private
    function GetDialog: TSavePictureDialog;
  protected
    function Getdialogclass: TCommonDialogClass; override;
  published
    property Dialog: TSavePictureDialog read GetDialog;
    property Caption;
    property Enabled;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SecondaryShortCuts;
    property Visible;
    property OnHint;
    property OnUpdate;
    property OnAccept;
    property OnCancel;
  end;

{$IFDEF MSWINDOWS}
{ TURLAction }

  TURLAction = class(TCustomAction)
  private
    FURL: String;
  public
    function HandlesTarget(Target: TObject): Boolean; override;
    procedure UpdateTarget(Target: TObject); override;
  published
    property Caption;
    property Enabled;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SecondaryShortCuts;
    property Visible;
    property URL: String read FURL write FURL;
    property OnHint;
  end;

{ TBrowserURL }

  TBrowseURL = class(TURLAction)
  private
    FAfterBrowse: TNotifyEvent;
    FBeforeBrowse: TNotifyEvent;
  public
    procedure ExecuteTarget(Target: TObject); override;
  published
    property Caption;
    property Enabled;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SecondaryShortCuts;
    property Visible;
    property URL;
    property OnHint;
    property BeforeBrowse: TNotifyEvent read FBeforeBrowse write FBeforeBrowse;
    property AfterBrowse: TNotifyEvent read FAfterBrowse write FAfterBrowse;
  end;

{ TDownLoadURL }

  TURLDownloadStatus = (dsFindingResource, dsConnecting, dsRedirecting,
    dsBeginDownloadData, dsDownloadingData, dsEndDownloadData,
    dsBeginDownloadComponents, dsInstallingComponents,
    dsEndDownloadComponents, dsUsingCachedCopy, dsSendingRequest,
    dsClassIDAvailable, dsMIMETypeAvailable, dsCacheFileNameAvailable,
    dsBeginSyncOperation, dsEndSyncOperation, dsBeginUploadData,
    dsUploadingData, dsEndUploadData, dsProtocolClassID, dsEncoding,
    dsVerifiedMIMETypeAvailable, dsClassInstallLocation, dsDecoding,
    dsLoadingMIMEHandler, dsContentDispositionAttach, dsFilterReportMIMEType,
    dsCLSIDCanInstantiate, dsIUnKnownAvailable, dsDirectBind, dsRawMIMEType,
    dsProxyDetecting, dsAcceptRanges, dsCookieSent, dsCompactPolicyReceived,
    dsCookieSuppressed, dsCookieStateUnknown, dsCookieStateAccept,
    dsCookeStateReject, dsCookieStatePrompt, dsCookieStateLeash,
    dsCookieStateDowngrade, dsPolicyHREF, dsP3PHeader, dsSessionCookieReceived,
    dsPersistentCookieReceived, dsSessionCookiesAllowed);

  TDownLoadURL = class;

  TDownloadProgressEvent = procedure(Sender: TDownLoadURL; Progress,
    ProgressMax: Cardinal; StatusCode: TURLDownloadStatus; StatusText: String;
    var Cancel: Boolean) of object;

  TDownLoadURL = class(TURLAction, IBindStatusCallback)
  private
    FOnDownloadProgress: TDownloadProgressEvent;
    FFilename: TFilename;
    FBeforeDownload: TNotifyEvent;
    FAfterDownload: TNotifyEvent;
  protected
    { IBindStatusCallback }
    function GetBindInfo(out grfBINDF: Cardinal;
      var bindinfo: _tagBINDINFO): HRESULT; stdcall;
    function GetPriority(out nPriority): HRESULT; stdcall;
    function OnDataAvailable(grfBSCF: Cardinal; dwSize: Cardinal;
      formatetc: PFormatEtc; stgmed: PStgMedium): HRESULT; stdcall;
    function OnLowResource(reserved: Cardinal): HRESULT; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HRESULT; stdcall;
    function OnProgress(ulProgress: Cardinal; ulProgressMax: Cardinal;
      ulStatusCode: Cardinal; szStatusText: PWideChar): HRESULT; stdcall;
    function OnStartBinding(dwReserved: Cardinal; pib: IBinding): HRESULT; stdcall;
    function OnStopBinding(hresult: HRESULT; szError: PWideChar): HRESULT; stdcall;
  public
    procedure ExecuteTarget(Target: TObject); override;
  published
    property Caption;
    property Enabled;
    property Filename: TFilename read FFilename write FFilename;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SecondaryShortCuts;
    property Visible;
    property URL;
    property BeforeDownload: TNotifyEvent read FBeforeDownload write FBeforeDownload;
    property AfterDownload: TNotifyEvent read FAfterDownload write FAfterDownload;
    property OnHint;
    property OnUpdate;
    property OnDownloadProgress: TDownloadProgressEvent read FOnDownloadProgress write FOnDownloadProgress;
  end;
{$ENDIF}     { MSWINDOWS }

{ TSendMail }

  TSendMail = class(TCustomAction)
  private
    FText: TStrings;
    procedure SetText(const Value: TStrings);
    function GetText: TStrings;
  public
    destructor Destroy; override;
    procedure ExecuteTarget(Target: TObject); override;
    function HandlesTarget(Target: TObject): Boolean; override;
    procedure UpdateTarget(Target: TObject); override;
  published
    property Caption;
    property Enabled;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SecondaryShortCuts;
    property Text: TStrings read GetText write SetText;
    property Visible;
    property OnHint;
    property OnUpdate;
  end;

{ TListControlAction }

  TListControlAction = class(TCustomAction)
  private
    FListControl: TCustomListControl;
    procedure SetListControl(const Value: TCustomListControl);
  protected
    function IsEnabled(Target: TObject): Boolean;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    function HandlesTarget(Target: TObject): Boolean; override;
    property ListControl: TCustomListControl read FListControl write SetListControl;
  end;

{ TListControlSelectAll }

  TListControlSelectAll = class(TListControlAction)
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  published