Image2Icon

[bernhard_LA]

In unserer Software verwenden wir CAD Zeichungen von verschiednen Gegenständen .
(Bsp: verschiende Möbelgegenstände werden in eine Bitmap mit 1000 x 1000 pixelin 2D und 3D gezeichnet)

Für manche Gegenstände gibt es nun Buttons (TBitBtn) mit denen der Benutzer Aktionen für diesen Gegenstand ausführen soll.
Die Idee für eine Intuitive Benutzerführung : das Glyth des Buttons soll diesen Gegenstand möglichst gut darstellen.

Wenn ich die Original Bitmap auf eine 16x16 Bitmap für den Button reduziere kann man aber nicht sinnvolles mehr erkennen da das Original Bild zu viele zu dünne Linien enthält.


Gibt es einen Algorithmus für TBitmap2Icon ( ..... ) ??

[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;

[Volker Z.]

Hallo,

Zitat:

Gibt es einen Algorithmus für TBitmap2Icon ( ..... ) ??

Kennst Du den schon http://www.swissdelphicenter.ch/de/showcode.php?id=426

Gruß