(*
*******************************************************************************
*         Copyright (C) SofCon 2003 All Rights Reserved                       *
*******************************************************************************
*
*    project:     Testy - ChnCan2
*
*    title:       DebWin.pas
*
*******************************************************************************
*
*    description: Jednotka implementuje praci s okny
*
*    version:     1.00
*    language:    Borland Pascal
*
*    author:      Hvozdovic
*    history:     date      sign   remark
*                 7.03      hv     start of development
*****************************************************************************
*)
{$I Sets.inc}
unit DebWin;
interface
uses
  Crt,
  _CrtWin;

const
 {ukazatele na ladici okna}
  pError   : pCrtWin = nil; { okno s chybami }
  pReceive    : pCrtWin = nil; { okno prijmu }

 {rozmery ladicich oken}
  cOutputRect   : tRect = (X: 2; Y: 5; W:78; H:8);
  cRecRect     : tRect = (X: 2; Y:15; W:78; H:23);

 {barvy oken a tvary kurzoru}
  cColWinFrame  = (Black shl 4) or LightGray; {barva ramecku oken}
  cColWinHeader = (Black shl 4) or White;     {barva nadpisu okna}
  cColWinText   = (Black shl 4) or LightGray; {barva normalniho textu v oknech}
  cColWinTextZv = (Black shl 4) or White;     {barva zvyrazneneho textu v oknech}
  cColWinCur    = (LightGray shl 4) or White; {barva zvyrazneneho textu v oknech se zvyraznenym podkladem}
  cCur1         = $20;
  cCur2         = $00;

procedure InitDebVyp;
procedure DoneDebVyp;


implementation
uses
  Timer,
  ChnVirt,
  NumToStr,
  Strings;


{-----------------------------------------------------------------------}
procedure WriteFreeMem; {vypis velikosti volne pameti}
begin
  MainWin^.LockWin;
   gotoxy(64,1); TextAttr:=cColWinTextZv;
   write('Free Mem:',MemAvail:8);
  MainWin^.UnLockWin;
end;

{-----------------------------------------------------------------------}
procedure WriteClock;
begin
  MainWin^.LockWin;
   gotoxy(64,2); TextAttr:=cColWinText;
   write(DateToStrPT(GetPackTime,'DD.MM.YY'),' ',TimeToStrPT(GetPackTime,'HH:MM:SS'));
  MainWin^.UnLockWin;
end;

{-----------------------------------------------------------------------}
procedure InitDebVyp;
var
  addr:LongInt;
label
  pom;
begin
  TextMode(Lo(LastMode)+Font8x8);
                         { na pridavnem VGA monitoru zmeni rezim na 80x50 }
  { inicializace vypisoveho prostredi }
  CrtInit;
  MainWin^.LockWin;
  MainWin^.HiddenCursor;
  TextAttr:=cColWinTextZv;
  ClrScr;
  write('COTest'); {:',Hi(word(VerApp)),'.',Lo(word(VerApp)),' ',DateToStrPT(VerApp,'DD.MM.YYYY'));}
  asm
    call far ptr pom
pom:
    pop ax
    mov word ptr [addr], ax
    pop ax
    mov word ptr [addr+2], ax
  end;
  write(' - ', LongintStrHex(addr));
  TextAttr:=cColWinText;
  MainWin^.UnLockWin;
  { okno vystupu }
  pError:=New(PCrtWin,Init(cOutputRect,' Error ',FrameD,
             cColWinHeader,cColWinFrame,cColWinText,cCur1,cCur2));
  pError^.LockWin;
  ClrScr;
  pError^.UnLockWin;
  { okno SLAVE }
  pReceive:=New(PCrtWin,Init(cRecRect,' Receive ',FrameD,
             cColWinHeader,cColWinFrame,cColWinText,cCur1,cCur2));
  pReceive^.LockWin;
  ClrScr;
  pReceive^.UnLockWin;
  WriteClock;
  WriteFreeMem;
end;

{-----------------------------------------------------------------------}
{$S-}
procedure DoneDebVyp;
begin
  if pError<>nil then Dispose(pError, Done); pError:=nil;
  if pReceive<>nil   then Dispose(pReceive, Done); pReceive:=nil;
  CrtClose;
end;
{$S+}

End.