Wie kann ich die Farbtiefe verringern?

[zer00]

Hi @ll

Ich habe eine App geschrieben, die einen ScreenShot vom Desktop(512*512 Pixel) erstellt und diesen in einer Bitmap speichert.
Eigentlich funktioniert alles wunderbar, nur möchte ein Anwender das die Bitmap anstelle einer 32Bit nur eine Frabtiefe von 256 Farben aufweist.
Vielleicht kann mir jemand sagen wo ich was im Code drehen muss um das Ziel zu erreichen?

grz zer00

Delphi-Quellcode:

type logPal = record
   lpal : TLogPalette;
   dummy : array[1..255] of TPaletteEntry;
end;


procedure TForm1.takeScreenShot;
var
  sysPal : logPal;
  aImage: TImage;          // Unit ExtCtrls!
  hPal: HPalette;
  aHDC: HDC;
  aCanvas: TCanvas;
  aRect: TRect;           // Source Rect
  Datum: String;          // Dateiname = Datum
 begin

 Datum:= DateToStr(Now) + '.bmp';

 aHDC := GetWindowDC(0);
 sysPal.lPal.palVersion:=$300;
 sysPal.lPal.palNumEntries:=256;
 GetSystemPaletteEntries(aHDC,0,256,SysPal.lpal.PalpalEntry);
 hPal:=CreatePalette(sysPal.lpal);
 aCanvas := TCanvas.Create;
 aCanvas.Handle := aHDC;


 aRect := Rect(0,0,Screen.Width,Screen.Height);
 aImage:=TImage.Create(Self);

 with aImage do
  begin
    Height:= LenRect;
    Width:= LenRect;
    Canvas.CopyRect(aRect,aCanvas,aRect);
    ReleaseDC(GetDeskTopWindow,aHDC);
    Picture.Bitmap.Palette:=hPal
  end;
  aImage.Picture.SavetoFile(Datum);
  aImage.Free;
  ReleaseDC(GetDeskTopWindow, aHDC);
  ReleaseDC(aHDC, aCanvas.Handle);

end;

[Matze]

Hi,

zeichne das Bild zuerst intern auf einem TBitmap, da kannst du dann über PixelFormat die Farbtiefe verringern:

Beispiel:

Delphi-Quellcode:

Bmp.PixelFormat := pf8Bit;

[zer00]

Danke Dir, werde ich gleich mal versuchen.

grz zer00

[zer00]

Danke noch einmal, klappt wunderbar!!!

grz zer00

[ferby]

Hallo,

ich glaube ich habe so zimlich das selbe Problem.
Ich zeichne auf einen TBitmap und möchte es dann als 256 Farben Bitmap abspeichern.

Ich erzeuge das Bitmap so:

Delphi-Quellcode:

BMP:=TBitmap.Create;
Bmp.PixelFormat := pf8Bit;

Und Speicher dann einfach mit

Delphi-Quellcode:

BMP.SaveToFile('test.bmp');

Wenn ich aber das Bitmap wieder öffne um zu überprüfen welches Format das Bitmap hat dann zeigt es an das test.bmp mit 32Bit gepseichert wurde.

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  bmp.LoadFromFile('test.bmp');
  if Bmp.PixelFormat = pf32Bit then showmessage('32');
end;

Warum wird das BMP bei Savetofile mit 32 BIt gespeichert obwohl die Farbtiefe des BMP auf 8 Bit eingestellt wurde?
Und wie kan nich das ändern?


Ferby

[toms]

Hallo,

Bei mir funktioniert's so ausgezeichnet:

Delphi-Quellcode:

procedure ScreenShot(x: Integer; // Bild Koordinaten
  y: Integer;
  Width: Integer;
  Height: Integer;
  PixelFormat: TPixelFormat; // Bit Format
  bm: TBitMap); // Ziel Bitmap
const
  CAPTUREBLT = $40000000; // Für transparente Fenster
var
  dc: HDC;
  lpPal: PLOGPALETTE;
begin
  {Breite und Höhe testen}
  if ((Width = 0) or
    (Height = 0)) then
    Exit;
  bm.Width := Width;
  bm.Height := Height;
  bm.PixelFormat := PixelFormat;
  {Handle des Anzeige-Gerätekontextes ermitteln}
  dc := GetDc(0);
  if (dc = 0) then
    Exit;
  {Haben wir einen Paletten-Gerätekontext?}
  if (GetDeviceCaps(dc, RASTERCAPS) and
    RC_PALETTE = RC_PALETTE) then
  begin
    {Speicher für eine logische Palette reservieren}
    GetMem(lpPal,
      SizeOf(TLOGPALETTE) +
      (255 * SizeOf(TPALETTEENTRY)));
    FillChar(lpPal^,
      SizeOf(TLOGPALETTE) +
      (255 * SizeOf(TPALETTEENTRY)),
      #0);
    {Die Palette-Version setzen}
    lpPal^.palVersion := $300;
    {Die System Paletten Einträge ermitteln}
    lpPal^.palNumEntries :=
      GetSystemPaletteEntries(dc,
      0,
      256,
      lpPal^.palPalEntry);
    if (lpPal^.PalNumEntries <> 0) then
      {Die Palette erzeugen}
      bm.Palette := CreatePalette(lpPal^);
    FreeMem(lpPal, SizeOf(TLOGPALETTE) +
      (255 * SizeOf(TPALETTEENTRY)));
  end;
  {Vom Screen aufs Bitmap kopieren}
  BitBlt(bm.Canvas.Handle,
    0,
    0,
    Width,
    Height,
    Dc,
    x,
    y,
    SRCCOPY or CAPTUREBLT);
  {Gerätekontext wieder freigeben}
  ReleaseDc(0, dc);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  BMP: TBitmap;
begin
  BMP := TBitmap.Create;
  try
    ScreenShot(0, 0, Screen.Width, Screen.Height, pf8bit, BMP);
    BMP.SaveToFile('c:\testbmp.bmp');
  finally
    BMP.Free;
  end;
end;

[Muetze1]

Mal was anderes: Warum diese grosse Aufwand mit der Systempalette? Ist doch bei 32 Bit eh unsinnig, da es keine Farbpalette gibt und ausserdem kümmert sich BitBlt() um die Anpassung und ordentliche setzen der Farbpalette beim kopieren. Nach meinem Wissen aus der MSDN, sollte somit deine ganze Palettenarbeit mit dem BitBlt() Aufruf hinfällig sein.

[TStringlist]

Zitat:

Zitat von ferby

Warum wird das BMP bei Savetofile mit 32 BIt gespeichert obwohl die Farbtiefe des BMP auf 8 Bit eingestellt wurde?

...normal ist das aber wahrscheinlich nicht. Bei einem einfachst möglichen Gegentest hatten solche Bitmaps nämlich, je nach ihrem Pixelformat, dann auch auf der Harddisk eine dementsprechend unterschiedliche Größe. Und dazu schön passend, ließ sich dann auch nach dem Re-Loaden das Pixelformat immer korrekt bestätigen.

[toms]

Zitat:

Zitat von Muetze1

Mal was anderes: Warum diese grosse Aufwand mit der Systempalette? Ist doch bei 32 Bit eh unsinnig, da es keine Farbpalette gibt und ausserdem kümmert sich BitBlt() um die Anpassung und ordentliche setzen der Farbpalette beim kopieren. Nach meinem Wissen aus der MSDN, sollte somit deine ganze Palettenarbeit mit dem BitBlt() Aufruf hinfällig sein.

Hallo Muetze1,

Der Code wurde von Joe C. Hecht (Borland Senior Engineer, Printer Driver Expert) geschrieben.
Anscheinend gibt's bei einigen Grafikkarten nur weisse Screenshots mit der "Standard" Screenshot Funktion