newlinkform.pas

详细讲述如何用delphi进行com编程

unit NewLinkForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ShlObj;

type
  TfrmNewShortcut = class(TForm)
    pnlBottom: TPanel;
    pnlClient: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    Label1: TLabel;
    cbLocation: TComboBox;
    Label2: TLabel;
    ecName: TEdit;
    procedure btnOKClick(Sender: TObject);
    procedure cbLocationClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FFolder: Integer;
    { Private declarations }
  public
    { Public declarations }
    property Folder: Integer read FFolder;
  end;

implementation

type
  TFolderRec = record
    FolderName: string;
    FolderID: Integer;
  end;

const
{$IFDEF VER100}
  CSIDL_INTERNET = $0001;
  CSIDL_ALTSTARTUP = $001d;
  CSIDL_COMMON_ALTSTARTUP = $001e;
  CSIDL_COMMON_FAVORITES = $001f;
  CSIDL_INTERNET_CACHE = $0020;
  CSIDL_COOKIES = $0021;
  CSIDL_HISTORY = $0022;
{$ENDIF}

  MAX_FOLDERS = 30;

  Folders: Array[0 .. MAX_FOLDERS - 1] of TFolderRec = (
    (FolderName: 'Alt Startup'; FolderID: CSIDL_ALTSTARTUP),
    (FolderName: 'App Data'; FolderID: CSIDL_APPDATA),
    (FolderName: 'Bit Bucket'; FolderID: CSIDL_BITBUCKET),
    (FolderName: 'Common Alt Startup'; FolderID: CSIDL_COMMON_ALTSTARTUP),
    (FolderName: 'Common Desktop Directory'; FolderID: CSIDL_COMMON_DESKTOPDIRECTORY),
    (FolderName: 'Common Favorites'; FolderID: CSIDL_COMMON_FAVORITES),
    (FolderName: 'Common Programs'; FolderID: CSIDL_COMMON_PROGRAMS),
    (FolderName: 'Common Start Menu'; FolderID: CSIDL_COMMON_STARTMENU),
    (FolderName: 'Common Startup'; FolderID: CSIDL_COMMON_STARTUP),
    (FolderName: 'Controls'; FolderID: CSIDL_CONTROLS),
    (FolderName: 'Cookies'; FolderID: CSIDL_COOKIES),
    (FolderName: 'Desktop'; FolderID: CSIDL_DESKTOP),
    (FolderName: 'Desktop Directory'; FolderID: CSIDL_DESKTOPDIRECTORY),
    (FolderName: 'Drives'; FolderID: CSIDL_DRIVES),
    (FolderName: 'Favorites'; FolderID: CSIDL_FAVORITES),
    (FolderName: 'Fonts'; FolderID: CSIDL_FONTS),
    (FolderName: 'History'; FolderID: CSIDL_HISTORY),
    (FolderName: 'Internet'; FolderID: CSIDL_INTERNET),
    (FolderName: 'Internet Cache'; FolderID: CSIDL_INTERNET_CACHE),
    (FolderName: 'Network Neighborhood'; FolderID: CSIDL_NETHOOD),
    (FolderName: 'Network'; FolderID: CSIDL_NETWORK),
    (FolderName: 'Personal'; FolderID: CSIDL_PERSONAL),
    (FolderName: 'Printers'; FolderID: CSIDL_PRINTERS),
    (FolderName: 'Printer Neighborhood'; FolderID: CSIDL_PRINTHOOD),
    (FolderName: 'Programs'; FolderID: CSIDL_PROGRAMS),
    (FolderName: 'Recent Files'; FolderID: CSIDL_RECENT),
    (FolderName: 'Send To'; FolderID: CSIDL_SENDTO),
    (FolderName: 'Start Menu'; FolderID: CSIDL_STARTMENU),
    (FolderName: 'Startup'; FolderID: CSIDL_STARTUP),
    (FolderName: 'Templates'; FolderID: CSIDL_TEMPLATES)
  );

{$R *.DFM}

procedure TfrmNewShortcut.btnOKClick(Sender: TObject);
begin
  if ecName.Text = '' then begin
    ModalResult := mrNone;
    ShowMessage('Please enter a file name for the shortcut.');
  end;
end;

procedure TfrmNewShortcut.cbLocationClick(Sender: TObject);
begin
  FFolder := Folders[cbLocation.ItemIndex].FolderID;
end;

procedure TfrmNewShortcut.FormCreate(Sender: TObject);
var
  Index: Integer;
begin
  for Index := 0 to High(Folders) - 1 do
    cbLocation.Items.Add(Folders[Index].FolderName);
  cbLocation.ItemIndex := 0;
  FFolder := Folders[0].FolderID;
end;

end.