Autor Beitrag
Martok
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 3661
Erhaltene Danke: 604

Win 8.1, Win 10 x64
Pascal: Lazarus Snapshot, Delphi 7,2007; PHP, JS: WebStorm
BeitragVerfasst: Mo 21.08.06 17:52 
Hallo Leute,

ich habe mal wieder ein Problem. Ich mache mit BitBlt einen Screenshot. Dieser soll an die WinAPI weitergegeben werden, dazu brauche ich eine PBitmapInfoHeader-Struktur, nach der die Bitmapdaten kommen.
Meine Momentane Lösung sieht so aus, ist aber leider zu langsam(ca 100-180 ms). Mit 75-100 könnte ich leben. Da ich das sicherlich viel zu umständlich mache, kann man bestimmt noch was rausholen, bzw. es gibt bestimmt eine gaanz einfache Lösung. In die umgekehrte Richtung hab ich schon einiges gefunden, das waren auch immer nur 5-10 Zeilen.
Der Code hier stammt aus einer C-Übersetzung, daher ist sicherlich nicht alles wirklich optimal für Delphi.

Hat jemand eine Idee?

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
procedure TScreenCam.Bitmap2InfoHdr( Bitmap:TBitmap; var Result:PBitmapInfoHeader);
var
  wLineLen,
  wColSize,
  dwSize: integer;
  lpBits:PByte;
begin
  // DWORD align the width of the DIB
  // Figure out the size of the colour table
  // Calculate the size of the DIB
  wLineLen := (Bitmap.Width*integer(bits)+31)div 32 * 4;
  if (bits <= 8) then
    wColSize:=sizeof(RGBQUAD)* (1 SHL bits)
  else
    wColSize:=0;
  dwSize := sizeof(BITMAPINFOHEADER) + wColSize +
  wLineLen*Bitmap.Height;

  if (Result=nil) or (integer(Result^.biSizeImage)<>dwSize) then
    ReallocMem(Result, dwSize);
  InitializeBitmapInfoHeader(Bitmap.Handle,Result^,0);

  //
  // Get the bits from the bitmap and stuff them after the LPBI
  //
  lpBits := @(PBITMAPINFO(Result)^.bmiColors);

  // retrieve the bits of hbitmap and copy them into the buffer lpBits
  // using the specified format in Result
  if GetDIBits(FScreenCanvas.Handle,Bitmap.Handle,0,bitmap.Height,
     lpBits,PBITMAPINFO(Result)^, DIB_RGB_COLORS)=0 then
  begin
    messagebox(0, 'Error retrieving bitmap bits', 'Error', mb_ok);
    exit;
  end;
  if bits <= 8 then
    Result^.biClrUsed := (1 SHL bits)
  else
    Result^.biClrUsed:=0;
end;


Danke,
Martok

_________________
"The phoenix's price isn't inevitable. It's not part of some deep balance built into the universe. It's just the parts of the game where you haven't figured out yet how to cheat."
Martok Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 3661
Erhaltene Danke: 604

Win 8.1, Win 10 x64
Pascal: Lazarus Snapshot, Delphi 7,2007; PHP, JS: WebStorm
BeitragVerfasst: Mo 21.08.06 23:24 
So, ich hab in der DP doch was gefunden, war nur immer falsch gesucht.
( www.delphipraxis.net...=tbitmap+pbitmapinfo )
Und zwar ist folgendes bei rausgekommen. Das funktioniert soweit auch, aber nur beim ersten Aufruf. Jeder weiter liefert exakt die selben Daten. Ich denke mal, es hat was damit zu tun dass das Bitmap kein DIB sondern ein DDB enthält, warum auch immer.

ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
  lpBits:PByte;
  Buffer:PByteArray;
  row : Integer;
begin
.....
  lpBits := @(PBITMAPINFO(Result)^.bmiColors);
  for row := Bitmap.Height - 1 downto 0 do
    begin
      buffer := Bitmap.Scanline[row];
      CopyMemory(lpBits, buffer, wLineLen);
      inc(lpBits, wLineLen);
    end;



Nun ist die Frage: wie kriege ich das Bitmap dazu, seine Daten zu aktualisieren? Ich hatte vorher zum Testen ein SaveToFile vor der Schleife, da ging es. Ich vermute mal, es wird dort etwas Aufgerufen, um das DIB zu aktualisieren. Ich tippe da mal auf DIBNeeded, aber die darf ich ja selbst nicht aufrufen, da sie private ist.

Was kann man da machen?

_________________
"The phoenix's price isn't inevitable. It's not part of some deep balance built into the universe. It's just the parts of the game where you haven't figured out yet how to cheat."