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