Einzelnen Beitrag anzeigen

EWeiss
(Gast)

n/a Beiträge
 
#1

DirectX problem beim zeichnen

  Alt 1. Jan 2014, 19:22
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

Geändert von EWeiss (11. Jul 2019 um 16:42 Uhr)
  Mit Zitat antworten Zitat