Image2Icon

[Popov]

Ja, ihr skaliert wahrscheinlich hart satt weich, da geht u. U. viel verloren.

Teste das mal. Noch kein Icon, aber weiches skalieren:

Delphi-Quellcode:

procedure StretchBitmap(BmpQ, BmpZ: TBitmap; f: Double);
var
  TmpBmpQ, TmpBmpZ: TBitmap;
begin
  TmpBmpQ := TBitmap.Create;
  try
    TmpBmpQ.PixelFormat := pf24Bit;
    TmpBmpQ.Assign(BmpQ);

    TmpBmpZ := TBitmap.Create;
    try
      TmpBmpZ.Width := Round(TmpBmpQ.Width * f);
      TmpBmpZ.Height := Round(TmpBmpQ.Height * f);

      SetStretchBltMode(TmpBmpZ.Canvas.Handle, Halftone);

      StretchBlt(
        TmpBmpZ.Canvas.Handle, 0, 0, TmpBmpZ.Width, TmpBmpZ.Height,
        TmpBmpQ.Canvas.Handle, 0, 0, TmpBmpQ.Width, TmpBmpQ.Height,
        SRCCOPY);

      BmpZ.Assign(TmpBmpZ);
    finally
      TmpBmpZ.Free;
    end;
  finally
    TmpBmpQ.Free;
  end;
end;

function GetScreenShot: TBitmap;
var
  Desktop: HDC;
begin
  Result  := TBitmap.Create;
  Desktop := GetDC(0);
  try
    try
      Result.PixelFormat := pf32bit;
      Result.Width := Screen.Width;
      Result.Height := Screen.Height;
      BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY);
      Result.Modified := True;
    finally
      ReleaseDC(0, Desktop);
    end;
  except
    Result.Free;
    Result := nil;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bmp: TBitmap;
begin
  try
    Bmp := GetScreenShot;
    StretchBitmap(Bmp, Bmp, 0.05);
    Canvas.Draw(0,0,Bmp);
  finally
    Bmp.Free;
  end;
end;