dubbelbuffring
12 svar · 513 visningar · startad av Alpha II
Antar att du menar för grafik. Dubbelbuffer använder man för att t.ex. scrollning ska gå mjukt. Det gör man genom att skapa två identiska minnes buffrar, ritar grafiken i den ena och sedan vid lämpligt tillfälle (oftast tillsammans med v-synk) byter man dem snabbt och börjar rita upp den andra bilden istället. DirectX (och de andra som t.ex. OpenGL) har färdiga funktioner för detta så det är enkelt att implementera dubbelbuffer om man programmerar spelet med DirectX.
------------------
winne.net
Finns det nån sida där man kan läsa om det?
Kan man inte rita upp grafiken på en paintbox som inte syns och sedan tilldela en paintbox som syns den osynliga paintboxens innehåll?
------------------
KLICKA HÄR!!!
Man brukar göra så att man ritar det man ska på ett Canvas "offscreen" sedan kopierar man in detta på ett annat Canvas "onScreen". Kopieringen kan du göra med CopyRect.
Med Paintboxar borde det bli något likande(ej testat).
OnPaintBox.Canvas.CopyRect(OnPaintBox.Canvas.Cliprect, OffPaintBox.Canvas, OffPaintBox.Canvas.Cliprect);
Varför får jag fel?
<font size="1" face="Verdana, Arial, Helvetica, sans-serif">Kod:<font size="1" face="Verdana, Arial, Helvetica, sans-serif" color="#666600">
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
panel: TImage;
PaintBox1: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure uppdatera(posX,posY:integer);
procedure PaintBox1Paint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
level:integer;
buffert : TPaintBox;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
buffert := TPaintbox.Create(self);
panel.Picture.LoadFromFile('Data\graphic\panel.bmp');
level:=1;
end;
procedure TForm1.uppdatera(posX,posY:integer);
begin
with buffert.Canvas do begin
MoveTo(posX,0);
LineTo(posX,height);
MoveTo(posY,0);
LineTo(posY,width);
end;
PaintBox1.Canvas.CopyRect(PaintBox1.Canvas.Cliprect, buffert.Canvas, buffert.canvas.ClipRect);
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
uppdatera(0,0);
end;
end.
------------------
KLICKA HÄR!!!
Använder en bitmap som buffer.
Ändrade lite för att jag skulle få något att hända.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
buffert: TBitmap;
procedure uppdatera(posX, posY: integer);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TForm1 }
procedure TForm1.uppdatera(posX, posY: integer);
begin
with Buffert.Canvas do begin
Brush.Color := clWhite;
Pen.Width := 5;
FillRect(ClipRect);
MoveTo(0, 0);
LineTo(posX, PosY);
MoveTo(100, 0);
LineTo(posX, Posy);
end;
PaintBox1.Canvas.CopyRect(PaintBox1.Canvas.Cliprect, buffert.Canvas, buffert.canvas.ClipRect);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
buffert := TBitmap.Create;
buffert.Width := PaintBox1.Width;
buffert.Height := PaintBox1.Height;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
buffert.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
for i := 0 to 300 do
begin
uppdatera(i, i);
sleep(10)
end;
end;
end.
Nu funkar det ju att kompilera iaf. men nu blir hela fönstret vitt. Meningen är att det bara ska ritas i PaintBoxen. Hur???? :q
------------------
KLICKA HÄR!!!
Koden jag skickade ritar ut några linjer i Paintbox1 när man trycker på button1.
Hur ser proceduren uppdatera ut?
Ladda ner spelet [A=http://w1.650.telia.com/\~u65004710/dk2.zip\]här[/A].
*Hur gör man en highscore lista?
*Nu flyger en fågel åt gången hur kan man göra så att det flyger några åt gången åt olika håll osv.
------------------
KLICKA HÄR!!!
[Redigerat av Alpha II den 03 nov 2000]
har också lite problem med dubbelbuffring.
kan inte få denna kod (nedan) att funka!
har provat med CopyRect, Draw, separata procedurer m.m.
vad jag vill åstakomma är att få två linjer att träffa muspekaren hela tiden.
(alltså gammla linjer ska raderas)
vad ska jag göra???
- - - SNIPP - - -
var
mainform: Tmainform;
implementation
{$R *.DFM}
var buffert, kalleanka: TBitMap; tmp: TRect;
procedure TextFX(x,y: integer; txt: string);
var z: SmallInt;
begin
with mainform.Canvas do
begin
z := Font.Size Div 10;
Brush.Style := bsClear;
Font.Color := clGreen;
TextOut(x-z,y-z, txt);
TextOut(x-z,y+z, txt);
TextOut(x+z,y-z, txt);
TextOut(x+z,y+z, txt);
Font.Color := clLime;
TextOut(x,y, txt);
end;
end;
procedure Tmainform.FormPaint(Sender: TObject);
begin
Canvas.Font.Name := 'Arial';
Canvas.Font.Style := [fsBold];
Canvas.Font.Size := 28;
TextFX(10,10,'SUPER-kalleanka 2000!');
Canvas.Font.Size := 20;
TextFX(55,80,'YOUR MISSION:');
Canvas.Draw(360,8,kalleanka);
end;
procedure Tmainform.FormCreate(Sender: TObject);
begin
buffert := TBitMap.Create;
kalleanka := TBitMap.Create;
if FileExists('kalleanka.bmp') then
begin
kalleanka.LoadFromFile('kalleanka.bmp');
end;
tmp := Rect(0,0,ClientWidth, ClientHeight);
buffert.Canvas.Pen.Color := clRed;
buffert.Canvas.Pen.Width := 2;
Cursor := crNone;
end;
procedure Tmainform.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
with buffert.Canvas do
begin
MoveTo(493,53);
LineTo(x,y);
MoveTo(507,54);
LineTo(x,y);
end;
// mainform.Canvas.Draw(0,0,buffert);
end;
end.
Dessa rader raderar(fyller med vit) ett cannvas. Använd dessa innan du uppdaterar med nya linjer.
Canvas.Brush.Color := clWhite;
Canvas.FillRect(Canvas.ClipRect);
ooops!
jag kom på det sedan... :r
men tack ändå!
(jag ska försöka tänka lite innan jag frågar nästa gång) :e
------------------
//N99ASP