📄 unit111.pas
字号:
if posLength > 0 then
begin
can.Pen.Color := clBlue;
ratio := h / maxV / 2;
x := round(posXArray[0]*ratio + wid/2);
y := round(h/2-posYArray[0]*ratio);
can.MoveTo(x,y);
can.Pixels[x,y] := $0000ff;
for i:= 1 to posLength-1 do
begin
x := round(posXArray[i]*ratio + wid/2);
y := round(h/2 - posYArray[i]*ratio);
can.LineTo(x,y);
end;
can.RoundRect(x,y,x+6,y+6,x-6,y-6);
end;
can.Free;
ImgTrace.Picture.Assign(gpsMeta);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i:Integer;
Ini: TIniFile;
begin
dlgDataSave .FileName:=ExtractFilePath(Application.ExeName )+'temp' ;
lbSaveName.Caption:=dlgDataSave .FileName+'_'+IntToStr(AutoSaveCount);
btnCloseSerial.Enabled :=False;
cmbbxModel.ItemIndex :=0;
cmbbxSerialIn.ItemIndex :=0;
cmbbxAgueNo.ItemIndex :=0;
cmbbxAgueNo.ItemIndex :=0;
cmbbxBaudIn.ItemIndex :=0;
hMutex:=CreateMutex(nil,False,nil);
hMutex2:=CreateMutex(nil,False,nil);
btnCloseSerial.Enabled:=False;
posLength := 0;
SetLength(posXArray,1000);
SetLength(posYArray,1000);
setLength(posZArray,1000);
posLengthLoad := 0;
SetLength(posXArrayLOad,0);
SetLength(posYArrayLoad,0);
gpsMeta := TMetaFile.Create;
DrawAxis;
for i:=0 to 19 do
MemsDataArrayZero[i]:=0;
Ini := TIniFile.Create(ExtractFilePath(Application.ExeName )+'station.INI' );
try
if Ini.ReadBool( 'Init', 'Init', false ) then
begin
MemsInitFlag:=True;
btSetSensorZero.Caption:='放弃设置机载零点';
for i:=0 to 19 do
MemsDataArrayZero[i]:=Ini.ReadInteger( 'data', IntToStr(i), 0 );
ChartHeightor.LeftAxis.Minimum:=-100;
ChartHeightor.LeftAxis.Maximum:=100;
ChartGyro.LeftAxis.Minimum:=-310;
ChartGyro.LeftAxis.Maximum:=310;
end
else
begin
MemsInitFlag:=False;
for i:=0 to 19 do
MemsDataArrayZero[i]:=0;
end
finally
ini.Free;
end;
end;
procedure TForm1.btnCloseSerialClick(Sender: TObject);
begin
tmrSerial.Interval := 0;
tmrSerial.Enabled :=False;
btnCloseSerial.Enabled := False;
btnOpenSerial.Enabled := True;
btnAllStart.Enabled := True;
cmbbxSerialIn.Enabled :=True;
end;
procedure TForm1.btnStoreSerialClick(Sender: TObject);
var
fileName:String;
str : TStrings;
temp: String;
i: Integer;
begin
begin
if dlgDataSave.Execute then
begin
fileName:=dlgDataSave .FileName ;
AutoSaveCount:=0;//autosave filename changed
lbSaveName.Caption:=fileName+'_'+IntToStr(AutoSaveCount);
rchdtTmp .Text :=DownStr;
rchdtTmp .Lines.SaveToFile(filename+'_Down'+'.txt');
rchdtTmp .Text :=FormatDownStr;
rchdtTmp .Lines.SaveToFile(filename+'_FormatDown'+'.txt');
rchdtTmp .Text :=MemsStr;
rchdtTmp .Lines.SaveToFile(filename+'_AD_All'+'.txt');
rchdtTmp .Text :=GpsStr1;
rchdtTmp .Lines.SaveToFile(filename+'_Gps'+'.txt');
rchdtTmp .Text :='';
str := TStringList.Create;
for i:=0 to posLength-1 do
begin
temp := FloatToStr(posXArray[i])+','+FloatToStr(posYArray[i]);
str.Add(temp);
end;
str.SaveToFile(filename+'_Trace'+'.txt');
str.Free;
posLength := 0;
SetLength(posXArray,1000);
SetLength(posYArray,1000);
end;
ChartHeightor.SaveToBitmapFile(fileName+'_Height.bmp');
ChartControl.SaveToBitmapFile(fileName+'_Control.bmp');
ChartGyro.SaveToBitmapFile(fileName+'_Gyro.bmp');
end;
end;
procedure TForm1.btnClearSerialClick(Sender: TObject);
begin
rchdtSerialIn.Text :='';
rchdtSerialOut.Text :='';
end;
procedure TForm1.edtSerialOut1Change(Sender: TObject);
begin
if Length(edtSerialOut1.Text)>2 then
edtSerialOut1.Text:='';
end;
procedure TForm1.edtSerialOut2Change(Sender: TObject);
begin
if Length(edtSerialOut1.Text)>2 then
edtSerialOut2.Text:='';
end;
procedure TForm1.edtSerialOut3Change(Sender: TObject);
begin
if Length(edtSerialOut1.Text)>2 then
edtSerialOut3.Text:='';
end;
procedure TForm1.edtSerialOut4Change(Sender: TObject);
begin
if Length(edtSerialOut1.Text)>2 then
edtSerialOut4.Text:='';
end;
procedure TForm1.tmrSerialTimer(Sender: TObject);
begin
TSerialInThread.Create(False);
end;
procedure TForm1.btnAllStartClick(Sender: TObject);
begin
btnOpenSerialClick(Sender);
end;
procedure TForm1.btnAllStopClick(Sender: TObject);
begin
btnCloseSerialClick(Sender);
end;
procedure TForm1.btnDataStoreClick(Sender: TObject);
begin
btnStoreSerialClick(Sender);
end;
procedure TForm1.tmrAutoSaveDataTimer(Sender: TObject);
var
fileName,temp:String;
str : TStrings;
i,st : Integer;
begin
fileName:=lbSaveName.Caption;
Inc(AutoSaveCount);
lbSaveName.Caption:=dlgDataSave .FileName +'_'+IntToStr(AutoSaveCount);
rchdtTmp .Text :=DownStr;
rchdtTmp .Lines.SaveToFile(filename+'_auto_Down'+'.dat');
rchdtTmp .Text :=FormatDownStr;
rchdtTmp .Lines.SaveToFile(filename+'_auto_FormatDown'+'.txt');
rchdtTmp .Text :=MemsStr;
rchdtTmp .Lines.SaveToFile(filename+'_auto_AD_All'+'.dat');
rchdtTmp .Text :=GpsStr1;
rchdtTmp .Lines.SaveToFile(filename+'_auto_Gps'+'.dat');
rchdtTmp .Text :='';
DownStr:='';
MemsStr:='';
GpsStr1:='';
str := TStringList.Create;
for i:=0 to posLength-1 do
begin
temp := FloatToStr(posXArray[i])+','+FloatToStr(posYArray[i]);
str.Add(temp);
end;
str.SaveToFile(filename+'_auto_Trace'+'.dat');
str.Free;
posXArray[0] := posXArray[posLength-1];
posYArray[0] := posYArray[posLength-1];
posLength := 1;
SetLength(posXArray,1000);
SetLength(posYArray,1000);
DrawAxis;
ChartHeightor.SaveToBitmapFile(fileName+'_auto_Height.bmp');
ChartControl.SaveToBitmapFile(fileName+'_auto_Control.bmp');
ChartGyro.SaveToBitmapFile(fileName+'_auto_Gyro.bmp');
if (AutoSaveCount mod 6)=0 then
btnHeightorClearClick(Sender);
end;
procedure TForm1.lbSaveNameClick(Sender: TObject);
begin
if dlgDataSave.Execute then
begin
AutoSaveCount:=0;
lbSaveName.Caption:=dlgDataSave.FileName+'_'+IntToStr(AutoSaveCount);
end;
end;
procedure TForm1.btnGPSLoadClick(Sender: TObject);
var
str : TStrings;
temp: String;
i,st : Integer;
begin
if dlgPath.Execute then
begin
str := TStringList.Create;
str.LoadFromFile(dlgPath.FileName);
posLengthLoad := str.Count;
setLength(posXArrayLoad,str.Count);
setLength(posYArrayLoad,str.Count);
for i:=0 to str.Count-1 do
begin
st := pos(',',str[i]);
temp := copy(str[i],0,st-1);
posXArrayLoad[i] := StrToFloat(temp);
temp := copy(str[i],st+1,length(str[i])-st);
posYArrayLoad[i] := StrToFloat(temp);
end;
str.Free;
DrawAxis;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
posLength :=0;
posLengthLoad :=0;
DrawAxis;
end;
procedure TForm1.btSetSensorZeroClick(Sender: TObject);
var
i:integer;
Ini:TIniFile;
begin
Ini := TIniFile.Create(ExtractFilePath(Application.ExeName )+'station.INI' );
try
if MemsInitFlag then
begin
btSetSensorZero.Caption:='设置机载零点';
srsControlAil.Clear;
srsControlEle.Clear;
srsRawAil.Clear;
srsRawEle.Clear;
srsRawHeight.Clear;
srsGyroX.Clear;
srsGyroY.Clear;
srsGyroZ.Clear;
ChartHeightor.LeftAxis.Maximum:=500;
ChartHeightor.LeftAxis.Minimum:=300;
ChartGyro.LeftAxis.Maximum:=600;
ChartGyro.LeftAxis.Minimum:=50;
for i:=0 to 19 do
MemsDataArrayZero[i]:=0;
Ini.WriteBool('Init', 'Init', False);
MemsInitFlag:=False;
end
else
begin
edtSerialOut1.Text :='66';
edtSerialOut2.Text :='11';
edtSerialOut3.Text :='66';
edtSerialOut4.Text :='88';
DataOut[0]:= edtSerialOut1.Text;
DataOut[1]:= edtSerialOut2.Text;
DataOut[2]:= edtSerialOut3.Text;
DataOut[3]:= edtSerialOut4.Text;
rdbtnCode.Checked:=True;
btnSendCodeClick(Sender);
btSetSensorZero.Caption:='放弃设置机载零点';
srsControlAil.Clear;
srsControlEle.Clear;
srsRawAil.Clear;
srsRawEle.Clear;
// srsKalmanHeight.Clear;
srsRawHeight.Clear;
srsGyroX.Clear;
srsGyroY.Clear;
srsGyroZ.Clear;
ChartHeightor.LeftAxis.Minimum:=-100;
ChartHeightor.LeftAxis.Maximum:=100;
ChartGyro.LeftAxis.Minimum:=-310;
ChartGyro.LeftAxis.Maximum:=310;
for i:=0 to 19 do
begin
MemsDataArrayZero[i]:=MemsDataArray[i];
Ini.WriteInteger( 'data', IntToStr(i),MemsDataArray[i] );
end;
Ini.WriteBool('Init', 'Init', True);
MemsInitFlag:=True ;
end;
finally
ini.Free;
end;
end;
procedure TForm1.btnSetModelClick(Sender: TObject);
begin
edtSerialOut1.Text :=cmbbxModel.Items[cmbbxModel.ItemIndex];
edtSerialOut2.Text :='11';
edtSerialOut3.Text :='66';
edtSerialOut4.Text :='66';
DataOut[0]:= edtSerialOut1.Text;
DataOut[1]:= edtSerialOut2.Text;
DataOut[2]:= edtSerialOut3.Text;
DataOut[3]:= edtSerialOut4.Text;
rdbtnCode.Checked:=True;
btnSendCodeClick(Sender);
end;
procedure TForm1.btnSetParClick(Sender: TObject);
var
tmpInt:Integer;
begin
tmpInt:=StrToInt(edtAgueValue.Text);
if (tmpInt>=0) and (tmpInt<256) then
begin
edtSerialOut1.Text :='66';
edtSerialOut2.Text :='11';
edtSerialOut3.Text :=IntToHex(StrToInt(cmbbxAgueNo.Text),2);
edtSerialOut4.Text :=IntToHex(StrToInt(edtAgueValue.Text),2);
DataOut[0]:= edtSerialOut1.Text;
DataOut[1]:= edtSerialOut2.Text;
DataOut[2]:= edtSerialOut3.Text;
DataOut[3]:= edtSerialOut4.Text;
rdbtnCode.Checked:=True;
btnSendCodeClick(Sender);
end
else
ShowMessage('设定的数据有问题,发送失败');
end;
procedure TForm1.btnSetHeightClick(Sender: TObject);
var
tmpInt:Integer;
begin
tmpInt:=StrToInt(edtSetHeight.Text);
if (tmpInt>255) or (tmpInt<0) then
ShowMessage('数据格式有问题,停止发送')
else
begin
edtSerialOut1.Text :='88';
edtSerialOut2.Text :='11';
edtSerialOut3.Text :='66';
edtSerialOut4.Text :=IntToHex(tmpInt,2);
DataOut[0]:= edtSerialOut1.Text;
DataOut[1]:= edtSerialOut2.Text;
DataOut[2]:= edtSerialOut3.Text;
DataOut[3]:= edtSerialOut4.Text;
rdbtnCode.Checked:=True;
btnSendCodeClick(Sender);
end;
end;
procedure TForm1.btnSetRollClick(Sender: TObject);
var
tmpInt:Integer;
begin
tmpInt:=StrToInt(edtSetRoll.Text)+128;
if (tmpInt>255) or (tmpInt<0) then
ShowMessage('数据格式有问题,停止发送')
else
begin
edtSerialOut1.Text :='88';
edtSerialOut2.Text :='11';
edtSerialOut3.Text :='77';
edtSerialOut4.Text :=IntToHex(tmpInt,2);
DataOut[0]:= edtSerialOut1.Text;
DataOut[1]:= edtSerialOut2.Text;
DataOut[2]:= edtSerialOut3.Text;
DataOut[3]:= edtSerialOut4.Text;
rdbtnCode.Checked:=True;
btnSendCodeClick(Sender);
end;
end;
procedure TForm1.btnSetDefClick(Sender: TObject);
var
tmpInt:Integer;
begin
tmpInt:=StrToInt(edtSetDef.Text)+128;
if (tmpInt>255) or (tmpInt<0) then
ShowMessage('数据格式有问题,停止发送')
else
begin
edtSerialOut1.Text :='88';
edtSerialOut2.Text :='11';
edtSerialOut3.Text :='88';
edtSerialOut4.Text :=IntToHex(tmpInt,2);
DataOut[0]:= edtSerialOut1.Text;
DataOut[1]:= edtSerialOut2.Text;
DataOut[2]:= edtSerialOut3.Text;
DataOut[3]:= edtSerialOut4.Text;
rdbtnCode.Checked:=True;
btnSendCodeClick(Sender);
end;
end;
procedure TForm1.btnAutoSwClick(Sender: TObject);
begin
if tmrAutoSaveData.Enabled =True then
begin
tmrAutoSaveData.Enabled :=False;
lbSaveName.Enabled :=False;
btnAutoSw.Caption :='自动保存?' ;
end
else
begin
tmrAutoSaveData.Enabled :=True;
lbSaveName.Enabled :=True;;
btnAutoSw.Caption :='停止保存?'
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
btnCloseSerialClick(Sender);
// sleep(1000);
if WaitForSingleObject(hMutex,InFinite) =WAIT_OBJECT_0 then
;
if WaitForSingleObject(hMutex,InFinite) =WAIT_OBJECT_0 then
;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -