Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 12 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

ООП библиотека для создания окошек в косольных приложениях



unit ConsoleVision;

interface uses Windows, Classes;

const
   SIZECONSOLEX : word = 80;
   SIZECONSOLEY : word = 25;

   clForeWhite =  FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE or FOREGROUND_INTENSITY;
   clBackWhite =  BACKGROUND_RED or BACKGROUND_GREEN or BACKGROUND_BLUE or BACKGROUND_INTENSITY;
   clForeLightGrey =  FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE;
   clBackLightGrey =  BACKGROUND_RED or BACKGROUND_GREEN or BACKGROUND_BLUE;
   clForeGrey =  FOREGROUND_INTENSITY ;
   clBackGrey =  BACKGROUND_INTENSITY ;

   clAccel          =  FOREGROUND_RED;
   clDefaultButton  =  FOREGROUND_BLUE  or BACKGROUND_RED;
   clButton         =  FOREGROUND_BLUE  or BACKGROUND_GREEN;
   clCheckBox       =  FOREGROUND_BLUE  or BACKGROUND_GREEN;
   clFocusedCheckBox=  FOREGROUND_RED   or BACKGROUND_GREEN;
   clEdit           =  FOREGROUND_RED   or BACKGROUND_GREEN;
   clEditSelected   =  FOREGROUND_BLUE  or BACKGROUND_RED;
   clEditScroll     =  FOREGROUND_GREEN or BACKGROUND_BLUE;
   clRadio          =  FOREGROUND_BLUE  or BACKGROUND_GREEN;
   clFocusedRadio   =  FOREGROUND_RED   or BACKGROUND_GREEN;
   clFrameCaption   =  clForeWhite or clBackLightGrey;
   clFrameButton    =  FOREGROUND_GREEN or FOREGROUND_INTENSITY or clBackLightGrey;
   clDialog         =  clBackLightGrey;
   clFrame          =  clForeWhite or clBackLightGrey;
   clShadow         =  clForeGrey;

   //////////  handlered commands ///////////////
   cmOK          = 2000;
   cmNothingToDo = 2001;
   cmAddItem     = 2002;
   cmDeleteItem  = 2003;
   cmChangeFocus = 2004;   // SenderName = кому пришел фокус
   cmRedraw      = 2005;   // приходит в группу
   cmClose       = 2006;   // приходит в группу
   cmMoveWindow  = 2007;
   cmRadioPressed= 2008;   // приходит в группу lpReserved = tRadioButton
   cmRedrawAll   = 2009;   // приходит в console
   cmSetMonopoly = 2010;   // приходит в AllItemsColl;
   cmReSetMonopoly = 2011; // приходит в AllItemsColl;
   cmGetCoord    = 2012;
   cmShowCursor  = 2013;  // LpReserved = boolean;
   cmHideCursor  = 2014;
   cmSetCursor   = 2015;   // lpReserved = ^TPoint;
   //////// user commands ///////////////
   cmTest        = 3000;
   cmMove        = 3001;

   ////////// events ////////////////////
   evNothing = 0;
   evBroadCasting = 1;
   evCommand = 2;

   ///////////// dialog and group options ////////////////
   opSingleFrame = $0001;
   opDoubleFrame = $0002;
   opCloseButton = $0004;
   opWithCaption = $0008;
   opDragAllowed = $0010;
   opFillBackGnd = $0020;
   opKeepBackGnd = $0040;

   ////////////////////// for internal use ///////////////////////////
   WithFrame   = $001F;
   ALT_PRESSED = $03;

   //////////////////////////cursor/////////////////////
   cInvisible: TCONSOLECURSORINFO = ( dwSIze:99 ; bVisible:false);
   cVisible01: TCONSOLECURSORINFO = ( dwSIze:1 ; bVisible:true);
   cVisible10: TCONSOLECURSORINFO = ( dwSIze:99 ; bVisible:true);

   ////////////////////// backbuffer ///////////////////////
   bkBuffNotPresent = 0;
   bkBuffPresent = 1;
   bkNeedRedraw = 2;

type
   TRect = record
    case Integer of
      0: (Left, Top, Right, Bottom: Integer);
      1: (TopLeft, BottomRight: TPoint);
      2: (X, Y, Width, Height: Integer);
    end;

   tpChar = array[0..0] of tCharInfo;     // screen buffer
   lpChar = ^tpChar;                      //

   tpCont = array[0..0,0..0] of tCharInfo;     // screen buffer
   lpCont = ^tpCont;                      //

   pEvent = ^tEvent;
   tEvent = record
               SenderName,
               ReceiverName : string;
               case What:word of
                  evBroadCasting :
                  (
                     Command      : word;
                     lpReserved   : Pointer;  // LongInt
                  );
                  evCommand :
                  (
                     INPUT        : tInputRecord;
                  );
            end;

