mainfrm.pas

采用PC控制Ca210彩色分析仪

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, CA200SRVRLib_TLB, ExtCtrls, StrUtils;

type
  TForm1 = class(TForm)
    BeginMeasure: TBitBtn;
    StopMeasure: TBitBtn;
    Ca210: TBitBtn;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    ConstantTime: TEdit;
    DelayTime: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    DelayTimer: TTimer;
    StopTimer: TTimer;
    Label5: TLabel;
    Ca210ch: TEdit;
    Label6: TLabel;
    StatusBar: TPanel;
    Timer1: TTimer;
    MesPanel: TBitBtn;
    procedure Ca210Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BeginMeasureClick(Sender: TObject);
    procedure StopTimerTimer(Sender: TObject);
    procedure StopMeasureClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure DelayTimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MesPanelClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ConnectCa210;
    procedure Measure_Ca210;
    procedure SetxyYData;
    procedure Ca210RGBMode;
    procedure Ca210xyYMode;
    procedure DestroyConnect;
    procedure Calibration;
    procedure Delay(t : LongInt);
    function  WriteDataToXls:Boolean;
    function  HeaderOfData:String;
    procedure ShowStatus(Status : Byte);
  end;

var
  Form1: TForm1;
  Ca210_On : Boolean = false;
  Lv,Sx,Sy : real;
  Interval,Constant : Integer;
  bStop : Boolean = false;
  m_Count : Integer;

  //CA-210相关变量
  objCa200 : Ca200;
  objCa : Ca;
  objProbe : Probe;       //object rgb mode
  objMemory : Memory;
  AdjCounter : Integer=0;


implementation

{$R *.dfm}
//------------------------------------------------------------------------------
procedure TForm1.ConnectCa210;
begin
     if not Ca210_On then
     begin
        ObjCa200 := CoCa200.Create;
        objCa200.AutoConnect;
        objCa := objCa200.SingleCa;
        objProbe := objCa.SingleProbe;
        objMemory := objCa.Memory;
        objMemory.ChannelNO := StrToInt(Ca210Ch.Text);
        objCa.SyncMode := 3;
        objCa.AveragingMode := 1;
        objCa.SetAnalogRange(2.5,2.5);
        objCa.DisplayMode := 0;
        objCa.DisplayDigits := 1;
        objMemory.ChannelNO := StrToInt(Ca210Ch.Text);
        objCa.RemoteMode := 1;
        objCa.CalZero;
        Ca210_On := true;
        Ca210.Caption := '断开Ca210';
     end
     else
         begin
         objCa.RemoteMode := 0;
         Ca210_On := false;
         Ca210.Caption := '连接Ca210';
         end;
end;
//------------------------------------------------------------------------------
procedure TForm1.Calibration;
begin
     objCa.CalZero;
     Ca210_On := true;
end;
//------------------------------------------------------------------------------
procedure TForm1.Ca210RGBMode;
begin
    objCa.DisplayMode := 0;
end;
//------------------------------------------------------------------------------
procedure TForm1.Ca210xyYMode;
begin
     objCa.DisplayMode := 3;
end;
//------------------------------------------------------------------------------
procedure TForm1.SetxyYData;
begin
     objCa.SetLvxyCalData(3,319,329,200);
     objCa.Enter;
end;
//------------------------------------------------------------------------------
procedure TForm1.DestroyConnect;
begin
     if Ca210_On then
     begin
         objCa.RemoteMode := 0;
         Ca210_On := false;
     end;
end;
//------------------------------------------------------------------------------
procedure TForm1.Measure_Ca210;
begin
     objCa.Measure(1);
     Sx := objProbe.sx * 1000;
     Sy := objProbe.sy * 1000;
     Lv := objProbe.Lv;
     WriteDataToXls;
end;
//------------------------------------------------------------------------------
procedure TForm1.Ca210Click(Sender: TObject);
begin
     if not Ca210_On then
     begin
         if Ca210Ch.Text = '' then
         begin
            ShowMessage('请先设置Ca210的通道！');
            exit;
         end;
         Delay(50);
         ConnectCa210;
         Ca210.Caption := '断开Ca210';
         Ca210_On := true;
     end
   else
     begin
         DestroyConnect;
         Ca210_On := false;
         Ca210.Caption := '连接Ca210';
     end;
end;
//-----------------------------------------------------------------------------
procedure TForm1.Delay(t : LongInt);
var
   InitialTime,Now : LongInt;
begin
   InitialTime := GetTickCount();
   repeat
     Application.ProcessMessages;
     Now := GetTickCount();
   Until (Now-InitialTime >= t) or (Now < InitialTime);
end;    
//------------------------------------------------------------------------------
function  TForm1.WriteDataToXls:Boolean;
var
   Path : String;
   F : TextFile;
   i : Integer;
   str : String;
