//============================================================================
unit TstFP;
//============================================================================
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ecrmini_TLB, StdCtrls, ExtCtrls;
const
   LIBID_ecrmini: TGUID = '{6BA29E5A-0176-4F17-94A8-8A57D7530720}';
   IID_It400: TGUID     = '{B1323744-EFA0-4D14-AD99-2C44718FCC99}';
   CLASS_t400: TGUID    = '{CCC213E0-B747-4FFC-9F45-30BC87ECB16E}';
   CR_LF   = #10#13;
type
  TForm1 = class(TForm)
    Panel2: TPanel;
    results: TMemo;
    Panel3: TPanel;
    Memo1: TMemo;
    Panel1: TPanel;
    bt_error: TButton;
    bt_event: TButton;
    bt_infoerr: TButton;
    bt_result: TButton;
    bt_mkCMD: TButton;
    Panel4: TPanel;
    Label1: TLabel;
    Panel5: TPanel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure bt_mkCMDClick(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
//    procedure CheckComServerInstalled(const CLSID: TGUID; const DllName: String);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SelLine(Index: integer);
    procedure Memo1Click(Sender: TObject);
    procedure bt_errorClick(Sender: TObject);
    procedure bt_eventClick(Sender: TObject);
    procedure bt_infoerrClick(Sender: TObject);
    procedure bt_resultClick(Sender: TObject);

   private
    { Private declarations }
//    libecr: IT400; // можна так
  public
    { Public declarations }
  end;
type TFake=class(TCustomMemo);

var
  Form1: TForm1;
  connected: Boolean;
  DllHandle: THandle;

  libecr: variant;   //IT400; // або так ...

implementation

{$R *.dfm}
{$R WindowsXP.res}
 uses  ComObj;
//
//============================================================================
function WideStringToString(const ws: WideString; codePage: Word): AnsiString;
//============================================================================
var
  l: integer;
begin
  if ws = '' then
    Result := ''
else
  begin
    l := WideCharToMultiByte(codePage,
      WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,
      @ws[1], -1, nil, 0, nil, nil);
    SetLength(Result, l - 1);
    if l > 1 then
      WideCharToMultiByte(codePage,
        WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,
        @ws[1], -1, @Result[1], l - 1, nil, nil);
  end;
end;
//
//========================================================================
function StringToWideString(const s: AnsiString; codePage: Word): WideString;
//============================================================================
var
  l: integer;
begin
  if s = '' then
    Result := ''
else
  begin
    l := MultiByteToWideChar(codePage, MB_PRECOMPOSED, PAnsiChar(@s[1]), -1, nil,
      0);
    SetLength(Result, l - 1);
    if l > 1 then
      MultiByteToWideChar(CodePage, MB_PRECOMPOSED, PAnsiChar(@s[1]),
        -1, PWideChar(@Result[1]), l - 1);
  end;
end;
//
//============================================================================
procedure TForm1.bt_mkCMDClick(Sender: TObject);
//============================================================================
var
 ff,k,val1:integer;
 ws:widestring;
 cc:Tpoint;
 WideCharPtr : PWideChar;
 curposnum: integer;
begin
if not connected then
  begin
   results.Lines.Append('Not connected with server');
   exit;
  end;
  ws := memo1.Lines.Strings[Memo1.CaretPos.Y]; // selected  string current pos cursor
 curposnum := Memo1.CaretPos.Y;
if  libecr.T400me(ws)  then
 begin
// with NO ERRORS
  results.Lines.Append(ws);
  Memo1.SetFocus;
 end
else
  begin
// with  ERRORS
if length(trim(ws))=0
 then results.Lines.Append('Error')
  else results.Lines.Append(ws);
   Memo1.SetFocus;
  end;
end;
//============================================================================
procedure TForm1.FormCreate(Sender: TObject);
//============================================================================
begin
 bt_mkCMD.hint :='Send command from active line (Commands window).'+CR_LF+
                  'Supported ECR - MINI-T 400ME  4101-1, MINI-T 400ME  4101-2.'+CR_LF+
                  '(Current version)';
// libecr :=  CreateComObject (CLASS_t400) as IT400; // можна так
   libecr := CreateOleObject('ecrmini.t400');         // Або так ...
   connected:=true;
end;
//============================================================================
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
//============================================================================
begin
if Key = VK_RETURN then // Если  Enter
 begin
  bt_mkCMD.Click;
 end;
end;
(*
//============================================================================
procedure TForm1.CheckComServerInstalled(const CLSID: TGUID; const DllName: String);
//============================================================================
var
  Size: Integer;
  FileName: String;
begin
     Size := MAX_PATH;
     SetLength(FileName, Size);
           try
                if RegQueryValue(HKEY_CLASSES_ROOT,
                     PChar(Format('CLSID\%s\InProcServer32',
                     [GUIDToString(CLSID)])), PChar(FileName), Size) = ERROR_SUCCESS then
                begin
                     SetLength(FileName, Size);
                     DllHandle := LoadLibrary(PChar(FileName));
                     FreeLibrary(DllHandle);
                     if DllHandle = 0 then begin
                          RegDeleteKey(HKEY_CLASSES_ROOT,
                               PChar(Format('CLSID\%s',[GUIDToString(CLSID)])));
                          RegisterComServer(DllName);
                     end;
           end else begin
                RegisterComServer(DllName);
           end;
        except
                raise Exception.CreateFmt('Cannot reg  %s.', [DllName]);
           end;
end;
*)
//
//============================================================================
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
//============================================================================
  Shift: TShiftState);
begin
if Key = VK_RETURN then // Если  Enter
 begin
 end;
end;
//============================================================================
Procedure TForm1.SelLine(Index: integer);
//============================================================================
begin
  with Memo1 do
    begin
      SelStart := Perform(EM_LINEINDEX, Index, 0);
      SelLength := Length(Lines[Index]);
      SetFocus;
    end;
end;
//============================================================================
procedure TForm1.Memo1Click(Sender: TObject);
//============================================================================
begin
 memo1.SetFocus;
end;
//============================================================================
procedure TForm1.bt_errorClick(Sender: TObject);
//============================================================================
begin
 results.Lines.Append(inttostr(libecr.Get_last_error));
end;
//============================================================================
procedure TForm1.bt_eventClick(Sender: TObject);
//============================================================================
begin
  results.Lines.Append(libecr.Get_last_event);
end;
//============================================================================
procedure TForm1.bt_infoerrClick(Sender: TObject);
//============================================================================
begin
  results.Lines.Append(libecr.Get_error_info);
end;
//============================================================================
procedure TForm1.bt_resultClick(Sender: TObject);
//============================================================================
begin
  results.Lines.Append(libecr.Get_last_result);
end;
//============================================================================
end.
