⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit111.pas

📁 模型飞机测控平台是在模型飞机使用的设备基础上增加测量和控制设备.
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  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 + -