begin
   Path := GetCurrentDir;
   Path := Path+'\'+'MeasureData.xls';
   if not FileExists(path) then
   begin
    AssignFile(F,path);
    Rewrite(F);
    WriteLn(F,HeaderOfData);
    Closefile(F);
   end;
   begin
   AssignFile(F,path);
   Append(F);
   for i:=1 to (((StrToInt(ConstantTime.Text))*60)div(StrToInt(DelayTime.Text))) do
   begin
       str := IntToStr(Interval*i);
       str := str + #9 + LeftStr(FloatToStr(Sx),5) + #9 + LeftStr(FloatToStr(Sy),5)
                  + #9 + LeftStr(FloatToStr(Lv),5);
       str := str + #9 + DateTimeToStr(Time);
   end;
   WriteLn(F,str);
   CloseFile(F);
   result := true;
   end;     
end;
//------------------------------------------------------------------------------
function TForm1.HeaderOfData:String;
var
   temp:String;
begin
  temp := 'Interval';
  temp := temp + #9 + 'x' + #9 + 'y' + #9 + 'Lv';
  temp := temp + #9 + 'DateTime';
  result := temp;
end;
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
    StopTimer.Enabled := false;
    DelayTimer.Enabled := false;
    StopMeasure.Enabled := false;
    Timer1.Enabled := false;
end;
//------------------------------------------------------------------------------
procedure TForm1.BeginMeasureClick(Sender: TObject);
begin
    if not Ca210_On then
    begin
       ShowMessage('请先连接Ca210!');
       exit;
    end;
    Interval := StrToInt(DelayTime.Text);
    DelayTimer.Interval := (StrToInt(DelayTime.Text))*60*1000;
    StopTimer.Interval := (StrToInt(ConstantTime.Text))*60*60*1000;
    DelayTimer.Enabled := true;
    StopTimer.Enabled := true;
    Timer1.Enabled := true;
    Measure_Ca210;
end;
//------------------------------------------------------------------------------
procedure TForm1.StopTimerTimer(Sender: TObject);
begin
     bStop := true;
     StopTimer.Enabled := false;
     BeginMeasure.Enabled := false;
     StopMeasure.Enabled := false;
     Timer1.Enabled := false;
     ShowStatus(3);
end;
//------------------------------------------------------------------------------
procedure TForm1.StopMeasureClick(Sender: TObject);
begin
     bStop := true;
     ShowStatus(2);
     Timer1.Enabled := false;
     BeginMeasure.Enabled := true;
     StopMeasure.Enabled := false;
     StopTimer.Enabled := false;
end;
///-----------------------------------------------------------------------------
procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Timer1.Interval := 500;
   Inc(m_Count);
   if m_Count>5 then
   begin
      m_Count := 0;
   end;
   case m_Count of
   0:
     StatusBar.Caption:='Measure';
   1:
     StatusBar.Caption:='Measure.';
   2:
     StatusBar.Caption:='Measure..';
   3:
     StatusBar.Caption:='Measure...';
   4:
     StatusBar.Caption:='Measure....';
   5:
     StatusBar.Caption:='Measure.....';
   end;
end;
//------------------------------------------------------------------------------
procedure TForm1.ShowStatus(Status : Byte);
begin
     case Status of
     0:
       begin
            Timer1.Enabled := false;
            StatusBar.Font.Color := clBlack;
            StatusBar.Color := clSkyBlue;
       end;
     1:
       begin
            Timer1.Enabled := true;
            StatusBar.Color := clSkyBlue;
            StatusBar.Font.Color := clBlack;
       end;
     2:
       begin
           Timer1.Enabled := false;
           StatusBar.Caption := 'Stop!';
           StatusBar.Color := clRed;
           StatusBar.Font.Color := clBlack;
       end;
     3:
       begin
           Timer1.Enabled := false;
           StatusBar.Caption := 'OK!';
           StatusBar.Color := clGreen;
           StatusBar.Font.Color := clBlack;
       end;
     end;
end;
//------------------------------------------------------------------------------

procedure TForm1.DelayTimerTimer(Sender: TObject);
begin
     if bStop then
     begin
        exit;
     end;
     Measure_Ca210;
     Delay(200);
end;
//------------------------------------------------------------------------------

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if Ca210_On then
    begin
        DestroyConnect;
        ObjCa.RemoteMode := 0;
    end;
end;
//------------------------------------------------------------------------------

procedure TForm1.MesPanelClick(Sender: TObject);
begin
    if not Ca210_On then
    begin
       ShowMessage('请先连接Ca210!');
       exit;
    end;
    Measure_Ca210;
end;
//------------------------------------------------------------------------------
end.