//   pItem = ^tItem;
   tItem = class
           protected
              name : shortstring;
              accel : char;
              Size : TRect;
              Owner : tItem;
              Attr : Word;
              Tabbed: boolean;
              CanFocus: boolean;
              procedure SendMessageTo(Event : tEvent); virtual;
              procedure HandleEvent(var Event : tEvent); virtual;
              function  PointInRect(P : tCoord): boolean; virtual;
              procedure SetFocus; virtual;
              procedure LostFocus;  virtual;
              function  GetCoordInScreenRect: TRect; virtual;
           public
              focus: boolean;
              function FormMessage(sName, rName : string; evComm : word; lpRes : pointer): tEvent;
              procedure DirectDraw;  virtual;
              procedure Draw(lpBuff: lpChar; RectSize: tPoint); virtual;
              // дает адрес буфера в котором надо рисовать и размеры
              // этого буфера
              constructor create(aName : string; A: word; R : tRect; aOwner : tItem);
              destructor destroy; override;
           private
              bufpresent : byte;
              backbuf : lpChar;
           end;

   pStatic = ^tStatic;
   tStatic = class(tItem)
           private
              data : string;
           public
              procedure SetData(aData : string);
              function GetData: string;
              procedure Draw(lpBuff: lpChar; RectSize: tPoint);  override;
              constructor create(aName : string; A: word; R : tRect; aOwner : tItem; aData : string);
           end;

   tLabel = class(tStatic)
           private
              Link : tItem;
           public
              procedure HandleEvent(var Event : tEvent); override;
              constructor create(aName : string; A: word; R : tRect; aOwner : tItem; aData : string; aLink : tItem);
           end;

   tCheckBox = class(tStatic)
           private
              checked : boolean;
           public
              constructor create(aName : string; A: word; R : tRect; aOwner : tItem; aData : string; achecked: boolean);
           protected
              procedure SetFocus; override;
              procedure LostFocus;  override;
              procedure HandleEvent(var Event : tEvent); override;
           end;

   tRadioButton = class(tStatic)
           private
              checked : boolean;
           public
              constructor Create(aName : string; A: word; R : tRect; aOwner : tItem; aData : string; achecked: boolean);
           protected
              procedure SetFocus; override;
              procedure LostFocus;  override;
              procedure HandleEvent(var Event : tEvent); override;
           end;

   tEdit = class(tStatic)
           private
              SelBegin, SelLen, Cur, CurS : integer;
              BlockMode : boolean;
           public
              procedure SetFocus; override;
              procedure LostFocus; override;
              procedure Draw(lpBuff: lpChar; RectSize: tPoint); override;
              constructor create(aName : string; A: word; R : tRect; aOwner : tItem; aData : string; aSelected: boolean);
           protected
              procedure HandleEvent(var Event : tEvent); override;
           end;

   tShadow = class(tItem)
           public
              function  PointInRect(P : tCoord): boolean; override;
              procedure Draw(lpBuff: lpChar; RectSize: tPoint);  override;
              constructor create(Aname : string; R : tRect; aOwner : tItem);
           end;

   tButton = class(tItem)
           private
              shadow : boolean;
              _down  : boolean;
              data : string;
              ButMess : word;
              downed: boolean;

           protected
              procedure SetFocus; override;
              procedure LostFocus;  override;
              procedure HandleEvent(var Event : tEvent); override;
              procedure Draw(lpBuff: lpChar; RectSize: tPoint);  override;
           public
              constructor create(aName : string; A: word; R : tRect; aOwner : tItem;
                                 aData : string; aShadow : boolean; aDefault: boolean; aButMess : word );
{              class function getDefButton: tButton;
              class procedure SetDefButton(aButton : tButton);
           public
              dButton : tButton;
              property defbutton : tButton read GetDefButton write SetDefButton; }
           end;

   tFrame = class(tItem)
             private
               caption : shortstring;
             public
              options : word;
              dragOn  : boolean;
              dragX, dragY : integer;
              procedure HandleEvent(var Event : tEvent); override;
              procedure Draw(lpBuff: lpChar; RectSize: tPoint);  override;
              function  PointInRect(P : tCoord): boolean;  override;
              // procedure HandleEvent(var Event : tEvent);  override;
              constructor create( aName : string; A: word; R : tRect;
                                aOwner : tItem; aOptions : word;  aCaption : string);
            end;



   tGroup = class (tItem)
            private
              ItemsColl : tStringList;
              Buff      : lpChar;
              Options   : word;
            public
              procedure CloseItem(lpItem : pointer); virtual;
              procedure InsertItem(aItem : tItem);
              procedure Draw(lpBuff: lpChar; RectSize: tPoint); override;
              procedure HandleEvent(var Event : tEvent); override;
              constructor create(aName : string; A: word; R : tRect; aOwner : tItem; aOptions : word; FrameCaption : string);
              destructor  destroy; override;
            end;

   tDialog = class (tGroup)
             public
                 constructor create (aName : string;
                                   AGroup, AFrame: word;
                                   R : tRect;
                                   aOwner : tItem;
                                   aCaption: string );
             private
                 caption : string;
                 procedure Draw(lpBuff: lpChar; RectSize: tPoint); override;
             end;

   tItemAddr = class (tObject)
                  AddrItem : tItem;
                  // RectInScreenCoord : TRect;
                  // это не объект а только его адрес. внимание -
                  // деструктор здесь нафиг не нужен, т.к. реальный
                  // объект релизится совсем в другом месте ...
               end;

    tAllItemsColl = class (tStringList) // of tItemAddr
                    private
                        PrevHandler : integer;
                    public
                        Focused : integer;
                        MonoPoly: integer;
                        procedure SetMonopoly(ItemName : string);
                        procedure RestoreMonopoly;
                        function SetFocusNext(order : boolean) : tItem;
                        function GetItemByName(ItemName: string) : tItem;
                        procedure Changefocus(ItemName: string);
                    end;

    tConsoleApp = class (tGroup)
                  public
                     constructor create;
                     procedure Run; // not virtualize
                     destructor destroy; override;
                     {}
                  private
                     Hndl,HndlI : tHandle;
                     AllItems: tAllItemsColl;
                     SaveScreen, Buff2 : lpChar;

                     procedure Draw(lpBuff: lpChar; RectSize: tPoint); override;
                     procedure SendMessageTo(Event : tEvent);      override;
                     procedure ReDraw(lpBuff: lpChar; RedrawRect: tRect; P : tPoint);
                  protected
                     WannaExit : boolean;
                     procedure DirectDraw;  override;
                     procedure HandleEvent(var Event : tEvent);        override;
                  end;
//////////////////// GLOBAL VARIABLE /////////////////////////////
const defaultbutton: tButton = nil;
const focusedcontrol: tItem = nil;
/////////////////////////////////////////////////////////////////////
  function StringCenter(S : string; Len : integer): string;
  function LengthA(s:string) : integer;
  function GetAccel(var aData:string) : char;
  function RECT (x,y,w,h:integer) : TRECT;
  function COORD(x,y:integer) : TCoord;
  function CoordInRect(P : TCoord; R : TRect):boolean;
  function CHARINFO(C : char; A : word): tCharInfo;
/////////////////////////////////////////////////////////////////////


implementation

function LengthA(s:string) : integer;
begin
   result := length(s);
   if pos('&',s)<>0 then dec(result);
end;

function GetAccel(var aData:string) : char;
var i:integer;
begin
   i := pos('&',adata);
   if i<>0 then
   begin
      result := UpCase(aData[i+1]);
      SYSTEM.Delete(aData,i,1);
   end
   else result := ' ';
end;

function RECT (x,y,w,h:integer) : TRECT;
begin
   result.X := x;
   result.Y := y;
   result.Width := w;
   result.Height := h;
end;

function COORD(x,y:integer) : TCoord;
begin
   result.X := x;
   result.Y := y;
end;

function CoordInRect(P : TCoord; R : TRect):boolean;
begin
   if (p.x >= R.Left) and (p.x < R.Left + R.Right) and
      (p.y >= R.top)  and (p.y < R.Top + R.Bottom)
      then Result := true
      else Result := false;
end;

function CHARINFO(C : char; A : word): tCharInfo;
begin
   result.Attributes := a;
   result.AsciiChar := C;
end;

function StringCenter(S : string; Len : integer): string;
var w,n,m,i : integer;
begin
   if Length(S) >= Len then begin Result := S; exit end;
   w := (Len - Length(S)) div 2;
   for n:=1 to w do result := result + ' ';
   i := 1;
   for n := w+1 to (Len)-w do
   begin
      result := result + s[i];
      inc(i);
   end;
   for n:= Len-W + 1 to Len do result := result + ' ';
end;


function  tItem.PointInRect(P : tCoord): boolean;
begin
   if (p.x >= size.Left) and (p.x < size.Left + size.Right) and
      (p.y >= size.top)  and (p.y < size.Top + size.Bottom)
      then Result := true
      else Result := false;
end;

procedure tItem.DirectDraw;
var
  redrawrect : trect;
  event      : tEvent;
begin
   Redrawrect := rect(size.x,size.y,size.width,size.height);
   Event := FormMessage(name,'',cmRedraw,@redrawrect);
   if owner<>nil then Owner.handleEvent(event);
end;

function tItem.GetCoordInScreenRect : TRect;
var
  redrawrect : trect;
  event      : tEvent;
begin
   Redrawrect := rect(size.x,size.y,size.width,size.height);
   Event := FormMessage(name,'',cmGetCoord,@redrawrect);
   if owner<>nil then Owner.handleEvent(event);
   result := RedrawRect;
end;

procedure tItem.SetFocus;
begin
  FOCUS := true;
  SendMessageTo(FormMessage(name, 'console', cmChangeFocus, self));
end;

procedure tItem.LostFocus;
begin
  FOCUS := false;
end;

destructor tItem.Destroy;
begin
   GetMem(BackBuf, size.right*size.bottom*sizeof(tCharInfo));
   inherited;
end;

{procedure tItem.RestoreBack(lpBuff: lpChar; RectSize: tPoint);
begin
   if not backpresent then exit;
end; }

procedure tItem.Draw(lpBuff: lpChar; RectSize: tPoint);
var n : integer;
    shX : lpChar;
begin
{  if bufpresent=0 then
  begin
     for n := 0 to size.Bottom-1 do
     begin
        shX := Pointer( longint(lpBuff) + (RectSize.X) *( n + Size.top) * 4 + Size.left*4);
        move (shX^, BackBuf^[n*Size.right], Size.Right*sizeof(tCharInfo));
     end;
     bufpresent := 1;
  end;
  if bufpresent=2 then
  begin
     for n := 0 to size.Bottom-1 do
     begin
        shX := Pointer( longint(lpBuff) + (RectSize.X) *( n + Size.top) * 4 + Size.left*4);
        move (BackBuf^[n*Size.right], shX^, Size.Right*sizeof(tCharInfo));
     end;
     bufpresent := 0;
  end; }
end;

constructor tItem.Create(aName : string; A: word; R : tRect; aOwner : tItem);
begin
   name := aname;
   Owner := aOwner;
   Size := R;
   Attr := A;
   Tabbed := True;
   Focus := false;
   GetMem(BackBuf, size.right*size.bottom*sizeof(tCharInfo));
   bufpresent := 0;
end;

function tItem.FormMessage(sName, rName : string; evComm : word; lpRes : pointer) : tEvent;
var Event : tEvent;
begin
   Event.SenderName := sName;
   Event.ReceiverName := rName;
   event.what := evBroadCasting;
   event.Command := evComm;
   event.lpReserved := lpRes;
   Result := Event;
end;

procedure tItem.SendMessageTo(Event : tEvent);
begin
   if Owner <> nil then Owner.SendMessageTo(Event);
end;

procedure tItem.HandleEvent(var Event : tEvent);
begin
   if (event.what = evCommand) then
   begin
      case event.INPUT.EventType of
         _MOUSE_EVENT :
         begin
            if (event.What = evCommand) and (event.INPUT.EventType = _MOUSE_EVENT) then
            begin
               if (Event.INPUT.MOUSEEVENT.dwEventFlags = 0) and
                  (Event.INPUT.MOUSEEVENT.dwButtonState = 1) then
               begin
                  if Tabbed then SetFocus;
               end
            end;
            event.what := evNothing;
         end;
         KEY_EVENT    : owner.handleevent(event);
      end;
   end;
   if (event.what = evBroadCasting) then
   begin
      case Event.Command of
         cmMove :
         begin
            if (Size.x + TPoint(event.lpreserved^).x) >= 0
               then Inc(Size.x, TPoint(event.lpreserved^).x );
            if ((Size.Y + TPoint(event.lpreserved^).Y ) >= 0)
               then Inc(Size.Y, TPoint(event.lpreserved^).Y );
            SendMessageTo( FormMessage(name,'console',cmRedrawAll,nil) );
            event.What := evNothing;
         end;
      end;
      if owner <> nil then owner.handleevent(event);
   end;
end;

/////////////////////////////////////////////////////////////////////
constructor tStatic.create(aName : string; A: word; R : tRect; aOwner : tItem; aData : string);
begin
   inherited create(aName, A, R, aOwner);
   Tabbed := false;
   Data := aData;
end;

procedure tStatic.SetData(aData : string);
begin
   Data := aData;
   DirectDraw;
end;

function tStatic.GetData: string;
begin
   result := Data;
end;

procedure  tStatic.Draw(lpBuff: lpChar; RectSize: tPoint);
var
    n : integer;
    ch : tCharInfo;
    shX: Pointer;  // Смещение
    R : trect;
begin
   inherited ;
   // мы должны нарисовать свои данные по своим правилам в
   // данном буфере
   r := GetCoordInScreenRect;
   shX := Pointer(  longint(lpBuff) + (RectSize.X * Size.top * 4) + (size.left * 4));
   for n := 1 to Size.Right do
   begin
      if n <= Length(data)
         then ch.AsciiChar := Data[n]
         else ch.AsciiChar := ' ';
      ch.Attributes := Attr;
      if (r.left + n > 0) and (r.top < SIZECONSOLEY)
      and (r.top >= 0) and (r.left+n < SIZECONSOLEX) then ;
      move(ch,shX^,sizeof(ch));
      inc(Longint(shx), sizeof(ch));
   end;
end;


////////////////////////////////////////////////////////////////////
procedure tLabel.handleEvent(var Event : tEvent);
begin
   if (event.What = evCommand) and (event.INPUT.EventType = _MOUSE_EVENT) then
   begin
      if (Event.INPUT.MOUSEEVENT.dwEventFlags = 0) and
         (Event.INPUT.MOUSEEVENT.dwButtonState = 1) then
      begin
         if Link<>nil then Link.SetFocus;
      end
   end;
   inherited;
end;

constructor tLabel.create(aName : string; A: word; R : tRect; aOwner : tItem; aData : string; aLink : tItem);
begin
   inherited create(aName, A, R, aOwner, aData);
   Link := aLink;
end;
////////////////////////////////////////////////////////////////////

procedure tcheckbox.SetFocus;
begin
   inherited;
   Attr := clFocusedCheckBox;
   DirectDraw;
end;

procedure tcheckbox.LostFocus;
begin
   inherited;
   Attr := clCheckBox;
   DirectDraw;
end;

constructor tcheckbox.create(aName : string; A: word; R : tRect; aOwner : tItem; aData : string; achecked: boolean);
begin
   data := '[';
   checked := achecked;
   if checked then data := data + 'X' else data := data + ' ';
   data := data + '] '+aData;
   Accel := getAccel(Data);
   inherited Create(Aname,A,R,aOwner,data);
   Tabbed := true;
end;

procedure tCheckBox.HandleEvent(var Event : tEvent);
begin
   case Event.What of
     evCommand:
     begin
        case event.INPUT.EventType of
           KEY_EVENT :
           begin
              if( event.INPUT.KeyEvent.bKeyDown)   and
                (
                 (event.INPUT.KeyEvent.wVirtualKeyCode = byte(Accel)) or
                 (event.INPUT.KeyEvent.wVirtualKeyCode = VK_SPACE )
                ) then
              begin
                 checked := not checked;
                 if checked then data[2] := 'X' else data[2] := ' ';
                 DirectDraw;
              end
           end;
           _MOUSE_EVENT :
           begin
              if (Event.INPUT.MOUSEEVENT.dwEventFlags = 0) and
                 (Event.INPUT.MOUSEEVENT.dwButtonState = 1) then
              begin
                 checked := not checked;
                 if checked then data[2] := 'X' else data[2] := ' ';
                 DirectDraw;
              end
           end;
        end;
     end;
   end;
   inherited handleEvent(event);
end;

////////////////////////////////////////////////////////////////////
procedure tEdit.SetFocus;
begin
   inherited;
   SendMessageTo(FormMessage(name, 'console', cmShowCursor, pointer(false)));
   DirectDraw;
end;

procedure tEdit.LostFocus;
begin
   inherited;
   SendMessageTo(FormMessage(name, 'console', cmHideCursor, nil));
   DirectDraw;
end;

procedure tEdit.Draw(lpBuff: lpChar; RectSize: tPoint);
var i,n,m : integer;
    ch  : tCharInfo;
    buf : lpCont;
    s   : string;
    R : TRect;
    P : TCoord;
