Extract Icon, Resize it and Save to file? 1

[BobbaFet]

I've written a program that allows me to launch other applications from it by having it dynamically generate buttons based on information in inifiles. I wrote it to get rid of the gazzillion shortcuts on my desktop. This all works just fine.

But now I've gotten it in my head that I want to buttons to show glyphs, so when I select a program (using a simple opendialog) I want to extract the icon, resize it to 16x16 if neccesary and save it as a bmp file.

I know how to extract an Icon:

var MyIcon: TIcon;
begin
if OpenDialog1.Execute then
        begin
        Edit1.Text := OpenDialog1.FileName;
        MyIcon := TIcon.Create;
        MyIcon.Handle := ExtractIcon(hInstance, PChar(OpenDialog1.FileName), 0);
        Image1.Canvas.Draw(0,0,MyIcon);
        MyIcon.Free;
        end;
end;

And I know how to resize a file:

const
  maxWidth = 200;
  maxHeight = 150;
var
  thumbnail : TBitmap;
  thumbRect : TRect;
begin
  thumbnail := Form1.GetFormImage;
  try
    thumbRect.Left := 0;
    thumbRect.Top := 0;

    //proportional resize
    if thumbnail.Width > thumbnail.Height then
    begin
      thumbRect.Right := maxWidth;
      thumbRect.Bottom := (maxWidth * thumbnail.Height) div thumbnail.Width;
    end
    else
    begin
      thumbRect.Bottom := maxHeight;
      thumbRect.Right := (maxHeight * thumbnail.Width) div thumbnail.Height;
    end;

    thumbnail.Canvas.StretchDraw(thumbRect, thumbnail) ;

//resize image
    thumbnail.Width := thumbRect.Right;
    thumbnail.Height := thumbRect.Bottom;

    //display in a TImage control
    Image1.Picture.Assign(thumbnail) ;
  finally
    thumbnail.Free;
  end;
end;

The problem lies in that I cannot for the life of me get these two to work together. Can anyone clue me in?

BobbaFet

if not Programming = 'Severe Migraine' then
                       ShowMessage('Eureka!');

 

[DelphiAaron]

why are you getting the Formimage?

this works

var bitmap: TBitmap;
const Dispwidth = 16;
begin
bitmap := TBitmap.create;
bitmap.width := Dispwidth;
bitmap.height := round(Image1.Height/(Image1.Width/Dispwidth));
bitmap.canvas.stretchDraw(rect( 0,0, Dispwidth,
round(Image1.Height/(Image1.Width/Dispwidth))), Image1.Picture.Graphic);
Image2.picture.bitmap.assign(bitmap);
bitmap.free;
end;

Aaron

 

[BobbaFet]

It wasn't actually about the form image, that was just the last time I tried to get it to work.

What I want to do is this:
- Extract icon from an application
- Convert from .ico to .bmp
- Resize to 16x16
- Save to file.

Anyway, I'm going to try your code, see if I can get it to work with that.

Thank you for your response!

BobbaFet

if not Programming = 'Severe Migraine' then
                       ShowMessage('Eureka!');

 

[Glenn9999]

Another one out of many "I hate programmings" that I keep running into these days, especially when it comes to graphics.

procedure TForm1.Button1Click(Sender: TObject);
var
  IconRes: TIcon;
  DrawRect: TRect;
  BitMapRes1, BitmapRes2: TBitmap;
begin
  if OpenDialog1.Execute then
    begin
      // create graphics resources
      IconRes := TICon.Create;
      BitMapRes1 := TBitMap.Create;
      BitMapRes2 := TBitMap.Create;
      try
        // extract icon
        IconRes.Handle := ExtractIcon(HInstance, PChar(OpenDialog1.FileName), 0);

        // set canvas to draw the original icon
        BitMapRes1.Width := 32;
        BitMapRes1.Height := 32;
        BitMapRes1.Canvas.Draw(0, 0, IconRes);

        // now copy icon to new resource, smaller
        BitMapRes2.Width := 16;
        BitMapRes2.Height := 16;
        DrawRect.Top := 0;
        DrawRect.Left := 0;
        DrawRect.Bottom := 16;
        DrawRect.Right := 16;

        // redraw icon resource, resizing
        BitMapRes2.Canvas.StretchDraw(DrawRect, BitMapRes1);
        // save file
        BitMapRes2.SaveToFile('C:\test01.bmp');
      finally
      // free resources
        BitMapRes1.Free;
        BitMapRes2.Free;
        IconRes.Free;
      end;
    end;
end;


Measurement is not management.

 

[Glenn9999]

Another better thought: You might consider researching how to load the explorer shell icon for an executable. This would be best since it is already 16x16, as you desire.

Measurement is not management.

 

[BobbaFet]

Thank you Glenn! That is a sweet bit of coding! It does exactly what I want! That's worth a star!

BobbaFet

if not Programming = 'Severe Migraine' then
                       ShowMessage('Eureka!');