一个游戏程序的画面，Delphi5中不闪烁，Delphi6中却闪烁，为什么？

作者： | 来源：互联网 | 2023-09-06 00:50

我发现一个奇怪的问题。可以这样来做一个试验：在Delphi5中建立一个工程，先放入两个Image控件，设定Image1.Width600;Image1.Height600;Im

我发现一个奇怪的问题。
可以这样来做一个试验：在Delphi5中建立一个工程，先放入两个Image控件，设定
Image1.Width = 600; Image1.Height = 600; Image2.Width = 50; Image2.Height = 50;
并确定它们的Picture属性，指定两个图片。然后添加一个button，在点击事件中写：
procedure TForm1.Button1Click(Sender: TObject);
var
  X, Y: integer;
begin
  x := Random(600);
  y := Random(600);
  image1.Canvas.CopyRect(Rect(X, Y, X + 50, Y + 50),
    image2.Canvas,
    Rect(0, 0, 50, 50));
end;
分别在Delphi5和Delphi6下面编译这两个程序，我们可以发现，当不停的点击按钮时，
在Delphi6下面，图形不断的闪烁，而在Delphi5下面根本不闪烁。
不知道是为什么？

btw: 我在编译鞠大龙的推箱子小游戏时发现这个问题的，大家可以试试，在网上
搜索推箱子，很容易找到源代码，用delphi6一编译，问题就出来了，屏幕不断的闪烁。
而用Delphi5编译后的exe根本不闪烁！

18 个解决方案

#1

打开双缓存模式试试

将做image容器的控件的DoubleBuffered := true;

#2

image属性设置不对，以前我也遇到过的!

#3

我也遇到过。不知道怎么解决

#4

cleverboy(小虫)可不可以详细地说一下？？？？
多谢了！

#5

是的，比如你的IMAGE放在Panel1上面，你可以这样试试

Panel1.DoubleBuffered := true;

#6

2312(007)兄说的是正确的！谢谢！
只是小虫弟说改image的属性倒是不知如何搞。

#7

使用DoubleBuffered，

另外，这个决不比鞠大龙的那个推箱子游戏差：
http://www.tonixsoft.com/index.php?mmenu_id=3&smenu_id=0025
sokoban

#8

好久没用了，可能是属性设置有问题！

#9

大家说说这个是什么原因啊？
我也遇到过

#10

这帖子怎么还没结呀？

楼上的，答案已经个给出了

就是调整 DoubleBuffered

#11

我刚刚试了下,没有发现这样的情况啊!

#12

DoubleBuffered设置为True后，显示速度特慢。应该不是正确答案

#13

把image 放到一个载体上pannel控件上，这样就解决了image在窗体移动时刷新不及时的问题

#14

错了，这种做法再在都不能用了。要获取位图1的内存DC,然后，再将位图2的内存DC合起来再放入内存3的DC，再读出来，也就是上面的双缓冲或多缓冲，具体的做法你可以看看《VC++游戏开发》或《游戏开发概论》

#15

doublebuffer，双缓冲，D5和D6不同，在D6需要设为true

#16

呵呵，推箱子啊，我也写了一个，绝对不闪，谁要？

#17

界面：1个 400 X 400 的panel，一个speedbutton。
源码：
unit Unit1;

interface

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

const
  XCount = 20;
  YCount = 20;
  C_SPACE = 0;
  C_WALL = 1;
  C_MAN = 2;
  C_BOX = 3;
  C_POINT = 4;
  C_ManPoint = C_MAN + C_POINT;
  C_BoxPoint = C_BOX + C_POINT;

type
  TWallImg = class(TImage)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TActImg = class(TImage)
  public
    constructor Create(AOwner: TComponent; cType: Integer); reintroduce; virtual;
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton1Click(Sender: TObject);
  private
    CurMap: String;
    function TurnX(X: Integer): Integer;
    function TurnY(Y: Integer): Integer;
    function TurnNum(Num, Count: Integer): Integer;
    function check(a, b: integer): boolean;
    function checkway(way: integer): boolean;
    function checkwin: BOOLEAN;
    procedure DrawWall;
    procedure DrawAct;
    procedure FreeAll;
    procedure Ini(cMap: String);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Y: array[0..XCount - 1, 0..YCount - 1] of Integer;
  ManX, ManY: Integer;

implementation

{$R *.dfm}

#18

{ TWallImg }

constructor TWallImg.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Picture.Bitmap.LoadFromFile('Wall.bmp');
  Stretch := true;
  Height := 20;
  Width := 20;
end;

destructor TWallImg.Destroy;
begin
  inherited Destroy;
end;

{ TActImg }

constructor TActImg.Create(AOwner: TComponent; cType: Integer);
begin
  inherited Create(AOwner);
  case cType of
    C_MAN, C_ManPoint: Picture.Bitmap.LoadFromFile('People.bmp');
    C_BOX: Picture.Bitmap.LoadFromFile('Box.bmp');
    C_POINT: Picture.Bitmap.LoadFromFile('Target.bmp');
    C_BoxPoint: Picture.Bitmap.LoadFromFile('Box2.bmp');
  end;
  Stretch := true;
  Height := 20;
  Width := 20;
end;

destructor TActImg.Destroy;
begin
  inherited Destroy;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case key of
    37:
      if Checkway(1) then
        begin
          DrawAct;
          manx := TurnX(manx - 1);
        end;
    39:
      if Checkway(2) then
        begin
          DrawAct;
          manx := TurnX(manx + 1);
        end;
    38:
      if Checkway(3) then
        begin
          DrawAct;
          many := TurnY(many - 1);
        end;
    40:
      if Checkway(4) then
        begin
          DrawAct;
          many := TurnY(many + 1);
        end;
  end;
  if checkwin then
    begin
      Showmessage('你赢了');
      self.OnKeyDown := nil;
    end;
