Нужно рисовать схему. Канва мигает

← →
mOOx © (2005-12-25 15:22) [0]

Добрый день.

Задача: Нужно релизовать рисовалку схем (типа как в ERWin и ему подобных). Рисую просто на канве формы. При движении картинки все страшно мигает. В принципе не критично, но хотелось бы более приятно.
Посоветуйте, как это дело можно ускорить.

← →
Fay © (2005-12-25 15:26) [1]

2 mOOx © (25.12.05 15:22)

А если добавить пустую
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
?

← →
mOOx © (2005-12-25 15:37) [2]

Обязательног попробую. Просто кода под руками сейчас нет :(.

Маленький вопрос. Я когда-то слышал, что можно установить DoubleBuffered=true и мигание должно уменьшиться. Вроду установил, но все равно тоже. Так вот вопрос: а на что влияет этот buffered?

← →
Fay © (2005-12-25 15:43) [3]

2 mOOx © (25.12.05 15:37) [2]
Открой Controls и иши по DoubleBuffered

← →
з. танька (2005-12-25 16:36) [4]

> mOOx © (25.12.05 15:37) [2]

ресуй в объекте tbitmap а потом копируй содержимое в картинку. мигать почти не будет. а есле на форме рисовать вместо имейджа - вообще замечательно.

← →
Eraser © (2005-12-26 01:11) [5]

> Fay © (25.12.05 15:26) [1]

Спасапет, но не всегда.

> mOOx © (25.12.05 15:22)

см. з. танька (25.12.05 16:36) [4], только "копирование" осуществляй в OnPaint, инициируй вызов с пом. InvalidateRect.

← →
Eraser © (2005-12-26 01:11) [6]

> Eraser © (26.12.05 01:11) [5]

Спасапет = спасает

>а на что влияет этот buffered?

Прорисовка формы и её контролов осуществляется во временном bitmap"е, а потом одной достаточно быстрой операцией этот временный bitmap выводится на экран (читать: в видеопамять).

unit Unit1;

////////////////////////////////////////////////////////////////////////////////
//Written by Dr Steve Evans (steve@lociuk.com) //
//You can use this code however you like providing the above credits remain //
////////////////////////////////////////////////////////////////////////////////
//Flicker free graphics with zoom and pan functions. //
////////////////////////////////////////////////////////////////////////////////

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ToolWin;

type TNode = record
X,Y: Double;
Scr: TPoint;
end;

type TTriangle = record
v1,v2,v3: Integer;
end;

type
TForm1 = class(TForm)
ToolBar1: TToolBar;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
Nodes: array of TNode; //an array to hold some geometric points
Triangles: array of TTriangle; //an array to hold some traingles
Buffer : TBitmap; //the buffer
OriginX: Integer; //used to control panning position
OriginY: Integer;
Zoom: Double; //used to control the zoom
AxisDX: Double; //used to control centre of zoom
AxisDY: Double;
function ScalePoint(xp,yp: Double): TPoint;
procedure ClearBackPage;
procedure FlipBackPage;
procedure RenderAll;
procedure CalculatePoints;
procedure DrawMesh;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
val: Single;
begin
DoubleBuffered:=True;

Buffer := TBitmap.Create;
Buffer.Height := 200;
Buffer.Width := 200;
Zoom:= 0.5;
AxisDX:=2; //mesh is 4 units wide in x direction, therefore centre of zoom is 2 (halfway)
AxisDY:=-2; //ditto above but for y direction
OriginX:=500;
OriginY:=350;

//set up some geometry (a mesh) to draw later
SetLength(Nodes,9);
Nodes[0].X:=0; Nodes[0].Y:=-0;
Nodes[1].X:=2; Nodes[1].Y:=-0;
Nodes[2].X:=4; Nodes[2].Y:=-0;
Nodes[3].X:=0; Nodes[3].Y:=-2;
Nodes[4].X:=2; Nodes[4].Y:=-2;
Nodes[5].X:=4; Nodes[5].Y:=-2;
Nodes[6].X:=0; Nodes[6].Y:=-4;
Nodes[7].X:=2; Nodes[7].Y:=-4;
Nodes[8].X:=4; Nodes[8].Y:=-4;

SetLength(Triangles,8);
Triangles[0].v1:=1; Triangles[0].v2:=5; Triangles[0].v3:=4;
Triangles[1].v1:=1; Triangles[1].v2:=2; Triangles[1].v3:=5;
Triangles[2].v1:=2; Triangles[2].v2:=5; Triangles[2].v3:=6;
Triangles[3].v1:=2; Triangles[3].v2:=6; Triangles[3].v3:=3;
Triangles[4].v1:=4; Triangles[4].v2:=7; Triangles[4].v3:=8;
Triangles[5].v1:=4; Triangles[5].v2:=8; Triangles[5].v3:=5;
Triangles[6].v1:=8; Triangles[6].v2:=9; Triangles[6].v3:=5;
Triangles[7].v1:=5; Triangles[7].v2:=9; Triangles[7].v3:=6;
end;

procedure TForm1.RenderAll;
begin
ClearBackPage; //clear the bitmap buffer
CalculatePoints; //do some calculations on my geometry
DrawMesh; //draw my geometry to the buffer
FlipBackPage; //copy the buffer to the forms canvas
end;

procedure TForm1.ClearBackPage;
begin
with Buffer do
begin
Height:=Form1.Height;
Width:=Form1.Width;
Canvas.Brush.Color := clWhite;
Canvas.FillRect(Rect(0,0,Form1.Width,Form1.Height));
end;
end;

procedure TForm1.CalculatePoints;
var
i: Integer;
begin
i:=0;
while i<= High(Nodes) do
begin
Nodes[i].Scr:=ScalePoint(Nodes[i].X,Nodes[i].Y);
Inc(i);
end;
end;

procedure TForm1.DrawMesh;
var
i: Integer;
begin
Buffer.Canvas.Brush.Color:=clYellow;

i:=0;
while i<= High(Triangles) do
begin
Buffer.Canvas.Polygon ( [ Nodes[Triangles[i].v1-1].Scr,
Nodes[Triangles[i].v2-1].Scr,
Nodes[Triangles[i].v3-1].Scr ] );
Inc(i);
end;
end;

procedure TForm1.FlipBackPage;
var
ARect : TRect;
begin
ARect.Left:=0;
ARect.Top:=0;
ARect.Right:=Form1.Width;
ARect.Bottom:=Form1.Height;
Form1.Canvas.CopyRect(ARect, Buffer.Canvas, ARect);
end;

function TForm1.ScalePoint(xp,yp: Double): TPoint;
begin
Result.X:=OriginX + Round((xp-AxisDX) * 200*Zoom);
Result.Y:=OriginY + Round((yp-AxisDy) * - 200*Zoom);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
RenderAll;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
Refresh;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Zoom:=Zoom*1.1;
Refresh;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Zoom:=Zoom*0.9;
Refresh;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
OriginX:=OriginX-5;
Refresh;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
OriginX:=OriginX+5;
Refresh;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
OriginY:=OriginY-5;
Refresh;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
OriginY:=OriginY+5;
Refresh;
end;

end.

Немного длинновато и файла проекта не хватает, но я думаю что это не проблема. Есть простор для оптимизации, а главное - дейстительно не мерцает! Использую этот прием во всех проектах со сложной отрисовкой.

Нужно рисовать схему. Канва мигает Найти похожие ветки