1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

function CreateIconFromBmp(Bmp: TBitmap): TIcon;
begin
  with TImageList.CreateSize(Bmp.Width, Bmp.Height) do
  try
    {$IFDEF VER90}
    with Bmp do AddMasked(Bmp, Canvas.Pixels[Width-1, Height-1]);
    {$ELSE}
    AddMasked(Bmp, Bmp.TransparentColor);
    {$ENDIF}
    Result := TIcon.Create;
    GetIcon(0, Result);
  finally
    Free;
  end;
end;					

1:
2:
3:
4:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.Icon:=CreateIconFromBmp(Bitbtn1.Glyph);
end;					

1:
2:
3:
4:
5:

var Icon:TIcon;
begin
Icon:=CreateIconFromBmp(Image1.Picture.Bitmap);
Icon.SaveToFile(InputBox('IconCreator','Bitte Dateiname und Pfad angeben, wo gespeichert werden soll','C:\Icon.ico'));
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

var endung:String;
jpeg:TJPegImage;
bitmap:Tbitmap;
begin
jpeg:=TJpegimage.Create;

      If OpenDialog1.Execute
      THen Image1.Picture.LoadFromFile(OpenDialog1.Filename);

Endung:=Copy(OpenDialog1.Filename,Pos('.',OpenDialog1.Filename),Length(OpenDialog1.Filename));
Endung:=LowerCase(Endung);

   If (Endung='.jpg') Or (Endung='.jpeg') Then begin

bitmap:=TBitmap.Create;
jpeg.LoadFromFile(OpenDialog1.Filename);
bitmap.Assign(jpeg);
image1.Picture.Bitmap:=bitmap;

   end;