Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   DirectX problem beim zeichnen (https://www.delphipraxis.net/178320-directx-problem-beim-zeichnen.html)

EWeiss 1. Jan 2014 18:22


DirectX problem beim zeichnen
 
Erst mal ein frohes neues für alle die das hier lesen oder auch nicht ;)

Mit dieser Funktion wird ein Rechteck auf mein Surface gezeichnet.

Delphi-Quellcode:
procedure TForm1.Timer1Timer(Sender: TObject);
var
  ARect: TRect;
  i: Integer;
  R,G,B: Byte;

begin
  Calculate();

   if (CaptureX.FDevice = nil) then
     Exit;
   CaptureX.FDevice.Clear(0, nil, D3DCLEAR_TARGET, D3DCOLOR_XRGB(0, 50, 100), 0, 0);
   if (SUCCEEDED(CaptureX.FDevice.BeginScene)) then
   begin
     // Draw Operations
     for i := 1 to High(CaptureX.ptop) do
     begin
       ARect.Left := CaptureX.ptop[I].Left;
       ARect.Top := CaptureX.ptop[I].Top;
       ARect.Right := CaptureX.ptop[I].Width;
       ARect.Bottom :=CaptureX.ptop[I].Height;

       TColor2RGB(CaptureX.ptop[I].Color, R, G, B);
       CaptureX.Fill2DRect(CaptureX.FDevice, ARect, D3DCOLOR_XRGB(R, G, B));
     end;
     CaptureX.FDevice.EndScene;
   end;
   CaptureX.FDevice.Present(nil, nil, 0, nil);
end;
Hintergrund wird gelöscht und das erste Rechteck gezeichnet seltsamerweise die darauf folgenden aber nicht.

Delphi-Quellcode:
function RGB2TColor(R, G, B: Byte): Integer;
begin
   // convert hexa-decimal values to RGB
   Result := R or (G shl 8) or (B shl 16); // ich mochte das OR halt viel lieber
end;
Delphi-Quellcode:
procedure TColor2RGB(Color: TColor; var R, G, B: Byte);
begin
   // convert hexa-decimal values to RGB
   if Color shr 24 = $FF then
     Color := GetSysColor(Color and $FF)
   else if Color shr 24 > $02 then
     Color := 0;
   R := Color;
   G := (Color shr 8);
   B := (Color shr 16);
end;
Delphi-Quellcode:
function TCaptureX.Fill2DRect(const Device: IDirect3DDevice9;
   TL, TR, BL, BR: TD3DXVector3; Color: TD3DColor): Boolean;
type
   TVertex = packed record
     Position: TD3DXVector3;
     R: Single;
     Color: TD3DColor;
   end;
var
   Prim: array[0..3] of TVertex;
   I: Integer;
begin
   for I := Low(Prim) to High(Prim) do
   begin
     Prim[I].Color := Color;
     Prim[I].Position.z := 0;
     Prim[I].R := 0;
   end;
   Prim[0].Position.x := TL.x;
   Prim[0].Position.y := TL.y;
   Prim[1].Position.x := TR.x + 1;
   Prim[1].Position.y := TR.y;
   Prim[2].Position.x := BL.x;
   Prim[2].Position.y := BL.y + 1;
   Prim[3].Position.x := BR.x + 1;
   Prim[3].Position.y := BR.y + 1;

   Device.SetTexture(0, nil);
   Device.SetRenderState(D3DRS_ZENABLE, 0);
   Device.SetRenderState(D3DRS_LIGHTING, 0);
   Device.SetRenderState(D3DRS_AMBIENT, 0);
   Device.SetRenderState(D3DRS_ALPHABLENDENABLE, 1);
   Device.SetRenderState(D3DRS_SRCBLEND, D3DBLEND_SRCALPHA);
   Device.SetRenderState(D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA);
   Device.SetFVF(D3DFVF_XYZRHW or D3DFVF_DIFFUSE);
   Result := Device.DrawPrimitiveUp(D3DPT_TRIANGLESTRIP, 2, Prim,
     SizeOf(TVertex)) = D3D_OK;
end;
Delphi-Quellcode:
function TCaptureX.Fill2DRect(const Device: IDirect3DDevice9;
   R: TRect; Color: TD3DColor): Boolean;
var
   TL, TR, BL, BR: TD3DXVector3;
begin
   TL.x := R.Left;
   TL.y := R.Top;
   TR.x := R.Right;
   TR.y := R.Top;
   BL.x := R.Left;
   BL.y := R.Bottom;
   BR.x := R.Right;
   BR.y := R.Bottom;
   Result := Fill2DRect(Device, TL, TR, BL, BR, Color);
end;
kann jemand sehen was hier falsch läuft?
Die gesamte obere Reihe von Bild 1 sollte eigentlich in das Surface gezeichnet werden
wie man aber auf dem 2 Bild sehen kann ist das nur der erste Balken.

Der sinn des ganzen ich möchte nachher alle meine Panels auf der Form für jeden Balken entfernen
und die Balken direkt auf das Surface zeichnen.

Danke an Zacherl für die Fill2DRect Function.

gruss

Zacherl 1. Jan 2014 18:44

AW: DirectX problem beim zeichnen
 
Sehe auf den ersten Blick keinen offensichtlichen Fehler. Kannst du mal debuggen und schauen, ob die Rects aus dem "CaptureX.ptop" Array zur Laufzeit korrekt sind? Wenn da alles in Ordnung ist, versuche das Zeichnen mal mit einer festen Farbe z.b. D3DCOLOR_RGBA(255, 0, 0, 255), um zu testen, ob die Berechnung der Farbe eventuell nicht richtig funktioniert.

Achso: Setze auch mal den RHW (R) Wert in den Vertizes auf 1 statt 0. Habe festgestellt, dass ein Nullwert da auf manchen Grafikkarten Probleme macht.

EWeiss 1. Jan 2014 18:52

AW: DirectX problem beim zeichnen
 
Zitat:

Zitat von Zacherl (Beitrag 1241656)
Sehe auf den ersten Blick keinen offensichtlichen Fehler. Kannst du mal debuggen und schauen, ob die Rects aus dem "CaptureX.ptop" Array zur Laufzeit korrekt sind? Wenn da alles in Ordnung ist, versuche das Zeichnen mal mit einer festen Farbe z.b. D3DCOLOR_RGBA(255, 0, 0, 255), um zu testen, ob die Berechnung der Farbe eventuell nicht richtig funktioniert.

Achso: Setze auch mal den RHW (R) Wert in den Vertizes auf 1 statt 0. Habe festgestellt, dass ein Nullwert da auf manchen Grafikkarten Probleme macht.

Habe alles mal nach deiner Anleitung versucht..
Alles ist korrekt der TRect genauso wie die Farbe, R: Änderung auf 1 hat leider nicht zum Erfolg geführt.
Timing sehe ich auch kein Problem sollte wohl mit 150 ms zu schaffen sein.

Bestimmt Eigenschaften für die Form werde ich wohl nicht setzen müssen oder?.
Wäre hier ein Problem würde überhaupt nichts zeichnen.

EDIT:
Bekomme auch überall eine positive Rück Meldung.
Hmmm...

Das war der Fehler Problem hat sich erledigt.. (Danke Zacherl)

Delphi-Quellcode:
       ARect.Left := CaptureX.pTop[I].Left;
       ARect.Top := CaptureX.pTop[I].Top;
       ARect.Right := CaptureX.pTop[I].Left + CaptureX.pTop[I].Width;
       ARect.Bottom :=CaptureX.pTop[I].Top + CaptureX.pTop[I].Height;
Manchmal ist man einfach nur noch blöd.. und übersieht die einfachsten Dinge.

gruss


Alle Zeitangaben in WEZ +1. Es ist jetzt 22:25 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