Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi Problem mit BITMAPINFO bezüglich des ColorTables (https://www.delphipraxis.net/63577-problem-mit-bitmapinfo-bezueglich-des-colortables.html)

McDaTob 20. Feb 2006 19:30


Problem mit BITMAPINFO bezüglich des ColorTables
 
Hallo,
ich programmiere gerade einen Editor für (vorerst nur) Cursor-Dateien.
Um einen Cursor aus einer Datei zu laden habe ich in meiner Klasse TCursorFile
eine Prodcedure "LoadCursor" definiert. Die Procedure soll dazu dienen, den
Cursor aus der Datei zu laden und anschließend die XOR- und die AND-Maske
in zwei getrennte Bitmaps zur weiteren Bearbeitung zu speichern.
Mein Problem liegt in der procedure SetDIBits. Diese erwartet als Parameter
ein BITMAPINFO record, welcher wie folgt deklariert ist:
Delphi-Quellcode:
  tagBITMAPINFO = packed record
    bmiHeader: TBitmapInfoHeader;
    bmiColors: array[0..0] of TRGBQuad;
  end;
Der BITMAPINFOHEADER kann ganz normal aus der Datei gelesen werden.
Wenn das ColorTable jedoch mehr als einen Eintrag hat, kann ich dieses record
nicht verwenden, weil bmiColors kein dynamisches ist (sondern array[0..0]).
Wie soll man denn dann in einem BITMAPINFO record ein ColorTable unterbringen,
das mehr als einen Eintrag hat?
Habe in meinem Code vorerst ein dynamisches Array vom Typ RGBQUAD als ColorTable definiert,
das dann mittels SetLength auf die richtige Größe gebracht wird. Aber dieses kann ich ja
nicht an SetDIBits übergeben. Ich hoffe mein Problem wird deutlich.

Hier der Code:
Delphi-Quellcode:
type
  TCursorDirEntry = record
    Width : byte;
    Height : byte;
    ColorCount : byte;
    Reserved : byte;
    XHotSpot : word;
    YHotSpot : word;
    BytesInRes : cardinal;
    ImageOffset : cardinal;
  end;

type
  TCursorDir = record
    Reserved : word;
    cdType : word;
    Count : word;
    Entries : array of TCursorDirEntry;
  end;

type
  TCursorImage = record
    XORHeader : BITMAPINFOHEADER;
    ANDHeader : BITMAPINFOHEADER;
    ColorTable : array of RGBQUAD;
    XORDIB : pointer;
    ANDDIB : pointer;
  end;

...

procedure TCursorFile.LoadCursor;
var
  i, j : integer;
  BitmapInfoHeaderOffset : integer;
  BitmapInfoHeaderSize : integer;
  ColorCount : integer;
  XORBmp : TBitmap;
  ANDBmp : TBitmap;
begin
  FileSeek(FFile,0,soFromBeginning);
  FileRead(FFile,FCursorDir.Reserved,SizeOf(word));
  FileRead(FFile,FCursorDir.cdType,SizeOf(word));
  FileRead(FFile,FCursorDir.Count,SizeOf(word));      // CursorDir laden
  SetLength(FCursorDir.Entries,FCursorDir.Count);
  for i := 0 to FCursorDir.Count - 1 do               // CursorDirEntries laden
    FileRead(FFile,FCursorDir.Entries[i],SizeOf(TCursorDirEntry));
  SetLength(FCursorImages,FCursorDir.Count);
  for i := 0 to FCursorDir.Count - 1 do               // CursorImagesLaden
  begin
    BitmapInfoHeaderOffset := FCursorDir.Entries[i].ImageOffset; // Offset des Image
    FileSeek(FFile,BitmapInfoHeaderOffset,soFromBeginning);
    FileRead(FFile,BitmapInfoHeaderSize,SizeOf(cardinal)); // SizeOf(BITMAPINFOHEADER)
    FileSeek(FFile,BitmapInfoHeaderOffset,soFromBeginning);
    FileRead(FFile,FCursorImages[i].XORHeader,BitmapInfoHeaderSize); // Header auslesen
    if FCursorImages[i].XORHeader.biBitCount = 24 then
    begin
      ColorCount := 0;
    end
    else
    begin
      if FCursorImages[i].XORHeader.biClrUsed = 0 then
      begin
        ColorCount := 1 shl FCursorImages[i].XORHeader.biBitCount; // 2^BitCount
      end
      else
      begin
        ColorCount := FCursorImages[i].XORHeader.biClrUsed;
      end;
    end; // Anzahl Farben im ColorTable festlegen
    SetLength(FCursorImages[i].ColorTable,ColorCount);
    for j := 0 to ColorCount - 1 do // ColorTable auslesen
      FileRead(FFile,FCursorImages[i].ColorTable,SizeOf(RGBQUAD));

    // Höhe von (XOR + AND) halbieren
    FCursorImages[i].XORHeader.biHeight := FCursorImages[i].XORHeader.biHeight div 2;
    // biImageSize des XOR-Header neu berechnen
    FCursorImages[i].XORHeader.biSizeImage := GetImageSize(FCursorImages[i].XORHeader.biWidth,FCursorImages[i].XORHeader.biHeight,FCursorImages[i].XORHeader.biBitCount);
    // XOR-DIBits in den Speicher laden
    GetMem(FCursorImages[i].XORDIB,FCursorImages[i].XORHeader.biSizeImage);
    FileRead(FFile,FCursorImages[i].XORDIB^,FCursorImages[i].XORHeader.biSizeImage);

    // AND-Header mit Daten des XOR-Header füllen
    FCursorImages[i].ANDHeader := FCursorImages[i].XORHeader;
    // biImageSize des AND-Header neu berechnen, 1 Bit
    FCursorImages[i].ANDHeader.biSizeImage := GetImageSize(FCursorImages[i].ANDHeader.biWidth,FCursorImages[i].ANDHeader.biHeight,1);
    // AND-DIBits in den Speicher laden
    GetMem(FCursorImages[i].ANDDIB,FCursorImages[i].ANDHeader.biSizeImage);
    FileRead(FFile,FCursorImages[i].ANDDIB^,FCursorImages[i].ANDHeader.biSizeImage);


    XORBmp := TBitmap.Create;
    XORBmp.Width := FCursorImages[i].XORHeader.biWidth;
    XORBmp.Height := FCursorImages[i].XORHeader.biHeight;

    case FCursorImages[i].XORHeader.biBitCount of
       1 : XORBmp.PixelFormat := pf1bit;
       4 : XORBmp.PixelFormat := pf4bit;
       8 : XORBmp.PixelFormat := pf8bit;
      else XORBmp.PixelFormat := pf24bit;
    end;

//    SetDIBits(XORBmp.Canvas.Handle,XORBmp.Handle,0,FCursorImages[i].XORHeader.biHeight,FCursorImages[i].XORDIB,FCursorImages[i].XORHeader,DIB_RGB_COLORS);

//    XORBmp.SaveToFile('test.bmp');
    XORBmp.Free;
  end;
end;

marabu 20. Feb 2006 20:03

Re: Problem mit BITMAPINFO bezüglich des ColorTables
 
Auch Hallo.

Zu deinem Code möchte ich jetzt nichts schreiben, aber mir scheint du kennst noch keine open ended structures. Ein array [0..0] of TRGBQuad am Ende eines record soll dir in Delphi bei ausgeschaltetem range checking den Zugriff auf beliebig große arrays erlauben.

Freundliche Grüße vom marabu

McDaTob 20. Feb 2006 20:12

Re: Problem mit BITMAPINFO bezüglich des ColorTables
 
Danke für die Antwort.
Da muss ich dir zustimmen.
Hab ich wirklich noch nie gehört.
Hab auch in der Suche nichts gefunden.
Ich vermute, dass ich ne Compiler-Directive dafür benutzen muss, oder?
Kannst du mir vielleicht ein kurzes Beispiel geben?
Kann ich dann bei ausgeschaltetem Range checking einfach schreiben:
x[0]
x[1]
x[2]
...

oder muss ich die Länge bzw. den Speicherbereich irgendwie festlegen?

marabu 20. Feb 2006 20:44

Re: Problem mit BITMAPINFO bezüglich des ColorTables
 
Die Compiler-Directive heißt $RANGECHECKS und das member biClrUsed gibt dir in der Regel die Anzahl der Einträge im array bmiColors an. Die Adressierung ist dann so, wie du vermutest. Beim Einlesen solcher Strukturen liest du zweistufig. Zuerst den Header, damit du den Speicherbedarf kalkulieren kannst, und wenn du dann den benötigten Speicher angefordert hast, dann kannst du alles einlesen. Beim Erzeugen einer solchen Struktur verfährst du sinngemäß anders herum.

marabu

McDaTob 20. Feb 2006 21:01

Re: Problem mit BITMAPINFO bezüglich des ColorTables
 
Sorry,
aber ich bekomme zur Laufzeit immer eine Fehlermeldung.
Wie kann ich den Speicher denn reservieren?
Hab es mal so probiert:
Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
var
  x : array [0..0] of integer;
  p : pointer;
  i : integer;
begin
{$RANGECHECKS OFF}
  p := Addr(x);
  GetMem(p,5 * SizeOf(integer));
  for i := 0 to 4 do
  begin
    x[i] := i;
  end;
{$RANGECHECKS ON}
end;

marabu 20. Feb 2006 21:24

Re: Problem mit BITMAPINFO bezüglich des ColorTables
 
Zu deinem Code:

Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
var
  x : array [0..0] of integer;
  p : pointer;
  i : integer;
begin
{$RANGECHECKS OFF}       // sind doch standardmäßig aus
  p := Addr(x);         // warum? p wird doch gleich überschrieben!
  GetMem(p,5 * SizeOf(integer));
  for i := 0 to 4 do
  begin
    x[i] := i;          // x hat nach wie vor nur ein Element, also AV
  end;
{$RANGECHECKS ON}
end;
Schau dir mal genau an, wie ich es mache:

Delphi-Quellcode:
procedure TDemoForm.ButtonClick(Sender: TObject);
const
  N = 5;
type
  PVector = ^TVector;
  TVector = array [0..0] of Integer;
var
  v: PVector;
  i: Integer;
begin
  GetMem(v, N * SizeOf(TVector));
  for i := 0 to Pred(N) do
    v[i] := i;
  for i := 0 to Pred(N) do
    ShowMessage(IntToStr(v[i]));
  FreeMem(v);
end;
Gute Nacht

marabu


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:14 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz