2008. szeptember 23., kedd

How to get the Icon of a CD-ROM


Problem/Question/Abstract:

I want to write an File explorer, but how can I get the Icon of a CD-ROM? The problem is it can be stored as an ICO File or as a Win32 Resource into an Executable File.

Answer:

With the following Code you can get the Icon of a CD inserted in your CD-ROM Drive. It opens the icon which is specified in the  "AutoRun.inf" of your CD. It's unimportant weather the icon is saved as a file or as a resource in a Win32 Executable File (*.EXE or *.DLL). If the "AutoRun.inf" doesn't exist, the function will stop themself.


function GetCDIcon(Drive: Char): TICon;
var
  ico: TIcon;
  ini: TIniFile;
  s, p: string;
  i, j: integer;
begin
  Result := nil;

  if GetDriveType(PChar(Drive + ':\')) <> DRIVE_CDROM then
    exit;

  //Abort if "AutoRun.inf" doesn't exists.
  if FileExists(Drive + ':\autorun.inf') = False then
    exit;

  //Open the "AutoRun.inf"
  ini := TIniFile.create(Drive + ':\autorun.inf');
  ico := TIcon.create;

  try
    //Read the filename
    s := ini.ReadString('Autorun', 'ICON', '');

    //Abort if there is no icon specified
    if s = '' then
      exit;

    //load the icon from a file
    if FileExists(s) then
      ico.LoadFromFile(s);
    if FileExists(Drive + ':\' + s) then
      ico.LoadFromFile(Drive + ':\' + s);

    //Load the icon from a Win32 resource
    if (FileExists(s) = False) and (FileExists(Drive + ':\' + s) = False) then
    begin
      for j := (Pos(',', s) + 1) to Length(s) do
      begin
        p := p + s[j];
      end;
      i := strtoint(p);
      for j := Length(s) downto (Pos(',', s)) do
        Delete(s, j, Length(s));

      if FileExists(s) = False then
        s := Drive + ':\' + s;

      ico.handle := ExtractIcon(hinstance, PChar(s), i);
    end;

    Result := ico;
  finally
    ini.free;
  end;
end;


Here an example how to use this function:


procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.picture.assign(GetCDIcon('F'));
end;

Nincsenek megjegyzések:

Megjegyzés küldése