begin
    R := GetCoordInScreenRect;
    P := COORD(R.X, R.Y);
    P.x := P.x + cur;
    if focus then SendMessageTo(FormMessage(name, 'console', cmSetCursor, @P));
    s := Data + ' ';
    GetMem (buf, size.Width*size.Height*sizeof(tCharInfo));
    ch.AsciiChar := ' ';
    ch.Attributes := clEdit;
    for n:=0 to size.Width-1 do
      for m:=0 to size.Height-1 do
         buf^ [n,m] := ch;

    if (CurS=Cur) or (not Focus) then
    begin
      for n:=1 to Length(s) do
      begin
         if (n > Size.Width - 2) and (focus) then
         begin
            buf^ [n,0].attributes := clEditScroll;
            buf^ [n,0].asciichar := #16;
            break;
         end;
         buf^ [n,0].asciichar := s[n];
      end;
    end;

    i := 1;
    if (CurS > Cur) and (focus) then
    begin
      buf^ [0,0].attributes := clEditScroll;
      buf^ [0,0].asciichar := #17;
      for n := CurS-Cur+1 to Length(s) do
      begin
         if i > Size.Width - 2 then
         begin
            buf^ [i,0].attributes := clEditScroll;
            buf^ [i,0].asciichar := #16;
            break;
         end;
         buf^ [i,0].asciichar := s[n];
         inc (i);
      end;
    end;

    for n:=0 to size.Width-1 do
      for m:=0 to size.Height-1 do
      begin
         if ((n + Size.X) >= RectSize.x) or ((m + Size.Y) >= RectSize.y) then continue;
         lpBuff^[((Size.Y+m)*rectsize.x)+(n+size.x)] := buf ^[n,m];
      end;
    FreeMem (buf, size.Width*size.Height*sizeof(tCharInfo));
end;

procedure tEdit.HandleEvent(var Event : tEvent);
var s:string;
begin
   s := data+' ';
   if (Event.What = evCommand) and (event.INPUT.EventType = KEY_EVENT) then
   begin
      if( event.INPUT.KeyEvent.bKeyDown) and ((event.INPUT.KeyEvent.dwControlKeyState and ALT_PRESSED) = 0) then
      case event.INPUT.KeyEvent.wVirtualKeyCode of
         VK_RIGHT :
         begin
            if CurS<>Length(S) then
            begin
               Inc(CurS);
               if Cur < Size.Width-2 then Inc(Cur);
               DirectDraw;
               Event.What := evNothing;
            end;
         end;
         VK_LEFT :
         begin
            if CurS<>1 then
            begin
               Dec(CurS);
               if Cur > 1 then Dec(Cur);
               DirectDraw;
               Event.What := evNothing;
            end;
         end;
         VK_END :
         begin
            CurS := length(S);
            begin
               if Curs > Size.width-1 then Cur := Size.width-2 else Cur := CurS;
               DirectDraw;
               Event.What := evNothing;
            end;
         end;
         VK_HOME :
         begin
            CurS := 1;
            Cur := 1;
            DirectDraw;
            Event.What := evNothing;
         end;
         VK_INSERT :
         begin
            blockmode := not blockmode;
            SendMessageTo(FormMessage(name, 'console', cmShowCursor, pointer(blockmode)));
         end;
         VK_BACK:
         begin
            if CurS<>1 then
            begin
               SYSTEM.Delete(Data,CurS-1,1);
               Dec(CurS); if Cur > 1 then Dec(Cur);
               DirectDraw;
               Event.What := evNothing;
            end;
         end;
         VK_DELETE:
         begin
            if CurS<>Length(s) then
            begin
               SYSTEM.Delete(Data,CurS,1);
               DirectDraw;
               Event.What := evNothing;
            end;
         end;
         VK_SPACE,48..90, 166..228:
         begin
            if (BlockMode) and (curS<>Length(S)) then
            begin
               data[CurS] := event.INPUT.KeyEvent.AsciiChar;
               Inc(CurS); if Cur < Size.Width-2 then Inc(Cur);
               DirectDraw;
               Event.What := evNothing;
            end;
            if (not (blockmode)) or ( not ((blockmode) and (curS<>Length(S))) ) then
            begin
               SYSTEM.Insert(event.INPUT.KeyEvent.AsciiChar,data,curS);
               Inc(CurS); if Cur < Size.Width-2 then Inc(Cur);
               DirectDraw;
               Event.What := evNothing;
            end;
         end;
         else
{            Event.What := evNothing; }
     end; // CASE and IF
   end;
   Inherited handleEvent(Event);
end;

constructor tEdit.create(aName : string; A: word; R : tRect; aOwner: tItem; aData : string; aSelected: boolean);
begin
   inherited Create(aName,A,R,aOwner,aData);
   Tabbed := true;
   if aSelected then
   begin
      Selbegin := 1;
      SelLen := Length(aData);
      Cur := 1;
      CurS := 1;
   end
   else begin
      Selbegin := 0;
      SelLen := 0;
      Cur := 1;
      CurS := 1;
   end;
   Cur := 1;
   CurS := 1;
   BlockMode := false;

{  LPos := 1;
   if Length(aData) > size.Width
      then RPos := Length(aData)
      else RPos := Size.Width;   }
end;

////////////////////////////////////////////////////////////////////
procedure tRadioButton.SetFocus;
begin
   inherited;
   Attr := clFocusedRadio;
   DirectDraw;
end;

procedure tRadioButton.LostFocus;
begin
   inherited;
   Attr := clRadio;
   DirectDraw;
end;

procedure tRadioButton.HandleEvent(var Event : tEvent);
var ev : TEvent;
begin
   case Event.What of
     evCommand:
     begin
        case event.INPUT.EventType of
           KEY_EVENT :
           begin
              if( event.INPUT.KeyEvent.bKeyDown)   and
                (
                 (event.INPUT.KeyEvent.wVirtualKeyCode = byte(Accel)) or
                 (event.INPUT.KeyEvent.wVirtualKeyCode = VK_SPACE )
                ) then
              begin
                 Event.What := evBroadCasting;
                 Event.Command := cmRadioPressed;
                 Event.lpReserved := self;
                 Owner.HandleEvent(event);
              end
           end;
           _MOUSE_EVENT :
           begin
              if (Event.INPUT.MOUSEEVENT.dwEventFlags = 0) and
                 (Event.INPUT.MOUSEEVENT.dwButtonState = 1) then
              begin
{                 Event.What := evBroadCasting;
                 Event.Command := cmRadioPressed;
                 Event.lpReserved := self; }
                 Ev := FormMessage(name, '', cmRadioPressed, self);
                 Owner.HandleEvent( Ev );
              end
           end;
        end;
     end;
   end;
   inherited handleEvent(event);
end;

constructor tRadioButton.create(aName : string; A: word; R : tRect; aOwner : tItem; aData : string; achecked: boolean);
begin
   data := '(';
   checked := achecked;
   if checked then data := data + #7 else data := data + ' ';
   data := data + ') '+aData;
   Accel := getAccel(Data);
   inherited Create(Aname,A,R,aOwner,data);
   Tabbed := true;
end;

////////////////////////////////////////////////////////////////////

constructor tGroup.create(aName : string; A: word; R : tRect; aOwner : tItem; aOptions:word; FrameCaption : string);
begin
   inherited create (aName,a, r, aOwner);
   Tabbed := false;
   options := aOptions and not (opDragAllowed or opCloseButton);
   ItemsColl := tStringList.Create;
   if (options and withframe)<>0 then
   begin
      InsertItem(tFrame.create(aName+'frame',A,Rect(0,0,R.right,r.bottom),self,aOptions,FrameCaption));
   end;
   GetMem(Buff, size.right*size.bottom*sizeof(tCharInfo));
end;

procedure tGroup.CloseItem(lpItem : pointer) ;
var n : integer;
begin
   n := ItemsColl.IndexOfObject (lpItem);
   if n <> -1 then ItemsColl.delete( n );
   DirectDraw;
end;

destructor tGroup.destroy;
begin
   ItemsColl.Destroy;
   FreeMem(Buff, size.right*size.bottom*sizeof(tCharInfo));
end;

procedure tGroup.HandleEvent(var Event : tEvent);
var n : integer;
    b : boolean;
begin
   case Event.What of
     evBroadCasting :
     begin
        case Event.Command of
           cmRedraw, cmGetCoord :
           begin
              inc(trect(Event.lpReserved^).x, size.x);
              inc(trect(Event.lpReserved^).y, size.y);
              if owner<>nil then Owner.HandleEvent(event);
           end;
           cmClose :
           begin
              CloseItem(event.lpReserved);
              event.what := evNothing;
           end;
           cmRadioPressed :
           begin
              for n := 1 to ItemsColl.count do
              begin
                 if (ItemsColl.objects[n-1] is tRadioButton) then
                 begin
                    if tRadioButton(ItemsColl.objects[n-1]).checked then
                    begin
                       (ItemsColl.objects[n-1] as tRadioButton).data[2] := ' ';
                       (ItemsColl.objects[n-1] as tItem).directdraw;
                    end;
                 end;
                 tRadioButton(event.lpReserved).data[2] := #7;
                 tRadioButton(event.lpReserved).checked := true;
                 tRadioButton(event.lpReserved).directdraw;
              end;
              // установка всех других Radio кнопок в (checked = false)
              // перерисовка всех тех которые должны быть перерисованы
           end;
        end;
        // if owner<>nil then Owner.HandleEvent(event);
     end;
     evCommand:
     begin
        case event.INPUT.EventType of
           _MOUSE_EVENT :
           begin
              // опрос всех входящих в состав группы контрол'ов, если
              // какой то из них возвращает true в PointInRect
              // то вызывается его HandleEvent
              b := false;
              dec (EVENT.INPUT.MouseEvent.dwMousePosition.X, size.left);
              dec (EVENT.INPUT.MouseEvent.dwMousePosition.Y, size.top);
              for n := 1 to ItemsColl.count do
              begin
                 if (ItemsColl.objects[n-1] as tItem).PointInRect(EVENT.INPUT.MouseEvent.dwMousePosition) then
                 begin
                    (ItemsColl.objects[n-1] as tItem).HandleEvent(Event);
                    b := true;
                    break;
                 end;
              end;
              if not b then
              begin
                 // default handler;
              end;
              Event.What := evNothing;
           end; // _MOUSE_EVENT;
        end;
     end;
   end;
   inherited HandleEvent(Event);
end;

procedure tGroup.InsertItem(aItem : tItem);
var Event : tEvent;
begin
   ItemsColl.AddObject(aItem.name, aItem);

   Event.SenderName := aItem.name;
   Event.ReceiverName := 'console';
   Event.What := evBroadCasting;
   Event.Command := cmAddItem;
   Event.lpReserved := aItem;

   SendMessageTo(Event);
end;

procedure tGroup.Draw(lpBuff: lpChar; RectSize: tPoint);
var m,n : integer;
    ch : tCharInfo;
    shX : pointer;
    sh  : longint;
begin
   // inherited Draw(lpBuff, RectSize);
   for n := 0 to size.Bottom-1 do
   begin
      shX := Pointer( longint(lpBuff) + (RectSize.X) *( n + Size.top) * 4 + Size.left*4);
      move (shX^, Buff^[n*Size.right], Size.Right*sizeof(tCharInfo));
   end;
   if (options and opFillBackGnd)<>0 then
   begin
      for n := 0 to (Size.Bottom*Size.Right-1) do
      begin
         Ch.AsciiChar := '@';
         Ch.Attributes := Attr;
         Buff^[n] := ch;
      end;
   end;
   for n := 1 to ItemsColl.Count do
   begin
      (ItemsColl.Objects[n-1] as tItem).Draw(Buff, Point (Size.Right, Size.Bottom));
   end;
   for n := 0 to size.Bottom-1 do
   begin
      for m := 0 to size.Right-1 do
      begin
         if (Size.x+m >= 0) and (Size.X+m < RectSize.X) and
            (Size.Y+n >= 0) and (Size.y+n < RectSize.Y)
            then lpBuff^[(size.y+n)*RectSize.x+(size.x+m)]:=buff^[n*size.width+m];
      end;
   end;
end;

////////////////////////////////////////////////////////////////////
constructor tConsoleApp.create;
var Addr : tItemAddr;
   c1,c2 : tCoord;
   tsr : tSmallRect;
   SCBI : TCONSOLESCREENBUFFERINFO;

begin
   WannaExit := false;
   AllItems := tAllItemsColl.Create;

   Addr := tItemAddr.Create;
   Addr.AddrItem := self;

   Hndl := GetStdHandle(STD_OUTPUT_HANDLE);
   HndlI := GetStdHandle(STD_INPUT_HANDLE);
   SetConsoleCursorInfo (hndl, cInVisible);

   // SetConsoleCP(1251);
   AllItems.AddObject('console',addr);
   AllItems.Focused := 0;  //consoleapp
   AllItems.MonoPoly := 0; //consoleapp
   AllItems.Prevhandler := 0; //consoleapp

   GetConsoleScreenBufferInfo(hndl, SCBI);
   SIZECONSOLEX := SCBI.dwSize.x;
   SIZECONSOLEY := SCBI.dwSize.y;


   GetMem(Buff2, SIZECONSOLEX*SIZECONSOLEY*sizeof(tCharInfo));
   GetMem(SaveScreen, SIZECONSOLEX*SIZECONSOLEY*sizeof(tCharInfo));


   inherited create('console',120, Rect(0,0,SIZECONSOLEX,SIZECONSOLEY),nil, opKeepBackGnd, '');
   //    0,0 - координата left/upper 80,SIZECONSOLEY -размер
   //
   c1.x := SIZECONSOLEX;
   c1.y := SIZECONSOLEY;
   c2.X := 0;
   c2.Y := 0;
   tsr.Left   :=  0;
   tsr.Top    :=  0;
   tsr.Right  :=  SIZECONSOLEX-1;
   tsr.Bottom :=  SIZECONSOLEY-1;

   ReadConsoleOutput(hndl,SaveScreen,C1,C2,TSR);
end;

procedure tConsoleApp.Run;
Var TI: tInputRecord;
    Event: tEvent;
    i : integer;
begin
  Draw(buff, Point (size.right, size.bottom));
  repeat