end;

function TForm1.check(a, b: integer): boolean;
begin
  result := false;
  case y[TurnX(manx + a), TurnY(many + b)] of
    C_SPACE, C_POINT:
      begin
        result := true;
        y[TurnX(manx + a), TurnY(many + b)] := C_MAN + y[TurnX(manx + a), TurnY(many + b)];
        y[manx, many] := y[manx, many] - C_MAN;
      end;
    C_WALL: result := false;
    C_BOX, C_BoxPoint:
      begin
        if (y[TurnX(manx + 2 * a), TurnY(many + 2 * b)] = C_SPACE)
          or (y[TurnX(manx + 2 * a), TurnY(many + 2 * b)] = C_POINT) then
          begin
            result := true;
            y[TurnX(manx + 2 * a), TurnY(many + 2 * b)] :=
              y[TurnX(manx + 2 * a), TurnY(many + 2 * b)] + C_BOX;
            y[TurnX(manx + a), TurnY(many + b)] :=
              y[TurnX(manx + a), TurnY(many + b)] + C_MAN - C_BOX;
            y[manx, many] := y[manx, many] - C_MAN;
          end
        else
          result := false;
      end;
  end;
end;

function TForm1.checkway(way: integer): boolean;
var
  a, b: integer;
begin
  a := 0;
  b := 0;
  case way of
    1:
      begin
        a := -1;
        b := 0;
      end;
    2:
      begin
        a := 1;
        b := 0;
      end;
    3:
      begin
        a := 0;
        b := -1;
      end;
    4:
      begin
        a := 0;
        b := 1;
      end;
  end;
  result := check(a, b);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{  CurMap := '1111111111' +
            '1111111111' +
            '1111111111' +
            '1120000111' +
            '1100301411' +
            '1100300011' +
            '1400000011' +
            '1111111111' +
            '1111111111' +
            '1111111111'; }

  CurMap := '00000000000000000000' +
            '00000000000000000000' +
            '00001111100000000000' +
            '00001000100000000000' +
            '00001300100000000000' +

            '00111003110000000000' +
            '00100303010000000000' +
            '11101011014001111110' +
            '10001011011111000410' +
            '10303000000000004410' +

            '11111011101211004410' +
            '00001000001111101110' +
            '00001111111000000000' +
            '00000000000000000000' +
            '00000000000000000000' +

            '00000000000000000000' +
            '00000000000000000000' +
            '00000000000000000000' +
            '00000000000000000000' +
            '00000000000000000000';
  Ini(CurMap);
end;

function TForm1.checkwin: BOOLEAN;
var
  i, j: Integer;
begin
  for i := 0 to XCount - 1 do
    for j := 0 to YCount - 1 do
      if Y[i, j] = C_BOX then
        begin
          Result := false;
          Exit;
        end
      else
        result := true;
end;

procedure TForm1.DrawWall;
  procedure DrawWallAtPos(X, Y: Integer);
  var
    Wall: TWallImg;
  begin
    Wall := TWallImg.Create(Panel1);
    Wall.Left := X * 20;
    Wall.Top := Y * 20;
    Wall.Parent := Panel1;
  end;

var
  i, j: Integer;
begin
  for i := 0 to XCount - 1 do
    for j := 0 to YCount - 1 do
      if Y[i, j] = C_WALL then
        begin
          DrawWallAtPos(i, j);
        end;
end;

procedure TForm1.DrawAct;
  procedure DrawActAtPos(X, Y, cType: Integer);
  var
    Act: TActImg;
  begin
    Act := TActImg.Create(Panel1, cType);
    Act.Left := X * 20;
    Act.Top := Y * 20;
    Act.Parent := Panel1;
  end;

var
  i, j: Integer;
begin
  for i := Panel1.ComponentCount - 1 downto 0 do
    if Panel1.Components[i] is TActImg then
      TActImg(Panel1.Components[i]).free;
  for i := 0 to XCount - 1 do
    for j := 0 to YCount - 1 do
      if (Y[i, j] <> C_SPACE) and (Y[i, j] <> C_WALL) then
        begin
          DrawActAtPos(i, j, Y[i, j]);
        end;
end;

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

procedure TForm1.FreeAll;
var
  i: Integer;
begin
  for i := Panel1.ComponentCount - 1 downto 0 do
    if Panel1.Components[i] is TImage then
      TImage(Panel1.Components[i]).free;
end;

procedure TForm1.Ini(cMap: String);
var
  i, j: Integer;
begin
  if Length(cMap) <> XCount * YCount then
    begin
      ShowMessage('载入游戏地图失败！');
      Exit;
    end;
  FreeAll;
  for j := 0 to YCount - 1 do
    for i := 0 to XCount - 1 do
      Y[i, j] := StrToInt(cMap[j * XCount + i + 1]);
  ManX := Pos(IntToStr(C_MAN), cMap) mod XCount - 1;
  ManY := Pos(IntToStr(C_MAN), cMap) div XCount;
  DrawWall;
  DrawAct;
  self.OnKeyDown := FormKeyDown;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Ini(CurMap);
end;

function TForm1.TurnNum(Num, Count: Integer): Integer;
begin
  Result := (Num + Count) Mod Count;
end;

function TForm1.TurnX(X: Integer): Integer;
begin
  Result := TurnNum(X, XCount);
end;

function TForm1.TurnY(Y: Integer): Integer;
begin
  Result := TurnNum(Y, YCount);
end;

end.