oleregister4.pas

是一个delphi的流程制作软件

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

{$I OLE.INC}

unit OleRegister4;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, ComCtrls, ActiveX, ExtDlgs,
  OleHelpers, OleDlgs;

type
  TOleIconForm = class(TForm)
    PageControl: TPageControl;
    StandardTabSheet: TTabSheet;
    GroupBox1: TGroupBox;
    HelpCheckBox: TCheckBox;
    UseExeCheckBox: TCheckBox;
    GroupBox2: TGroupBox;
    CaptionEdit: TEdit;
    CentreCheckBox: TCheckBox;
    AdditionalTabSheet: TTabSheet;
    GroupBox5: TGroupBox;
    OKBtn: TBitBtn;
    CancelBtn: TBitBtn;
    SelectRadioGroup: TRadioGroup;
    CLSIDEdit: TEdit;
    Label4: TLabel;
    TestCLSIDBitBtn: TBitBtn;
    ExeEdit: TEdit;
    Label5: TLabel;
    BrowseExeBitBtn: TBitBtn;
    OpenExeDialog: TOpenDialog;
    BrowseCLSIDBitBtn: TBitBtn;
    LoadBitBtn: TBitBtn;
    ClearBitBtn: TBitBtn;
    OpenPictureDialog: TOpenPictureDialog;
    ImagePanel: TPanel;
    MFImage: TImage;
    Bevel1: TBevel;
    procedure BrowseExeBitBtnClick(Sender: TObject);
    procedure TestCLSIDBitBtnClick(Sender: TObject);
    procedure BrowseCLSIDBitBtnClick(Sender: TObject);
    procedure LoadBitBtnClick(Sender: TObject);
    procedure ClearBitBtnClick(Sender: TObject);
  private
    FComponent : TComponent;
  public
    property Dialog : TComponent read FComponent write FComponent;
    procedure Initialise;
    procedure Finalise;
  end;

var
  OleIconForm: TOleIconForm;

implementation

{$R *.DFM}

uses
  OleRegister8;


procedure TOleIconForm.Initialise;
var
  Copy : TUIMetafile;
begin
  with FComponent as TOleChangeIconDialog do
  begin
    CentreCheckBox.Checked := AutoCentre;
    CaptionEdit.Text := Caption;
    HelpCheckBox.Checked := ShowHelp;
    UseExeCheckBox.Checked := UseExe;
    SelectRadioGroup.ItemIndex := ord (Select);
    CLSIDEdit.Text := CLSID;
    ExeEdit.Text := Filename;

    if not Metafile.Empty then
    begin
      Copy := TUIMetafile.Create;
      Copy.Assign (Metafile);
      MFImage.Picture.Graphic := Copy;
      ImagePanel.Caption := ''
    end else
      ImagePanel.Caption := '(empty)'
  end
end;

procedure TOleIconForm.Finalise;
begin
  with FComponent as TOleChangeIconDialog do
  begin
    AutoCentre := CentreCheckBox.Checked;
    Caption := CaptionEdit.Text;
    ShowHelp := HelpCheckBox.Checked;
    UseExe := UseExeCheckBox.Checked;
    Select:= TChangeIconSelect (SelectRadioGroup.ItemIndex);
    CLSID := CLSIDEdit.Text;
    Filename := ExeEdit.Text;
    if Assigned (MFImage.Picture) then
      Metafile.Assign (MFImage.Picture.Graphic)
    else
      Metafile.Assign (nil)
  end
end;

procedure TOleIconForm.BrowseExeBitBtnClick(Sender: TObject);
begin
  with OpenExeDialog do
  begin
    Filename := ExeEdit.Text;
    if Execute then
      ExeEdit.Text := Filename
  end
end;

procedure TOleIconForm.TestCLSIDBitBtnClick(Sender: TObject);
var
  CLSID : TCLSID;
begin
  if CLSIDFromString (PWideChar(WideString(CLSIDEdit.Text)), CLSID) <> NOERROR then
    ShowMessage ('CLSID is not valid')
  else
    ShowMessage ('CLSID is valid')
end;

procedure TOleIconForm.BrowseCLSIDBitBtnClick(Sender: TObject);
begin
  with TBrowseCLSIDForm2.Create (Application) do
  try
    SelectIconMode;
    SelectedCLSID := CLSIDEdit.Text;
    if ShowModal = mrOk then
      CLSIDEdit.Text := SelectedCLSID
  finally
    Free
  end
end;

procedure TOleIconForm.LoadBitBtnClick(Sender: TObject);
var
  M : TUIMetafile;
begin
  with OpenPictureDialog do
  begin
    if Execute then
    begin
      M := TUIMetafile.Create;
      M.LoadFromFile (Filename);
      MFImage.Picture.Graphic := M;
      if Assigned (MFImage.Picture) then
        ImagePanel.Caption := ''
      else
        ImagePanel.Caption := '(empty)'
    end
  end
end;

procedure TOleIconForm.ClearBitBtnClick(Sender: TObject);
begin
  ImagePanel.Caption := '(empty)';
  MFImage.Picture := nil
end;

end.