急!急!急!画面闪烁问题(300分)

  • 主题发起人 主题发起人 zjkzs
  • 开始时间 开始时间
截取掉form的WM_ERASEBKGND试试:

procedure TForm1.WMEraseBkgnd (var Msg : TWMEraseBkgnd );
begin
Msg.Result := 1;
end;
 
这么多分啊,帮你顶
 
将内容先画在内存的画布上,然后在Copy到Canvas
 
同意楼上的观点
 
在那边不是和你说了啊~~,有来开一帖~~……
 
to lmxcyx
和funxu一样,太模糊。这样改图象就没了:

unit Test1Unt1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;

type
TTurn=(tnTop,tnLeft,tnRight,tnBottom);

TGameImage = TRect;
TGameObject = TRect;
TTable = record
Last,First:TGameImage;
Middle:Array of TGameImage;
End;

TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Label3: TLabel;
Edit2: TEdit;
Label4: TLabel;
Edit3: TEdit;
Label5: TLabel;
Edit4: TEdit;
Label6: TLabel;
Label7: TLabel;
Edit5: TEdit;
Button2: TButton;
Label8: TLabel;
Edit6: TEdit;
Label9: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);

private
{ Private declarations }
public
{ Public declarations }
end;



var
Form1: TForm1;
CHeight,CWidth:Word; //总宽度,总高度
PatBmp,XPatBmp,MakeBmp:TBitmap; //贴图用,贴图时XOR用,制作用
Ballx,Bally,Tablex,Tabley,TableWidth,Rx,Ry:Integer; //球位置,板子位置,板子宽,撞击前球位置
St:Byte; //进度变量
Rectd:TRect; //全屏幕Rect
DR2:Extended; //角度
TX,TY,CT,ACT,DefCT,YPos:Integer; //算角度用变量,总步长,步长,默认步长,系数
Fen:Cardinal; //分数
Bind:Boolean;//防止一次撞击Table,多次弹射
DefaultSize:Integer; //默认笔宽
Del,Ball:TGameImage; //删除图样,球图样(在Images.bmp中的范围)
Table:TTable; //板子图样(在Images.bmp中的范围)

procedure CDot(Canvas:TCanvas); //删除球
procedure DDot(Canvas:TCanvas); //画球
procedure CTable(Canvas:TCanvas); //删除板子
procedure DTable(Canvas:TCanvas); //画板子
procedure ZJ(Turn:TTurn;Form:TForm1); //撞击时改变角度
function IsIn(S,D:TGameObject):Boolean; //S是否撞到D
function IsZJ(S:TGameObject;Turn:TTurn):Boolean; //S是否撞到边界 //撞击
procedure Cursor(Form:TCustomForm); //控制鼠标
procedure DLine(Canvas:TCanvas); //画边界线
procedure Pat(Canvas:TCanvas;Image:TGameImage;DestRect:TRect); //贴图
implementation

{$R *.DFM}

procedure Pat(Canvas:TCanvas;Image:TGameImage;DestRect:TRect);
Begin
Canvas.CopyMode := cmSrcPaint;
Canvas.CopyRect(DestRect, XpatBmp.Canvas,Image);
Canvas.CopyMode := cmSrcAnd;
Canvas.CopyRect(DestRect, PatBmp.Canvas,Image);
Canvas.CopyMode := cmSrcCopy;
End;

procedure DDot(Canvas:TCanvas);
var Dest:TRect;
Begin
Dest:=Rect(Ballx-15 div 2,Bally-15 div 2,Ballx+15 div 2,Bally+15 div 2);
Pat(Canvas,Ball,Dest);
End;

procedure CDot(Canvas:TCanvas);
var Dest:TRect;
Begin
Dest:=Rect(Ballx-15 div 2,Bally-15 div 2,Ballx+15 div 2,Bally+15 div 2);
Canvas.FillRect(Dest);
End;

procedure CTable(Canvas:TCanvas);
var Dest:TRect;
i,k:Integer;
Begin
k:=Tablex-TableWidth div 2; //左界
Dest:=Rect(k,Tabley+20 div 2,k+22,Tabley-20 div 2);
Canvas.CopyRect(Dest, PatBmp.Canvas,Del);
k:=k+22;
for i:=0 to High(Table.Middle) do Begin
Dest:=Rect(k,Tabley+20 div 2,k+53,Tabley-20 div 2);
Canvas.CopyRect(Dest, PatBmp.Canvas,Del);
k:=k+53;
End;
Dest:=Rect(k,Tabley+20 div 2,k+22,Tabley-20 div 2);
Canvas.CopyRect(Dest, PatBmp.Canvas,Del);
End;

procedure DTable(Canvas:TCanvas);
var Dest:TRect;
i,k:Integer;
Begin
k:=Tablex-TableWidth div 2; //左界
Dest:=Rect(k,Tabley+20 div 2,k+22,Tabley-20 div 2);
Pat(Canvas,Table.First,Dest);
k:=k+22;
for i:=0 to High(Table.Middle) do Begin
Dest:=Rect(k,Tabley+20 div 2,k+53,Tabley-20 div 2);
Pat(Canvas,Table.Middle,Dest);
k:=k+53;
End;
Dest:=Rect(k,Tabley+20 div 2,k+22,Tabley-20 div 2);
Pat(Canvas,Table.Last,Dest);
End;

procedure ZJ(Turn:TTurn;Form:TForm1);
Begin
Rx:=Ballx;
Ry:=Bally;
CT:=0;
Inc(Fen);
Form.Label9.Caption:=IntToStr(Fen);
Case Turn of
tnRight:Begin
DR2:=Pi-DR2;
if DR2<0 Then DR2:=DR2+2*Pi;
End;
tnLeft:Begin
DR2:=Pi-DR2;
if DR2<0 then DR2:=DR2+2*Pi;
End;
else DR2:=2*Pi-DR2;
End;
End;

function IsIn(S,D:TGameObject):Boolean;
Begin
Result:=False;
if (s.Bottom >= D.Top)and(s.Right >= D.Left)and(s.Left <= D.Right)and(s.Top <= D.Bottom) then Result:=True; //上下
if (s.Left <= D.Right)and(s.Right >= D.Left)and(s.Top <= D.Bottom)and(s.Bottom >= D.Top) then Result:=True; //左右
End;

function IsZJ(S:TGameObject;Turn:TTurn):Boolean;
Begin
Result:=False;
Case Turn of
tnTop:if s.Top<=1 then Result:=True;
tnLeft:if s.Left<=1 then Result:=True;
tnBottom:if s.Bottom>=CHeight then Result:=True;
tnRight:if s.Right>=CWidth then Result:=True;
End;
End;

procedure DLine(Canvas:TCanvas);
Begin
Canvas.Pen.Width:=DefaultSize*2;
Canvas.Pen.Color:=clRed;
Canvas.Rectangle(RectD);
Canvas.Pen.Width:=DefaultSize;
End;

procedure Cursor(Form:TCustomForm);
var lpPoint:TPoint;
Begin
GetCursorPos(lpPoint);
if ((lpPoint.x-Form.Left+TableWidth div 2)<CWidth) and ((lpPoint.x-TableWidth div 2)>Form.Left) and (lpPoint.y<Form.Top+CHeight)and(lpPoint.y>Form.Top) then Begin
//CTable(Form.Canvas);
Tablex:=lpPoint.x-Form.Left;
//DTable(Form.Canvas);
SetCursorPos(lpPoint.x,Form.Top+Tabley);
End else Begin
SetCursorPos(Form.Left+Tablex,Form.Top+Tabley);
End;
End;

procedure TForm1.FormCreate(Sender: TObject);
var RectL:TRect;
begin
CHeight:=ClientHeight;
CWidth:=570;
MakeBmp:=TBitmap.Create;
MakeBmp.Height:=CHeight;
MakeBmp.Width:=CWidth;
St:=0;
Label9.Caption:=IntToStr(0);
Fen:=0;
RectD := Rect(0, 0, Cwidth, Cheight);
DefaultSize:=Canvas.Pen.Width;
PatBmp:=TBitmap.Create;
PatBmp.LoadFromFile('Images.bmp');
XPatBmp:=TBitmap.Create;
XPatBmp.Width:=PatBmp.Width;
XPatBmp.Height:=PatBmp.Height;
RectL:=Rect(0,0,PatBmp.Width,PatBmp.Height);
XPatBmp.Canvas.CopyMode:=cmSrcCopy;
XPatBmp.Canvas.CopyRect(RectL,PatBmp.Canvas,RectL);
XPatBmp.Canvas.Brush.Color:=clBlack;
XPatBmp.Canvas.BrushCopy(RectL,PatBmp,RectL,clWhite);
XPatBmp.Canvas.CopyMode:=cmMergePaint;
XPatBmp.Canvas.CopyRect(RectL,PatBmp.Canvas,RectL);
Ball:=Rect(98,0,112,15);
Table.Last:=Rect(76,0,97,20);
Table.First:=Rect(0,0,22,20);
Del:=Rect(112,0,165,20);
XPatBmp.SaveToFile('XPat.bmp');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MakeBmp.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var I:Integer;
Tab,Bal:TGameObject;
lx,ly:Integer;
begin
Case St of
0:Begin
Cursor:=crDefault;
//Self.Canvas.Brush.Color := clBlack;
//Self.Canvas.FillRect(RectD);
// DLine(Self.Canvas);
MakeBmp.Canvas.Brush.Color := clBlack;
MakeBmp.Canvas.FillRect(RectD);
DLine(MakeBmp.Canvas);
//************球位置**************
Ballx:=CWidth div 2+StrToInt(Self.Edit1.Text);
Bally:=CHeight-StrToInt(Self.Edit2.Text);
//********************************
Tablex:=CWidth div 2;
Tabley:=CHeight-StrToInt(Self.Edit3.Text);
DefCT:=StrToInt(Self.Edit5.Text);
YPos:=StrToInt(Self.Edit4.Text);
TableWidth:=44+53*StrToInt(Self.Edit6.Text);
SetLength(Table.Middle,StrToInt(Self.Edit6.Text));
For i:=0 to High(Table.Middle) do Table.Middle:=Rect(23,0,75,20);
DDot(MakeBmp.Canvas);
DTable(MakeBmp.Canvas);
//DDot(Self.Canvas);
//DTable(Self.Canvas);
St:=1;
Fen:=0;
End;
1:Begin
Self.Label1.Caption:='Ready!';
Self.Button1.Enabled:=True;
Self.Button2.Enabled:=True;
Self.EDit1.Enabled:=True;
Self.EDit2.Enabled:=True;
Self.EDit3.Enabled:=True;
Self.EDit4.Enabled:=True;
Self.EDit5.Enabled:=True;
Self.EDit6.Enabled:=True;
End;
2:Begin
St:=3;
Rx:=Ballx;
Ry:=Bally;
CT:=0;
DR2:=Pi/2;
Bind:=True;
Cursor:=crNone;
ACT:=DefCT;
End;
3:Begin
CDot(MakeBmp.Canvas);
//CDot(Self.Canvas);
CT := CT + ACT;
ACT:=DefCT;
Ballx := Rx + Round(CT * Cos(DR2));
Bally := RY + Round(CT * Sin(DR2));
DDot(MakeBmp.Canvas);
//DDot(Self.Canvas);
CTable(MakeBmp.Canvas);
Test1Unt1.Cursor(Self);
DTable(MakeBmp.Canvas);
DLine(MakeBmp.Canvas);
Tab:=Rect(Tablex-TableWidth div 2,Tabley-20 div 2,Tablex+TableWidth div 2,Tabley+20 div 2);
Bal:=Rect(Ballx-15 div 2,Bally-15 div 2,Ballx+15 div 2,Bally+15 div 2);
if IsIn(Bal,Tab) then Begin
if Bind then Begin
TX:=Ballx-Tablex;

if TX>0 then Begin
TX:=-TX;
DR2:=ArcTan(YPos/TX);
DR2 := DR2;
End else Begin
if TX<0 then Begin
DR2:=ArcTan(YPos/TX);
DR2:=DR2+Pi+(Pi/2);
End else DR2 :=Pi+(Pi/2);
End;
Rx:=Ballx;
Ry:=Bally;
CT:=0;
Inc(Fen);
Self.Label9.Caption:=IntToStr(Fen);
Bind:=False;
End;
End;
if not IsIn(Bal,Tab) then Bind:=True;
LX:=Rx + Round((CT+ACT) * Cos(DR2));
LY:=Ry + Round((CT+ACT) * Sin(DR2));
Bal:=Rect(Lx-15 div 2,Ly-15 div 2,Lx+15 div 2,Ly+15 div 2);
if IsIn(Bal,Tab)and Bind then Begin
ACT:=Tab.Top-(Bally+15 div 2);
End;
if IsZJ(Bal,tnRight) then ZJ(tnRight,Self);
if IsZJ(Bal,tnLeft) then ZJ(tnLeft,Self);
if IsZJ(Bal,tnTop) then ZJ(tnTop,Self);
if IsZJ(Bal,tnBottom) Then Begin
St:=0;
CDot(MakeBmp.Canvas);
//CDot(Self.Canvas);
DLine(MakeBmp.Canvas);

