?? statcurvebig_f.pas
字號:
unit StatCurveBig_F;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, DB, ADODB;
type
TRePaintType = (
mNoPaint, //未畫線
mRePaint, //重畫
mPaintNext); //畫新的線
rPoint = record //定義坐標上的點
x,y,z:single;
end;
rLine=array[0..99] of rPoint; //定義由100個點的連成的曲線
TfrmStatCurveBig = class(TForm)
Panel1: TPanel;
GroupBox2: TGroupBox;
Label1: TLabel;
edt_X: TEdit;
Label2: TLabel;
edt_Y: TEdit;
GroupBox1: TGroupBox;
StatusBar1: TStatusBar;
imgCanvas: TImage;
pbCanvas: TPaintBox;
btnClose: TButton;
lab_X: TLabel;
lab_Y: TLabel;
lab_Z: TLabel;
ADOConnection: TADOConnection;
ADOQuery: TADOQuery;
btnPrint: TButton;
labCarLic: TLabel;
labCarType: TLabel;
labDriverLic: TLabel;
labDateTime: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure btnCloseClick(Sender: TObject);
procedure OriginAndScale(Sender: TObject); //確定坐標原點位置和刻度長度
procedure EstablishXYWorld(imgCanvas: TImage); //畫坐標系
procedure XYWorldToScreen(x, y: single; var xx, yy: integer); //把xy坐標轉換成屏幕坐標
procedure pMoveTo(x, y: single; pbCanvas: TPaintBox); //移動畫筆到(x,y)點
procedure pLineTo(x, y: single; pbCanvas: TPaintBox); //從當前點畫線到(x,y)點
procedure pPolyline(rl: rLine; pbCanvas: TPaintBox); //連接所有點
procedure SetPaintBoxPosition(imgCanvas: TImage; pbCanvas: TPaintBox);
procedure FormCreate(Sender: TObject);
procedure pbCanvasPaint(Sender: TObject);
procedure pbCanvasMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DrawLine(Sender: TObject);
procedure DrawSwitch(rl: rLine; pbCanvas: TPaintBox);
procedure btnPrintClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmStatCurveBig: TfrmStatCurveBig;
x_min,y_min,x_max,y_max:integer; //在坐標系中的xy的最值相對于paintbox容器的實際位置
x_scale,y_scale:integer; //x和y軸1刻度的實際象素值
px_min,py_min,px_max,py_max:integer;
tmpLine: rLine;
rePaintType:TRePaintType;
old_x,old_y:integer;
DotNum:integer;
implementation
uses
StatCurveBig_IMP;
{$R *.dfm}
procedure TfrmStatCurveBig.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmStatCurveBig.OriginAndScale(Sender: TObject);
begin
x_min:=50;
y_min:=imgCanvas.Height-30;
x_max:=imgCanvas.Width-40;
y_max:=15;
x_scale:=trunc((x_max-x_min-60)/20); //x軸1刻度的象素
y_scale:=trunc((y_min-y_max-5)/180); //y軸1刻度的象素
end;
procedure TfrmStatCurveBig.EstablishXYWorld(imgCanvas: TImage);
var
i,j:integer;
begin
imgCanvas.Canvas.Pen.Color:=clBlack; //黑色畫筆
imgCanvas.Canvas.MoveTo(0,0);
imgCanvas.Canvas.LineTo(imgCanvas.Width-1,0);
imgCanvas.Canvas.LineTo(imgCanvas.Width-1,imgCanvas.Height-1);
imgCanvas.Canvas.LineTo(0,imgCanvas.Height-1);
imgCanvas.Canvas.LineTo(0,0); //畫四周邊框
imgCanvas.Canvas.MoveTo(x_min,y_min);
imgCanvas.Canvas.LineTo(x_max,y_min);
imgCanvas.Canvas.LineTo(x_max-7,y_min-7);
imgCanvas.Canvas.MoveTo(x_max,y_min);
imgCanvas.Canvas.LineTo(x_max-7,y_min+7);
imgCanvas.Canvas.Font.Size:=8;
//imgCanvas.Canvas.TextOut(x_max+10,y_min-8,'t(s)'); //畫x軸
imgCanvas.Canvas.TextOut(x_max+10,y_min-8,'時間'); //畫x軸
imgCanvas.Canvas.TextOut(x_max+10,y_min+6,'(s)');
imgCanvas.Canvas.MoveTo(x_min,y_min);
imgCanvas.Canvas.LineTo(x_min,y_max);
imgCanvas.Canvas.LineTo(x_min,y_max+30);
imgCanvas.Canvas.LineTo(x_min-7,y_max+9+30);
imgCanvas.Canvas.MoveTo(x_min,y_max+30);
imgCanvas.Canvas.LineTo(x_min+7,y_max+9+30);
imgCanvas.Canvas.Font.Size:=8;
//imgCanvas.Canvas.TextOut(x_min-25,y_max-20,'v(km/h)'); //畫y軸
imgCanvas.Canvas.TextOut(x_min-40,y_max+25,'速度'); //畫y軸
imgCanvas.Canvas.TextOut(x_min-40,y_max+40,'(km/h)');
imgCanvas.Canvas.Font.Size:=8;
imgCanvas.Canvas.TextOut(x_min-16,y_min+5,'0'); //坐標原點
imgCanvas.Canvas.TextOut(x_min-40,y_max+5,'制動');
i:=y_min;
j:=0;
while (i>y_max+20) and (j<180) do
begin
i:=i-10*y_scale;
j:=j+10;
imgCanvas.Canvas.MoveTo(x_min,i);
imgCanvas.Canvas.LineTo(x_min+4,i);
imgCanvas.Canvas.TextOut(x_min-22,i,intToStr(j));
end; //畫y軸刻度
x_scale:=trunc((x_max-x_min-30)/20); //x軸1刻度的象素
i:=x_min;
j:=0;
while (i<x_max-50) and (j<20) do
begin
i:=i+x_scale;
j:=j+1;
imgCanvas.Canvas.MoveTo(i,y_min);
imgCanvas.Canvas.LineTo(i,y_min-4);
imgCanvas.Canvas.TextOut(i,y_min+5,intToStr(j));
end; //畫x軸刻度
end;
procedure TfrmStatCurveBig.XYWorldToScreen(x, y: single; var xx, yy: integer);
begin
xx:=trunc(x*x_scale);
yy:=trunc(py_min-y*y_scale);
end;
procedure TfrmStatCurveBig.pMoveTo(x, y: single; pbCanvas: TPaintBox);
var
sx, sy: integer;
begin
XYWorldToScreen(x, y, sx, sy); //把XY系坐標轉換為實際坐標
pbCanvas.Canvas.MoveTo(sx, sy); //移動刷子到要畫的點
end;
procedure TfrmStatCurveBig.pLineTo(x, y: single; pbCanvas: TPaintBox);
var
sx, sy: integer;
begin
XYWorldToScreen(x, y, sx, sy); //把XY系坐標轉換為實際坐標
pbCanvas.Canvas.LineTo(sx, sy); //連接兩點
end;
procedure TfrmStatCurveBig.pPolyline(rl: rLine; pbCanvas: TPaintBox);
var
i: integer;
begin
pbCanvas.Canvas.Pen.Color:=clRed;
pMoveto(rl[0].x, rl[0].y, pbCanvas);
for i := 1 to DotNum-1 do
pLineto(rl[i].x, rl[i].y, pbCanvas);
end;
procedure TfrmStatCurveBig.SetPaintBoxPosition(imgCanvas: TImage; pbCanvas: TPaintBox);
begin
pbCanvas.Left:=imgCanvas.Left+50;
pbCanvas.Top:=imgCanvas.Top+30;
pbCanvas.Width:=imgCanvas.Width-90;
pbCanvas.Height:=imgCanvas.Height-60;
px_min:=0;
px_max:=pbCanvas.Width;
py_min:=pbCanvas.Height;
py_max:=0;
end;
procedure TfrmStatCurveBig.FormCreate(Sender: TObject);
var
strSql: string;
i: integer;
begin
ADOConnection.ConnectionString := DataString;
ADOConnection.Connected := True;
strSql:='select Car_LicensePlate,Car_LicensePlateColor,Driver_ID,AccidentDoubtful_Time,AccidentDoubtful_Speed,AccidentDoubtful_Switch,AccidentDoubtful_ID from View_Data_AccidentDoubtful where Car_ID='+strCarID+' and AccidentDoubtful_CurveID='+strCurveID+' order by AccidentDoubtful_ID';
ADOQuery.Close;
ADOQuery.SQL.Clear;
ADOQuery.SQL.Add(strSql);
ADOQuery.Open;
for i:=0 to 99 do
begin
tmpLine[i].x:=ADOQuery.FieldByName('AccidentDoubtful_Time').Value;
tmpLine[i].y:=ADOQuery.FieldByName('AccidentDoubtful_Speed').Value;
tmpLine[i].z:=ADOQuery.FieldByName('AccidentDoubtful_Switch').Value;
ADOQuery.Next;
end;
strSql:='select Car_LicensePlate,Car_Type from Info_Car where Car_ID='+strCarID;
ADOQuery.Close;
ADOQuery.SQL.Clear;
ADOQuery.SQL.Add(strSql);
ADOQuery.Open;
if NOT(ADOQuery.FieldByName('Car_LicensePlate').Value=NULL) then
labCarLic.Caption:='車牌號碼:'+ADOQuery.FieldByName('Car_LicensePlate').AsString;
if NOT(ADOQuery.FieldByName('Car_Type').Value=NULL) then
labCarType.Caption:='車輛分類:'+ADOQuery.FieldByName('Car_Type').AsString;
strSql:='select TOP 1 Driver_Licence,AccidentDoubtful_RealTime from View_Data_AccidentDoubtful where Car_ID='+strCarID+' and AccidentDoubtful_CurveID='+strCurveID+' order by AccidentDoubtful_ID DESC';
ADOQuery.Close;
ADOQuery.SQL.Clear;
ADOQuery.SQL.Add(strSql);
ADOQuery.Open;
if NOT(ADOQuery.FieldByName('Driver_Licence').Value=NULL) then
labDriverLic.Caption:='駕駛證號:'+ADOQuery.FieldByName('Driver_Licence').AsString;
if NOT(ADOQuery.FieldByName('AccidentDoubtful_RealTime').Value=NULL) then
labDateTime.Caption:='實時日期、時間(對應坐標20s處):'+ADOQuery.FieldByName('AccidentDoubtful_RealTime').AsString;
rePaintType:=mNoPaint;
SetPaintBoxPosition(imgCanvas,pbCanvas);
OriginAndScale(Sender);
EstablishXYWorld(imgCanvas);
old_x:=-1;
old_y:=-1;
DotNum:=100;//length(tmpLine);
DrawLine(Sender);
DrawSwitch(tmpLine,pbCanvas);
end;
procedure TfrmStatCurveBig.pbCanvasPaint(Sender: TObject);
begin
if rePaintType=mRePaint then
DrawLine(Sender);
end;
procedure TfrmStatCurveBig.pbCanvasMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
edt_X.Text:=formatfloat('0.00',(x/x_scale));
edt_Y.Text:=formatfloat('0.00',(py_min-y)/y_scale);
lab_X.Visible:=true;
lab_Y.Visible:=true;
lab_X.Caption:='x: '+formatfloat('0.00',(x/x_scale));
lab_Y.Caption:='y: '+formatfloat('0.00',(py_min-y)/y_scale);
lab_X.Left:=pbCanvas.Left+x+10;
lab_X.Top:=pbCanvas.Top+y-20;
lab_Y.Left:=pbCanvas.Left+x+60;
lab_Y.Top:=pbCanvas.Top+y-20;
if (old_x<>-1) and (old_x>5) and (old_y<pbCanvas.Height-5) then
begin
pbCanvas.Canvas.Pen.Color:=clWhite;
pbCanvas.Canvas.MoveTo(old_x,pbCanvas.Height-5);
pbCanvas.Canvas.LineTo(old_x,0);
pbCanvas.Canvas.MoveTo(5,old_y);
pbCanvas.Canvas.LineTo(pbCanvas.Width,old_y);
end;
if rePaintType=mRePaint then
DrawLine(Sender);
if (x>5) and (y<pbCanvas.Height-5) then
begin
pbCanvas.Canvas.Pen.Color:=clBtnFace;
pbCanvas.Canvas.MoveTo(x,pbCanvas.Height-5);
pbCanvas.Canvas.LineTo(x,0);
pbCanvas.Canvas.LineTo(pbCanvas.Width,y);
old_x:=x;
old_y:=y;
end;
end;
procedure TfrmStatCurveBig.DrawLine(Sender: TObject);
begin
pbCanvas.Canvas.Pen.Color := clRed;
rePaintType:=mRePaint;
pPolyline(tmpLine,pbCanvas);
DrawSwitch(tmpLine,pbCanvas);
end;
procedure TfrmStatCurveBig.DrawSwitch(rl: rLine; pbCanvas: TPaintBox);
var
i: Integer;
j: Integer;
intWritePrepare: Integer;
begin
j:= y_max-8;
//i:=0;
intWritePrepare:=0; //寫標志,0為不寫,1為準備寫
pbCanvas.Canvas.Pen.Color := clBlue;
pbCanvas.Canvas.MoveTo(0, j);
{if rl[0].z = 1 then
begin
pbCanvas.Canvas.MoveTo(0, j-5);
pbCanvas.Canvas.LineTo(trunc(rl[0].x*x_scale),j-5);
end
else
begin
pbCanvas.Canvas.MoveTo(0, j+5);
pbCanvas.Canvas.LineTo(trunc(rl[0].x*x_scale),j+5);
end;
for i := 1 to DotNum-1 do
begin
if rl[i].z = 1 then
begin
pbCanvas.Canvas.LineTo(trunc(rl[i-1].x*x_scale),j-5);
pbCanvas.Canvas.LineTo(trunc(rl[i].x*x_scale),j-5);
end
else
begin
pbCanvas.Canvas.LineTo(trunc(rl[i-1].x*x_scale),j+5);
pbCanvas.Canvas.LineTo(trunc(rl[i].x*x_scale),j+5);
end;
end;}
for i:=0 to DotNum-1 do
begin
if (intWritePrepare=0) and (rl[i].z=0) then
begin
CONTINUE;
end;
if (intWritePrepare=1) and (rl[i].z=0) then
begin
pbCanvas.Canvas.LineTo(trunc(rl[i].x*x_scale),j-5);
intWritePrepare:=0;
end;
if (intWritePrepare=0) and (rl[i].z=1) then
begin
pbCanvas.Canvas.MoveTo(trunc(rl[i].x*x_scale), j-5);
intWritePrepare:=1;
end;
if (intWritePrepare=1) and (rl[i].z=1) then
begin
if i=DotNum-1 then
pbCanvas.Canvas.LineTo(trunc(rl[i].x*x_scale),j-5)
else
CONTINUE;
end;
end;
end;
procedure TfrmStatCurveBig.btnPrintClick(Sender: TObject);
begin
Print;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -