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

📄 mainfrm.pas

📁 可测试Panel Gamma曲线
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, SPComm,CA200SRVRLib_TLB, Grids,
  DBGrids,IniFiles;

type
  TForm1 = class(TForm)
    Comm2: TComm;
    GroupBox1: TGroupBox;
    Ca210: TBitBtn;
    SetPGPort: TBitBtn;
    Shape1: TShape;
    Shape2: TShape;
    GroupBox2: TGroupBox;
    Memo1: TMemo;
    BeginMes: TBitBtn;
    StopMes: TBitBtn;
    GammaTable: TStringGrid;
    GroupBox3: TGroupBox;
    SelPC: TRadioButton;
    SelAV: TRadioButton;
    SelCP: TRadioButton;
    SelHDMI: TRadioButton;
    SelCS: TRadioButton;
    COMPUTER: TBitBtn;
    GammaData: TEdit;
    GroupBox4: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    SSx: TEdit;
    SSy: TEdit;
    SSLv: TEdit;
    ComPort: TComboBox;
    ResultStatus: TPanel;
    Label4: TLabel;
    ClearGammaData: TBitBtn;
    Label5: TLabel;
    SerialNum: TEdit;
    ReadIni: TBitBtn;
    Sel0: TCheckBox;
    Sel3: TCheckBox;
    Sel4: TCheckBox;
    Sel5: TCheckBox;
    Sel6: TCheckBox;
    Sel7: TCheckBox;
    Sel8: TCheckBox;
    Sel9: TCheckBox;
    Sel10: TCheckBox;
    Sel2: TCheckBox;
    Sel1: TCheckBox;
    WriteIni: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure SetPGPortClick(Sender: TObject);
    procedure ConnectCa210;
    procedure Measure_Ca210;
    procedure DestroyConnect;
    procedure EnumComPorts(Ports: TStrings);
    procedure Ca210Click(Sender: TObject);
    procedure ShowInf(Inf : String);
    procedure Delay(t : LongInt);
    function CompGamma(MaxLv,i : real;Step : Integer) : real;
    procedure SendStringToCom2(const str: string);
    procedure SendToPGPort(command : string);
    procedure BeginMesClick(Sender: TObject);
    procedure MinMaxShow;
    procedure FormDestroy(Sender: TObject);
    procedure StopMesClick(Sender: TObject);
    function MeasIRE:real;
    procedure ClearData;
    function MeasGamma : Boolean;
    procedure ShowStatus(Status : Byte);
    procedure COMPUTERClick(Sender: TObject);
    function  HeaderOfGrid:String;
    function  WriteToTxt:Boolean;
    procedure ClearGammaDataClick(Sender: TObject);
    procedure ReadIniClick(Sender: TObject);
    procedure Memo1DblClick(Sender: TObject);
    function CheckSrcname:String;
    procedure WriteIniClick(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Ca210On,Com2On : Boolean;
  Lv,Sx,Sy : real;
  FTXNum : Integer;
  bStop : Boolean;
  bError : Boolean;
  PCTiming,AVTiming,CPTiming,CSTiming,HDMITiming  : Integer;
  IREP0,IREP10,IREP20,IREP30,IREP40,IREP50,IREP60,IREP70,IREP80,IREP90,IREP100 : Integer;
  TimingDelay,PatternDelay : Integer;

  IRE100Lv,IRE0Lv : real;

  IRE0Enable,IRE10Enable,IRE20Enable,IRE30Enable,IRE40Enable,IRE50Enable,
  IRE60Enable,IRE70Enable,IRE80Enable,IRE90Enable,IRE100Enable : Boolean;

  Status  : array[1..11] of String;

  Colorx : array[1..11] of real;
  Colory : array[1..11] of real;

implementation

uses Math,StrUtils;
{$R *.dfm}
var
  //CA-210相关变量
  objCa200 : Ca200;
  objCa : Ca;
  objProbe : Probe;       //object rgb mode
  objMemory : Memory;
  AdjCounter : Integer=0;

//------------------------------------------------------------------------------
procedure TForm1.ConnectCa210;
begin
     if not Ca210On then
     begin
        ObjCa200 := CoCa200.Create;
        objCa200.AutoConnect;
        objCa := objCa200.SingleCa;
        objProbe := objCa.SingleProbe;
        objMemory := objCa.Memory;
        objMemory.ChannelNO := 5;
        objCa.SyncMode := 3;
        objCa.AveragingMode := 1;
        objCa.SetAnalogRange(10,10);
        objCa.DisplayMode := 0;
        objCa.DisplayDigits := 0;
        objMemory.ChannelNO := 5;
        objCa.RemoteMode := 1;
        //objCa.CalZero;
        Ca210On := true;
        Form1.ShowInf('Ca210 is already open');
     end
     else
         begin
         objCa.RemoteMode := 0;
         Ca210On := false;
         end;
end;
//------------------------------------------------------------------------------
procedure TForm1.DestroyConnect;
begin
     if Ca210On then
     begin
         objCa.RemoteMode := 0;
         Ca210On := false;
     end;
end;
//------------------------------------------------------------------------------
procedure TForm1.Measure_Ca210;
begin
     objCa.Measure(1);
     Sx := objProbe.sx * 1000;
     Sy := objProbe.sy * 1000;
     Lv := StrToFloat(FormatFloat('#.00',objProbe.Lv));

     SSx.Text := LeftStr(FloatToStr(Sx),5);
     SSy.Text := LeftStr(FloatToStr(Sy),5);
     SSLv.Text := LeftStr(FloatToStr(Lv),5);

     Form1.ShowInf('x = '+LeftStr(FloatToStr(Sx),5));
     Form1.ShowInf('y = '+LeftStr(FloatToStr(Sy),5));
     Form1.ShowInf('Lv = '+LeftStr(FloatToStr(Lv),5));
end;
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
    FTXNum := 0;
    Com2On := false;
    Ca210On := false;
    Shape1.Brush.Color := clRed;
    Shape2.Brush.Color := clRed;
    bError := false;

    GammaTable.Cols[0].Add('GAMMA');
    GammaTable.Cols[1].Add('MIN 1.9');
    GammaTable.Cols[2].Add('MEASURE');
    GammaTable.Cols[3].Add('MAX 3.0');
    GammaTable.Cols[4].Add('TEST');

    GammaTable.Rows[1].Add('0 IRE');
    GammaTable.Rows[2].Add('10 IRE');
    GammaTable.Rows[3].Add('20 IRE');
    GammaTable.Rows[4].Add('30 IRE');
    GammaTable.Rows[5].Add('40 IRE');
    GammaTable.Rows[6].Add('50 IRE');
    GammaTable.Rows[7].Add('60 IRE');
    GammaTable.Rows[8].Add('70 IRE');
    GammaTable.Rows[9].Add('80 IRE');
    GammaTable.Rows[10].Add('90 IRE');
    GammaTable.Rows[11].Add('100 IRE');

    EnumComPorts(ComPort.Items);    //得到串口列表
    ComPort.ItemIndex := 0;
    BeginMes.Enabled := false;
    WriteIni.Enabled := false;
    ClearGammaData.Enabled := false;
end;
//------------------------------------------------------------------------------
procedure TForm1.SetPGPortClick(Sender: TObject);
begin
    if not Com2On then
    begin
             Comm2.CommName := Comport.Text;
             Comm2.BaudRate := 9600;
             Comm2.Parity := NONE;
             Comm2.ByteSize := _8;
             Comm2.StopBits := _1;
             Comm2.StartComm;
             Com2On := true;
             SetPGPort.Caption := 'CLOSE PG';
             ShowInf('PG Port '+ComPort.Text+' is open');
             Shape2.Brush.Color := clGreen;
     end
    else
     begin
             Comm2.StopComm;
             Com2On := false;
             SetPGPort.Caption := 'OPEN PG';
             ShowInf('PG Port '+ComPort.Text+' is close');
             Shape2.Brush.Color := clRed;
     end;
end;
//------------------------------------------------------------------------------
procedure TForm1.EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  ErrCode := RegOpenKeyEx(
                          HKEY_LOCAL_MACHINE,
                          'HARDWARE\DEVICEMAP\SERIALCOMM',
                          0,
                          KEY_READ,
                          KeyHandle
                          );

  if ErrCode <> ERROR_SUCCESS then
    Exit;  // raise EComPort.Create(CError_RegError, ErrCode);

  TmpPorts := TStringList.Create;
  try
    Index := 0;
    repeat
      ValueLen := 256;
      DataLen := 256;
      SetLength(ValueName, ValueLen);
      SetLength(Data, DataLen);
      ErrCode := RegEnumValue(
                              KeyHandle,
                              Index,
                              PChar(ValueName),
                              Cardinal(ValueLen),
                              nil,
                              @ValueType,
                              PByte(PChar(Data)),
                              @DataLen
                              );

      if ErrCode = ERROR_SUCCESS then
      begin
        SetLength(Data, DataLen);
        TmpPorts.Add(Data);
        Inc(Index);
      end
      else
        if ErrCode <> ERROR_NO_MORE_ITEMS then
          exit; //raise EComPort.Create(CError_RegError, ErrCode);

    until (ErrCode <> ERROR_SUCCESS) ;

    TmpPorts.Sort;
    Ports.Assign(TmpPorts);
  finally
    RegCloseKey(KeyHandle);
    TmpPorts.Free;
  end;
end;
//------------------------------------------------------------------------------

procedure TForm1.Ca210Click(Sender: TObject);
begin
     if not Ca210On then
     begin
      ConnectCa210;
      Ca210.Caption := 'CA210';
      Shape1.Brush.Color := clGreen;
     end
    else
     begin
      DestroyConnect;
      Ca210.Caption := 'CA210';
      Shape1.Brush.Color := clRed;
     end;
end;
//------------------------------------------------------------------------------
procedure TForm1.ShowInf(Inf : String);
begin
    Form1.Memo1.Lines.Add('<<'+Inf);
    Form1.Memo1.Lines.Add('---------------------------------------------------------');

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.CompGamma(MaxLv,i : real;Step : Integer) : real;
begin
   result := StrToFloat(FormatFloat('#.00',(MaxLv / Power(100,i)) * Power(Step,i)));

  // a^b=c
    
 // c   :=   Power(a,b);
 // b   :=   ln(c)   /   ln(a);
 // a   :=   Power(c,1/b)
end;
//------------------------------------------------------------------------------
procedure TForm1.SendToPGPort(command : string);
begin
     if Com2On then
     begin
          SendStringToCom2(Command);
          Delay(200);
          SendStringToCom2(Command);
          Delay(200);
          ShowInf(Command);
     end
     else
     begin
          ShowMessage('Com2未打开');
          exit;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -