Делфи + ардуино

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TeEngine, Series, TeeProcs, Chart, ExtCtrls, StdCtrls, Spin, Buttons,
  ComCtrls,CommDlg;
 
type
  RType = double;
 
  TForm1 = class(TForm)
    Panel1: TPanel;
    Chart1: TChart;
    Series1: TFastLineSeries;
    Series2: TFastLineSeries;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Bevel1: TBevel;
    TrackBar1: TTrackBar;
    CheckBox1: TCheckBox;
    ComportIN: TComboBox;
    Button1: TButton;
    CheckBox2: TCheckBox;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Edit7: TEdit;
    Button2: TButton;
    Label10: TLabel;
    ComPortOUT: TComboBox;
    Button3: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EditBoxChange(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
//    procedure TrackBar2Change(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    U_start,U_end,U_step :RType;
    T_aver,S_aver,i_aver :dword;
    N_points,S_factor :dword;
    FileIndex :word;
    procedure Smoothing;
  public
    { Public declarations }
  end;
 
  TBuildSpectr = class(TThread)
    procedure Execute; override;
  end;
 
const PortNameIN:string = 'COM1'+#0;
      PortNameOUT:string = 'COM1'+#0;
      Preview:boolean=false;
 
var
  Form1: TForm1;
  BuildSpectr :TBuildSpectr;
  hCOMin,hCOMout :THandle;    //file handle
  DACcode :word;
 
implementation
 
{$R *.DFM}
 
uses    IniFiles, Unit2;
 
function StrToFloatDef(Str:string;Def:RType):RType;
var  i:integer;
     ok:boolean;
begin
  DecimalSeparator:='.';
  ok:=true;
  for i:=1 to Length(str) do
    if not (str[i] in ['0'..'9','-','.']) then ok:=false;
  if (length(str)<=0) or (str='-') then ok:=false;
  if ok then Result:=StrToFloat(str)
  else Result:=Def;
  
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var Ini :TIniFile;
 
    Present:boolean;
  i: integer;
    h: THandle;
begin
 
  comportIN.Items.clear;
  comportOUT.Items.clear;
  for i:=1 to 128 do
    begin
    h:=CreateFile(PChar('COM'+IntToStr(i)),
      GENERIC_READ or GENERIC_WRITE,
      0,
      nil,
      OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
    If(h<>INVALID_HANDLE_VALUE)then
    begin
      ComPortIN.Items.Add('COM'+IntToStr(i));
      ComPortOUT.Items.Add('COM'+IntToStr(i));
    end;
    CloseHandle(h);
    end;
   comportIN.ItemIndex:=0;
   comportOUT.ItemIndex:=0;
 
   Present:=True;
   //create file
   
 
   Chart1.Frame.Color:=clLime;
   DecimalSeparator:='.';
 
   Ini := TIniFile.Create(GetCurrentDir+'\e-spectr.ini');
   Edit1.Text := Ini.ReadString('Voltage','Start','-10.0');
   Edit2.Text := Ini.ReadString('Voltage','End',  '0.0');
   Edit3.Text := Ini.ReadString('Voltage','Step','0.01');
   Edit4.Text := Ini.ReadString('Timer','Account','50');
   Edit5.Text := Ini.ReadString('Average','Spectra','1');
   Edit6.Text := Ini.ReadString('Average','Factor','1');
   Ini.Free;
   FileIndex:=2;
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var Ini :TIniFile;
begin
   Ini := TIniFile.Create(GetCurrentDir+'\e-spectr.ini');
   Ini.WriteString('Voltage','Start',Format('%3.3f',[U_start]));
   Ini.WriteString('Voltage','End',  Format('%3.3f',[U_end]));
   Ini.WriteString('Voltage','Step',Format('%3.3f',[U_step]));
   Ini.WriteString('Timer','Account', Format('%d',[T_aver]));
   Ini.WriteString('Average','Spectra',Format('%d',[S_aver]));
   Ini.WriteString('Average','Factor',Format('%d',[S_factor]));
   Ini.Free;
end;
 
procedure TForm1.EditBoxChange(Sender: TObject);
begin
   with Sender as TEdit do
   case Tag of
   1:U_start := StrToFloatDef(Text,-5);
   2:U_end   := StrToFloatDef(Text,0);
   3:U_step  := StrToFloatDef(Text,0.01);
   5:S_aver  := StrToIntDef(Text,1);
   6:S_factor := StrToIntDef(Text,1);
   4:begin T_aver := StrToInt(Text); TrackBar1.Position:=T_aver end;
   end;
   if U_step<>0 then
   Label9.Caption:=Format('Расчётное время %0.2f c',
   [trunc(abs(U_end-U_start)/U_step)*T_aver/1000*S_aver]);
end;
 
procedure TForm1.BitBtn2Click(Sender: TObject);
var FullFileName,
    myFileName,
    sFilter       :array[0..255] of Char;
    FD            :TOpenFileName;
    i           :DWORD;
    fDat          :TextFile;
    Summ        :RType;
begin
  // ShowMessage(IntToStr(15 shl 12));
   FullFileName:=#0;                     //no predefined filenames
   sFilter := 'рисунок bmp' + #0 + '*.bmp' +#0+
          'файл дынных'   + #0 + '*.dat' +#0;
    //    'общий файл'+ #0 + '*.sum' +#0+#0;
 
   fillchar(FD,SizeOf(TOpenFileName),0);
   with FD do
   begin
     LStructSize    := SizeOf(TOpenFileName);
     HWndOwner      := Handle;              //parent descriptor
     hInstance  := 0;
     LPstrFilter    := sFilter;
     LPstrCustomFilter := nil;            //no user defined filters
     nMaxCustFilter := 0;
     nFilterIndex := FileIndex;             //№ of availabled filter
     LPstrFile      := FullFileName;
     LPstrFileTitle := myFileName;        //if <>nil then filename part
     nMaxFile       := SizeOf(FullFileName);
     nMaxFileTitle := SizeOf(myFileName);
     LPstrInitialDir := PChar(GetCurrentDir); //nil = current dir "???"
     LPstrTitle     := nil;                 //Caption, or "nil" for default
     LPstrDefExt  := 'dat';
     Flags        := ofn_HideReadOnly;// or ofn_OverWritePrompt;
   end;
 
   if GetSaveFileName(FD) then
   begin
    FileIndex:=FD.nFilterIndex;
    case FileIndex of
    1:Chart1.SaveToBitmapFile(FullFileName);
    2:begin
         AssignFile(fDat,FullFileName);
         Rewrite(fDat);
         for i:=0 to Series1.LastValueIndex do
          WriteLn(fDat,
             Series1.XValues.Value[i]:8:3,' ',
             Series1.YValues.Value[i]:10:3);
         CloseFile(fDat);
      end;
{   3:if Form2.ShowModal=mrOK then
      begin
         Summ:=0;
         for i:=0 to Series1.LastValueIndex do
          Summ:=Summ+Series1.YValues.Value[i];
         AssignFile(fDat,FullFileName);
      {$i-}
{        Append(fDat);
         if IOResult <> 0 then Rewrite(fDat);
         {$i+}
{        WriteLn(fDat,Form2.Volt:8:3,' ',Summ:10:3);
         CloseFile(fDat);
      end;          }
    end;{case}
   end;{if}
end;
 
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
   T_aver:=TrackBar1.Position;
   Edit4.Text:=IntToStr(T_aver);
end;
 
{procedure TForm1.TrackBar2Change(Sender: TObject);
var  i:dword;
     x:Extended;
begin
   x:=(TrackBar2.Position)/4095*(-10);
   Label6.Caption:=Format('%3.3f В',[(TrackBar2.Position)/4095*(-10)]);
   DACcode:=4095-TrackBar2.Position;
   //DACcode:=0;//65535;
   WriteFile(hCOM,DACcode,2,i,nil);
end;}
 
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   preview:=false;
   if BitBtn1.Caption='Старт'
   then begin
      BuildSpectr:=TBuildSpectr.Create(False);
      BuildSpectr.Priority:=tpHigher;
      BuildSpectr.FreeOnTerminate:=True;
      BitBtn1.Caption:='Стоп';
      end
   else begin
      BuildSpectr.Terminate;
      BitBtn1.Caption:='Старт';
      end;
end;
 
procedure TBuildSpectr.Execute;
var i,j,z:dword;
    inbyte :byte;
    inbyte2,counter:LongWord;
    status_bar:word;
    buffer :array of dword;
    t1:dword;
    q:LongWord;
    b: array[0..3] of byte;
begin
  with Form1 do begin
      Series1.Clear;
      Series2.Clear;
      N_Points:=trunc(abs(U_end-U_start)/U_step);
      SetLength(Buffer,N_Points);
      FillChar(Buffer[0],N_Points*SizeOf(dword),0);
 
      if U_start<U_end
      then for i:=0 to N_Points do Series1.AddXY(U_start+i*U_step,0)
      else for i:=0 to N_Points do Series1.AddXY(U_start-i*U_step,0);
 
      i_aver:=0;
    t1:=t_aver;
    if preview then begin
      TrackBar1.Position:=1;
      t_aver:=1;
    end;
      repeat
        inc(i_aver);
        Label7.Caption:=Format('Текущий: %d',[i_aver]);
 
        for i:=0 to N_Points-1 do begin
        DACcode:=4095-round(-(Series1.XValues[i])/10*4095);
        status_bar:=round(16*i/(N_Points-1));
        status_bar:=status_bar shl 12;
        DACcode:=DACcode or status_bar;
            //WriteFile(hCOMin,DACcode,2,z,nil);    //ОТПРАВКА НА COM ПОРТ
        Label6.Caption:=Format('%3.3f В',[Series1.XValues[i]]);
 
            counter:=0;
 
            for j:=1 to t_aver do begin
              if Terminated then exit;
              if CheckBox2.Checked then
            counter:=counter+round((20+10*sin(2*pi*i/n_points)+random*5))
              else begin
            repeat
                    ReadFile(hCOMin,inbyte2,4,z,nil);       //СЧИТЫВАНИЕ С COM ПОРТА
              //Memo1.Lines.add(inttostr(inbyte2));
           {   b[0]:=inbyte2 and 255;
         b[1]:=inbyte2 shr 8;
         b[1]:=b[1] and 255;
         b[2]:=inbyte2 shr 16;
         b[2]:=b[2] and 255;
         b[3]:=inbyte2 shr 24;
         b[3]:=b[3] and 255;
   Memo1.lines.add(inttostr(b[3]) + ' '+inttostr(b[2])+' '+inttostr(b[1])+' '+inttostr(b[0]));}
  // Memo1.lines.Add(inttostr(inbyte2)) ;
            until (inbyte2<1000000) or (z=0);
                  if z=0 then begin
              BitBtn1.Caption:='Старт'; Terminate; exit end;
                    counter:=counter+inbyte2;
                  end;
              end;
            Buffer[i]:=Buffer[i]+counter;
            Series1.YValues[i]:=(Buffer[i]/T_aver*1000)/i_aver;
        Memo1.Lines.add(floattoStr(inbyte2));
         b[0]:=inbyte2 and 255;
         b[1]:=inbyte2 shr 8;
         b[1]:=b[1] and 255;
         b[2]:=inbyte2 shr 16;
         b[2]:=b[2] and 255;
         b[3]:=inbyte2 shr 24;
         b[3]:=b[3] and 255;
   Memo1.lines.add(inttostr(b[3]) + ' '+inttostr(b[2])+' '+inttostr(b[1])+' '+inttostr(b[0]));
 
            if i mod 10 = 0 then Chart1.Refresh;
        end;
 
        if CheckBox1.Checked then Smoothing;
        beep;
      until (terminated) or (i_aver>=S_aver);
    if preview then begin
      t_aver:=t1;
      TrackBar1.Position:=t_aver;
      preview:=false;
    end;
      BitBtn1.Caption:='Старт';
      Terminate;
  end;
 
end;
 
procedure TForm1.Smoothing;
var i,j,Nq,Nr :integer;
    Sx,Sxx,Sy,Sxy :double;
begin
   Series2.Clear;
   Nq:=S_factor;
   for i:=0 to Series1.Count-1 do
   begin
    Sx:=0;Sy:=0;Sxy:=0;Sxx:=0;Nr:=0;
    with Series1 do
    for j:=-Nq to Nq do
    begin
       Sx:=Sx+j; //equal to zero here
       Sxx:=Sxx+Sqr(j);
       if (i+j>=0) and (i+j<Count) then
       begin
         Sy:=Sy+YValues[i+j];
         Sxy:=Sxy+j*YValues[i+j];
         inc(Nr);
       end;
    end;
    Series2.AddXY(Series1.XValues[i],(Sy*Sxx-Sx*Sxy)/(Sxx*Nr-Sx*Sx));
   end;
end;
 
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
   if CheckBox1.Checked
   then Smoothing
   else Series2.Clear;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const start_enable:boolean=true;
var DCB:TDCB;
    TimeOuts:TCommTimeouts;
  i:dword;
begin
  PortNameIN:=ComportIN.Items[ComportIN.ItemIndex]+#0;
 // PortNameIN:=ComportOUT.Items[ComportOUT.ItemIndex]+#0;
 
  hCOMin:=CreateFile(@PortNameIN[1],           //device name
    Generic_Read or Generic_Write,    //access type
    0,                                //share (for devs == 0)
    nil,                              //protect attribs (for devs = nil)
    Open_Existing,                    //creation distribution
    File_Attribute_Normal,            //flags (normal, directory, hidden, etc.)
    0);                               //pattern file
  if hCOMin=Invalid_Handle_Value then
    MessageBox(Handle,'Ошибка инициализации COM порта',nil,mb_IconExclamation);
 
   //set DCB
    GetCommState(hCOMin,DCB);
    with DCB do begin
        BaudRate:=CBR_57600;
        Parity:=NoParity;
        ByteSize:=8;
        StopBits:=1;
        Flags:=Flags;         // Flags |= fBinary & fParity
    end;
  if not SetCommState(hCOMin,DCB) then begin
    ShowMessage('Can''t set COM state');
    start_enable:=false;
  end;
   //set Timeouts
  with TimeOuts do begin
      ReadIntervalTimeout        := 0;//MAXDWORD;
    ReadTotalTimeoutMultiplier := 1000;//MAXDWORD;
      ReadTotalTimeoutConstant   := 0;//MAXDWORD;
  end;
  if not SetCommTimeouts(hCOMin,Timeouts) then begin
    ShowMessage('Невозможно установить timeouts');
    start_enable:=false;
  end;
  start_enable:=true;
  if start_enable then begin
    BitBtn1.Enabled:=true;
    BitBtn2.Enabled:=true;
    BitBtn4.Enabled:=true;
    TrackBar1.Enabled:=true;
    //TrackBar2.Enabled:=true;
    Edit1.Enabled:=true;
    Edit2.Enabled:=true;
    Edit3.Enabled:=true;
   // TrackBar2.Enabled:=true;
    TrackBar1.Enabled:=true;
    Edit4.Enabled:=true;
    Edit6.Enabled:=true;
    CheckBox1.Enabled:=true;
    Edit5.Enabled:=true;
    DACcode:=0;
    WriteFile(hCOMin,DACcode,2,i,nil);     //ОТПРАВКА НА COM ПОРТ
    Button1.Enabled:=false;
  end;
   //clear Buffers
  PurgeComm(hCOMin,PURGE_TXCLEAR or PURGE_RXCLEAR);
end;
 
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  preview:=true;
 
     if BitBtn1.Caption='Старт'
   then begin
      BuildSpectr:=TBuildSpectr.Create(False);
      BuildSpectr.Priority:=tpHigher;
      BuildSpectr.FreeOnTerminate:=True;
      BitBtn1.Caption:='Стоп';
      end
   else begin
      BuildSpectr.Terminate;
      BitBtn1.Caption:='Старт';
      end;
 
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var  i:dword;
     x,q:LongWord;
     code:integer;
     freq:LongWord;
     s:string;
     b: array[0..3] of byte;
begin
   s:=Edit7.text;
   Val(s,x,Code);
   if Code<>0 then begin
     MessageDlg('Ошибка: введено не число!',mtError,[mbOk],0);
     Exit;
   end;
   if (x<1) or (x>8000000000) then begin
     MessageDlg('Ошибка: введите частоту в диапозоне от 1 до 8000000 Гц',mtError,[mbOk],0);
     Exit;
   end;
   b[0]:=x and 255;
   b[1]:=x shr 8;
   b[1]:=b[1] and 255;
   b[2]:=x shr 16;
   b[2]:=b[2] and 255;
   b[3]:=x shr 24;
   b[3]:=b[3] and 255;
   Memo1.lines.add(inttostr(b[3]) + ' '+inttostr(b[2])+' '+inttostr(b[1])+' '+inttostr(b[0]));
 
   PurgeComm(hCOMin,PURGE_TXCLEAR or PURGE_RXCLEAR);
   WriteFile(hCOMout,b,4,i,nil);       //ОТПРАВКА НА COM ПОРТ
 
end;
 
procedure TForm1.Button3Click(Sender: TObject);
const start_enable:boolean=true;
var DCB:TDCB;
    TimeOuts:TCommTimeouts;
  i:dword;
begin
 // PortNameOUT:=ComportIN.Items[ComportIN.ItemIndex]+#0;
  PortNameOUT:=ComportOUT.Items[ComportOUT.ItemIndex]+#0;
 
  hCOMout:=CreateFile(@PortNameOUT[1],           //device name
    Generic_Read or Generic_Write,    //access type
    0,                                //share (for devs == 0)
    nil,                              //protect attribs (for devs = nil)
    Open_Existing,                    //creation distribution
    File_Attribute_Normal,            //flags (normal, directory, hidden, etc.)
    0);                               //pattern file
  if hCOMout=Invalid_Handle_Value then
    MessageBox(Handle,'Ошибка инициализации COM порта',nil,mb_IconExclamation);
 
   //set DCB
    GetCommState(hCOMout,DCB);
    with DCB do begin
        BaudRate:=CBR_57600;
        Parity:=NoParity;
        ByteSize:=8;
        StopBits:=2;
        Flags:=Flags;         // Flags |= fBinary & fParity
    end;
  if not SetCommState(hCOMout,DCB) then begin
    ShowMessage('Can''t set COM state');
    start_enable:=false;
  end;
   //set Timeouts
  with TimeOuts do begin
      ReadIntervalTimeout        := 0;//MAXDWORD;
    ReadTotalTimeoutMultiplier := 1000;//MAXDWORD;
      ReadTotalTimeoutConstant   := 0;//MAXDWORD;
  end;
  if not SetCommTimeouts(hCOMout,Timeouts) then begin
    ShowMessage('Невозможно установить timeouts');
    start_enable:=false;
  end;
  start_enable:=true;
  if start_enable then begin
    BitBtn1.Enabled:=true;
    BitBtn2.Enabled:=true;
    BitBtn4.Enabled:=true;
    TrackBar1.Enabled:=true;
    //TrackBar2.Enabled:=true;
    Edit1.Enabled:=true;
    Edit2.Enabled:=true;
    Edit3.Enabled:=true;
   // TrackBar2.Enabled:=true;
    TrackBar1.Enabled:=true;
    Edit4.Enabled:=true;
    Edit6.Enabled:=true;
    CheckBox1.Enabled:=true;
    Edit5.Enabled:=true;
    DACcode:=0;
    WriteFile(hCOMout,DACcode,2,i,nil);     //ОТПРАВКА НА COM ПОРТ
    Button3.Enabled:=false;
  end;
   //clear Buffers
  PurgeComm(hCOMout,PURGE_TXCLEAR or PURGE_RXCLEAR);
end;
 
end.

Label7.Caption:=Format('Текущий: %d',[i_aver]);
...
Label6.Caption:=Format('%3.3f В',[Series1.XValues[i]]);

Synchronize(procedure begin Form1.Label7.Caption:=Format('Текущий: %d',[i_aver]); end);

Synchronize(procedure begin Form1.Label6.Caption:=Format('%3.3f В',[Form1.Series1.XValues[i]]); end);

Synchronize(procedure begin for i := 1 to 100 do n := n + i; end);

for i := 1 to 100 do Synchronize(procedure begin n := n + i; end);

procedure Form1.UpdateLabel(Lbl: TLabel; Value: String);
begin
  Lbl.Caption := Value;
end;

Synchronize(UpdateLabel(Label7, Format('Текущий: %d',[i_aver])));
...
Synchronize(UpdateLabel(Label6, Format('%3.3f В',[Form1.Series1.XValues[i]])));

 TForm1 = class(TForm)
    ...
 private
    procedure UpdateLabel(Lbl: TLabel; Value: String);
 end;

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  TMyThread = class(TThread)
    procedure UpdateInfo;
    procedure Execute; override;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TMyThread }
 
procedure TMyThread.UpdateInfo;
begin
  // Здесь можно вызвать другие методы с параметрами, или сразу обратиться к VCL компонентам
  Form1.Label1.Caption := IntToStr(Random(1000));
end;
 
procedure TMyThread.Execute;
begin
  inherited;
  repeat
    // Здесь разные вычисления
 
 
    // Обновление информации
    Synchronize(UpdateInfo);
    Sleep(100);
  until Terminated;
end;
 
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  with TMyThread.Create(true) do begin
    FreeOnTerminate := true;
    Resume;
  end;
end;
 
end.