unit MainForm;

interface

uses
  ProtocolBase, GovProtocol, Funcs, BufferCL,  CmdByte,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActnList, ExtCtrls, ShellAPI, ToolWin, ComCtrls,
  Buttons, Menus, CheckLst;

const
  Retries = 100;

type

  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet3: TTabSheet;
    Memo2: TMemo;
    Memo1: TMemo;
    Panel1: TPanel;
    AddrList: TCheckListBox;
    Button4: TButton;
    Button1: TButton;
    MyAddrEdit: TEdit;
    MainMenu1: TMainMenu;
    Action1: TMenuItem;
    CloseAll1M: TMenuItem;
    Connect1M: TMenuItem;
    Timer1M: TMenuItem;
    RunClone1: TMenuItem;
    Streamstr1: TMenuItem;
    ActionList1: TActionList;
    AConect: TAction;
    ADisconect: TAction;
    ABrowse: TAction;
    AClearText: TAction;
    AConDecon: TAction;
    ATimmerOnOff: TAction;
    AWriteInfo: TAction;
    AClose: TAction;
    ACloseAll: TAction;
    ARunClone: TAction;
    Timer1: TTimer;
    Label1: TLabel;
    Memo3: TMemo;
    TabSheet2: TTabSheet;
    LInfo: TLabel;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure Timer1Timer(Sender: TObject);

    procedure AConectExecute(Sender: TObject);
    procedure ADisconectExecute(Sender: TObject);
    procedure ABrowseExecute(Sender: TObject);
    procedure AClearTextExecute(Sender: TObject);
    procedure AConDeconExecute(Sender: TObject);
    procedure ACloseExecute(Sender: TObject);
    procedure ACloseAllExecute(Sender: TObject);
    procedure ATimmerOnOffExecute(Sender: TObject);
    procedure AWriteInfoExecute(Sender: TObject);
    procedure ARunCloneExecute(Sender: TObject);

    procedure Action1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;      ARect: TRect; State: TOwnerDrawState);
    procedure MyAddrEditExit(Sender: TObject);
    procedure StatusBar1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure StatusBar1DblClick(Sender: TObject);

    procedure OnStateChange(Sender: TObject);
    procedure OnDataReceived(Sender: TObject);

    procedure SendFormSizeCmd(Sender: TObject);
    procedure SendTestCmd (Sender: TObject);
    procedure SendWriteCmd(Sender: TObject);
    procedure SendCloseCmd(Sender: TObject);
    procedure SendClearCmd(Sender: TObject);
    procedure AddrListClick(Sender: TObject);
  private
    { Private declarations }
    ToClose:boolean;
    Cnter: integer;
    Condition: boolean;
    FX, FY: integer;
  public
    { Public declarations }
    IO: TProtocolBase;
    tgt: TBArray;
    b_tgt: byte;
    procedure ShowMsg(s: TBArray);
    procedure FormResize(bf: TBArray);
    procedure FormMove(bf: TBArray);
    procedure FormMoveTo(bf: TBArray);

  end;

var
  Form1: TForm1;

{-----------------------------------------------------------------------------}
function PutText(Sender: TObject; s: String): Boolean;
{-----------------------------------------------------------------------------}
implementation
{$R *.dfm}
{-----------------------------------------------------------------------------}
function PutText(Sender: TObject; s: String): Boolean;
begin
  if Sender = nil then exit;
  Result:=true;
  if Sender is TCustomEdit then TCustomEdit(Sender).Text := s else
  if(Sender is TMenuItem)then TMenuItem(Sender).Caption := s else
  if(Sender is TLabel)then TLabel(Sender).Caption := s else
  if(Sender is TButton)then TButton(Sender).Caption := s
                       else Result:=false;
  s := Sender.ClassName;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
    IO := TGovProtocol.Create(Self, 'Chanels\Stream.str');
    IO.IDs[0]  := ToBAr('<To All>');
    IO.OnStateChange := OnStateChange;
    setLength(tgt, 0);
    b_tgt      := ToAll;
    ToClose    := false;
    Condition  := false;
    Top        := (Screen.Height-Height)div 2;
    Left       := (Screen.Width-Width)  div 2;
    AConectExecute(MainMenu1.Items[0].Items[1]);
    ATimmerOnOffExecute(Sender);
end;
{-----------------------------------------------------------------------------}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := IntToStr((IO as TGovProtocol).getState);
  OnDataReceived(Sender);  
  AWriteInfoExecute(Sender);
  if ToClose then ACloseExecute(Sender);
end;
{-----------------------------------------------------------------------------}
procedure TForm1.AConectExecute(Sender: TObject);
begin
   if not IO.Conect then
      ShowMessage('Nu ma pot conecta la ' + IO.FileName + '!')
   else
      PutText(Sender, 'Conected');
end;
{-----------------------------------------------------------------------------}
procedure TForm1.ADisconectExecute(Sender: TObject);
begin 
  Cnter := Retries * IO.MaxAddr; 
  while not IO.Disconect(Cnter=0) do dec(Cnter); 
  PutText(Sender, 'Disconected');
end;
{-----------------------------------------------------------------------------}
procedure TForm1.AConDeconExecute(Sender: TObject);
begin
  if IO.Conected then begin
    ADisconectExecute(Sender);
    PutText(Sender, '&Conect');
  end else begin
    AConectExecute(Sender);
    PutText(Sender, 'Dis&conect');
  end;
  AWriteInfoExecute(Sender);
end;
{-----------------------------------------------------------------------------}
procedure TForm1.ATimmerOnOffExecute(Sender: TObject);
begin
  Timer1.Enabled := not Timer1.Enabled;
  if Timer1.Enabled then PutText(Sender, 'Timer On')
                    else PutText(Sender, 'Timer Off');
  AWriteInfoExecute(Sender);
end;
{-----------------------------------------------------------------------------}
procedure TForm1.ABrowseExecute(Sender: TObject); var FN: String;
begin
  FN := IO.FileName;
  if PromptForFileName(FN,
                       '(str)|*.str|(txt)|*.txt', '*.str',
                       'Chose a streaming file',
                       '', True)
  then begin
     IO.Conect(FN);
     PutText(Sender, FN);
     AWriteInfoExecute(Sender);
  end;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.AClearTextExecute(Sender: TObject); begin (Sender as TCustomEdit).Clear; end;
{-----------------------------------------------------------------------------}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ACloseExecute(Sender);
  Action := caNone;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.Action1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; State: TOwnerDrawState);
begin
  if IO.Conected then PutText(Connect1M, 'Dis&connect')
                 else PutText(Connect1M, '&Connect');

  if Timer1.Enabled then PutText(Timer1M, 'Timer On')
                    else PutText(Timer1M, 'Timer Off');

end;
{-----------------------------------------------------------------------------}
procedure TForm1.MyAddrEditExit; begin  IO.ID := MyAddrEdit.Text; end;
{-----------------------------------------------------------------------------}
procedure TForm1.AWriteInfoExecute(Sender: TObject);
var i:word;
    s:string;
begin
  with IO do begin
    PutText(LInfo, '' +
    #13#10#9'~ TIOStream ~' + #13#10 +
    'Opened: '#9 + Bool2Str(Opened) + #13#10 +
    'Chanel: '#9 + FileName + #13#10 +
    'CycleCount:'#9 + IntToStr(CycleCount) + #13#10 +
    'NoReadCount:'#9 + IntToStr(NoReadCount) + #13#10 +
    'NoWriteCount:'#9 + IntToStr(NoWriteCount) + #13#10 +
    'Received:'#9 + IntToStr(ReadPackets) + #13#10 +
    'Sent:'#9#9 + IntToStr(WrittenPackets) + #13#10 +

    #13#10#9'~ TConnection ~' + #13#10 +
    'My Name: '#9 + ID + #13#10 +
    'My Address: '#9 + '$' + byte2str(MyAddr) + #13#10 +
    'Max Addr: '#9 + '$' + byte2str(MaxAddr) + #13#10 +
    'Connected:'#9 + TimeToStr(Time-ConectionTime) + #13#10 +
    'Reading: '#9 + Bool2Str(Reading) + #13#10 +
    'Writing: '#9 + Bool2Str(Writing) + #13#10 +
    'BaudRate:'#9 + IntToStr(BaudRate) + #13#10 +
    '');
  end;

  with StatusBar1 do begin
    if IO.Conected then begin
       Panels[0].Text   := 'Connected';
    end else begin
       Panels[0].Text := 'Disconnected';
    end;
    if Timer1.Enabled then Panels[1].Text := 'Timer On'
                      else Panels[1].Text := 'Timer Off';
    Panels[2].Text := 'Addr: '+byte2str(IO.MyAddr);
    Panels[3].Text := IntToStr(IO.CycleCount);
    if IO.Writing then
       Panels[4].Text := 'Writing'
    else if IO.Reading then
       Panels[4].Text := 'Reading'
    else
       Panels[4].Text := '...';

    AddrListClick(Sender);
    if MyAddrEdit.Text <> IO.ID then IO.ID := MyAddrEdit.Text;
  end;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.ACloseExecute(Sender: TObject);
begin
  if not ToClose then begin
    ToClose := true;
    Cnter   := IO.BaudRate div Timer1.Interval * IO.MaxAddr * 2;
    if IO.Conected then begin
       IO.Send(cmd_stop, 1, ToAll);
       IO.SendNow(cmd_stop, 1, ToAll);
    end;
  end;
  if not IO.Disconect then Application.Minimize;
  if IO.Disconect(Cnter=0) then Application.Terminate;
  dec(Cnter);
end;
{-----------------------------------------------------------------------------}
procedure TForm1.ACloseAllExecute(Sender: TObject);
begin
  if IO.Conected then
      if length(tgt)=0 then IO.Send(cmd_write, cmd_close, ToAll);
  ToClose := true;
  ACloseExecute(Sender);
end;
{-----------------------------------------------------------------------------}
procedure TForm1.StatusBar1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin FX := X;  FY := y; end;
procedure TForm1.StatusBar1DblClick(Sender: TObject);
var PanelNr: byte;
    X: integer;
    P: Pointer;
begin
    PanelNr := 0;
    X := 0;
    repeat
      inc(X, StatusBar1.Panels.Items[PanelNr].Width);
      inc(PanelNr);
    until (FX < X) or (StatusBar1.Panels.Count = PanelNr);
    P:= StatusBar1.Panels.Items[PanelNr-1];
    case PanelNr of
    1:AConDeconExecute(P);
    2:ATimmerOnOffExecute(P);
    3:;
    4:IO.ResetCycleCount;
    5:ABrowseExecute(P);
    end;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.ARunCloneExecute(Sender: TObject); begin ShellExecute(0, 0, PChar(ParamStr(0)), 0, 0, 0); end;
{-----------------------------------------------------------------------------}
procedure TForm1.OnStateChange(Sender: TObject);
begin
  if Timer1.Enabled then with Sender as TProtocolBase do Memo3.Lines.Append(StateMsg);
end;
{-----------------------------------------------------------------------------}
procedure TForm1.OnDataReceived(Sender: TObject);
var i:  word;
    bf: TBArray;
    cmd, src: byte;
begin
  with IO.RSBuf do while ready <> 0 do begin
     bf  := Each;
     i   := length(bf)-1;
     cmd := ShiftBAr(bf, 1);
     src := bf[i];
//      setlength(bf, i); // sometimes its' required
     case cmd of
        cmd_close        : Close;
        cmd_write        : ShowMsg(bf);
        cmd_clear        : AClearTextExecute(Memo2);
        cmd_set_form_size: FormResize(bf);
        cmd_get_on_top   : ;
        else PutText(Memo2, 'Unknown cmd: $'+byte2str(cmd));
     end;
  end;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.SendTestCmd;
var t: byte;
begin
  if Length(tgt) = 1 then t := tgt[0] else t := ToAll;
  with IO do begin
    SendType(cmd_write, 'Testare codif/decodif:', t); // String
    SendTime(cmd_write, Time, t);              // TDateTime
    SendType(cmd_write, MyAddr, t);            // byte
    SendType(cmd_write, 'Q', t);               // char
    SendType(cmd_write, word($FFFF), t);       // word
    SendType(cmd_write, -1, t);                // integer
    SendType(cmd_write, $FFFFFFFF, t);         // longword
    SendType(cmd_write, 123.456789, t);        // double / real
  end;                                  
end;                                    
{-----------------------------------------------------------------------------}
procedure TForm1.SendWriteCmd;          
begin                                   
  if Length(tgt)=0 then IO.SendType(cmd_write, Memo1.Text)
                   else IO.ListSendType(cmd_write, Memo1.Text, tgt);
  Memo1.Clear;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.SendCloseCmd;
begin
  if length(tgt)=0 then IO.Send(cmd_Data, cmd_close)
                   else IO.ListSend(cmd_Data, cmd_close, tgt);
end;
{-----------------------------------------------------------------------------}
procedure TForm1.SendClearCmd;
begin
  if Length(tgt)=0 then IO.Send(cmd_Data, cmd_clear)
                   else IO.ListSend(cmd_Data, cmd_clear, tgt);
end;
{-----------------------------------------------------------------------------}
procedure TForm1.SendFormSizeCmd;
begin
  if Length(tgt)=0 then IO.Send(cmd_set_form_size, Join(ToBar(word(Width)), ToBar(word(Height))) )
                   else IO.ListSend(cmd_set_form_size, Join(ToBar(word(Width)), ToBar(word(Height))), tgt);
end;
{-----------------------------------------------------------------------------}
procedure TForm1.ShowMsg;
var src, t: byte;
    msg: string;
    BAr: TBArray;
begin
  src := PopBAr(s);
  t   := ShiftBAr(s, 1);
  Memo2.Lines.Append(BAr2Str(IO.IDs[src])+':');
  case t of
  cmd_Byte    : msg := byte2str(BAr2Word(s)and $FF);
  cmd_Word    : msg := IntToStr(BAr2Word(s));
  cmd_Int     : msg := IntToStr(BAr2Int(s));
  cmd_LongWord: msg := IntToStr(BAr2LongWord(s));
  cmd_Char    : msg := chr(BAr2Word(s)and $FF);
  cmd_String  : msg := BAr2Str(s);
  cmd_Time    : msg := TimeToStr(BAr2Double(s));
  cmd_Double  : msg := FloatToStr(BAr2Double(s));
  else          msg := 'Unknown #'+byte2str(t);
  end;
  Memo2.Lines.Append(msg);
  Memo2.Lines.Append('~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
end;
{-----------------------------------------------------------------------------}
procedure TForm1.FormResize;
var w, h: integer;
begin
  w := ShiftBAr(bf, 2);
  h := ShiftBAr(bf, 2); 
  if w > 0 then Width  := w;
  if h > 0 then Height := h;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.FormMove;
var dx, dy: integer;
begin
  dx := integer(BAr2Word(bf, 0, 2));
  dy := integer(BAr2Word(bf, 2, 2));
  Left := Left+dx;
  Top  := Top+dy;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.FormMoveTo;
var x, y: integer;
begin
  x := integer(BAr2Word(bf, 0, 2));
  y := integer(BAr2Word(bf, 2, 2));
  Left := x - Width  div 2;
  Top  := y - Height div 2;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.AddrListClick(Sender: TObject);
var i: integer;
    s: string;
begin
    with AddrList do begin
      setLength(tgt,0);
      while Count <= IO.MaxAddr do Items.Append('');
      while Count-1 > IO.MaxAddr do Items.Delete(AddrList.Count-1);
      i := Count;
      while i > 0 do begin
        Dec(i);
        if Checked[i] then IncBAr(tgt, 1, i);
        s := BAr2Str(IO.IDs[i]);
        if s='' then s := byte2str(i);
        if Items.Strings[i] <> s then Items.Strings[i] := s;
      end;
      if Checked[0] then SetLength(tgt,0);
    end;
end;

end.