//     WaitForSingleObject(HNDLI,1000);
     if WannaExit then
     begin
        //if not CloseQuery then WannaExit := false else
        break;
     end;

     ReadConsoleInput(hndlI,TI,1,i);
     Case Ti.EventType of
        KEY_EVENT:
        begin
{           if( TI.KeyEvent.bKeyDown) and ((TI.KeyEvent.dwControlKeyState and ALT_PRESSED) = 0)
           and (TI.KeyEvent.wVirtualKeyCode in [VK_SPACE,48..90, 166..228]) then
           begin
              // ReadConsole(Hndli, @pCh, 0, i, nil);
              ReadConsoleInput(hndlI,TI,1,i);
              //Ti.KeyEvent.AsciiChar := pCh[0];
           end
           else
           begin
              ReadConsoleInput(hndlI,TI,1,i);
           end; }
           Event.What := evCommand;
           Event.INPUT := TI;
           ((AllItems.objects[AllItems.Focused] as tItemAddr).AddrItem as tItem).HandleEvent(event);
        end;
        _MOUSE_EVENT:
        begin
            // ReadConsoleInput(hndlI,TI,1,i);
            Event.What := evCommand;
            Event.INPUT := TI;
            ((AllItems.objects[AllItems.Monopoly] as tItemAddr).AddrItem as tItem).HandleEvent(event);
        end;

     end;
  until false;
end;

destructor tConsoleApp.destroy;
begin
   AllItems.Destroy;
   FreeMem(Buff2, SIZECONSOLEX*SIZECONSOLEY*sizeof(tCharInfo));
   FreeMem(SaveScreen, SIZECONSOLEX*SIZECONSOLEY*sizeof(tCharInfo));
   inherited destroy;
end;

procedure tConsoleApp.SendMessageTo(Event : tEvent);
var i : integer;
    p : tItem;
begin
   // шлем мессажку объекту с именем указанным в поле Event.ReceiverName
   // то есть вызываем метод HandleEvent некоторого объекта
   i := AllItems.IndexOF(Event.ReceiverName);
   if i<>-1 then
   begin
      p := (AllItems.objects[i] as tItemAddr).AddrItem;
      P.HandleEvent(Event);
   end;
end;

procedure tConsoleApp.HandleEvent(var Event : tEvent);
var Addr : tItemAddr;
    i : integer;
begin
   case Event.What of
     evBroadCasting:
     begin
        inherited HandleEvent(event);
        case Event.Command of
          cmRedraw :
          begin
             with trect(Event.lpReserved^) do
             begin
                AllItems.GetItemByName(Event.Sendername).Draw(Buff2,Point(SIZECONSOLEX,SIZECONSOLEY));
                with AllItems.GetItemByName(Event.Sendername) do
                     Redraw( buff2, trect(Event.lpReserved^), Point(Size.X,Size.Y) );
             end;
          end;
          cmGetCoord : ;
          cmRedrawAll : Draw(buff,Point(SIZECONSOLEX,SIZECONSOLEY));
          cmChangeFocus :
          begin
             AllItems.Changefocus(event.sendername);
          end;
          cmShowCursor :
          begin
             if boolean(Event.lpReserved)
                then SetConsoleCursorInfo (hndl, cVisible10)
                else SetConsoleCursorInfo (hndl, cVisible01);
          end;
          cmSetCursor :
          begin
             SetConsoleCursorPosition(hndl, TCoord(Event.lpReserved^))
          end;
          cmHideCursor :
          begin
             SetConsoleCursorInfo (hndl, cInVisible);
          end;
          cmSetMonopoly :
          begin
             AllItems.SetMonopoly(Event.Sendername);
          end;
          cmReSetMonopoly :
          begin
             AllItems.RestoreMonopoly;
          end;
          cmAddItem :
          begin
             Addr := tItemAddr.Create;
             Addr.AddrItem := Event.lpReserved;
             AllItems.AddObject(Event.SenderName, Addr);
          end;
          cmDeleteItem :
          begin
             i := AllItems.IndexOF(Event.ReceiverName);
             if i<>-1 then AllItems.Delete(i);
          end;
        end;
     end;
     evCommand:
     begin
        case event.INPUT.EventType of
           KEY_EVENT :
           begin
              if (event.INPUT.KeyEvent.wVirtualKeyCode = byte('X') ) and
                 ((event.INPUT.KeyEvent.dwControlKeyState and ALT_PRESSED) <> 0) then
              begin
                 WannaExit := true;
              end;
              if (event.INPUT.KeyEvent.wVirtualKeyCode = VK_TAB ) and
                 (event.INPUT.KeyEvent.bKeyDown) then
              begin
                 AllItems.SetFocusNext( (event.INPUT.KeyEvent.dwControlKeyState and SHIFT_PRESSED)=0 )
              end;
           end; // KEY_EVENT
           _MOUSE_EVENT :
           begin
              inherited HandleEvent(Event); // tGroup
           end; // _MOUSE_EVENT;
        end;
     end;
   end;
   Event.What := evNothing;
end;

procedure tConsoleApp.ReDraw(lpBuff: lpChar; redrawRect: tRECT; P : tPoint);
var
   c1,c2 : tCoord;
   tsr : tSmallRect;
begin
   c1.x := SIZECONSOLEX;
   c1.y := SIZECONSOLEY;
   c2.X := p.x; //size.x
   c2.Y := p.y; //size.y
   tsr.Left   :=  redrawRect.x;
   tsr.Top    :=  redrawRect.y;
   tsr.Right  :=  redrawRect.x + redrawRect.width -1;
   tsr.Bottom :=  redrawRect.y + redrawRect.height -1;
   WriteConsoleOutput(hndl, lpBuff, c1 ,c2, tsr);
end;

procedure tConsoleApp.DirectDraw;
begin
   Draw(buff, Point(Size.Width, size.Height));
end;

procedure tConsoleApp.Draw(lpBuff: lpChar; RectSize: tPoint);
begin
   if (Options and opKeepBackGnd)<>0 then
   begin
      Move (SaveScreen^, lpBuff^, SIZECONSOLEX*SIZECONSOLEY*sizeof(tCharInfo) );
   end;
   inherited Draw (lpBuff, RectSize);
   Redraw(lpBuff, Size, Point(0,0));
end;
////////////////////////////////////////////////////////////////////

procedure tButton.Draw(lpBuff: lpChar; RectSize: tPoint);
var
    m,n : integer;
    ch : tCharInfo;
    shX: LongInt;
    s  : string;
    color : word;

