如何用delphi实现动态绘图啊?(100分)

  • 主题发起人 主题发起人 blueSpecter
  • 开始时间 开始时间
B

blueSpecter

Unregistered / Unconfirmed
GUEST, unregistred user!
各位大侠,,希望大家给我一点建议啊,最好上传给我 源程序,谢谢啊~!
 
image 控件
move to
line to
........
 
详细研究Delphi中的TCanvas(画布),看Delphi(帮助)
 
如数据库
dbchart
 
忘了是那位大虾的代码,借用一下:
动态绘制直线单元:
unit DynamicLine;

interface
uses
Windows, classes, Graphics;
type
TLine = class //y=ax+b
private
FLineStyle: (Horizontal, Vertical, Diagonal);
FPoints: array of TPoint;
FStartPoint: TPoint; //开始端点
FEndPoint: TPoint; //结束端点
FPointCount, FFactPointCount: Integer;
FA, FB: Double; //a,b参数
FInterval: Integer;
function GetSpace(P1, P2: TPoint): Integer;
function GetLength: Integer;
procedure CalcAB;
procedure CalcPoints;
function OnLine(P: TPoint): Boolean;
public
constructor Create; overload;
constructor Create(AStartPoint, AEndPoint: TPoint; APointCount: Integer);
overload;
destructor Destroy; override;
procedure Draw(ACanvas: TCanvas);
property StartPoint: TPoint read FStartPoint write FStartPoint;
property EndPoint: TPoint read FEndPoint write FEndPoint;
property PointCount: Integer read FPointCount write FPointCount;
property Length: Integer read GetLength;
property Interval: Integer read FInterval write FInterval;
end;

implementation

constructor TLine.Create;
begin
FInterval := 10;
end;

constructor TLine.Create(AStartPoint, AEndPoint: TPoint; APointCount: Integer);
begin
FStartPoint := AStartPoint;
FEndPoint := AEndPoint;
FPointCount := APointCount;
FInterval := 10;
end;

destructor TLine.Destroy;
begin
SetLength(FPoints, 0);
inherited;
end;

procedure TLine.CalcAB; //求a,b参数
begin
if (FEndPoint.X - FStartPoint.X) = 0 then
begin
FA := 0;
FB := FStartPoint.X;
FLineStyle := Vertical;
end
else if (FEndPoint.Y - FStartPoint.Y) = 0 then
begin
FA := 0;
FB := FStartPoint.Y;
FLineStyle := Horizontal;
end
else
begin
FA := (FEndPoint.Y - FStartPoint.Y) / (FEndPoint.X - FStartPoint.X);
FB := FStartPoint.Y - FA * FStartPoint.X;
FLineStyle := Diagonal;
end;
end;

function TLine.GetSpace(P1, P2: TPoint): Integer; //两点间距离
begin
Result := Round(Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y)));
end;

function TLine.GetLength: Integer; //线段长度
begin
Result := GetSpace(FStartPoint, FEndPoint);
end;

function TLine.OnLine(P: TPoint): Boolean; //某点是否在线段上
begin
if (GetSpace(FStartPoint, P) < Length) and (GetSpace(FEndPoint, P) < Length)
then
Result := True
else
Result := False;
end;

procedure TLine.CalcPoints; //选取线上的一些点
var
I: Integer;
PerLength: Double;
X, Y: Integer;
FlagX, FlagY: Integer;
begin
SetLength(FPoints, FPointCount);
PerLength := Length / (FPointCount - 1); //所选点间的距离
FFactPointCount := 0;
FPoints[0] := FStartPoint;
Inc(FFactPointCount);
if FStartPoint.X > FEndPoint.X then
FlagX := -1
else
FlagX := 1;
if FStartPoint.Y > FEndPoint.Y then
FlagY := -1
else
FlagY := 1;
for I := 1 to FPointCount - 3 do
begin
if FLineStyle = Vertical then //竖线
begin
X := Round(FB);
Y := Round(PerLength * I) * FlagY + FStartPoint.Y;
end
else if FLineStyle = Horizontal then //横线
begin
X := Round(PerLength * I) * FlagX + FStartPoint.X;
Y := Round(FB);
end
else
begin //斜线
X := Round(PerLength * I) * FlagX + FStartPoint.X;
Y := Round(FA * X + FB);
end;
if OnLine(Point(X, Y)) then
begin
FPoints[FFactPointCount] := Point(X, Y);
Inc(FFactPointCount);
end;
end;
FPoints[FFactPointCount] := FEndPoint;
Inc(FFactPointCount);
SetLength(FPoints, FFactPointCount);
end;

procedure TLine.Draw(ACanvas: TCanvas); //动态绘制该直线
var
I: Integer;
begin
CalcAB;
CalcPoints;
with ACanvas do
begin
Pen.Color := clRed;
for I := 0 to FFactPointCount - 2 do
begin
Sleep(Interval); //延时
MoveTo(FPoints.X, FPoints.Y);
LineTo(FPoints[I + 1].X, FPoints[I + 1].Y);
end;
end;
end;

end.

用法如下:
procedure TForm1.Button1Click(Sender: TObject);
var
Line: TLine;
begin
Line := TLine.Create;
try
Line.Interval := 10;
Line.PointCount := 50;
Line.StartPoint := Point(20, 120);
Line.EndPoint := Point(70, 20);
Line.Draw(PaintBox1.Canvas);
Line.StartPoint := Point(70, 20);
Line.EndPoint := Point(120, 120);
Line.Draw(PaintBox1.Canvas);
Line.StartPoint := Point(120, 120);
Line.EndPoint := Point(170, 20);
Line.Draw(PaintBox1.Canvas);
Line.StartPoint := Point(170, 20);
Line.EndPoint := Point(220, 120);
Line.Draw(PaintBox1.Canvas);
finally
Line.Free;
end;
end;
 

Similar threads

回复
0
查看
1K
不得闲
D
回复
0
查看
954
DelphiTeacher的专栏
D
D
回复
0
查看
891
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部