End;
End;
End;
//**
Canvas.Draw(0, 0, MakeBmp);
//**
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.CopyMode := cmSrcCopy;
Canvas.Draw(0, 0, MakeBmp);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
St:=2;
Fen:=0;
Label9.Caption:=IntToStr(Fen);
Label1.Caption:='Start!';
Button1.Enabled:=False;
Button2.Enabled:=False;
Edit1.Enabled:=False;
Edit2.Enabled:=False;
Edit3.Enabled:=False;
Edit4.Enabled:=False;
Edit5.Enabled:=False;
Edit6.Enabled:=False;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
St:=0;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=VK_ESCAPE then Begin
St:=0;
CDot(MakeBmp.Canvas);
CDot(Self.Canvas);
DLine(MakeBmp.Canvas);
DLine(Canvas);
End;
end;

end.
 
to 老大,救我!,

doublebuffer:=true 在大富翁离线数据库(1998-2005)里有,我试验了,不行!
 
to weiliu,

不行!
 
这是Dfm文件,大家配合源码看看:
TestUnt1.dfm


object Form1: TForm1
Left = 189
Top = 191
BorderStyle = bsDialog
Caption = 'Form1'
ClientHeight = 453
ClientWidth = 681
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnKeyDown = FormKeyDown
OnPaint = FormPaint
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 600
Top = 88
Width = 32
Height = 13
Caption = 'Label1'
end
object Label2: TLabel
Left = 592
Top = 104
Width = 91
Height = 13
Caption = '球X(距板中心) '
end
object Label3: TLabel
Left = 592
Top = 152
Width = 22
Height = 13
Caption = '球Y '
end
object Label4: TLabel
Left = 592
Top = 200
Width = 27
Height = 13
Caption = '板高 '
end
object Label5: TLabel
Left = 592
Top = 248
Width = 54
Height = 13
Caption = '弹射系数 '
end
object Label6: TLabel
Left = 576
Top = 264
Width = 86
Height = 13
Caption = '最好是板长/4 '
end
object Label7: TLabel
Left = 592
Top = 312
Width = 27
Height = 13
Caption = '步长 '
end
object Label8: TLabel
Left = 592
Top = 352
Width = 27
Height = 13
Caption = '板长 '
end
object Label9: TLabel
Left = 600
Top = 72
Width = 32
Height = 13
Caption = 'Label9'
end
object Button1: TButton
Left = 604
Top = 8
Width = 25
Height = 25
Caption = 'Hit'
TabOrder = 0
OnClick = Button1Click
end
object Edit1: TEdit
Left = 600
Top = 120
Width = 33
Height = 21
TabOrder = 1
Text = '20'
end
object Edit2: TEdit
Left = 600
Top = 168
Width = 33
Height = 21
TabOrder = 2
Text = '336'
end
object Edit3: TEdit
Left = 600
Top = 216
Width = 33
Height = 21
TabOrder = 3
Text = '20'
end
object Edit4: TEdit
Left = 600
Top = 288
Width = 33
Height = 21
TabOrder = 4
Text = '20'
end
object Edit5: TEdit
Left = 600
Top = 328
Width = 33
Height = 21
TabOrder = 5
Text = '5'
end
object Button2: TButton
Left = 604
Top = 40
Width = 25
Height = 25
Caption = 'Set'
TabOrder = 6
OnClick = Button2Click
end
object Edit6: TEdit
Left = 600
Top = 368
Width = 33
Height = 21
TabOrder = 7
Text = '1'
end
object Timer1: TTimer
Interval = 20
OnTimer = Timer1Timer
Left = 600
Top = 408
end
end
 
MakeBmp的大小有CLIENTHEIGHT,570大,还每20毫秒就刷新一次,不闪才怪呢!

每次只绘制图象有变化的部分才能快一些,而且这个东东估计用GDI做,是消除不了闪烁的。
 
闪烁是必然的。。。改成MergeCopy,试试,,必要的时候,LOCK一下,看看能否改善。。
把你的TIMER慢点。。。也许好些。


我的看不大懂。
 
to wk_knife,

板子闪,球和背景不闪
 
[purple]把你的TIMER慢点。。。也许好些。[/purple]

是好些,但游戏速度太慢,步长高了又不连贯。
 
我没用多线程,LOCK就不用了吧!
 
你不如把绘制代码都放到PAINT中去,在KEYDOWN和定时器中使用INVALIDATE
 
画前锁定
 
INVALIDATE?怎么使?
 
做游戏既然不用Direct????!!!!。。。。。
 

Similar threads

D
回复
0
查看
849
DelphiTeacher的专栏
D
D
回复
0
查看
693
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部