{ Расширение для форм программы управления масс-спектрометром МИ-1201 АГМ}
{---------------------------------------------------------------------------
The control program for mass-spectrometer MI1201-AGM
(c) Copyright	 Aleksandrov O.E., 2001

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

Программа управления масс-спектрометром МИ1201-АГМ
(c) Собственность     Александрова О.Е., 2001

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
unit MCAD_MI1201_XForm;

interface

uses
  Registry, Windows, Messages, SysUtils,
  Classes, Controls, Forms, StdCtrls,
  xSystem, xRegistry,
  MCAD_MI1201_Registry,
  MCAD_MI1201_Thread0, MCAD_MI1201_Thread, MCAD_MI1201_Thread_Types;

  resourcestring rsInvalidNumberTitle='Неправильное число';
  resourcestring rsInvalidNumber='Введено неправильное число или недопустимое значение!'+cEOL+cEOL
                                  +'Проверьте:'+cEOL
                                  +'1) В целом числе допустимы только цифры.'+cEOL
                                  +'2) В числе с плавающей точной допустим показатель степени "E" и десятичный разделитель "%s".'+cEOL
                                  +  #09'Например, "100%s1234509E-20"'+cEOL
                                  +'3) В числе допустим разделитель тысяч, но при вводе его лучше не использовать.';
type
  TXForm0 = class(TForm)
    protected

      procedure RegistryClose;
      function  RegistryOpenForRead:boolean;
      function  RegistryOpenForWrite:boolean;
      function  RegistryOpenForReadSubKey(SubKey:string):boolean;
      function  RegistryOpenForWriteSubKey(SubKey:string):boolean;
      procedure RegistryReadForm;
      procedure RegistryWriteForm;
      procedure RegistryReadComboBox0(AComboBox:tComboBox);
      procedure RegistryWriteComboBox(AComboBox:tComboBox);
      function GetRegistry:tRegistry;
      property prRegistry:tRegistry read GetRegistry;
      property Registry:tRegistry read GetRegistry;
      function  MessageBox(Text:string; Caption:string; Style:uint):integer;
      procedure Msg_InvalidNumber;
      function StrToInt_MSG(s:string):integer;
      function StrToFloat_MSG(s:string):extended;
    public
      { Public declarations }
  end;

const
  CM_EXECPROC = $8FFF;
  CM_EXECPROC_EX = $8FFF+1;

type
  tMassNotifyReason=(nrAttach, nrDetach, nrDetachOnExcept, nrMass);
  tMassNotifyAnsver=(naOK, naCancel, naDoNotDetach);
  tMassNotifyEvent=function(Sender:TObject; Reason:tMassNotifyReason; Mass:double):tMassNotifyAnsver of object;

  TCMExecute=packed record
    Msg: Cardinal;
    Method:TThreadMethod;
  end;

  TCMExecute_EX=packed record
    Msg: Cardinal;
    ProcPtr:Pointer;
    DataPtr:Pointer;
  end;

  TThreadMethod_Ex = procedure(Ptr:pointer) of object; register;

  TMethodOfObject=packed record
    ProcPtr:pointer;
    Obj:TObject;
  end;

  TXForm = class(TXForm0)
    protected
      prMassSpectrometer:tMsThread;
      prNotifyData:tMI1201_Thread_NotifyData;
      prMainFormTreadID:THandle;
      prMsSpDestroyed:boolean;

      procedure CMExecute(var Message:TCMExecute); message CM_EXECPROC;
//      procedure CMExecute_EX(var Message:TCMExecute_EX); message CM_EXECPROC_EX;
      function Synchronize(Method: TThreadMethod):boolean;
//      procedure SynchronizeEx(Method: TThreadMethod_Ex; DataPtr:pointer);
      function  MainThread:boolean;
      procedure NotifyHandler(Sender:TObject; Event:tMI1201_Thread_Event); virtual; abstract;
      procedure MassSpectrometerSet(const MassSpectr:tMsThread); virtual;
      procedure MassSpectrometerNIL;
      procedure MessageBoxMSIsOFF;
      procedure MessageBoxMSIsERROR;
      function  MessageBoxError:integer;
      procedure ProcessMassSpectrometerSet;
    public
      { Public declarations }
      constructor Create(AOwner:tComponent); override;
      destructor Destroy; override;
      procedure ProcessMessages;
      property MassSpectrometer:tMsThread read prMassSpectrometer write MassSpectrometerSet default NIL;
      function MsValid:boolean;
      function MsON:boolean;
      function MsERROR:boolean;
      function MsERROR_WithMsg:boolean;
      function MsON_WithMsg:boolean;
      function MsOK_WithMsg:boolean;
      procedure ClearAll;
      function NotVisible:boolean;
  end;

procedure AddTextToStringsList0(AComboBox:tComboBox);
procedure AddTextToStringsList1(AComboBox:tComboBox);

procedure AddTextToStringsListIfNotExist0(AComboBox:tComboBox);

procedure AddTextToStringsListIfNotExistAndMoveUp1(AComboBox:tComboBox);

implementation

var
  vRegistry:tRegistry=NIL;

function TXForm0.GetRegistry:tRegistry;
begin
  if not Assigned(vRegistry) then begin
    try
      vRegistry:=tRegistry.Create;
    except
      vRegistry:=NIL;
    end;
  end;
  Result:=vRegistry;
end;


procedure AddTextToStringsListIfNotExist(AComboBox:tComboBox; APos:Integer);
begin
  if AComboBox.Items.IndexOf(AComboBox.Text)=-1 then begin
    if AComboBox.Items.Count>=AComboBox.DropDownCount then begin
      AComboBox.Items.Delete(Pred(AComboBox.Items.Count));
    end;
    if APos>AComboBox.Items.Count then
      APos:=AComboBox.Items.Count;
    if (APos=AComboBox.Items.Count) or (AComboBox.Items[APos]<>AComboBox.Text) then
      AComboBox.Items.Insert(APos,AComboBox.Text);
  end;
end;

procedure AddTextToStringsListIfNotExistAndMoveUp(AComboBox:tComboBox; APos:Integer);
  var i:integer;
begin
  i:=AComboBox.Items.IndexOf(AComboBox.Text);
  if (i=-1) then begin
    if AComboBox.Items.Count>=AComboBox.DropDownCount then begin
      AComboBox.Items.Delete(Pred(AComboBox.Items.Count));
    end;
    if APos>AComboBox.Items.Count then
      APos:=AComboBox.Items.Count;
    if (APos=AComboBox.Items.Count) or (AComboBox.Items[APos]<>AComboBox.Text) then
      AComboBox.Items.Insert(APos,AComboBox.Text);
  end else if (i<>APos) then begin
    AComboBox.Items.Insert(APos,AComboBox.Text);
    AComboBox.Items.Delete(Succ(i));
  end;
end;

procedure AddTextToStringsListIfNotExistAndMoveUp1(AComboBox:tComboBox);
begin
  AddTextToStringsListIfNotExistAndMoveUp(AComboBox,1);
end;

procedure AddTextToStringsListIfNotExist0(AComboBox:tComboBox);
begin
  AddTextToStringsListIfNotExist(AComboBox,0);
end;

procedure AddTextToStringsList(AComboBox:tComboBox; APos:integer);
begin
  if AComboBox.Items.IndexOf(AComboBox.Text)=-1 then begin
    if AComboBox.Items.Count>=AComboBox.DropDownCount then begin
      AComboBox.Items.Delete(Pred(AComboBox.Items.Count));
    end;
    if APos>AComboBox.Items.Count then
      APos:=AComboBox.Items.Count;
    AComboBox.Items.Insert(APos,AComboBox.Text);
  end;
end;

procedure AddTextToStringsList0(AComboBox:tComboBox);
begin
  AddTextToStringsList(AComboBox,0);
end;

procedure AddTextToStringsList1(AComboBox:tComboBox);
begin
  AddTextToStringsList(AComboBox,1);
end;

procedure TXForm0.RegistryReadComboBox0(AComboBox:tComboBox);
begin
  try
    AComboBox.Text:=prRegistry.ReadString(AComboBox.Name);
    AComboBox.Items.Text:=prRegistry.ReadString(AComboBox.Name+'.Text');
  except end;
end;

procedure TXForm0.RegistryWriteComboBox(AComboBox:tComboBox);
begin
  try
    prRegistry.WriteString(AComboBox.Name,AComboBox.Text);
    prRegistry.WriteString(AComboBox.Name+'.Text',AComboBox.Items.Text);
  except end;
end;

procedure TXForm.MassSpectrometerSet(const MassSpectr:tMsThread);
begin
  if MassSpectr=MassSpectrometer then Exit;
  if Assigned(MassSpectrometer) then begin
    if not prMsSpDestroyed then try
      MassSpectrometer.NotifyDel(prNotifyData);
    except end;
  end;
  prMassSpectrometer:=MassSpectr;
  if Assigned(MassSpectrometer) then begin
    prMsSpDestroyed:=FALSE;
    MassSpectrometer.NotifyAdd(prNotifyData);
  end else begin
  end;
  Synchronize(ProcessMassSpectrometerSet);
end;

procedure TXForm.MassSpectrometerNIL;
begin
  MassSpectrometer:=NIL;
end;

function TXForm.MsValid;
begin
  Result:=Assigned(MassSpectrometer);
end;

function TXForm.MsON;
begin
  Result:=MsValid and MassSpectrometer.IsON;
end;

function TXForm.MsERROR;
begin
  Result:=not MsValid or MassSpectrometer.IsERROR;
end;

function TXForm.MsON_WithMsg:boolean;
begin
  Result:=MsON;
  if not Result then begin
    MessageBoxMsIsOFF;
  end;
end;

function TXForm.MsERROR_WithMsg:boolean;
begin
  Result:=MsERROR;
  if Result then begin
    MessageBoxMsIsERROR;
  end;
end;

function TXForm.MsOK_WithMsg:boolean;
begin
  Result:=MsON_WithMsg;
  if Result then begin
    Result:=MassSpectrometer.IsNoError;
    if not Result then begin
      MessageBoxError;
    end;
  end;
end;

constructor TXForm.Create;
begin
  Inherited;
  prMainFormTreadID:=GetCurrentThreadID;
  prNotifyData:=tMI1201_Thread_NotifyData.Create;
  prNotifyData.NotiFyHandler:=NotifyHandler;
end;

destructor TXForm.Destroy;
begin
  prNotifyData.Free;
  Inherited;
end;

function TXForm0.RegistryOpenForWriteSubKey(SubKey:string):boolean;
begin
  result:=RegistryOpenForWrite;
  if Result then begin
    Result:=prRegistry.OpenKey(SubKey,TRUE);
  end;
end;

function TXForm0.RegistryOpenForWrite:boolean;
begin
//  if not Assigned(prRegistry) then prRegistry:=tRegistry.Create(KEY_WRITE);
  prRegistry.RootKey:=HKEY_CURRENT_USER;
  prRegistry.Access:=KEY_WRITE;
  Result:=prRegistry.OpenKey(cRegistryKeyForms+'\'+Name,TRUE);
end;

procedure TXForm0.RegistryWriteForm;
begin
  if Assigned(Self) and RegistryOpenForWrite then begin
    try
      prRegistry.WriteInteger('Left',Left);
      prRegistry.WriteInteger('Top',Top);
      prRegistry.WriteBool('ShowHints',ShowHint);
      if Assigned(ActiveControl) then
        prRegistry.WriteInteger('ActiveControlIndex',ActiveControl.ComponentIndex);
    except end;
    prRegistry.CloseKey;
  end;
end;

function  TXForm0.RegistryOpenForReadSubKey(SubKey:string):boolean;
begin
  result:=RegistryOpenForRead;
  if Result then begin
    Result:=prRegistry.OpenKeyReadOnly(SubKey);
  end;
end;

procedure TXForm0.RegistryClose;
begin
  prRegistry.CloseKey;
end;

function TXForm0.RegistryOpenForRead:boolean;
begin
//  if not Assigned(prRegistry) then prRegistry:=tRegistry.Create(KEY_READ);
  prRegistry.RootKey:=HKEY_CURRENT_USER;
  Result:=prRegistry.OpenKeyReadOnly(cRegistryKeyForms+'\'+Name);
  if not Result then begin
    prRegistry.RootKey:=HKEY_LOCAL_MACHINE;
    Result:=prRegistry.OpenKey(cRegistryKeyForms+'\'+Name,FALSE);
  end;
end;

procedure TXForm0.RegistryReadForm;
  var i:integer;
begin
  if RegistryOpenForRead then
  try
    try
      Left:=prRegistry.ReadInteger('Left');
      if (Left<0) then Left:=0;
      if ((Left+Width)>Screen.Width) then Left:=Screen.Width-Width;
    except end;
    try
      Top:=prRegistry.ReadInteger('Top');
      if (Top<0) then Top:=0;
      if ((Top+Height)>Screen.Height) then Top:=Screen.Height-Height;
    except end;
    ShowHint:=prRegistry.ReadBoolDef('ShowHints',ShowHint);
    try
      i:=prRegistry.ReadInteger('ActiveControlIndex');
      if Components[i].InheritsFrom(TWinControl)
        and TWinControl(Components[i]).CanFocus then begin
        ActiveControl:=TWinControl(Components[i]);
      end;
    except end;
  finally
    prRegistry.CloseKey;
  end;
end;

function TXForm.MessageBoxError:integer;
  resourcestring rsTitle='Описание ошибки драйвера МИ-1201 АГМ';
begin
   Result:=IDCANCEL;
   if Assigned(MassSpectrometer) then begin
     if MassSpectrometer.Error<>ecOK then begin
       Result:=MessageBox(MassSpectrometer.ErrorMsg
                      +#13'_______________________________'
                      +#13#13'Пока драйвер находится в состоянии ошибки никакие операции невозможны.'
                      +#13'_______________________________'
                      +#13#13'Сбросить состояние ошибки?',rsTitle,
                           MB_YESNO+MB_ICONINFORMATION);
       if IDYES=Result then begin
          prMassSpectrometer.ResetError;
       end;
     end;
   end;
end;

function TXForm0.MessageBox(Text:string; Caption:string; Style:uint):integer;
  var OldFormStyle:tFormStyle;
begin
  OldFormStyle:=FormStyle;
  try
    FormStyle:=fsStayOnTop;
  except end;
  Result:=Windows.MessageBox(Handle, Pchar(Text),Pchar(Caption),Style);
  FormStyle:=OldFormStyle;
end;

function TXForm.MainThread:boolean;
begin
  Result:=(prMainFormTreadID=GetCurrentThreadID);
end;

function TXForm.Synchronize(Method: TThreadMethod):boolean;
begin
  if MainThread then begin
    Method;
    Result:=TRUE;
  end else begin
    Result:=PostMessage(Self.Handle, CM_EXECPROC,
                Longint(TMethodOfObject(Method).ProcPtr),
                Longint(TMethodOfObject(Method).Obj));
  end;
end;

(*procedure TXForm.SynchronizeEx(Method: TThreadMethod_Ex; DataPtr:pointer);
begin
  if MainThread then begin
    Method(DataPtr);
  end else begin
    PostMessage(Handle, CM_EXECPROC_EX,
                Longint(TMethodOfObject(Method).ProcPtr),
                Longint(DataPtr));
  end;
end;*)

procedure TXForm.CMExecute(var Message:TCMExecute);
begin
  try
    Message.Method;
  except end;
end;

(*procedure TXForm.CMExecute_EX(var Message:TCMExecute_EX);
  var Method:TMethodOfObject;
begin
  Method.ProcPtr:=Message.ProcPtr;
  Method.Obj:=Self;
  try
    TThreadMethod_Ex(Method)(Message.DataPtr);
  except end;
end;*)

procedure TXForm.ProcessMessages;
begin
  if not Assigned(Owner) then Exit;
  if not Owner.InheritsFrom(tApplication) then Exit;
  tApplication(Owner).ProcessMessages;
end;

procedure TXForm.MessageBoxMSIsOFF;
  resourcestring rsTitle='Масс-спектрометр НЕ ВКЛЮЧЕН!';
  resourcestring rsText=  '  Операция недоступна.';
begin
  MessageBox(rsText, rsTitle, MB_OK+MB_ICONINFORMATION);
end;

procedure TXForm.MessageBoxMSIsERROR;
  resourcestring rsTitle='Масс-спектрометр ОШИБКА!';
  resourcestring rsText=  '  Операция недоступна.';
begin
  MessageBox(rsText, rsTitle, MB_OK+MB_ICONINFORMATION);
end;

procedure TXForm.ClearAll;
  resourcestring
     rsTitle='Очистка данных измерения';
     rsText1='ВНИМАНИЕ! ВСЕ данные будут удалены. Восстановление данных невозможно.'+
             #13'____________'+
            #13#13'Выполнить операцию?';
begin
  if not Assigned(MassSpectrometer) then Exit;
  if IDYES=MessageBox(rsText1,rsTitle,MB_YESNO+MB_ICONQUESTION)  then begin
    MassSpectrometer.Clear;
  end;
end;

procedure TXForm0.Msg_InvalidNumber;
begin
  MessageBox(
    Format(rsInvalidNumber,[DecimalSeparator,DecimalSeparator]),
    rsInvalidNumberTitle,
    MB_OK+MB_ICONWARNING
  );
end;

function TXForm0.StrToInt_MSG(s:string):integer;
begin
  try
    Result:=StrToInt(s);
  except
    Msg_InvalidNumber;
    Raise;
  end;
end;

function TXForm0.StrToFloat_MSG(s:string):extended;
begin
  try
    Result:=StrToFloat(s);
  except
    Msg_InvalidNumber;
    Raise;
  end;
end;

function TXForm.NotVisible:boolean;
begin
  Result:=(not Visible)  or (WindowState=wsMinimized);
end;

procedure TXForm.ProcessMassSpectrometerSet;
begin
  Enabled:=Assigned(MassSpectrometer);
end;

initialization
finalization
  FreeAndNil(vRegistry);
end.