如何实现无闪烁画图?(50分)

  • 主题发起人 主题发起人 joyallday
  • 开始时间 开始时间
J

joyallday

Unregistered / Unconfirmed
GUEST, unregistred user!
我有个土问题不明白,当使用delphi进行画图时,
使用image 则会出现屏幕的闪烁现象,而使用
paintbox或label 则无法自动重绘图像,这可
怎搞?
还望大虾不吝赐教!
 
Hi Happyboy,

请具体一点, 你要画的是什么图, 闪烁在什么情况下发生?
 
不知你是如何画图的(最好贴出代码)
开始画图可以使用LockWindow函数

结束后LockWindow(0),这时才刷新窗口屏幕

还有可以关闭Windows的背景重画消息Wm_erasebkground
procedure wm_erasebkgroup(var msg: TMessage);message wmErasebkgroun
begin
end;
 
The general method is prepare a MemDC, then draw within
this memDC. After completing drawing work, you can use BitBlt
to paint the real DC of your window.

Otherwise, you can use double buffer.technic, which is used frequently
in OpenGL or other Graphics package.
 
你的问题不是很清楚,我就多费几句,不知能否帮你:
如果用了两个 Image ,由于某原因其中一个需要在另一个上面(叠加)
当刷新或重绘上面的 Image 时会出现强烈闪烁,解决方法是:
只用一个 Image ,叠加效果用 CANVAS 拷贝实现,反正我见到的大多数
说闪烁厉害往往是有两个或以上 Image 重叠产生的
在用了大量运算处理 Image 并不断更新也会产生闪烁,在运算开始前
禁止 Image 的刷新,运算完成后 刷新一次就可以了.
 
我的程序主要如下:
该程序主要是在屏幕一定范围内用bresen算法画直线.
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
x0:=X;
y0:=Y;
x1:=X;
y1:=Y;
down:=true;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if down =true then
begin
//Image1.canvas.MoveTo(x0,y0);
Image1.canvas.Pen.mode:=pmnotxor;
//Image1.Canvas.LineTo(x1,y1);
bresen_line(x0,y0,x1,y1);
x1:=X;
y1:=Y;
Image1.canvas.pen.color:=mcolor;

//image1.canvas.pen.mode:=pmcopy;
Image1.canvas.Pen.mode:=pmnotxor;
//image1.canvas.Pen.mode:=pmxor;
//Image1.canvas.MoveTo(x0,y0);
//Image1.canvas.LineTo(x1,y1);
bresen_line(x0,y0,x1,y1);


end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Image1.canvas.Pen.mode:=pmcopy;
//Image1.canvas.moveto(x0,y0);
//Image1.canvas.LineTo(x1,y1);
bresen_line(x0,y0,x1,y1);
down:=false;
end;
 
用LineTo画图肯定不会有闪烁现象, 问题可能出在bresen_line上

能否将这个bresen_line贴上来大家讨论一下
 
这是关于bresenham 算法的程序,主要就是画直线.
估计应该不是这个问题.
铁上来,以供大家参考.

procedure TForm1.bresen_line(x0,y0,x1,y1:short);
var
x,y,dx,dy,dx1,dy1:short;
xt0,yt0,xt1,yt1:short;
i: short;
e: real;
linecolor:tcolor;
begin

//image1.canvas.moveto(x0,y0+50);
//image1.canvas.LineTo(x1,y1+50);
//linecolor:=rgb(255,0,0);
if(x0>x1) then
begin
xt0:=x1;
yt0:=y1;
xt1:=x0;
yt1:=y0;
end
else
begin
xt0:=x0;
yt0:=y0;
xt1:=x1;
yt1:=y1;
end;
dx:=xt1-xt0;
dy:=yt1-yt0;
x:=xt0;
y:=yt0;
if dy>dx then
begin
dx1:=yt1-yt0;
dy1:=xt1-xt0;
x:=yt0;
y:=xt0;
end
else
if -dy>dx then
begin
dx1:=-(yt1-yt0);
dy1:=xt1-xt0;
x:=-yt0;
y:=xt0;
end
else if (dy<0) and ((-dy)<dx) then
begin
dx1:=xt1-xt0;
dy1:=-(yt1-yt0);
x:=xt0;
y:=-yt0;
end
else
begin
dx1:=xt1-xt0;
dy1:=yt1-yt0;
x:=xt0;
y:=yt0;
end;
e:=-dx1;

for i:=0 to dx1 do
begin
if dy>dx then
image1.canvas.Pixels[y,x]:=mcolor
else if -dy>dx then
image1.canvas.Pixels[y,-x]:=mcolor
else if (dy<0) and (-dy<dx) then
image1.canvas.Pixels[x,-y]:=mcolor
else
image1.canvas.Pixels[x,y]:=mcolor;
x:=x+1;
e:=e+2*dy1;
if e>=0 then
begin
y:=y+1;
e:=e-2*dx1;
end;
end;
end;
 
只要鼠标在 Image 上时对Image 做变动,不接管 Image 的刷新必定会出现闪烁!
不信你用 Timer 接管 MouseMove,再移动鼠标试试:
if down =true then
begin
在此处禁止 Image 刷新
.
. // 由于你在此处两次刷新 Image ,也是造成闪烁的原因
. // 这样处理后至少减少一半闪烁
.
对 Image 进行刷新
end
 
先再Tcanvas上draw,然后再复制。
 
与image.width,height 有关,Autosize:=True;
 
建议用tpaintbox,而不用timage,直接往dc上画
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
1K
DelphiTeacher的专栏
D
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
781
import
I
后退
顶部