begin
   inherited Draw(lpBuff, RectSize);

   // centr (data , size.width)
   s := StringCenter(Data , size.width);

   if DefaultButton = self
      then begin color := clDefaultButton; s[1] := #16; s[size.Width-1] := #17; end
      else color := clButton;

   shX := Size.Y * RectSize.X  +  Size.X;
   if (shadow) then
   begin
      lpBuff^[shX+(RectSize.x)] := CHARINFO (' ', ATTR);
      if (_down) then
      begin
         for n:=0 to Size.Width-2 do
         begin
            lpBuff^[shX+n+1] := CHARINFO (s[n+1], color);
            lpBuff^[shX+(RectSize.x)+n+1] := CHARINFO (' ', ATTR);
         end;
         lpBuff^[shX] := CHARINFO (' ', ATTR);
      end
      else begin
         for n:=0 to Size.Width-2 do
         begin
            lpBuff^[shX+n] := CHARINFO (s[n+1], color);
            lpBuff^[shX+(RectSize.x)+n+1] := CHARINFO (#223, ATTR);
         end;
         lpBuff^[shX+Size.Width-1] := CHARINFO (#220, ATTR);
      end;
   end;
   if (not shadow) then
   begin
      for n:=0 to Size.Width-1 do
      begin
         lpBuff^[shX+n] := CHARINFO (s[n+1], color);
         lpBuff^[shX+(RectSize.x)+n] := CHARINFO (' ', ATTR);
      end;
   end;
{   for n := 1 to Size.Right do
   begin
      ch.AsciiChar := data[1];
      if DefaultButton = self then
      begin
         ch.Attributes := clDefaultButton;
         if n=1 then ch.AsciiChar := #16;
         if n=size.right then ch.AsciiChar := #17;
      end
      else ch.Attributes:= clButton;
      if (n = Size.Right) and (Shadow and not _Down) then
      begin
          tpchar(Pointer(LongInt(shX)+4)^)[0].Attributes:= Attr;
          tpchar(pointer(longint(shX)+4)^)[0].AsciiChar := #220;
          tpchar(Pointer(LongInt(shX)+RectSize.X*4+4)^)[0].Attributes:= Attr;
          tpchar(Pointer(LongInt(shX)+RectSize.X*4+4)^)[0].AsciiChar := #223;
      end;
{     if UpCase(Data[n])=Accel then ch.attributes := ch.attributes or clAccel; }
 {
      if (_down) and (shadow) then m := 1 else m := 0;
      move(ch,tpchar(shx^)[m],sizeof(ch));
      tpchar(Pointer(LongInt(shX)+RectSize.X*4)^)[0].Attributes:= Attr;
      if (shadow) then
      begin
         if (n=1)
           then tpchar(Pointer(LongInt(shX)+RectSize.X*4)^)[0].AsciiChar := #32
           else tpchar(Pointer(LongInt(shX)+RectSize.X*4)^)[0].AsciiChar := #223;
      end;
      if _down then
      begin
         tpchar(Pointer(LongInt(shX)+RectSize.X*4)^)[0].AsciiChar := '4';
      end;
      inc(Longint(shx), sizeof(ch));
   end; }
end;

procedure tButton.SetFocus;
begin
   inherited;
   defaultbutton := self;
   DirectDraw;
end;

procedure tButton.LostFocus;
begin
   inherited;
   defaultbutton := nil;
   DirectDraw;
end;

procedure tButton.HandleEvent(var Event : tEvent);
label 1;
const R : tRect = ();
var   butpressed : boolean;
begin
   case Event.What of
     evCommand:
     begin
        case event.INPUT.EventType of
           _MOUSE_EVENT :
           begin
{MOUSE_DOWN}  if (Event.INPUT.MOUSEEVENT.dwEventFlags = 0) and
                 (Event.INPUT.MOUSEEVENT.dwButtonState = 1) then
              begin
                 if assigned(DefaultButton) then DefaultButton.LostFocus;
                 SendMessageTo( FormMessage(name,'console',cmSetMonoPoly,nil) );
                 downed := true;
                 R := GetCoordInScreenRect;
                 _down := true;
                 DirectDraw;
//                 SetFocus;
              end;
{MOUSE_MOVE}  if (Event.INPUT.MOUSEEVENT.dwEventFlags = 1) then
              begin
                 if Downed then
                 begin
                    if CoordInRect(Event.INPUT.MOUSEEVENT.dwMousePosition, R)
                       then _down := true
                       else _down := false;
                    directdraw;
                 end;
              end;
{MOUSE_UP}    if (Event.INPUT.MOUSEEVENT.dwEventFlags = 0) and
                 (Event.INPUT.MOUSEEVENT.dwButtonState = 0) then
              begin
                 SendMessageTo( FormMessage(name,'console',cmReSetMonoPoly,nil) );
                 butpressed := _down;
                 downed := false;
                 _down := false;
                 DirectDraw;
                 if butpressed then goto 1;
              end;
              if (Event.INPUT.MOUSEEVENT.dwEventFlags = DOUBLE_CLICK) then goto 1;
           end;
           KEY_EVENT :
           begin
              if( event.INPUT.KeyEvent.bKeyDown)   and
                (
                 (event.INPUT.KeyEvent.wVirtualKeyCode = byte(Accel))  or
                 (event.INPUT.KeyEvent.wVirtualKeyCode = VK_RETURN  )
                ) then
              begin
1:               Event.What := evBroadCasting;
                 Event.Command := ButMess;
                 Event.lpReserved := self;
                 Owner.HandleEvent(event);
              end
           end;
        end;
     end;
   end;
   inherited handleEvent(event);
end;


constructor tButton.create( aName : string; A: word; R : tRect; aOwner : tItem;
              aData : string; aShadow : boolean; aDefault: boolean; aButMess : word);
begin
   inherited create (aName, a, r, aOwner);
   Tabbed := true;
   shadow := aShadow;
   downed := false;
   if aDefault then defaultbutton := self;
   Accel := getAccel(aData);
   Data := aData;
   ButMess := aButMess;
end;

////////////////////////////////////////////////////////////////////
procedure tFrame.Draw(lpBuff: lpChar; RectSize: tPoint);
var n,m : integer;
    ch : tCharInfo;
    shX: longint;
    c1,c2,c3,c4,c5,c6 : char;
begin
   // inherited ;
   shX := ( (Size.X * Size.top) + (size.left));
   Ch.Attributes := clFrame;

   if (Options and (opSingleFrame or opDoubleFrame)) <>0 then
   begin
      if (Options and opDoubleFrame) = 0 then
      begin
         c1 := #196; c2 := #179; c3 := #218;
         c4 := #191; c5 := #217; c6 := #192;
      end
      else begin
         c1 := #205; c2 := #186; c3 := #201;
         c4 := #187; c5 := #188; c6 := #200;
      end;
      Ch.AsciiChar := c1;
      for n:=0 to Size.Right-1 do
      begin
         lpBuff^[shX+n] := ch;
         lpBuff^[shX+(Size.Height-1)*RectSize.x+n] := ch;
      end;
      Ch.AsciiChar := c2;
      for n:=1 to Size.Bottom-1 do
      begin
         lpBuff^[shX+n*RectSize.x] := ch;
         lpBuff^[shX+n*RectSize.x+size.Right-1] := ch;
      end;
      lpBuff^[shX].AsciiChar := c3;
      lpBuff^[shX+Size.Width-1].AsciiChar := c4;
      lpBuff^[shX+(Size.Height-1)*RectSize.x+Size.Width-1].AsciiChar := c5;
      lpBuff^[shX+(Size.Height-1)*RectSize.x].AsciiChar := c6;
   end;

   if (Options and opCloseButton) <> 0 then
   begin
      Ch.AsciiChar := '[';
      lpBuff^[shX+1] := ch;
      Ch.AsciiChar := ']';
      lpBuff^[shX+3] := ch;
      lpBuff^[shX+2] := charinfo(#254, clFrameButton);
   end;

   if (Options and opWithCaption) <> 0 then
   begin
      m := (Size.Right - Length(caption)) div 2 ;
      if m < 4 then m := 4;
      for n := 1 to Length(caption) do
      begin
        if m >= (size.Right-1) then break;
        lpBuff^[shX+m] := CHARINFO (caption[n], clFrameCaption);
        inc(m);
      end;
   end;

end;

procedure tframe.HandleEvent(var Event : tEvent);
var P : TPoint;
begin
   if (Event.What = evCommand) and (event.INPUT.EventType = _MOUSE_EVENT) then
   begin
      if (Event.INPUT.MOUSEEVENT.dwEventFlags = 0) and
         (Event.INPUT.MOUSEEVENT.dwButtonState = 1) then
      begin
         if (Event.INPUT.MOUSEEVENT.dwMousePosition.X = 2) and
            (Event.INPUT.MOUSEEVENT.dwMousePosition.Y = 0) and
            ( (options or opCloseButton) <> 0)             then
         begin
            event.What       :=  evBroadCasting;
            event.Command    :=  cmClose;
            event.lpReserved :=  owner;
            owner.owner.HandleEvent(event);
            event.What := evNothing;
            exit;
         end;
         if (Event.INPUT.MOUSEEVENT.dwMousePosition.Y = 0) and
            ((options and opDragAllowed) <> 0)              then
         begin
            DragOn := true;
            DragX := GetCoordInScreenRect.x + Event.INPUT.MOUSEEVENT.dwMousePosition.X;
            DragY := GetCoordInScreenRect.y + Event.INPUT.MOUSEEVENT.dwMousePosition.Y;
            {DragX := Event.INPUT.MOUSEEVENT.dwMousePosition.X;
            DragY := Event.INPUT.MOUSEEVENT.dwMousePosition.Y;}
            SendMessageTo( FormMessage(name,'console',cmSetMonoPoly,nil) );
            options := (options and (not opDoubleFrame));
            SendMessageTo( FormMessage(name,'console',cmRedrawAll,nil) );
         end;
      end; // left button DOWN handler
      if (Event.INPUT.MOUSEEVENT.dwEventFlags = 0) and
         (Event.INPUT.MOUSEEVENT.dwButtonState = 0) then
      begin
         if DragOn then
         begin
            DragOn := false;
            SendMessageTo( FormMessage(name,'console',cmReSetMonoPoly,nil) );
            options := (options or opDoubleFrame);
            SendMessageTo( FormMessage(name,'console',cmRedrawAll,nil) );
         end;
      end; // left button UP handler
      if (Event.INPUT.MOUSEEVENT.dwEventFlags = 1) and
         (Event.INPUT.MOUSEEVENT.dwButtonState = 1) then
      begin
         if dragOn then
         begin
            P := Point ( Event.INPUT.MOUSEEVENT.dwMousePosition.X - DragX,
                         Event.INPUT.MOUSEEVENT.dwMousePosition.Y - DragY);
            // if P.x < 0;
            DragX := Event.INPUT.MOUSEEVENT.dwMousePosition.X;
            DragY := Event.INPUT.MOUSEEVENT.dwMousePosition.Y;
            Event := FormMessage(name,'',cmMove,@P);
            owner.HandleEvent( event );
            Event.What := evNothing;
         end;
      end;
  end;
  inherited HandleEvent(event);
end;

constructor tframe.create(aName : string; A: word; R : tRect; aOwner : tItem;
                        aOptions : word; aCaption : string);
begin
   inherited create(aname, a, r, aOwner);
   dragOn  :=  false;
   options :=  aOptions;
   Tabbed  :=  false;
   caption :=  aCaption;
end;

function  tframe.PointInRect(P : tCoord): boolean;
begin
   result := false;
   if ( ( p.x = size.x ) or ( p.x = size.x + size.Width - 1 ) ) and
      ( ( p.y >= size.Y ) and ( p.y <= size.Y + size.Height -1 ) )
      then result := true;
   if ( ( p.y = size.y ) or ( p.y = size.x + size.Height - 1 ) ) and
      ( ( p.x >= size.x ) and ( p.x <= size.Y + size.Width - 1) )
      then result := true
end;


////////////////////////////////////////////////////////////////////
function  tShadow.PointInRect(P : tCoord): boolean;
begin
   result := false;
end;

procedure tShadow.Draw(lpBuff: lpChar; RectSize: tPoint);
var
    n : integer;
    shX: longint;
begin
 // inherited ?
   shX := ( (RectSize.X * Size.top) + (size.left));
   for n:=2 to Size.Right do
   begin
      lpBuff^[shX+(Size.bottom-1)*RectSize.X+n].Attributes := clShadow;
         //lpBuff^[shX+(Size.bottom-1)*RectSize.X+n].Attributes and $07;
   end;
   for n:=1 to Size.Bottom do
   begin
      lpBuff^[shX+n*RectSize.x+size.Right-1].attributes :=   clShadow;
//         lpBuff^[shX+n*RectSize.x+size.Right-1].attributes  and $07;
      lpBuff^[shX+n*RectSize.x+size.Right-2].attributes :=   clShadow;
//         lpBuff^[shX+n*RectSize.x+size.Right-2].attributes and $07;
   end;
end;

constructor tShadow.create(aName:string; R : tRect; aOwner : tItem);
begin
   inherited create(aName, 0, R, aOwner);
   Tabbed := false;
end;

////////////////////////////////////////////////////////////////////}
procedure tDialog.Draw(lpBuff: lpChar; RectSize: tPoint);
var n,m : integer;
    ch : tCharInfo;
    shX : lpChar;
begin
{   if Size.x < 0 then exit;
   if Size.x+Size.Width > RectSize.x then exit;
   if Size.Y < 0 then exit;
   if Size.y+Size.Height > RectSize.Y then exit; }
   for n := 0 to size.Bottom-2 do
   begin
      for m := 0 to size.Right-3 do
      begin
         if (Size.x+m >= 0) and (Size.X+m < RectSize.X) and
            (Size.Y+n >= 0) and (Size.y+n < RectSize.Y)
            then lpBuff^[(size.y+n)*RectSize.x+(size.x+m)]:=CHARINFO(' ',attr);
      end;
   end;
   inherited;
end;

constructor tDialog.create (aName : string; AGroup, AFrame: word;
                            R : tRect; aOwner : tItem; aCaption: string);
begin
   caption := aCaption;
   inherited create(aName, aGroup, R, aOwner, 0, '');
   // InsertItem(tGroup.create(aName+'group', aFrame, Rect(0,0,R.Right-2, R.Bottom-1), self, opFillBackGnd, aCaption));
   InsertItem(tFrame.create(aName+'frame1', aFrame, Rect(0,0,R.Right-2, R.Bottom-1), self, withFrame, aCaption));
   InsertItem(tShadow.create(aName+'shadow1', Rect(0,0,R.Right,r.Bottom), self ));
end;

////////////////////////////////////////////////////////////////////
procedure tAllItemsColl.ChangeFocus(ItemName : string);
var n : integer;
begin
   n := IndexOf(ItemName);
   if n<>-1 then
   begin
      (objects[focused] as tItemAddr).AddrItem.LostFocus;
      Focused := n;
   end;
end;

function tAllItemsColl.GetItemByName(ItemName: string) : tItem;
var i :integer;
begin
   i := IndexOf(ItemName);
   if i <> -1
      then result := (objects[i] as tItemAddr).AddrItem
      else result := nil;
end;

procedure tAllItemsColl.SetMonopoly(ItemName : string);
var n : integer;
begin
   n := IndexOf(ItemName);
   if n<>-1 then
   begin
      PrevHandler := MonoPoly;
      MonoPoly := n;
   end;
end;

procedure tAllItemsColl.RestoreMonopoly;
begin
   MonoPoly := PrevHandler;
end;

function tAllItemsColl.SetFocusNext(order : boolean) : titem;
begin
   (objects[focused] as tItemAddr).AddrItem.LostFocus;
   if order then
   begin
      if focused = count-1 then focused := 0
                           else inc(focused);
   end
   else begin
      if focused = 0 then focused := count-1
                     else dec(focused);
   end;
   result := (objects[focused] as tItemAddr).AddrItem;
   if result.Tabbed
      then result.setfocus
      else Result := SetFocusNext(order);
end;

end.


Хотите поделиться своими творениями? Размещу с удовольствием, мыльте!

К списку статей


Есть комментарии, вопросы, ссылки на полезные ресурсы? Все это можно указать здесь:

E-mail для ответа:

Сообщение:



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS