home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / bpos2tv.zip / VIEWS.PAS < prev   
Pascal/Delphi Source File  |  1994-02-04  |  95KB  |  3,861 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Views;
  12.  
  13. {$O+,F+,X+,I-,S-}
  14.  
  15. interface
  16.  
  17. uses Objects, Drivers, Memory;
  18.  
  19. const
  20.  
  21. { TView State masks }
  22.  
  23.   sfVisible     = $0001;
  24.   sfCursorVis   = $0002;
  25.   sfCursorIns   = $0004;
  26.   sfShadow      = $0008;
  27.   sfActive      = $0010;
  28.   sfSelected    = $0020;
  29.   sfFocused     = $0040;
  30.   sfDragging    = $0080;
  31.   sfDisabled    = $0100;
  32.   sfModal       = $0200;
  33.   sfDefault     = $0400;
  34.   sfExposed     = $0800;
  35.  
  36. { TView Option masks }
  37.  
  38.   ofSelectable  = $0001;
  39.   ofTopSelect   = $0002;
  40.   ofFirstClick  = $0004;
  41.   ofFramed      = $0008;
  42.   ofPreProcess  = $0010;
  43.   ofPostProcess = $0020;
  44.   ofBuffered    = $0040;
  45.   ofTileable    = $0080;
  46.   ofCenterX     = $0100;
  47.   ofCenterY     = $0200;
  48.   ofCentered    = $0300;
  49.   ofValidate    = $0400;
  50.   ofVersion     = $3000;
  51.   ofVersion10   = $0000;
  52.   ofVersion20   = $1000;
  53.  
  54. { TView GrowMode masks }
  55.  
  56.   gfGrowLoX = $01;
  57.   gfGrowLoY = $02;
  58.   gfGrowHiX = $04;
  59.   gfGrowHiY = $08;
  60.   gfGrowAll = $0F;
  61.   gfGrowRel = $10;
  62.  
  63. { TView DragMode masks }
  64.  
  65.   dmDragMove = $01;
  66.   dmDragGrow = $02;
  67.   dmLimitLoX = $10;
  68.   dmLimitLoY = $20;
  69.   dmLimitHiX = $40;
  70.   dmLimitHiY = $80;
  71.   dmLimitAll = $F0;
  72.  
  73. { TView Help context codes }
  74.  
  75.   hcNoContext = 0;
  76.   hcDragging  = 1;
  77.  
  78. { TScrollBar part codes }
  79.  
  80.   sbLeftArrow  = 0;
  81.   sbRightArrow = 1;
  82.   sbPageLeft   = 2;
  83.   sbPageRight  = 3;
  84.   sbUpArrow    = 4;
  85.   sbDownArrow  = 5;
  86.   sbPageUp     = 6;
  87.   sbPageDown   = 7;
  88.   sbIndicator  = 8;
  89.  
  90. { TScrollBar options for TWindow.StandardScrollBar }
  91.  
  92.   sbHorizontal     = $0000;
  93.   sbVertical       = $0001;
  94.   sbHandleKeyboard = $0002;
  95.  
  96. { TWindow Flags masks }
  97.  
  98.   wfMove  = $01;
  99.   wfGrow  = $02;
  100.   wfClose = $04;
  101.   wfZoom  = $08;
  102.  
  103. { TWindow number constants }
  104.  
  105.   wnNoNumber = 0;
  106.  
  107. { TWindow palette entries }
  108.  
  109.   wpBlueWindow = 0;
  110.   wpCyanWindow = 1;
  111.   wpGrayWindow = 2;
  112.  
  113. { Standard command codes }
  114.  
  115.   cmValid   = 0;
  116.   cmQuit    = 1;
  117.   cmError   = 2;
  118.   cmMenu    = 3;
  119.   cmClose   = 4;
  120.   cmZoom    = 5;
  121.   cmResize  = 6;
  122.   cmNext    = 7;
  123.   cmPrev    = 8;
  124.   cmHelp    = 9;
  125.  
  126. { Application command codes }
  127.  
  128.   cmCut     = 20;
  129.   cmCopy    = 21;
  130.   cmPaste   = 22;
  131.   cmUndo    = 23;
  132.   cmClear   = 24;
  133.   cmTile    = 25;
  134.   cmCascade = 26;
  135.  
  136. { TDialog standard commands }
  137.  
  138.   cmOK      = 10;
  139.   cmCancel  = 11;
  140.   cmYes     = 12;
  141.   cmNo      = 13;
  142.   cmDefault = 14;
  143.  
  144. { Standard messages }
  145.  
  146.   cmReceivedFocus     = 50;
  147.   cmReleasedFocus     = 51;
  148.   cmCommandSetChanged = 52;
  149.  
  150. { TScrollBar messages }
  151.  
  152.   cmScrollBarChanged  = 53;
  153.   cmScrollBarClicked  = 54;
  154.  
  155. { TWindow select messages }
  156.  
  157.   cmSelectWindowNum   = 55;
  158.  
  159. { TListViewer messages }
  160.  
  161.   cmListItemSelected  = 56;
  162.  
  163. { Color palettes }
  164.  
  165.   CFrame      = #1#1#2#2#3;
  166.   CScrollBar  = #4#5#5;
  167.   CScroller   = #6#7;
  168.   CListViewer = #26#26#27#28#29;
  169.  
  170.   CBlueWindow = #8#9#10#11#12#13#14#15;
  171.   CCyanWindow = #16#17#18#19#20#21#22#23;
  172.   CGrayWindow = #24#25#26#27#28#29#30#31;
  173.  
  174. { TDrawBuffer maximum view width }
  175.  
  176.   MaxViewWidth = 132;
  177.  
  178. type
  179.  
  180. { Command sets }
  181.  
  182.   PCommandSet = ^TCommandSet;
  183.   TCommandSet = set of Byte;
  184.  
  185. { Color palette type }
  186.  
  187.   PPalette = ^TPalette;
  188.   TPalette = String;
  189.  
  190. { TDrawBuffer, buffer used by draw methods }
  191.  
  192.   TDrawBuffer = array[0..MaxViewWidth - 1] of Word;
  193.  
  194. { TView object Pointer }
  195.  
  196.   PView = ^TView;
  197.  
  198. { TGroup object Pointer }
  199.  
  200.   PGroup = ^TGroup;
  201.  
  202. { TView object }
  203.  
  204.   TView = object(TObject)
  205.     Owner: PGroup;
  206.     Next: PView;
  207.     Origin: TPoint;
  208.     Size: TPoint;
  209.     Cursor: TPoint;
  210.     GrowMode: Byte;
  211.     DragMode: Byte;
  212.     HelpCtx: Word;
  213.     State: Word;
  214.     Options: Word;
  215.     EventMask: Word;
  216.     constructor Init(var Bounds: TRect);
  217.     constructor Load(var S: TStream);
  218.     destructor Done; virtual;
  219.     procedure Awaken; virtual;
  220.     procedure BlockCursor;
  221.     procedure CalcBounds(var Bounds: TRect; Delta: TPoint); virtual;
  222.     procedure ChangeBounds(var Bounds: TRect); virtual;
  223.     procedure ClearEvent(var Event: TEvent);
  224.     function CommandEnabled(Command: Word): Boolean;
  225.     function DataSize: Word; virtual;
  226.     procedure DisableCommands(Commands: TCommandSet);
  227.     procedure DragView(Event: TEvent; Mode: Byte;
  228.       var Limits: TRect; MinSize, MaxSize: TPoint);
  229.     procedure Draw; virtual;
  230.     procedure DrawView;
  231.     procedure EnableCommands(Commands: TCommandSet);
  232.     procedure EndModal(Command: Word); virtual;
  233.     function EventAvail: Boolean;
  234.     function Execute: Word; virtual;
  235.     function Exposed: Boolean;
  236.     function Focus: Boolean;
  237.     procedure GetBounds(var Bounds: TRect);
  238.     procedure GetClipRect(var Clip: TRect);
  239.     function GetColor(Color: Word): Word;
  240.     procedure GetCommands(var Commands: TCommandSet);
  241.     procedure GetData(var Rec); virtual;
  242.     procedure GetEvent(var Event: TEvent); virtual;
  243.     procedure GetExtent(var Extent: TRect);
  244.     function GetHelpCtx: Word; virtual;
  245.     function GetPalette: PPalette; virtual;
  246.     procedure GetPeerViewPtr(var S: TStream; var P);
  247.     function GetState(AState: Word): Boolean;
  248.     procedure GrowTo(X, Y: Integer);
  249.     procedure HandleEvent(var Event: TEvent); virtual;
  250.     procedure Hide;
  251.     procedure HideCursor;
  252.     procedure KeyEvent(var Event: TEvent);
  253.     procedure Locate(var Bounds: TRect);
  254.     procedure MakeFirst;
  255.     procedure MakeGlobal(Source: TPoint; var Dest: TPoint);
  256.     procedure MakeLocal(Source: TPoint; var Dest: TPoint);
  257.     function MouseEvent(var Event: TEvent; Mask: Word): Boolean;
  258.     function MouseInView(Mouse: TPoint): Boolean;
  259.     procedure MoveTo(X, Y: Integer);
  260.     function NextView: PView;
  261.     procedure NormalCursor;
  262.     function Prev: PView;
  263.     function PrevView: PView;
  264.     procedure PutEvent(var Event: TEvent); virtual;
  265.     procedure PutInFrontOf(Target: PView);
  266.     procedure PutPeerViewPtr(var S: TStream; P: PView);
  267.     procedure Select;
  268.     procedure SetBounds(var Bounds: TRect);
  269.     procedure SetCommands(Commands: TCommandSet);
  270.     procedure SetCmdState(Commands: TCommandSet; Enable: Boolean);
  271.     procedure SetCursor(X, Y: Integer);
  272.     procedure SetData(var Rec); virtual;
  273.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  274.     procedure Show;
  275.     procedure ShowCursor;
  276.     procedure SizeLimits(var Min, Max: TPoint); virtual;
  277.     procedure Store(var S: TStream);
  278.     function TopView: PView;
  279.     function Valid(Command: Word): Boolean; virtual;
  280.     procedure WriteBuf(X, Y, W, H: Integer; var Buf);
  281.     procedure WriteChar(X, Y: Integer; C: Char; Color: Byte;
  282.       Count: Integer);
  283.     procedure WriteLine(X, Y, W, H: Integer; var Buf);
  284.     procedure WriteStr(X, Y: Integer; Str: String; Color: Byte);
  285.   private
  286.     procedure DrawCursor;
  287.     procedure DrawHide(LastView: PView);
  288.     procedure DrawShow(LastView: PView);
  289.     procedure DrawUnderRect(var R: TRect; LastView: PView);
  290.     procedure DrawUnderView(DoShadow: Boolean; LastView: PView);
  291.     procedure ResetCursor; virtual;
  292.   end;
  293.  
  294. { TFrame types }
  295.  
  296.   TTitleStr = string[80];
  297.  
  298. { TFrame object }
  299.  
  300.   { Palette layout }
  301.   { 1 = Passive frame }
  302.   { 2 = Passive title }
  303.   { 3 = Active frame }
  304.   { 4 = Active title }
  305.   { 5 = Icons }
  306.  
  307.   PFrame = ^TFrame;
  308.   TFrame = object(TView)
  309.     constructor Init(var Bounds: TRect);
  310.     procedure Draw; virtual;
  311.     function GetPalette: PPalette; virtual;
  312.     procedure HandleEvent(var Event: TEvent); virtual;
  313.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  314.   private
  315.     FrameMode: Word;
  316.     procedure FrameLine(var FrameBuf; Y, N: Integer; Color: Byte);
  317.   end;
  318.  
  319. { ScrollBar characters }
  320.  
  321.   TScrollChars = array[0..4] of Char;
  322.  
  323. { TScrollBar object }
  324.  
  325.   { Palette layout }
  326.   { 1 = Page areas }
  327.   { 2 = Arrows }
  328.   { 3 = Indicator }
  329.  
  330.   PScrollBar = ^TScrollBar;
  331.   TScrollBar = object(TView)
  332.     Value: Integer;
  333.     Min: Integer;
  334.     Max: Integer;
  335.     PgStep: Integer;
  336.     ArStep: Integer;
  337.     constructor Init(var Bounds: TRect);
  338.     constructor Load(var S: TStream);
  339.     procedure Draw; virtual;
  340.     function GetPalette: PPalette; virtual;
  341.     procedure HandleEvent(var Event: TEvent); virtual;
  342.     procedure ScrollDraw; virtual;
  343.     function ScrollStep(Part: Integer): Integer; virtual;
  344.     procedure SetParams(AValue, AMin, AMax, APgStep, AArStep: Integer);
  345.     procedure SetRange(AMin, AMax: Integer);
  346.     procedure SetStep(APgStep, AArStep: Integer);
  347.     procedure SetValue(AValue: Integer);
  348.     procedure Store(var S: TStream);
  349.   private
  350.     Chars: TScrollChars;
  351.     procedure DrawPos(Pos: Integer);
  352.     function GetPos: Integer;
  353.     function GetSize: Integer;
  354.   end;
  355.  
  356. { TScroller object }
  357.  
  358.   { Palette layout }
  359.   { 1 = Normal text }
  360.   { 2 = Selected text }
  361.  
  362.   PScroller = ^TScroller;
  363.   TScroller = object(TView)
  364.     HScrollBar: PScrollBar;
  365.     VScrollBar: PScrollBar;
  366.     Delta: TPoint;
  367.     Limit: TPoint;
  368.     constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  369.     constructor Load(var S: TStream);
  370.     procedure ChangeBounds(var Bounds: TRect); virtual;
  371.     function GetPalette: PPalette; virtual;
  372.     procedure HandleEvent(var Event: TEvent); virtual;
  373.     procedure ScrollDraw; virtual;
  374.     procedure ScrollTo(X, Y: Integer);
  375.     procedure SetLimit(X, Y: Integer);
  376.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  377.     procedure Store(var S: TStream);
  378.   private
  379.     DrawLock: Byte;
  380.     DrawFlag: Boolean;
  381.     procedure CheckDraw;
  382.   end;
  383.  
  384. { TListViewer }
  385.  
  386.   { Palette layout }
  387.   { 1 = Active }
  388.   { 2 = Inactive }
  389.   { 3 = Focused }
  390.   { 4 = Selected }
  391.   { 5 = Divider }
  392.  
  393.   PListViewer = ^TListViewer;
  394.  
  395.   TListViewer = object(TView)
  396.     HScrollBar: PScrollBar;
  397.     VScrollBar: PScrollBar;
  398.     NumCols: Integer;
  399.     TopItem: Integer;
  400.     Focused: Integer;
  401.     Range: Integer;
  402.     constructor Init(var Bounds: TRect; ANumCols: Word;
  403.       AHScrollBar, AVScrollBar: PScrollBar);
  404.     constructor Load(var S: TStream);
  405.     procedure ChangeBounds(var Bounds: TRect); virtual;
  406.     procedure Draw; virtual;
  407.     procedure FocusItem(Item: Integer); virtual;
  408.     function GetPalette: PPalette; virtual;
  409.     function GetText(Item: Integer; MaxLen: Integer): String; virtual;
  410.     function IsSelected(Item: Integer): Boolean; virtual;
  411.     procedure HandleEvent(var Event: TEvent); virtual;
  412.     procedure SelectItem(Item: Integer); virtual;
  413.     procedure SetRange(ARange: Integer);
  414.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  415.     procedure Store(var S: TStream);
  416.   private
  417.     procedure FocusItemNum(Item: Integer); virtual;
  418.   end;
  419.  
  420. { Video buffer }
  421.  
  422.   PVideoBuf = ^TVideoBuf;
  423.   TVideoBuf = array[0..3999] of Word;
  424.  
  425. { Selection modes }
  426.  
  427.   SelectMode = (NormalSelect, EnterSelect, LeaveSelect);
  428.  
  429. { TGroup object }
  430.  
  431.   TGroup = object(TView)
  432.     Last: PView;
  433.     Current: PView;
  434.     Phase: (phFocused, phPreProcess, phPostProcess);
  435.     Buffer: PVideoBuf;
  436.     EndState: Word;
  437.     constructor Init(var Bounds: TRect);
  438.     constructor Load(var S: TStream);
  439.     destructor Done; virtual;
  440.     procedure Awaken; virtual;
  441.     procedure ChangeBounds(var Bounds: TRect); virtual;
  442.     function DataSize: Word; virtual;
  443.     procedure Delete(P: PView);
  444.     procedure Draw; virtual;
  445.     procedure EndModal(Command: Word); virtual;
  446.     procedure EventError(var Event: TEvent); virtual;
  447.     function ExecView(P: PView): Word;
  448.     function Execute: Word; virtual;
  449.     function First: PView;
  450.     function FirstThat(P: Pointer): PView;
  451.     function FocusNext(Forwards: Boolean): Boolean;
  452.     procedure ForEach(P: Pointer);
  453.     procedure GetData(var Rec); virtual;
  454.     function GetHelpCtx: Word; virtual;
  455.     procedure GetSubViewPtr(var S: TStream; var P);
  456.     procedure HandleEvent(var Event: TEvent); virtual;
  457.     procedure Insert(P: PView);
  458.     procedure InsertBefore(P, Target: PView);
  459.     procedure Lock;
  460.     procedure PutSubViewPtr(var S: TStream; P: PView);
  461.     procedure Redraw;
  462.     procedure SelectNext(Forwards: Boolean);
  463.     procedure SetData(var Rec); virtual;
  464.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  465.     procedure Store(var S: TStream);
  466.     procedure Unlock;
  467.     function Valid(Command: Word): Boolean; virtual;
  468.   private
  469.     Clip: TRect;
  470.     LockFlag: Byte;
  471.     function At(Index: Integer): PView;
  472.     procedure DrawSubViews(P, Bottom: PView);
  473.     function FirstMatch(AState: Word; AOptions: Word): PView;
  474.     function FindNext(Forwards: Boolean): PView;
  475.     procedure FreeBuffer;
  476.     procedure GetBuffer;
  477.     function IndexOf(P: PView): Integer;
  478.     procedure InsertView(P, Target: PView);
  479.     procedure RemoveView(P: PView);
  480.     procedure ResetCurrent;
  481.     procedure ResetCursor; virtual;
  482.     procedure SetCurrent(P: PView; Mode: SelectMode);
  483.   end;
  484.  
  485. { TWindow object }
  486.  
  487.   { Palette layout }
  488.   { 1 = Frame passive }
  489.   { 2 = Frame active }
  490.   { 3 = Frame icon }
  491.   { 4 = ScrollBar page area }
  492.   { 5 = ScrollBar controls }
  493.   { 6 = Scroller normal text }
  494.   { 7 = Scroller selected text }
  495.   { 8 = Reserved }
  496.  
  497.   PWindow = ^TWindow;
  498.   TWindow = object(TGroup)
  499.     Flags: Byte;
  500.     ZoomRect: TRect;
  501.     Number: Integer;
  502.     Palette: Integer;
  503.     Frame: PFrame;
  504.     Title: PString;
  505.     constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
  506.     constructor Load(var S: TStream);
  507.     destructor Done; virtual;
  508.     procedure Close; virtual;
  509.     function GetPalette: PPalette; virtual;
  510.     function GetTitle(MaxSize: Integer): TTitleStr; virtual;
  511.     procedure HandleEvent(var Event: TEvent); virtual;
  512.     procedure InitFrame; virtual;
  513.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  514.     procedure SizeLimits(var Min, Max: TPoint); virtual;
  515.     function StandardScrollBar(AOptions: Word): PScrollBar;
  516.     procedure Store(var S: TStream);
  517.     procedure Zoom; virtual;
  518.   end;
  519.  
  520. { Message dispatch function }
  521.  
  522. function Message(Receiver: PView; What, Command: Word;
  523.   InfoPtr: Pointer): Pointer;
  524.  
  525. { Views registration procedure }
  526.  
  527. procedure RegisterViews;
  528.  
  529. const
  530.  
  531. { Event masks }
  532.  
  533.   PositionalEvents: Word = evMouse;
  534.   FocusedEvents: Word = evKeyboard + evCommand;
  535.  
  536. { Minimum window size }
  537.  
  538.   MinWinSize: TPoint = (X: 16; Y: 6);
  539.  
  540. { Shadow definitions }
  541.  
  542.   ShadowSize: TPoint = (X: 2; Y: 1);
  543.   ShadowAttr: Byte = $08;
  544.  
  545. { Markers control }
  546.  
  547.   ShowMarkers: Boolean = False;
  548.  
  549. { MapColor error return value }
  550.  
  551.   ErrorAttr: Byte = $CF;
  552.  
  553. { Stream Registration Records }
  554.  
  555. const
  556.   RView: TStreamRec = (
  557.      ObjType: 1;
  558.      VmtLink: Ofs(TypeOf(TView)^);
  559.      Load:    @TView.Load;
  560.      Store:   @TView.Store
  561.   );
  562.  
  563. const
  564.   RFrame: TStreamRec = (
  565.      ObjType: 2;
  566.      VmtLink: Ofs(TypeOf(TFrame)^);
  567.      Load:    @TFrame.Load;
  568.      Store:   @TFrame.Store
  569.   );
  570.  
  571. const
  572.   RScrollBar: TStreamRec = (
  573.      ObjType: 3;
  574.      VmtLink: Ofs(TypeOf(TScrollBar)^);
  575.      Load:    @TScrollBar.Load;
  576.      Store:   @TScrollBar.Store
  577.   );
  578.  
  579. const
  580.   RScroller: TStreamRec = (
  581.      ObjType: 4;
  582.      VmtLink: Ofs(TypeOf(TScroller)^);
  583.      Load:    @TScroller.Load;
  584.      Store:   @TScroller.Store
  585.   );
  586.  
  587. const
  588.   RListViewer: TStreamRec = (
  589.      ObjType: 5;
  590.      VmtLink: Ofs(TypeOf(TListViewer)^);
  591.      Load:    @TListViewer.Load;
  592.      Store:   @TLIstViewer.Store
  593.   );
  594.  
  595. const
  596.   RGroup: TStreamRec = (
  597.      ObjType: 6;
  598.      VmtLink: Ofs(TypeOf(TGroup)^);
  599.      Load:    @TGroup.Load;
  600.      Store:   @TGroup.Store
  601.   );
  602.  
  603. const
  604.   RWindow: TStreamRec = (
  605.      ObjType: 7;
  606.      VmtLink: Ofs(TypeOf(TWindow)^);
  607.      Load:    @TWindow.Load;
  608.      Store:   @TWindow.Store
  609.   );
  610.  
  611. { Characters used for drawing selected and default items in  }
  612. { monochrome color sets                                      }
  613.  
  614.   SpecialChars: array[0..5] of Char = (#175, #174, #26, #27, ' ', ' ');
  615.  
  616. { True if the command set has changed since being set to false }
  617.  
  618.   CommandSetChanged: Boolean = False;
  619.  
  620. implementation
  621.  
  622. uses
  623.   OS2Def, BSESub;
  624.  
  625. type
  626.   PFixupList = ^TFixupList;
  627.   TFixupList = array[1..4096] of Pointer;
  628.  
  629. const
  630.   OwnerGroup: PGroup = nil;
  631.   FixupList: PFixupList = nil;
  632.   TheTopView: PView = nil;
  633.  
  634. const
  635.  
  636. { Bit flags to determine how to draw the frame icons }
  637.  
  638.   fmCloseClicked = $0001;
  639.   fmZoomClicked  = $0002;
  640.  
  641. { Current command set. All but window commands are active by default }
  642.  
  643.   CurCommandSet: TCommandSet =
  644.     [0..255] - [cmZoom, cmClose, cmResize, cmNext, cmPrev];
  645.  
  646. { Convert color into attribute                          }
  647. { In    AL = Color                                      }
  648. { Out   AL = Attribute                                  }
  649.  
  650. procedure MapColor; near; assembler;
  651. const
  652.   Self = 6;
  653.   TView_GetPalette = vmtHeaderSize + $2C;
  654. asm
  655.         OR      AL,AL
  656.         JE      @@3
  657.         LES     DI,[BP].Self
  658. @@1:    PUSH    ES
  659.         PUSH    DI
  660.         PUSH    AX
  661.         PUSH    ES
  662.         PUSH    DI
  663.         MOV     DI,ES:[DI]
  664.         CALL    DWORD PTR [DI].TView_GetPalette
  665.         MOV     BX,AX
  666.         MOV     ES,DX
  667.         OR      AX,DX
  668.         POP     AX
  669.         POP     DI
  670.         POP     DX
  671.         JE      @@2
  672.         CMP     AL,ES:[BX]
  673.         JA      @@3
  674.         SEGES   XLAT
  675.         OR      AL,AL
  676.         JE      @@3
  677. @@2:    MOV     ES,DX
  678.         LES     DI,ES:[DI].TView.Owner
  679.         MOV     SI,ES
  680.         OR      SI,DI
  681.         JNE     @@1
  682.         JMP     @@4
  683. @@3:    MOV     AL,ErrorAttr
  684. @@4:
  685. end;
  686.  
  687. { Convert color pair into attribute pair                }
  688. { In    AX = Color pair                                 }
  689. { Out   AX = Attribute pair                             }
  690.  
  691. procedure MapCPair; near; assembler;
  692. asm
  693.         OR      AH,AH
  694.         JE      @@1
  695.         XCHG    AL,AH
  696.         CALL    MapColor
  697.         XCHG    AL,AH
  698. @@1:    CALL    MapColor
  699. end;
  700.  
  701. { Write to view                                         }
  702. { In    AX    = Y coordinate                            }
  703. {       BX    = X coordinate                            }
  704. {       CX    = Count                                   }
  705. {       ES:DI = Buffer Pointer                          }
  706.  
  707. var
  708.   MouseRect : NOPTRRECT;
  709. procedure WriteView; near; assembler;
  710. const
  711.   Self   =   6;
  712.   Target =  -4;
  713.   Buffer =  -8;
  714.   BufOfs = -10;
  715. asm
  716.         MOV     [BP].BufOfs,BX
  717.         MOV     [BP].Buffer[0],DI
  718.         MOV     [BP].Buffer[2],ES
  719.         ADD     CX,BX
  720.         XOR     DX,DX
  721.         LES     DI,[BP].Self
  722.         OR      AX,AX
  723.         JL      @@3
  724.         CMP     AX,ES:[DI].TView.Size.Y
  725.         JGE     @@3
  726.         OR      BX,BX
  727.         JGE     @@1
  728.         XOR     BX,BX
  729. @@1:    CMP     CX,ES:[DI].TView.Size.X
  730.         JLE     @@2
  731.         MOV     CX,ES:[DI].TView.Size.X
  732. @@2:    CMP     BX,CX
  733.         JL      @@10
  734. @@3:    RET
  735. @@10:   TEST    ES:[DI].TView.State,sfVisible
  736.         JE      @@3
  737.         CMP     ES:[DI].TView.Owner.Word[2],0
  738.         JE      @@3
  739.         MOV     [BP].Target[0],DI
  740.         MOV     [BP].Target[2],ES
  741.         ADD     AX,ES:[DI].TView.Origin.Y
  742.         MOV     SI,ES:[DI].TView.Origin.X
  743.         ADD     BX,SI
  744.         ADD     CX,SI
  745.         ADD     [BP].BufOfs,SI
  746.         LES     DI,ES:[DI].TView.Owner
  747.         CMP     AX,ES:[DI].TGroup.Clip.A.Y
  748.         JL      @@3
  749.         CMP     AX,ES:[DI].TGroup.Clip.B.Y
  750.         JGE     @@3
  751.         CMP     BX,ES:[DI].TGroup.Clip.A.X
  752.         JGE     @@11
  753.         MOV     BX,ES:[DI].TGroup.Clip.A.X
  754. @@11:   CMP     CX,ES:[DI].TGroup.Clip.B.X
  755.         JLE     @@12
  756.         MOV     CX,ES:[DI].TGroup.Clip.B.X
  757. @@12:   CMP     BX,CX
  758.         JGE     @@3
  759.         LES     DI,ES:[DI].TGroup.Last
  760. @@20:   LES     DI,ES:[DI].TView.Next
  761.         CMP     DI,[BP].Target[0]
  762.         JNE     @@21
  763.         MOV     SI,ES
  764.         CMP     SI,[BP].Target[2]
  765.         JNE     @@21
  766.         JMP     @@40
  767. @@21:   TEST    ES:[DI].TView.State,sfVisible
  768.         JE      @@20
  769.         MOV     SI,ES:[DI].TView.Origin.Y
  770.         CMP     AX,SI
  771.         JL      @@20
  772.         ADD     SI,ES:[DI].TView.Size.Y
  773.         CMP     AX,SI
  774.         JL      @@23
  775.         TEST    ES:[DI].TView.State,sfShadow
  776.         JE      @@20
  777.         ADD     SI,ShadowSize.Y
  778.         CMP     AX,SI
  779.         JGE     @@20
  780.         MOV     SI,ES:[DI].TView.Origin.X
  781.         ADD     SI,ShadowSize.X
  782.         CMP     BX,SI
  783.         JGE     @@22
  784.         CMP     CX,SI
  785.         JLE     @@20
  786.         CALL    @@30
  787. @@22:   ADD     SI,ES:[DI].TView.Size.X
  788.         JMP     @@26
  789. @@23:   MOV     SI,ES:[DI].TView.Origin.X
  790.         CMP     BX,SI
  791.         JGE     @@24
  792.         CMP     CX,SI
  793.         JLE     @@20
  794.         CALL    @@30
  795. @@24:   ADD     SI,ES:[DI].TView.Size.X
  796.         CMP     BX,SI
  797.         JGE     @@25
  798.         CMP     CX,SI
  799.         JLE     @@31
  800.         MOV     BX,SI
  801. @@25:   TEST    ES:[DI].TView.State,sfShadow
  802.         JE      @@20
  803.         PUSH    SI
  804.         MOV     SI,ES:[DI].TView.Origin.Y
  805.         ADD     SI,ShadowSize.Y
  806.         CMP     AX,SI
  807.         POP     SI
  808.         JL      @@27
  809.         ADD     SI,ShadowSize.X
  810. @@26:   CMP     BX,SI
  811.         JGE     @@27
  812.         INC     DX
  813.         CMP     CX,SI
  814.         JLE     @@27
  815.         CALL    @@30
  816.         DEC     DX
  817. @@27:   JMP     @@20
  818. @@30:   PUSH    [BP].Target.Word[2]
  819.         PUSH    [BP].Target.Word[0]
  820.         PUSH    [BP].BufOfs.Word[0]
  821.         PUSH    ES
  822.         PUSH    DI
  823.         PUSH    SI
  824.         PUSH    DX
  825.         PUSH    CX
  826.         PUSH    AX
  827.         MOV     CX,SI
  828.         CALL    @@20
  829.         POP     AX
  830.         POP     CX
  831.         POP     DX
  832.         POP     SI
  833.         POP     DI
  834.         POP     ES
  835.         POP     [BP].BufOfs.Word[0]
  836.         POP     [BP].Target.Word[0]
  837.         POP     [BP].Target.Word[2]
  838.         MOV     BX,SI
  839. @@31:   RET
  840. @@40:   LES     DI,ES:[DI].TView.Owner
  841.         MOV     SI,ES:[DI].TGroup.Buffer.Word[2]
  842.         OR      SI,SI
  843.         JE      @@44
  844.         CMP     SI,ScreenBuffer.Word[2]
  845.         JE      @@41
  846. @@42:
  847.     PUSH    CX
  848.         PUSH    DI
  849.         CALL    @@50
  850.         POP    DI
  851.         POP    CX
  852.         JMP     @@44
  853. @@41:
  854.         PUSHA
  855.         PUSHA
  856.         MOV    MouseRect.row,AX
  857.         MOV    MouseRect.cRow,AX
  858.         MOV    MouseRect.col,BX
  859.         ADD    CX,BX
  860.         DEC    CX
  861.         MOV    MouseRect.cCol,CX
  862.         PUSH    DS
  863.         PUSH    OFFSET MouseRect
  864.         PUSH    HMouse
  865.         CALL    MouRemovePtr
  866.         POPA
  867.         CALL    @@50
  868.         PUSH    DI
  869.         PUSH    CX
  870.     PUSH    0
  871.         CALL    VioShowBuf
  872.         PUSH    HMouse
  873.         CALL    MouDrawPtr
  874.         POPA
  875. @@44:   CMP     ES:[DI].TGroup.LockFlag,0
  876.         JNE     @@31
  877.         JMP     @@10
  878. @@50:   PUSH    ES
  879.         PUSH    DS
  880.         PUSH    AX
  881.         MUL     ES:[DI].TView.Size.X.Byte[0]
  882.         ADD     AX,BX
  883.         SHL     AX,1
  884.         ADD     AX,ES:[DI].TGroup.Buffer.Word[0]
  885.         MOV     DI,AX
  886.         MOV     ES,SI
  887.         XOR     AL,AL
  888.         CMP     SI,ScreenBuffer.Word[2]
  889.         JNE     @@51
  890. @@51:   MOV     AH,ShadowAttr
  891.         SUB     CX,BX
  892.     PUSH    DI
  893.         SHL    CX,1
  894.         PUSH    CX
  895.         SHR    CX,1
  896.         MOV     SI,BX
  897.         SUB     SI,[BP].BufOfs
  898.         SHL     SI,1
  899.         ADD     SI,[BP].Buffer.Word[0]
  900.         MOV     DS,[BP].Buffer.Word[2]
  901.         CLD
  902.         OR      DX,DX
  903.         JNE     @@52
  904.         REP     MOVSW
  905.         JMP     @@70
  906. @@52:   LODSB
  907.         INC     SI
  908.         STOSW
  909.         LOOP    @@52
  910. @@70:
  911.         POP    CX
  912.         POP    DI
  913.         MOV    SI,ES
  914.         POP     AX
  915.         POP     DS
  916.         POP     ES
  917.         RET
  918. end;
  919.  
  920. { TView }
  921.  
  922. constructor TView.Init(var Bounds: TRect);
  923. begin
  924.   TObject.Init;
  925.   Owner := nil;
  926.   State := sfVisible;
  927.   SetBounds(Bounds);
  928.   DragMode := dmLimitLoY;
  929.   HelpCtx := hcNoContext;
  930.   EventMask := evMouseDown + evKeyDown + evCommand;
  931. end;
  932.  
  933. constructor TView.Load(var S: TStream);
  934. begin
  935.   TObject.Init;
  936.   S.Read(Origin,
  937.     SizeOf(TPoint) * 3 +
  938.     SizeOf(Byte) * 2 +
  939.     SizeOf(Word) * 4);
  940. end;
  941.  
  942. destructor TView.Done;
  943. begin
  944.   Hide;
  945.   if Owner <> nil then Owner^.Delete(@Self);
  946. end;
  947.  
  948. procedure TView.Awaken;
  949. begin
  950. end;
  951.  
  952. procedure TView.BlockCursor;
  953. begin
  954.   SetState(sfCursorIns, True);
  955. end;
  956.  
  957. procedure TView.CalcBounds(var Bounds: TRect; Delta: TPoint);
  958. var
  959.   S, D: Integer;
  960.   Min, Max: TPoint;
  961.  
  962. procedure Grow(var I: Integer);
  963. begin
  964.   if GrowMode and gfGrowRel = 0 then Inc(I, D) else
  965.     I := (I * S + (S - D) shr 1) div (S - D);
  966. end;
  967.  
  968. function Range(Val, Min, Max: Integer): Integer;
  969. begin
  970.   if Val < Min then Range := Min else
  971.     if Val > Max then Range := Max else
  972.       Range := Val;
  973. end;
  974.  
  975. begin
  976.   GetBounds(Bounds);
  977.   S := Owner^.Size.X;
  978.   D := Delta.X;
  979.   if GrowMode and gfGrowLoX <> 0 then Grow(Bounds.A.X);
  980.   if GrowMode and gfGrowHiX <> 0 then Grow(Bounds.B.X);
  981.   if Bounds.B.X - Bounds.A.X > MaxViewWidth then
  982.     Bounds.B.X := Bounds.A.X + MaxViewWidth;
  983.   S := Owner^.Size.Y;
  984.   D := Delta.Y;
  985.   if GrowMode and gfGrowLoY <> 0 then Grow(Bounds.A.Y);
  986.   if GrowMode and gfGrowHiY <> 0 then Grow(Bounds.B.Y);
  987.   SizeLimits(Min, Max);
  988.   Bounds.B.X := Bounds.A.X + Range(Bounds.B.X - Bounds.A.X, Min.X, Max.X);
  989.   Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y - Bounds.A.Y, Min.Y, Max.Y);
  990. end;
  991.  
  992. procedure TView.ChangeBounds(var Bounds: TRect);
  993. begin
  994.   SetBounds(Bounds);
  995.   DrawView;
  996. end;
  997.  
  998. procedure TView.ClearEvent(var Event: TEvent);
  999. begin
  1000.   Event.What := evNothing;
  1001.   Event.InfoPtr := @Self;
  1002. end;
  1003.  
  1004. function TView.CommandEnabled(Command: Word): Boolean;
  1005. begin
  1006.   CommandEnabled := (Command > 255) or (Command in CurCommandSet);
  1007. end;
  1008.  
  1009. function TView.DataSize: Word;
  1010. begin
  1011.   DataSize := 0;
  1012. end;
  1013.  
  1014. procedure TView.DisableCommands(Commands: TCommandSet);
  1015. begin
  1016.   CommandSetChanged := CommandSetChanged or (CurCommandSet * Commands <> []);
  1017.   CurCommandSet := CurCommandSet - Commands;
  1018. end;
  1019.  
  1020. procedure TView.DragView(Event: TEvent; Mode: Byte;
  1021.   var Limits: TRect; MinSize, MaxSize: TPoint);
  1022. var
  1023.   P, S: TPoint;
  1024.   SaveBounds: TRect;
  1025.  
  1026. function Min(I, J: Integer): Integer;
  1027. begin
  1028.   if I < J then Min := I else Min := J;
  1029. end;
  1030.  
  1031. function Max(I, J: Integer): Integer;
  1032. begin
  1033.   if I > J then Max := I else Max := J;
  1034. end;
  1035.  
  1036. procedure MoveGrow(P, S: TPoint);
  1037. var
  1038.   R: TRect;
  1039. begin
  1040.   S.X := Min(Max(S.X, MinSize.X), MaxSize.X);
  1041.   S.Y := Min(Max(S.Y, MinSize.Y), MaxSize.Y);
  1042.   P.X := Min(Max(P.X, Limits.A.X - S.X + 1), Limits.B.X - 1);
  1043.   P.Y := Min(Max(P.Y, Limits.A.Y - S.Y + 1), Limits.B.Y - 1);
  1044.   if Mode and dmLimitLoX <> 0 then P.X := Max(P.X, Limits.A.X);
  1045.   if Mode and dmLimitLoY <> 0 then P.Y := Max(P.Y, Limits.A.Y);
  1046.   if Mode and dmLimitHiX <> 0 then P.X := Min(P.X, Limits.B.X - S.X);
  1047.   if Mode and dmLimitHiY <> 0 then P.Y := Min(P.Y, Limits.B.Y - S.Y);
  1048.   R.Assign(P.X, P.Y, P.X + S.X, P.Y + S.Y);
  1049.   Locate(R);
  1050. end;
  1051.  
  1052. procedure Change(DX, DY: Integer);
  1053. begin
  1054.   if (Mode and dmDragMove <> 0) and (GetShiftState and $03 = 0) then
  1055.   begin
  1056.     Inc(P.X, DX);
  1057.     Inc(P.Y, DY);
  1058.   end else
  1059.   if (Mode and dmDragGrow <> 0) and (GetShiftState and $03 <> 0) then
  1060.   begin
  1061.     Inc(S.X, DX);
  1062.     Inc(S.Y, DY);
  1063.   end;
  1064. end;
  1065.  
  1066. procedure Update(X, Y: Integer);
  1067. begin
  1068.   if Mode and dmDragMove <> 0 then
  1069.   begin
  1070.     P.X := X;
  1071.     P.Y := Y;
  1072.   end;
  1073. end;
  1074.  
  1075. begin
  1076.   SetState(sfDragging, True);
  1077.   if Event.What = evMouseDown then
  1078.   begin
  1079.     if Mode and dmDragMove <> 0 then
  1080.     begin
  1081.       P.X := Origin.X - Event.Where.X;
  1082.       P.Y := Origin.Y - Event.Where.Y;
  1083.       repeat
  1084.         Inc(Event.Where.X, P.X);
  1085.         Inc(Event.Where.Y, P.Y);
  1086.         MoveGrow(Event.Where, Size);
  1087.       until not MouseEvent(Event, evMouseMove);
  1088.     end else
  1089.     begin
  1090.       P.X := Size.X - Event.Where.X;
  1091.       P.Y := Size.Y - Event.Where.Y;
  1092.       repeat
  1093.         Inc(Event.Where.X, P.X);
  1094.         Inc(Event.Where.Y, P.Y);
  1095.         MoveGrow(Origin, Event.Where);
  1096.       until not MouseEvent(Event, evMouseMove);
  1097.     end;
  1098.   end else
  1099.   begin
  1100.     GetBounds(SaveBounds);
  1101.     repeat
  1102.       P := Origin;
  1103.       S := Size;
  1104.       KeyEvent(Event);
  1105.       case Event.KeyCode and $FF00 of
  1106.         kbLeft: Change(-1, 0);
  1107.         kbRight: Change(1, 0);
  1108.         kbUp: Change(0, -1);
  1109.         kbDown: Change(0, 1);
  1110.         kbCtrlLeft: Change(-8, 0);
  1111.         kbCtrlRight: Change(8, 0);
  1112.         kbHome: Update(Limits.A.X, P.Y);
  1113.         kbEnd: Update(Limits.B.X - S.X, P.Y);
  1114.         kbPgUp: Update(P.X, Limits.A.Y);
  1115.         kbPgDn: Update(P.X, Limits.B.Y - S.Y);
  1116.       end;
  1117.       MoveGrow(P, S);
  1118.     until (Event.KeyCode = kbEnter) or (Event.KeyCode = kbEsc);
  1119.     if Event.KeyCode = kbEsc then Locate(SaveBounds);
  1120.   end;
  1121.   SetState(sfDragging, False);
  1122. end;
  1123.  
  1124. procedure TView.Draw;
  1125. var
  1126.   B: TDrawBuffer;
  1127. begin
  1128.   MoveChar(B, ' ', GetColor(1), Size.X);
  1129.   WriteLine(0, 0, Size.X, Size.Y, B);
  1130. end;
  1131.  
  1132. procedure TView.DrawCursor;
  1133. begin
  1134.   if State and sfFocused <> 0 then ResetCursor;
  1135. end;
  1136.  
  1137. procedure TView.DrawHide(LastView: PView);
  1138. begin
  1139.   DrawCursor;
  1140.   DrawUnderView(State and sfShadow <> 0, LastView);
  1141. end;
  1142.  
  1143. procedure TView.DrawShow(LastView: PView);
  1144. begin
  1145.   DrawView;
  1146.   if State and sfShadow <> 0 then DrawUnderView(True, LastView);
  1147. end;
  1148.  
  1149. procedure TView.DrawUnderRect(var R: TRect; LastView: PView);
  1150. begin
  1151.   Owner^.Clip.Intersect(R);
  1152.   Owner^.DrawSubViews(NextView, LastView);
  1153.   Owner^.GetExtent(Owner^.Clip);
  1154. end;
  1155.  
  1156. procedure TView.DrawUnderView(DoShadow: Boolean; LastView: PView);
  1157. var
  1158.   R: TRect;
  1159. begin
  1160.   GetBounds(R);
  1161.   if DoShadow then
  1162.   begin
  1163.     Inc(R.B.X, ShadowSize.X);
  1164.     Inc(R.B.Y, ShadowSize.Y);
  1165.   end;
  1166.   DrawUnderRect(R, LastView);
  1167. end;
  1168.  
  1169. procedure TView.DrawView;
  1170. begin
  1171.   if Exposed then
  1172.   begin
  1173.     Draw;
  1174.     DrawCursor;
  1175.   end;
  1176. end;
  1177.  
  1178. procedure TView.EnableCommands(Commands: TCommandSet);
  1179. begin
  1180.   CommandSetChanged := CommandSetChanged or
  1181.     (CurCommandSet * Commands <> Commands);
  1182.   CurCommandSet := CurCommandSet + Commands;
  1183. end;
  1184.  
  1185. procedure TView.EndModal(Command: Word);
  1186. var
  1187.   P: PView;
  1188. begin
  1189.   P := TopView;
  1190.   if TopView <> nil then TopView^.EndModal(Command);
  1191. end;
  1192.  
  1193. function TView.EventAvail: Boolean;
  1194. var
  1195.   Event: TEvent;
  1196. begin
  1197.   GetEvent(Event);
  1198.   if Event.What <> evNothing then PutEvent(Event);
  1199.   EventAvail := Event.What <> evNothing;
  1200. end;
  1201.  
  1202. procedure TView.GetBounds(var Bounds: TRect); assembler;
  1203. asm
  1204.         PUSH    DS
  1205.         LDS     SI,Self
  1206.         ADD     SI,OFFSET TView.Origin
  1207.         LES     DI,Bounds
  1208.         CLD
  1209.         LODSW                           {Origin.X}
  1210.         MOV     CX,AX
  1211.         STOSW
  1212.         LODSW                           {Origin.Y}
  1213.         MOV     DX,AX
  1214.         STOSW
  1215.         LODSW                           {Size.X}
  1216.         ADD     AX,CX
  1217.         STOSW
  1218.         LODSW                           {Size.Y}
  1219.         ADD     AX,DX
  1220.         STOSW
  1221.         POP     DS
  1222. end;
  1223.  
  1224. function TView.Execute: Word;
  1225. begin
  1226.   Execute := cmCancel;
  1227. end;
  1228.  
  1229. function TView.Exposed: Boolean; assembler;
  1230. var
  1231.   Target: Pointer;
  1232. asm
  1233.         LES     DI,Self
  1234.         TEST    ES:[DI].TView.State,sfExposed
  1235.         JE      @@2
  1236.         XOR     AX,AX
  1237.         CMP     AX,ES:[DI].TView.Size.X
  1238.         JGE     @@2
  1239.         CMP     AX,ES:[DI].TView.Size.Y
  1240.         JGE     @@2
  1241. @@1:    XOR     BX,BX
  1242.         MOV     CX,ES:[DI].TView.Size.X
  1243.         PUSH    AX
  1244.         CALL    @@11
  1245.         POP     AX
  1246.         JNC     @@3
  1247.         LES     DI,Self
  1248.         INC     AX
  1249.         CMP     AX,ES:[DI].TView.Size.Y
  1250.         JL      @@1
  1251. @@2:    MOV     AL,0
  1252.         JMP     @@30
  1253. @@3:    MOV     AL,1
  1254.         JMP     @@30
  1255. @@8:    STC
  1256. @@9:    RETN
  1257. @@10:   LES     DI,ES:[DI].TView.Owner
  1258.         CMP     ES:[DI].TGroup.Buffer.Word[2],0
  1259.         JNE     @@9
  1260. @@11:   MOV     Target.Word[0],DI
  1261.         MOV     Target.Word[2],ES
  1262.         ADD     AX,ES:[DI].TView.Origin.Y
  1263.         MOV     SI,ES:[DI].TView.Origin.X
  1264.         ADD     BX,SI
  1265.         ADD     CX,SI
  1266.         LES     DI,ES:[DI].TView.Owner
  1267.         MOV     SI,ES
  1268.         OR      SI,DI
  1269.         JE      @@9
  1270.         CMP     AX,ES:[DI].TGroup.Clip.A.Y
  1271.         JL      @@8
  1272.         CMP     AX,ES:[DI].TGroup.Clip.B.Y
  1273.         JGE     @@8
  1274.         CMP     BX,ES:[DI].TGroup.Clip.A.X
  1275.         JGE     @@12
  1276.         MOV     BX,ES:[DI].TGroup.Clip.A.X
  1277. @@12:   CMP     CX,ES:[DI].TGroup.Clip.B.X
  1278.         JLE     @@13
  1279.         MOV     CX,ES:[DI].TGroup.Clip.B.X
  1280. @@13:   CMP     BX,CX
  1281.         JGE     @@8
  1282.         LES     DI,ES:[DI].TGroup.Last
  1283. @@20:   LES     DI,ES:[DI].TView.Next
  1284.         CMP     DI,Target.Word[0]
  1285.         JNE     @@21
  1286.         MOV     SI,ES
  1287.         CMP     SI,Target.Word[2]
  1288.         JE      @@10
  1289. @@21:   TEST    ES:[DI].TView.State,sfVisible
  1290.         JE      @@20
  1291.         MOV     SI,ES:[DI].TView.Origin.Y
  1292.         CMP     AX,SI
  1293.         JL      @@20
  1294.         ADD     SI,ES:[DI].TView.Size.Y
  1295.         CMP     AX,SI
  1296.         JGE     @@20
  1297.         MOV     SI,ES:[DI].TView.Origin.X
  1298.         CMP     BX,SI
  1299.         JL      @@22
  1300.         ADD     SI,ES:[DI].TView.Size.X
  1301.         CMP     BX,SI
  1302.         JGE     @@20
  1303.         MOV     BX,SI
  1304.         CMP     BX,CX
  1305.         JL      @@20
  1306.         STC
  1307.         RETN
  1308. @@22:   CMP     CX,SI
  1309.         JLE     @@20
  1310.         ADD     SI,ES:[DI].TView.Size.X
  1311.         CMP     CX,SI
  1312.         JG      @@23
  1313.         MOV     CX,ES:[DI].TView.Origin.X
  1314.         JMP     @@20
  1315. @@23:   PUSH    Target.Word[2]
  1316.         PUSH    Target.Word[0]
  1317.         PUSH    ES
  1318.         PUSH    DI
  1319.         PUSH    SI
  1320.         PUSH    CX
  1321.         PUSH    AX
  1322.         MOV     CX,ES:[DI].TView.Origin.X
  1323.         CALL    @@20
  1324.         POP     AX
  1325.         POP     CX
  1326.         POP     BX
  1327.         POP     DI
  1328.         POP     ES
  1329.         POP     Target.Word[0]
  1330.         POP     Target.Word[2]
  1331.         JC      @@20
  1332.         RETN
  1333. @@30:
  1334. end;
  1335.  
  1336. function TView.Focus: Boolean;
  1337. var
  1338.   Result: Boolean;
  1339. begin
  1340.   Result := True;
  1341.   if State and (sfSelected + sfModal) = 0 then
  1342.   begin
  1343.     if Owner <> nil then
  1344.     begin
  1345.       Result := Owner^.Focus;
  1346.       if Result then
  1347.         if ((Owner^.Current = nil) or
  1348.           (Owner^.Current^.Options and ofValidate = 0) or
  1349.           (Owner^.Current^.Valid(cmReleasedFocus))) then
  1350.           Select
  1351.         else
  1352.           Result := False;
  1353.     end;
  1354.   end;
  1355.   Focus := Result;
  1356. end;
  1357.  
  1358. procedure TView.GetClipRect(var Clip: TRect);
  1359. begin
  1360.   GetBounds(Clip);
  1361.   if Owner <> nil then Clip.Intersect(Owner^.Clip);
  1362.   Clip.Move(-Origin.X, -Origin.Y);
  1363. end;
  1364.  
  1365. function TView.GetColor(Color: Word): Word; assembler;
  1366. asm
  1367.         MOV     AX,Color
  1368.         CALL    MapCPair
  1369. end;
  1370.  
  1371. procedure TView.GetCommands(var Commands: TCommandSet);
  1372. begin
  1373.   Commands := CurCommandSet;
  1374. end;
  1375.  
  1376. procedure TView.GetData(var Rec);
  1377. begin
  1378. end;
  1379.  
  1380. procedure TView.GetEvent(var Event: TEvent);
  1381. begin
  1382.   if Owner <> nil then Owner^.GetEvent(Event);
  1383. end;
  1384.  
  1385. procedure TView.GetExtent(var Extent: TRect); assembler;
  1386. asm
  1387.         PUSH    DS
  1388.         LDS     SI,Self
  1389.         ADD     SI,OFFSET TView.Size
  1390.         LES     DI,Extent
  1391.         CLD
  1392.         XOR     AX,AX
  1393.         STOSW
  1394.         STOSW
  1395.         MOVSW
  1396.         MOVSW
  1397.         POP     DS
  1398. end;
  1399.  
  1400. function TView.GetHelpCtx: Word;
  1401. begin
  1402.   if State and sfDragging <> 0 then
  1403.     GetHelpCtx := hcDragging else
  1404.     GetHelpCtx := HelpCtx;
  1405. end;
  1406.  
  1407. function TView.GetPalette: PPalette;
  1408. begin
  1409.   GetPalette := nil;
  1410. end;
  1411.  
  1412. procedure TView.GetPeerViewPtr(var S: TStream; var P);
  1413. var
  1414.   Index: Integer;
  1415. begin
  1416.   S.Read(Index, SizeOf(Word));
  1417.   if (Index = 0) or (OwnerGroup = nil) then Pointer(P) := nil
  1418.   else
  1419.   begin
  1420.     Pointer(P) := FixupList^[Index];
  1421.     FixupList^[Index] := @P;
  1422.   end;
  1423. end;
  1424.  
  1425. function TView.GetState(AState: Word): Boolean;
  1426. begin
  1427.   GetState := State and AState = AState;
  1428. end;
  1429.  
  1430. procedure TView.GrowTo(X, Y: Integer);
  1431. var
  1432.   R: TRect;
  1433. begin
  1434.   R.Assign(Origin.X, Origin.Y, Origin.X + X, Origin.Y + Y);
  1435.   Locate(R);
  1436. end;
  1437.  
  1438. procedure TView.HandleEvent(var Event: TEvent);
  1439. begin
  1440.   if Event.What = evMouseDown then
  1441.     if (State and (sfSelected + sfDisabled) = 0) and
  1442.        (Options and ofSelectable <> 0) then
  1443.       if not Focus or (Options and ofFirstClick = 0) then
  1444.         ClearEvent(Event);
  1445. end;
  1446.  
  1447. procedure TView.Hide;
  1448. begin
  1449.   if State and sfVisible <> 0 then SetState(sfVisible, False);
  1450. end;
  1451.  
  1452. procedure TView.HideCursor;
  1453. begin
  1454.   SetState(sfCursorVis, False);
  1455. end;
  1456.  
  1457. procedure TView.KeyEvent(var Event: TEvent);
  1458. begin
  1459.   repeat GetEvent(Event) until Event.What = evKeyDown;
  1460. end;
  1461.  
  1462. procedure TView.Locate(var Bounds: TRect);
  1463. var
  1464.   R: TRect;
  1465.   Min, Max: TPoint;
  1466.  
  1467. function Range(Val, Min, Max: Integer): Integer;
  1468. begin
  1469.   if Val < Min then Range := Min else
  1470.     if Val > Max then Range := Max else
  1471.       Range := Val;
  1472. end;
  1473.  
  1474. begin
  1475.   SizeLimits(Min, Max);
  1476.   Bounds.B.X := Bounds.A.X + Range(Bounds.B.X - Bounds.A.X, Min.X, Max.X);
  1477.   Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y - Bounds.A.Y, Min.Y, Max.Y);
  1478.   GetBounds(R);
  1479.   if not Bounds.Equals(R) then
  1480.   begin
  1481.     ChangeBounds(Bounds);
  1482.     if (Owner <> nil) and (State and sfVisible <> 0) then
  1483.     begin
  1484.       if State and sfShadow <> 0 then
  1485.       begin
  1486.         R.Union(Bounds);
  1487.         Inc(R.B.X, ShadowSize.X);
  1488.         Inc(R.B.Y, ShadowSize.Y);
  1489.       end;
  1490.       DrawUnderRect(R, nil);
  1491.     end;
  1492.   end;
  1493. end;
  1494.  
  1495. procedure TView.MakeFirst;
  1496. begin
  1497.   PutInFrontOf(Owner^.First);
  1498. end;
  1499.  
  1500. procedure TView.MakeGlobal(Source: TPoint; var Dest: TPoint); assembler;
  1501. asm
  1502.         LES     DI,Self
  1503.         XOR     AX,AX
  1504.         MOV     DX,AX
  1505. @@1:    ADD     AX,ES:[DI].TView.Origin.X
  1506.         ADD     DX,ES:[DI].TView.Origin.Y
  1507.         LES     DI,ES:[DI].TView.Owner
  1508.         MOV     SI,ES
  1509.         OR      SI,DI
  1510.         JNE     @@1
  1511.         ADD     AX,Source.X
  1512.         ADD     DX,Source.Y
  1513.         LES     DI,Dest
  1514.         CLD
  1515.         STOSW
  1516.         XCHG    AX,DX
  1517.         STOSW
  1518. end;
  1519.  
  1520. procedure TView.MakeLocal(Source: TPoint; var Dest: TPoint); assembler;
  1521. asm
  1522.         LES     DI,Self
  1523.         XOR     AX,AX
  1524.         MOV     DX,AX
  1525. @@1:    ADD     AX,ES:[DI].TView.Origin.X
  1526.         ADD     DX,ES:[DI].TView.Origin.Y
  1527.         LES     DI,ES:[DI].TView.Owner
  1528.         MOV     SI,ES
  1529.         OR      SI,DI
  1530.         JNE     @@1
  1531.         NEG     AX
  1532.         NEG     DX
  1533.         ADD     AX,Source.X
  1534.         ADD     DX,Source.Y
  1535.         LES     DI,Dest
  1536.         CLD
  1537.         STOSW
  1538.         XCHG    AX,DX
  1539.         STOSW
  1540. end;
  1541.  
  1542. function TView.MouseEvent(var Event: TEvent; Mask: Word): Boolean;
  1543. begin
  1544.   repeat GetEvent(Event) until Event.What and (Mask or evMouseUp) <> 0;
  1545.   MouseEvent := Event.What <> evMouseUp;
  1546. end;
  1547.  
  1548. function TView.MouseInView(Mouse: TPoint): Boolean;
  1549. var
  1550.   Extent: TRect;
  1551. begin
  1552.   MakeLocal(Mouse, Mouse);
  1553.   GetExtent(Extent);
  1554.   MouseInView := Extent.Contains(Mouse);
  1555. end;
  1556.  
  1557. procedure TView.MoveTo(X, Y: Integer);
  1558. var
  1559.   R: TRect;
  1560. begin
  1561.   R.Assign(X, Y, X + Size.X, Y + Size.Y);
  1562.   Locate(R);
  1563. end;
  1564.  
  1565. function TView.NextView: PView;
  1566. begin
  1567.   if @Self = Owner^.Last then NextView := nil else NextView := Next;
  1568. end;
  1569.  
  1570. procedure TView.NormalCursor;
  1571. begin
  1572.   SetState(sfCursorIns, False);
  1573. end;
  1574.  
  1575. function TView.Prev: PView; assembler;
  1576. asm
  1577.         LES     DI,Self
  1578.         MOV     CX,DI
  1579.         MOV     BX,ES
  1580. @@1:    MOV     AX,DI
  1581.         MOV     DX,ES
  1582.         LES     DI,ES:[DI].TView.Next
  1583.         CMP     DI,CX
  1584.         JNE     @@1
  1585.         MOV     SI,ES
  1586.         CMP     SI,BX
  1587.         JNE     @@1
  1588. end;
  1589.  
  1590. function TView.PrevView: PView;
  1591. begin
  1592.   if @Self = Owner^.First then PrevView := nil else PrevView := Prev;
  1593. end;
  1594.  
  1595.  
  1596. procedure TView.PutEvent(var Event: TEvent);
  1597. begin
  1598.   if Owner <> nil then Owner^.PutEvent(Event);
  1599. end;
  1600.  
  1601. procedure TView.PutInFrontOf(Target: PView);
  1602. var
  1603.   P, LastView: PView;
  1604.  
  1605. procedure MoveView;
  1606. begin
  1607.   Owner^.RemoveView(@Self);
  1608.   Owner^.InsertView(@Self, Target);
  1609. end;
  1610.  
  1611. begin
  1612.   if (Owner <> nil) and (Target <> @Self) and (Target <> NextView) and
  1613.     ((Target = nil) or (Target^.Owner = Owner)) then
  1614.     if State and sfVisible = 0 then MoveView else
  1615.     begin
  1616.       
  1617.       LastView := NextView;
  1618.       if LastView <> nil then
  1619.       begin
  1620.         P := Target;
  1621.         while (P <> nil) and (P <> LastView) do P := P^.NextView;
  1622.         if P = nil then LastView := Target;
  1623.       end;
  1624.       State := State and not sfVisible;
  1625.       if LastView = Target then DrawHide(LastView);
  1626.       MoveView;
  1627.       State := State or sfVisible;
  1628.       if LastView <> Target then DrawShow(LastView);
  1629.       if Options and ofSelectable <> 0 then
  1630.       begin
  1631.         Owner^.ResetCurrent;
  1632.         Owner^.ResetCursor;
  1633.       end;
  1634.     end;
  1635. end;
  1636.  
  1637. procedure TView.PutPeerViewPtr(var S: TStream; P: PView);
  1638. var
  1639.   Index: Integer;
  1640. begin
  1641.   if (P = nil) or (OwnerGroup = nil) then Index := 0
  1642.   else Index := OwnerGroup^.IndexOf(P);
  1643.   S.Write(Index, SizeOf(Word));
  1644. end;
  1645.  
  1646. procedure TView.ResetCursor; assembler;
  1647. var
  1648.   CurInfo : VIOCURSORINFO;
  1649. asm
  1650.         LES     DI,Self
  1651.         MOV     AX,ES:[DI].TView.State
  1652.         NOT     AX
  1653.         TEST    AX,sfVisible+sfCursorVis+sfFocused
  1654.         JNE     @@4
  1655.         MOV     AX,ES:[DI].TView.Cursor.Y
  1656.         MOV     DX,ES:[DI].TView.Cursor.X
  1657. @@1:    OR      AX,AX
  1658.         JL      @@4
  1659.         CMP     AX,ES:[DI].TView.Size.Y
  1660.         JGE     @@4
  1661.         OR      DX,DX
  1662.         JL      @@4
  1663.         CMP     DX,ES:[DI].TView.Size.X
  1664.         JGE     @@4
  1665.         ADD     AX,ES:[DI].TView.Origin.Y
  1666.         ADD     DX,ES:[DI].TView.Origin.X
  1667.         MOV     CX,DI
  1668.         MOV     BX,ES
  1669.         LES     DI,ES:[DI].TView.Owner
  1670.         MOV     SI,ES
  1671.         OR      SI,DI
  1672.         JE      @@5
  1673.         TEST    ES:[DI].TView.State,sfVisible
  1674.         JE      @@4
  1675.         LES     DI,ES:[DI].TGroup.Last
  1676. @@2:    LES     DI,ES:[DI].TView.Next
  1677.         CMP     CX,DI
  1678.         JNE     @@3
  1679.         MOV     SI,ES
  1680.         CMP     BX,SI
  1681.         JNE     @@3
  1682.         LES     DI,ES:[DI].TView.Owner
  1683.         JMP     @@1
  1684. @@3:    TEST    ES:[DI].TView.State,sfVisible
  1685.         JE      @@2
  1686.         MOV     SI,ES:[DI].TView.Origin.Y
  1687.         CMP     AX,SI
  1688.         JL      @@2
  1689.         ADD     SI,ES:[DI].TView.Size.Y
  1690.         CMP     AX,SI
  1691.         JGE     @@2
  1692.         MOV     SI,ES:[DI].TView.Origin.X
  1693.         CMP     DX,SI
  1694.         JL      @@2
  1695.         ADD     SI,ES:[DI].TView.Size.X
  1696.         CMP     DX,SI
  1697.         JGE     @@2
  1698. @@4:    MOV     CX,2000H
  1699.         JMP     @@6
  1700. @@5:    PUSH    AX
  1701.         PUSH    DX
  1702.         PUSH    0
  1703.         CALL    VioSetCurPos
  1704.         MOV     CX,CursorLines
  1705.         LES     DI,Self
  1706.         TEST    ES:[DI].TView.State,sfCursorIns
  1707.         JE      @@6
  1708.         MOV     CH,0
  1709.         OR      CL,CL
  1710.         JNE     @@6
  1711.         MOV     CL,7
  1712. @@6:
  1713.         XOR    AX,AX
  1714.         CMP    CX,2000H
  1715.     JNE    @@7
  1716.     DEC    AX
  1717.         MOV    CX,001FH
  1718. @@7:
  1719.         MOV     CurInfo.attr,AX
  1720.     MOV     BYTE PTR [CurInfo.yStart],CH
  1721.     MOV    BYTE PTR [CurInfo.yStart+1],0
  1722.     MOV     BYTE PTR [CurInfo.cEnd],CL
  1723.     MOV    BYTE PTR [CurInfo.cEnd+1],0
  1724.         MOV    WORD PTR [CurInfo.cEnd+2],0 { cursor width }
  1725.         LEA    AX,CurInfo
  1726.         PUSH    SS
  1727.         PUSH    AX
  1728.         PUSH    0
  1729.         CALL    VioSetCurType
  1730. end;
  1731.  
  1732. procedure TView.Select;
  1733. begin
  1734.   if Options and ofSelectable <> 0 then
  1735.     if Options and ofTopSelect <> 0 then MakeFirst else
  1736.       if Owner <> nil then Owner^.SetCurrent(@Self, NormalSelect);
  1737. end;
  1738.  
  1739. procedure TView.SetBounds(var Bounds: TRect); assembler;
  1740. asm
  1741.         PUSH    DS
  1742.         LES     DI,Self
  1743.         LDS     SI,Bounds
  1744.         MOV     AX,[SI].TRect.A.X
  1745.         MOV     ES:[DI].Origin.X,AX
  1746.         MOV     AX,[SI].TRect.A.Y
  1747.         MOV     ES:[DI].Origin.Y,AX
  1748.         MOV     AX,[SI].TRect.B.X
  1749.         SUB     AX,[SI].TRect.A.X
  1750.         MOV     ES:[DI].Size.X,AX
  1751.         MOV     AX,[SI].TRect.B.Y
  1752.         SUB     AX,[SI].TRect.A.Y
  1753.         MOV     ES:[DI].Size.Y,AX
  1754.         POP     DS
  1755. end;
  1756.  
  1757. procedure TView.SetCmdState(Commands: TCommandSet; Enable: Boolean);
  1758. begin
  1759.   if Enable then EnableCommands(Commands)
  1760.   else DisableCommands(Commands);
  1761. end;
  1762.  
  1763. procedure TView.SetCommands(Commands: TCommandSet);
  1764. begin
  1765.   CommandSetChanged := CommandSetChanged or (CurCommandSet <> Commands);
  1766.   CurCommandSet := Commands;
  1767. end;
  1768.  
  1769. procedure TView.SetCursor(X, Y: Integer);
  1770. begin
  1771.   Cursor.X := X;
  1772.   Cursor.Y := Y;
  1773.   DrawCursor;
  1774. end;
  1775.  
  1776. procedure TView.SetData(var Rec);
  1777. begin
  1778. end;
  1779.  
  1780. procedure TView.SetState(AState: Word; Enable: Boolean);
  1781. var
  1782.   Command: Word;
  1783. begin
  1784.   if Enable then
  1785.     State := State or AState else
  1786.     State := State and not AState;
  1787.   if Owner <> nil then
  1788.     case AState of
  1789.       sfVisible:
  1790.         begin
  1791.           if Owner^.State and sfExposed <> 0 then
  1792.             SetState(sfExposed, Enable);
  1793.           if Enable then DrawShow(nil) else DrawHide(nil);
  1794.           if Options and ofSelectable <> 0 then Owner^.ResetCurrent;
  1795.         end;
  1796.       sfCursorVis, sfCursorIns:
  1797.         DrawCursor;
  1798.       sfShadow:
  1799.         DrawUnderView(True, nil);
  1800.       sfFocused:
  1801.         begin
  1802.           ResetCursor;
  1803.           if Enable then
  1804.             Command := cmReceivedFocus else
  1805.             Command := cmReleasedFocus;
  1806.           Message(Owner, evBroadcast, Command, @Self);
  1807.         end;
  1808.     end;
  1809. end;
  1810.  
  1811. procedure TView.Show;
  1812. begin
  1813.   if State and sfVisible = 0 then SetState(sfVisible, True);
  1814. end;
  1815.  
  1816. procedure TView.ShowCursor;
  1817. begin
  1818.   SetState(sfCursorVis, True);
  1819. end;
  1820.  
  1821. procedure TView.SizeLimits(var Min, Max: TPoint);
  1822. begin
  1823.   Longint(Min) := 0;
  1824.   if Owner <> nil then
  1825.     Max := Owner^.Size else
  1826.     Longint(Max) := $7FFF7FFF;
  1827. end;
  1828.  
  1829. procedure TView.Store(var S: TStream);
  1830. var
  1831.   SaveState: Word;
  1832. begin
  1833.   SaveState := State;
  1834.   State := State and not (sfActive + sfSelected + sfFocused + sfExposed);
  1835.   S.Write(Origin,
  1836.     SizeOf(TPoint) * 3 +
  1837.     SizeOf(Byte) * 2 +
  1838.     SizeOf(Word) * 4);
  1839.   State := SaveState;
  1840. end;
  1841.  
  1842. function TView.TopView: PView;
  1843. var
  1844.   P: PView;
  1845. begin
  1846.   if TheTopView = nil then
  1847.   begin
  1848.     P := @Self;
  1849.     while (P <> nil) and (P^.State and sfModal = 0) do P := P^.Owner;
  1850.     TopView := P;
  1851.   end
  1852.   else TopView := TheTopView;
  1853. end;
  1854.  
  1855. function TView.Valid(Command: Word): Boolean;
  1856. begin
  1857.   Valid := True;
  1858. end;
  1859.  
  1860. procedure TView.WriteBuf(X, Y, W, H: Integer; var Buf); assembler;
  1861. var
  1862.   Target: Pointer; {Variables used by WriteView}
  1863.   Buffer: Pointer;
  1864.   Offset: Word;
  1865. asm
  1866.         CMP     H,0
  1867.         JLE     @@2
  1868. @@1:
  1869.     MOV     AX,Y
  1870.         MOV     BX,X
  1871.         MOV     CX,W
  1872.         LES     DI,Buf
  1873.         CALL    WriteView
  1874.         MOV     AX,W
  1875.         SHL     AX,1
  1876.         ADD     WORD PTR Buf[0],AX
  1877.         INC     Y
  1878.         DEC     H
  1879.         JNE     @@1
  1880. @@2:
  1881. end;
  1882.  
  1883. procedure TView.WriteChar(X, Y: Integer; C: Char; Color: Byte;
  1884.   Count: Integer); assembler;
  1885. var
  1886.   Target: Pointer; {Variables used by WriteView}
  1887.   Buffer: Pointer;
  1888.   Offset: Word;
  1889. asm
  1890.         MOV     AL,Color
  1891.         CALL    MapColor
  1892.         MOV     AH,AL
  1893.         MOV     AL,C
  1894.         MOV     CX,Count
  1895.         OR      CX,CX
  1896.         JLE     @@2
  1897.         CMP     CX,256
  1898.         JLE     @@1
  1899.         MOV     CX,256
  1900. @@1:    MOV     DI,CX
  1901.         SHL     DI,1
  1902.         SUB     SP,DI
  1903.         MOV     DI,SP
  1904.         PUSH    SS
  1905.         POP     ES
  1906.         MOV     DX,CX
  1907.         CLD
  1908.         REP     STOSW
  1909.         MOV     CX,DX
  1910.         MOV     DI,SP
  1911.         MOV     AX,Y
  1912.         MOV     BX,X
  1913.         CALL    WriteView
  1914. @@2:
  1915. end;
  1916.  
  1917. procedure TView.WriteLine(X, Y, W, H: Integer; var Buf); assembler;
  1918. var
  1919.   Target: Pointer; {Variables used by WriteView}
  1920.   Buffer: Pointer;
  1921.   Offset: Word;
  1922. asm
  1923.         CMP     H,0
  1924.         JLE     @@2
  1925. @@1:    MOV     AX,Y
  1926.         MOV     BX,X
  1927.         MOV     CX,W
  1928.         LES     DI,Buf
  1929.         CALL    WriteView
  1930.         INC     Y
  1931.         DEC     H
  1932.         JNE     @@1
  1933. @@2:
  1934. end;
  1935.  
  1936. procedure TView.WriteStr(X, Y: Integer; Str: String; Color: Byte); assembler;
  1937. var
  1938.   Target: Pointer; {Variables used by WriteView}
  1939.   Buffer: Pointer;
  1940.   Offset: Word;
  1941. asm
  1942.         MOV     AL,Color
  1943.         CALL    MapColor
  1944.         MOV     AH,AL
  1945.         MOV     BX,DS
  1946.         LDS     SI,Str
  1947.         CLD
  1948.         LODSB
  1949.         MOV     CL,AL
  1950.         XOR     CH,CH
  1951.         JCXZ    @@3
  1952.         MOV     DI,CX
  1953.         SHL     DI,1
  1954.         SUB     SP,DI
  1955.         MOV     DI,SP
  1956.         PUSH    SS
  1957.         POP     ES
  1958.         MOV     DX,CX
  1959. @@1:    LODSB
  1960.         STOSW
  1961.         LOOP    @@1
  1962.         MOV     DS,BX
  1963.         MOV     CX,DX
  1964.         MOV     DI,SP
  1965.         MOV     AX,Y
  1966.         MOV     BX,X
  1967.         CALL    WriteView
  1968.         JMP     @@2
  1969. @@3:    MOV     DS,BX
  1970. @@2:
  1971. end;
  1972.  
  1973. { TFrame }
  1974.  
  1975. constructor TFrame.Init(var Bounds: TRect);
  1976. begin
  1977.   TView.Init(Bounds);
  1978.   GrowMode := gfGrowHiX + gfGrowHiY;
  1979.   EventMask := EventMask or evBroadcast;
  1980. end;
  1981.  
  1982. procedure TFrame.FrameLine(var FrameBuf; Y, N: Integer;
  1983.   Color: Byte); assembler;
  1984. const
  1985.   InitFrame: array[0..17] of Byte =
  1986.     ($06, $0A, $0C, $05, $00, $05, $03, $0A, $09,
  1987.      $16, $1A, $1C, $15, $00, $15, $13, $1A, $19);
  1988.   FrameChars: array[0..31] of Char =
  1989.     '   └ │┌├ ┘─┴┐┤┬┼   ╚ ║╔╟ ╝═╧╗╢╤ ';
  1990. var
  1991.   FrameMask: array[0..MaxViewWidth-1] of Byte;
  1992. asm
  1993.         LES     BX,Self
  1994.         MOV     DX,ES:[BX].TFrame.Size.X
  1995.         MOV     CX,DX
  1996.         DEC     CX
  1997.         DEC     CX
  1998.         MOV     SI,OFFSET InitFrame
  1999.         ADD     SI,N
  2000.         LEA     DI,FrameMask
  2001.         PUSH    SS
  2002.         POP     ES
  2003.         CLD
  2004.         MOVSB
  2005.         LODSB
  2006.         REP     STOSB
  2007.         MOVSB
  2008.         LES     BX,Self
  2009.         LES     BX,ES:[BX].TFrame.Owner
  2010.         LES     BX,ES:[BX].TGroup.Last
  2011.         DEC     DX
  2012. @1:     LES     BX,ES:[BX].TView.Next
  2013.         CMP     BX,WORD PTR Self[0]
  2014.         JNE     @2
  2015.         MOV     AX,ES
  2016.         CMP     AX,WORD PTR Self[2]
  2017.         JE      @10
  2018. @2:     TEST    ES:[BX].TView.Options,ofFramed
  2019.         JE      @1
  2020.         TEST    ES:[BX].TView.State,sfVisible
  2021.         JE      @1
  2022.         MOV     AX,Y
  2023.         SUB     AX,ES:[BX].TView.Origin.Y
  2024.         JL      @3
  2025.         CMP     AX,ES:[BX].TView.Size.Y
  2026.         JG      @1
  2027.         MOV     AX,0005H
  2028.         JL      @4
  2029.         MOV     AX,0A03H
  2030.         JMP     @4
  2031. @3:     INC     AX
  2032.         JNE     @1
  2033.         MOV     AX,0A06H
  2034. @4:     MOV     SI,ES:[BX].TView.Origin.X
  2035.         MOV     DI,ES:[BX].TView.Size.X
  2036.         ADD     DI,SI
  2037.         CMP     SI,1
  2038.         JG      @5
  2039.         MOV     SI,1
  2040. @5:     CMP     DI,DX
  2041.         JL      @6
  2042.         MOV     DI,DX
  2043. @6:     CMP     SI,DI
  2044.         JGE     @1
  2045.         OR      BYTE PTR FrameMask[SI-1],AL
  2046.         XOR     AL,AH
  2047.         OR      BYTE PTR FrameMask[DI],AL
  2048.         OR      AH,AH
  2049.         JE      @1
  2050.         MOV     CX,DI
  2051.         SUB     CX,SI
  2052. @8:     OR      BYTE PTR FrameMask[SI],AH
  2053.         INC     SI
  2054.         LOOP    @8
  2055.         JMP     @1
  2056. @10:    INC     DX
  2057.         MOV     AH,Color
  2058.         MOV     BX,OFFSET FrameChars
  2059.         MOV     CX,DX
  2060.         LEA     SI,FrameMask
  2061.         LES     DI,FrameBuf
  2062. @11:    SEGSS   LODSB
  2063.         XLAT
  2064.         STOSW
  2065.         LOOP    @11
  2066. end;
  2067.  
  2068. procedure TFrame.Draw;
  2069. var
  2070.   CFrame, CTitle: Word;
  2071.   F, I, L, Width: Integer;
  2072.   B: TDrawBuffer;
  2073.   Title: TTitleStr;
  2074.   Min, Max: TPoint;
  2075. begin
  2076.   if State and sfDragging <> 0 then
  2077.   begin
  2078.     CFrame := $0505;
  2079.     CTitle := $0005;
  2080.     F := 0;
  2081.   end else if State and sfActive = 0 then
  2082.   begin
  2083.     CFrame := $0101;
  2084.     CTitle := $0002;
  2085.     F := 0;
  2086.   end else
  2087.   begin
  2088.     CFrame := $0503;
  2089.     CTitle := $0004;
  2090.     F := 9;
  2091.   end;
  2092.   CFrame := GetColor(CFrame);
  2093.   CTitle := GetColor(CTitle);
  2094.   Width := Size.X;
  2095.   L := Width - 10;
  2096.   if PWindow(Owner)^.Flags and (wfClose+wfZoom) <> 0 then Dec(L,6);
  2097.   FrameLine(B, 0, F, Byte(CFrame));
  2098.   if (PWindow(Owner)^.Number <> wnNoNumber) and
  2099.      (PWindow(Owner)^.Number < 10) then
  2100.   begin
  2101.     Dec(L,4);
  2102.     if PWindow(Owner)^.Flags and wfZoom <> 0 then I := 7
  2103.     else I := 3;
  2104.     WordRec(B[Width - I]).Lo := PWindow(Owner)^.Number + $30;
  2105.   end;
  2106.   if Owner <> nil then Title := PWindow(Owner)^.GetTitle(L)
  2107.   else Title := '';
  2108.   if Title <> '' then
  2109.   begin
  2110.     L := Length(Title);
  2111.     if L > Width - 10 then L := Width - 10;
  2112.     if L < 0 then L := 0;
  2113.     I := (Width - L) shr 1;
  2114.     MoveChar(B[I - 1], ' ', CTitle, 1);
  2115.     MoveBuf(B[I], Title[1], CTitle, L);
  2116.     MoveChar(B[I + L], ' ', CTitle, 1);
  2117.   end;
  2118.   if State and sfActive <> 0 then
  2119.   begin
  2120.     if PWindow(Owner)^.Flags and wfClose <> 0 then
  2121.       if FrameMode and fmCloseClicked = 0 then
  2122.         MoveCStr(B[2], '[~■~]', CFrame)
  2123.       else MoveCStr(B[2], '[~'#15'~]', CFrame);
  2124.     if PWindow(Owner)^.Flags and wfZoom <> 0 then
  2125.     begin
  2126.       MoveCStr(B[Width - 5], '[~'#24'~]', CFrame);
  2127.       Owner^.SizeLimits(Min, Max);
  2128.       if FrameMode and fmZoomClicked <> 0 then
  2129.         WordRec(B[Width - 4]).Lo := 15
  2130.       else if Longint(Owner^.Size) = Longint(Max) then
  2131.         WordRec(B[Width - 4]).Lo := 18;
  2132.     end;
  2133.   end;
  2134.   WriteLine(0, 0, Size.X, 1, B);
  2135.   for I := 1 to Size.Y - 2 do
  2136.   begin
  2137.     FrameLine(B, I, F + 3, Byte(CFrame));
  2138.     WriteLine(0, I, Size.X, 1, B);
  2139.   end;
  2140.   FrameLine(B, Size.Y - 1, F + 6, Byte(CFrame));
  2141.   if State and sfActive <> 0 then
  2142.     if PWindow(Owner)^.Flags and wfGrow <> 0 then
  2143.       MoveCStr(B[Width - 2], '~─┘~', CFrame);
  2144.   WriteLine(0, Size.Y - 1, Size.X, 1, B);
  2145. end;
  2146.  
  2147. function TFrame.GetPalette: PPalette;
  2148. const
  2149.   P: String[Length(CFrame)] = CFrame;
  2150. begin
  2151.   GetPalette := @P;
  2152. end;
  2153.  
  2154. procedure TFrame.HandleEvent(var Event: TEvent);
  2155. var
  2156.   Mouse: TPoint;
  2157.  
  2158. procedure DragWindow(Mode: Byte);
  2159. var
  2160.   Limits: TRect;
  2161.   Min, Max: TPoint;
  2162. begin
  2163.   Owner^.Owner^.GetExtent(Limits);
  2164.   Owner^.SizeLimits(Min, Max);
  2165.   Owner^.DragView(Event, Owner^.DragMode or Mode, Limits, Min, Max);
  2166.   ClearEvent(Event);
  2167. end;
  2168.  
  2169. begin
  2170.   TView.HandleEvent(Event);
  2171.   if Event.What = evMouseDown then
  2172.   begin
  2173.     MakeLocal(Event.Where, Mouse);
  2174.     if Mouse.Y = 0 then
  2175.     begin
  2176.       if (PWindow(Owner)^.Flags and wfClose <> 0) and
  2177.         (State and sfActive <> 0) and (Mouse.X >= 2) and (Mouse.X <= 4) then
  2178.       begin
  2179.         repeat
  2180.           MakeLocal(Event.Where, Mouse);
  2181.           if (Mouse.X >= 2) and (Mouse.X <= 4) and (Mouse.Y = 0) then
  2182.             FrameMode := fmCloseClicked
  2183.           else FrameMode := 0;
  2184.           DrawView;
  2185.         until not MouseEvent(Event, evMouseMove + evMouseAuto);
  2186.         FrameMode := 0;
  2187.         if (Mouse.X >= 2) and (Mouse.X <= 4) and (Mouse.Y = 0) then
  2188.         begin
  2189.           Event.What := evCommand;
  2190.           Event.Command := cmClose;
  2191.           Event.InfoPtr := Owner;
  2192.           PutEvent(Event);
  2193.         end;
  2194.         ClearEvent(Event);
  2195.         DrawView;
  2196.       end else
  2197.         if (PWindow(Owner)^.Flags and wfZoom <> 0) and
  2198.           (State and sfActive <> 0) and (Event.Double or
  2199.           (Mouse.X >= Size.X - 5) and
  2200.           (Mouse.X <= Size.X - 3)) then
  2201.         begin
  2202.           if not Event.Double then
  2203.             repeat
  2204.               MakeLocal(Event.Where, Mouse);
  2205.               if (Mouse.X >= Size.X - 5) and (Mouse.X <= Size.X - 3) and
  2206.                 (Mouse.Y = 0) then
  2207.                 FrameMode := fmZoomClicked
  2208.               else FrameMode := 0;
  2209.               DrawView;
  2210.             until not MouseEvent(Event, evMouseMove + evMouseAuto);
  2211.           FrameMode := 0;
  2212.           if ((Mouse.X >= Size.X - 5) and (Mouse.X <= Size.X - 3) and
  2213.               (Mouse.Y = 0)) or Event.Double then
  2214.           begin
  2215.             Event.What := evCommand;
  2216.             Event.Command := cmZoom;
  2217.             Event.InfoPtr := Owner;
  2218.             PutEvent(Event);
  2219.           end;
  2220.           ClearEvent(Event);
  2221.           DrawView;
  2222.         end else
  2223.           if PWindow(Owner)^.Flags and wfMove <> 0 then
  2224.             DragWindow(dmDragMove);
  2225.     end else
  2226.       if (State and sfActive <> 0) and (Mouse.X >= Size.X - 2) and
  2227.           (Mouse.Y >= Size.Y - 1) then
  2228.         if PWindow(Owner)^.Flags and wfGrow <> 0 then
  2229.           DragWindow(dmDragGrow);
  2230.   end;
  2231. end;
  2232.  
  2233. procedure TFrame.SetState(AState: Word; Enable: Boolean);
  2234. begin
  2235.   TView.SetState(AState, Enable);
  2236.   if AState and (sfActive + sfDragging) <> 0 then DrawView;
  2237. end;
  2238.  
  2239. { TScrollBar }
  2240.  
  2241. constructor TScrollBar.Init(var Bounds: TRect);
  2242. const
  2243.   VChars: TScrollChars = (#30, #31, #177, #254, #178);
  2244.   HChars: TScrollChars = (#17, #16, #177, #254, #178);
  2245. begin
  2246.   TView.Init(Bounds);
  2247.   Value := 0;
  2248.   Min := 0;
  2249.   Max := 0;
  2250.   PgStep := 1;
  2251.   ArStep := 1;
  2252.   if Size.X = 1 then
  2253.   begin
  2254.     GrowMode := gfGrowLoX + gfGrowHiX + gfGrowHiY;
  2255.     Chars := VChars;
  2256.   end else
  2257.   begin
  2258.     GrowMode := gfGrowLoY + gfGrowHiX + gfGrowHiY;
  2259.     Chars := HChars;
  2260.   end;
  2261. end;
  2262.  
  2263. constructor TScrollBar.Load(var S: TStream);
  2264. begin
  2265.   TView.Load(S);
  2266.   S.Read(Value, SizeOf(Integer) * 5 + SizeOf(TScrollChars));
  2267. end;
  2268.  
  2269. procedure TScrollBar.Draw;
  2270. begin
  2271.   DrawPos(GetPos);
  2272. end;
  2273.  
  2274. procedure TScrollBar.DrawPos(Pos: Integer);
  2275. var
  2276.   S: Integer;
  2277.   B: TDrawBuffer;
  2278. begin
  2279.   S := GetSize - 1;
  2280.   MoveChar(B[0], Chars[0], GetColor(2), 1);
  2281.   if Max = Min then
  2282.     MoveChar(B[1], Chars[4], GetColor(1), S - 1)
  2283.   else
  2284.   begin
  2285.     MoveChar(B[1], Chars[2], GetColor(1), S - 1);
  2286.     MoveChar(B[Pos], Chars[3], GetColor(3), 1);
  2287.   end;
  2288.   MoveChar(B[S], Chars[1], GetColor(2), 1);
  2289.   WriteBuf(0, 0, Size.X, Size.Y, B);
  2290. end;
  2291.  
  2292. function TScrollBar.GetPalette: PPalette;
  2293. const
  2294.   P: String[Length(CScrollBar)] = CScrollBar;
  2295. begin
  2296.   GetPalette := @P;
  2297. end;
  2298.  
  2299. function TScrollBar.GetPos: Integer;
  2300. var
  2301.   R: Integer;
  2302. begin
  2303.   R := Max - Min;
  2304.   if R = 0 then
  2305.     GetPos := 1 else
  2306.     GetPos := LongDiv(LongMul(Value - Min, GetSize - 3) + R shr 1, R) + 1;
  2307. end;
  2308.  
  2309. function TScrollBar.GetSize: Integer;
  2310. var
  2311.   S: Integer;
  2312. begin
  2313.   if Size.X = 1 then S := Size.Y else S := Size.X;
  2314.   if S < 3 then GetSize := 3 else GetSize := S;
  2315. end;
  2316.  
  2317. procedure TScrollBar.HandleEvent(var Event: TEvent);
  2318. var
  2319.   Tracking: Boolean;
  2320.   I, P, S, ClickPart: Integer;
  2321.   Mouse: TPoint;
  2322.   Extent: TRect;
  2323.  
  2324. function GetPartCode: Integer;
  2325. var
  2326.   Mark, Part: Integer;
  2327. begin
  2328.   Part := -1;
  2329.   if Extent.Contains(Mouse) then
  2330.   begin
  2331.     if Size.X = 1 then Mark := Mouse.Y else Mark := Mouse.X;
  2332.     if Mark = P then Part := sbIndicator else
  2333.     begin
  2334.       if Mark < 1 then Part := sbLeftArrow else
  2335.         if Mark < P then Part := sbPageLeft else
  2336.           if Mark < S then Part := sbPageRight else
  2337.             Part := sbRightArrow;
  2338.       if Size.X = 1 then Inc(Part, 4);
  2339.     end;
  2340.   end;
  2341.   GetPartCode := Part;
  2342. end;
  2343.  
  2344. procedure Clicked;
  2345. begin
  2346.   Message(Owner, evBroadcast, cmScrollBarClicked, @Self);
  2347. end;
  2348.  
  2349. begin
  2350.   TView.HandleEvent(Event);
  2351.   case Event.What of
  2352.     evMouseDown:
  2353.       begin
  2354.         Clicked;
  2355.         MakeLocal(Event.Where, Mouse);
  2356.         GetExtent(Extent);
  2357.         Extent.Grow(1, 1);
  2358.         P := GetPos;
  2359.         S := GetSize - 1;
  2360.         ClickPart := GetPartCode;
  2361.         if ClickPart <> sbIndicator then
  2362.         begin
  2363.           repeat
  2364.             MakeLocal(Event.Where, Mouse);
  2365.             if GetPartCode = ClickPart then
  2366.               SetValue(Value + ScrollStep(ClickPart));
  2367.           until not MouseEvent(Event, evMouseAuto);
  2368.         end else
  2369.         begin
  2370.           repeat
  2371.             MakeLocal(Event.Where, Mouse);
  2372.             Tracking := Extent.Contains(Mouse);
  2373.             if Tracking then
  2374.             begin
  2375.               if Size.X = 1 then I := Mouse.Y else I := Mouse.X;
  2376.               if I <= 0 then I := 1;
  2377.               if I >= S then I := S - 1;
  2378.             end else I := GetPos;
  2379.             if I <> P then
  2380.             begin
  2381.               DrawPos(I);
  2382.               P := I;
  2383.             end;
  2384.           until not MouseEvent(Event, evMouseMove);
  2385.           if Tracking and (S > 2) then
  2386.           begin
  2387.             Dec(S, 2);
  2388.             SetValue(LongDiv(LongMul(P - 1, Max - Min) + S shr 1, S) + Min);
  2389.           end;
  2390.         end;
  2391.         ClearEvent(Event);
  2392.       end;
  2393.     evKeyDown:
  2394.       if State and sfVisible <> 0 then
  2395.       begin
  2396.         ClickPart := sbIndicator;
  2397.         if Size.Y = 1 then
  2398.           case CtrlToArrow(Event.KeyCode) of
  2399.             kbLeft: ClickPart := sbLeftArrow;
  2400.             kbRight: ClickPart := sbRightArrow;
  2401.             kbCtrlLeft: ClickPart := sbPageLeft;
  2402.             kbCtrlRight: ClickPart := sbPageRight;
  2403.             kbHome: I := Min;
  2404.             kbEnd: I := Max;
  2405.           else
  2406.             Exit;
  2407.           end
  2408.         else
  2409.           case CtrlToArrow(Event.KeyCode) of
  2410.             kbUp: ClickPart := sbUpArrow;
  2411.             kbDown: ClickPart := sbDownArrow;
  2412.             kbPgUp: ClickPart := sbPageUp;
  2413.             kbPgDn: ClickPart := sbPageDown;
  2414.             kbCtrlPgUp: I := Min;
  2415.             kbCtrlPgDn: I := Max;
  2416.           else
  2417.             Exit;
  2418.           end;
  2419.         Clicked;
  2420.         if ClickPart <> sbIndicator then I := Value + ScrollStep(ClickPart);
  2421.         SetValue(I);
  2422.         ClearEvent(Event);
  2423.       end;
  2424.   end;
  2425. end;
  2426.  
  2427. procedure TScrollBar.ScrollDraw;
  2428. begin
  2429.   Message(Owner, evBroadcast, cmScrollBarChanged, @Self);
  2430. end;
  2431.  
  2432. function TScrollBar.ScrollStep(Part: Integer): Integer;
  2433. var
  2434.   Step: Integer;
  2435. begin
  2436.   if Part and 2 = 0 then Step := ArStep else Step := PgStep;
  2437.   if Part and 1 = 0 then ScrollStep := -Step else ScrollStep := Step;
  2438. end;
  2439.  
  2440. procedure TScrollBar.SetParams(AValue, AMin, AMax, APgStep,
  2441.   AArStep: Integer);
  2442. var
  2443.   SValue: Integer;
  2444. begin
  2445.   if AMax < AMin then AMax := AMin;
  2446.   if AValue < AMin then AValue := AMin;
  2447.   if AValue > AMax then AValue := AMax;
  2448.   SValue := Value;
  2449.   if (SValue <> AValue) or (Min <> AMin) or (Max <> AMax) then
  2450.   begin
  2451.     Value := AValue;
  2452.     Min := AMin;
  2453.     Max := AMax;
  2454.     DrawView;
  2455.     if SValue <> AValue then ScrollDraw;
  2456.   end;
  2457.   PgStep := APgStep;
  2458.   ArStep := AArStep;
  2459. end;
  2460.  
  2461. procedure TScrollBar.SetRange(AMin, AMax: Integer);
  2462. begin
  2463.   SetParams(Value, AMin, AMax, PgStep, ArStep);
  2464. end;
  2465.  
  2466. procedure TScrollBar.SetStep(APgStep, AArStep: Integer);
  2467. begin
  2468.   SetParams(Value, Min, Max, APgStep, AArStep);
  2469. end;
  2470.  
  2471. procedure TScrollBar.SetValue(AValue: Integer);
  2472. begin
  2473.   SetParams(AValue, Min, Max, PgStep, ArStep);
  2474. end;
  2475.  
  2476. procedure TScrollBar.Store(var S: TStream);
  2477. begin
  2478.   TView.Store(S);
  2479.   S.Write(Value, SizeOf(Integer) * 5 + SizeOf(TScrollChars));
  2480. end;
  2481.  
  2482. { TScroller }
  2483.  
  2484. constructor TScroller.Init(var Bounds: TRect; AHScrollBar,
  2485.   AVScrollBar: PScrollBar);
  2486. begin
  2487.   TView.Init(Bounds);
  2488.   Options := Options or ofSelectable;
  2489.   EventMask := EventMask or evBroadcast;
  2490.   HScrollBar := AHScrollBar;
  2491.   VScrollBar := AVScrollBar;
  2492. end;
  2493.  
  2494. constructor TScroller.Load(var S: TStream);
  2495. begin
  2496.   TView.Load(S);
  2497.   GetPeerViewPtr(S, HScrollBar);
  2498.   GetPeerViewPtr(S, VScrollBar);
  2499.   S.Read(Delta, SizeOf(TPoint)*2);
  2500. end;
  2501.  
  2502. procedure TScroller.ChangeBounds(var Bounds: TRect);
  2503. begin
  2504.   SetBounds(Bounds);
  2505.   Inc(DrawLock);
  2506.   SetLimit(Limit.X, Limit.Y);
  2507.   Dec(DrawLock);
  2508.   DrawFlag := False;
  2509.   DrawView;
  2510. end;
  2511.  
  2512. procedure TScroller.CheckDraw;
  2513. begin
  2514.   if (DrawLock = 0) and DrawFlag then
  2515.   begin
  2516.     DrawFlag := False;
  2517.     DrawView;
  2518.   end;
  2519. end;
  2520.  
  2521. function TScroller.GetPalette: PPalette;
  2522. const
  2523.   P: String[Length(CScroller)] = CScroller;
  2524. begin
  2525.   GetPalette := @P;
  2526. end;
  2527.  
  2528. procedure TScroller.HandleEvent(var Event: TEvent);
  2529. begin
  2530.   TView.HandleEvent(Event);
  2531.   if (Event.What = evBroadcast) and (Event.Command = cmScrollBarChanged) and
  2532.      ((Event.InfoPtr = HScrollBar) or (Event.InfoPtr = VScrollBar)) then
  2533.       ScrollDraw;
  2534. end;
  2535.  
  2536. procedure TScroller.ScrollDraw;
  2537. var
  2538.   D: TPoint;
  2539. begin
  2540.   if HScrollBar <> nil then D.X := HScrollBar^.Value
  2541.   else D.X := 0;
  2542.   if VScrollBar <> nil then D.Y := VScrollBar^.Value
  2543.   else D.Y := 0;
  2544.   if (D.X <> Delta.X) or (D.Y <> Delta.Y) then
  2545.   begin
  2546.     SetCursor(Cursor.X + Delta.X - D.X, Cursor.Y + Delta.Y - D.Y);
  2547.     Delta := D;
  2548.     if DrawLock <> 0 then DrawFlag := True else DrawView;
  2549.   end;
  2550. end;
  2551.  
  2552. procedure TScroller.ScrollTo(X, Y: Integer);
  2553. begin
  2554.   Inc(DrawLock);
  2555.   if HScrollBar <> nil then HScrollBar^.SetValue(X);
  2556.   if VScrollBar <> nil then VScrollBar^.SetValue(Y);
  2557.   Dec(DrawLock);
  2558.   CheckDraw;
  2559. end;
  2560.  
  2561. procedure TScroller.SetLimit(X, Y: Integer);
  2562. begin
  2563.   Limit.X := X;
  2564.   Limit.Y := Y;
  2565.   Inc(DrawLock);
  2566.   if HScrollBar <> nil then
  2567.     HScrollBar^.SetParams(HScrollBar^.Value, 0, X - Size.X, Size.X - 1,
  2568.       HScrollBar^.ArStep);
  2569.   if VScrollBar <> nil then
  2570.     VScrollBar^.SetParams(VScrollBar^.Value, 0, Y - Size.Y, Size.Y - 1,
  2571.       VScrollBar^.ArStep);
  2572.   Dec(DrawLock);
  2573.   CheckDraw;
  2574. end;
  2575.  
  2576. procedure TScroller.SetState(AState: Word; Enable: Boolean);
  2577.  
  2578. procedure ShowSBar(SBar: PScrollBar);
  2579. begin
  2580.   if (SBar <> nil) then
  2581.     if GetState(sfActive + sfSelected) then SBar^.Show
  2582.     else SBar^.Hide;
  2583. end;
  2584.  
  2585. begin
  2586.   TView.SetState(AState, Enable);
  2587.   if AState and (sfActive + sfSelected) <> 0 then
  2588.   begin
  2589.     ShowSBar(HScrollBar);
  2590.     ShowSBar(VScrollBar);
  2591.   end;
  2592. end;
  2593.  
  2594. procedure TScroller.Store(var S: TStream);
  2595. begin
  2596.   TView.Store(S);
  2597.   PutPeerViewPtr(S, HScrollBar);
  2598.   PutPeerViewPtr(S, VScrollBar);
  2599.   S.Write(Delta, SizeOf(TPoint)*2);
  2600. end;
  2601.  
  2602. { TListViewer }
  2603.  
  2604. constructor TListViewer.Init(var Bounds: TRect; ANumCols: Word;
  2605.   AHScrollBar, AVScrollBar: PScrollBar);
  2606. var
  2607.   ArStep, PgStep: Integer;
  2608. begin
  2609.   TView.Init(Bounds);
  2610.   Options := Options or (ofFirstClick + ofSelectable);
  2611.   EventMask := EventMask or evBroadcast;
  2612.   Range := 0;
  2613.   NumCols := ANumCols;
  2614.   Focused := 0;
  2615.   if AVScrollBar <> nil then
  2616.   begin
  2617.     if NumCols = 1 then
  2618.     begin
  2619.       PgStep := Size.Y -1;
  2620.       ArStep := 1;
  2621.     end else
  2622.     begin
  2623.       PgStep := Size.Y * NumCols;
  2624.       ArStep := Size.Y;
  2625.     end;
  2626.     AVScrollBar^.SetStep(PgStep, ArStep);
  2627.   end;
  2628.   if AHScrollBar <> nil then AHScrollBar^.SetStep(Size.X div NumCols, 1);
  2629.   HScrollBar := AHScrollBar;
  2630.   VScrollBar := AVScrollBar;
  2631. end;
  2632.  
  2633. constructor TListViewer.Load(var S: TStream);
  2634. begin
  2635.   TView.Load(S);
  2636.   GetPeerViewPtr(S, HScrollBar);
  2637.   GetPeerViewPtr(S, VScrollBar);
  2638.   S.Read(NumCols, SizeOf(Word) * 4);
  2639. end;
  2640.  
  2641. procedure TListViewer.ChangeBounds(var Bounds: TRect);
  2642. begin
  2643.   TView.ChangeBounds(Bounds);
  2644.   if HScrollBar <> nil then
  2645.     HScrollBar^.SetStep(Size.X div NumCols, HScrollBar^.ArStep);
  2646.   if VScrollBar <> nil then
  2647.     VScrollBar^.SetStep(Size.Y, VScrollBar^.ArStep);
  2648. end;
  2649.  
  2650. procedure TListViewer.Draw;
  2651. var
  2652.   I, J, Item: Integer;
  2653.   NormalColor, SelectedColor, FocusedColor, Color: Word;
  2654.   ColWidth, CurCol, Indent: Integer;
  2655.   B: TDrawBuffer;
  2656.   Text: String;
  2657.   SCOff: Byte;
  2658. begin
  2659.   if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2660.   begin
  2661.     NormalColor := GetColor(1);
  2662.     FocusedColor := GetColor(3);
  2663.     SelectedColor := GetColor(4);
  2664.   end else
  2665.   begin
  2666.     NormalColor := GetColor(2);
  2667.     SelectedColor := GetColor(4);
  2668.   end;
  2669.   if HScrollBar <> nil then Indent := HScrollBar^.Value
  2670.   else Indent := 0;
  2671.   ColWidth := Size.X div NumCols + 1;
  2672.   for I := 0 to Size.Y - 1 do
  2673.   begin
  2674.     for J := 0 to NumCols-1 do
  2675.     begin
  2676.       Item := J*Size.Y + I + TopItem;
  2677.       CurCol := J*ColWidth;
  2678.       if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2679.         (Focused = Item) and (Range > 0) then
  2680.       begin
  2681.         Color := FocusedColor;
  2682.         SetCursor(CurCol+1,I);
  2683.         SCOff := 0;
  2684.       end
  2685.       else if (Item < Range) and IsSelected(Item) then
  2686.       begin
  2687.         Color := SelectedColor;
  2688.         SCOff := 2;
  2689.       end
  2690.       else
  2691.       begin
  2692.         Color := NormalColor;
  2693.         SCOff := 4;
  2694.       end;
  2695.       MoveChar(B[CurCol], ' ', Color, ColWidth);
  2696.       if Item < Range then
  2697.       begin
  2698.         Text := GetText(Item, ColWidth + Indent);
  2699.         Text := Copy(Text,Indent,ColWidth);
  2700.         MoveStr(B[CurCol+1], Text, Color);
  2701.         if ShowMarkers then
  2702.         begin
  2703.           WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2704.           WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2705.         end;
  2706.       end;
  2707.       MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2708.     end;
  2709.     WriteLine(0, I, Size.X, 1, B);
  2710.   end;
  2711. end;
  2712.  
  2713. procedure TListViewer.FocusItem(Item: Integer);
  2714. begin
  2715.   Focused := Item;
  2716.   if VScrollBar <> nil then VScrollBar^.SetValue(Item);
  2717.   if Item < TopItem then
  2718.     if NumCols = 1 then TopItem := Item
  2719.     else TopItem := Item - Item mod Size.Y
  2720.   else if Item >= TopItem + (Size.Y*NumCols) then
  2721.     if NumCols = 1 then TopItem := Item - Size.Y + 1
  2722.     else TopItem := Item - Item mod Size.Y - (Size.Y*(NumCols - 1));
  2723. end;
  2724.  
  2725. procedure TListViewer.FocusItemNum(Item: Integer);
  2726. begin
  2727.   if Item < 0 then Item := 0
  2728.   else if (Item >= Range) and (Range > 0) then Item := Range-1;
  2729.   if Range <> 0 then FocusItem(Item);
  2730. end;
  2731.  
  2732. function TListViewer.GetPalette: PPalette;
  2733. const
  2734.   P: String[Length(CListViewer)] = CListViewer;
  2735. begin
  2736.   GetPalette := @P;
  2737. end;
  2738.  
  2739. function TListViewer.GetText(Item: Integer; MaxLen: Integer): String;
  2740. begin
  2741.   Abstract;
  2742. end;
  2743.  
  2744. function TListViewer.IsSelected(Item: Integer): Boolean;
  2745. begin
  2746.   IsSelected := Item = Focused;
  2747. end;
  2748.  
  2749. procedure TListViewer.HandleEvent(var Event: TEvent);
  2750. const
  2751.   MouseAutosToSkip = 4;
  2752. var
  2753.   Mouse: TPoint;
  2754.   ColWidth: Word;
  2755.   OldItem, NewItem: Integer;
  2756.   Count: Word;
  2757. begin
  2758.   TView.HandleEvent(Event);
  2759.   if Event.What = evMouseDown then
  2760.   begin
  2761.     ColWidth := Size.X div NumCols + 1;
  2762.     OldItem := Focused;
  2763.     MakeLocal(Event.Where, Mouse);
  2764.     if MouseInView(Event.Where) then
  2765.       NewItem := Mouse.Y + (Size.Y * (Mouse.X div ColWidth)) + TopItem
  2766.     else NewItem := OldItem;
  2767.     Count := 0;
  2768.     repeat
  2769.       if NewItem <> OldItem then
  2770.       begin
  2771.         FocusItemNum(NewItem);
  2772.         DrawView;
  2773.       end;
  2774.       OldItem := NewItem;
  2775.       MakeLocal(Event.Where, Mouse);
  2776.       if MouseInView(Event.Where) then
  2777.         NewItem := Mouse.Y + (Size.Y * (Mouse.X div ColWidth)) + TopItem
  2778.       else
  2779.       begin
  2780.         if NumCols = 1 then
  2781.         begin
  2782.           if Event.What = evMouseAuto then Inc(Count);
  2783.           if Count = MouseAutosToSkip then
  2784.           begin
  2785.             Count := 0;
  2786.             if Mouse.Y < 0 then NewItem := Focused-1
  2787.             else if Mouse.Y >= Size.Y then NewItem := Focused+1;
  2788.           end;
  2789.         end
  2790.         else
  2791.         begin
  2792.           if Event.What = evMouseAuto then Inc(Count);
  2793.           if Count = MouseAutosToSkip then
  2794.           begin
  2795.             Count := 0;
  2796.             if Mouse.X < 0 then NewItem := Focused-Size.Y
  2797.             else if Mouse.X >= Size.X then NewItem := Focused+Size.Y
  2798.             else if Mouse.Y < 0 then
  2799.               NewItem := Focused - Focused mod Size.Y
  2800.             else if Mouse.Y > Size.Y then
  2801.               NewItem := Focused - Focused mod Size.Y + Size.Y - 1;
  2802.           end
  2803.         end;
  2804.       end;
  2805.     until not MouseEvent(Event, evMouseMove + evMouseAuto);
  2806.     FocusItemNum(NewItem);
  2807.     DrawView;
  2808.     if Event.Double and (Range > Focused) then SelectItem(Focused);
  2809.     ClearEvent(Event);
  2810.   end
  2811.   else if Event.What = evKeyDown then
  2812.   begin
  2813.     if (Event.CharCode = ' ') and (Focused < Range) then
  2814.     begin
  2815.       SelectItem(Focused);
  2816.       NewItem := Focused;
  2817.     end
  2818.     else case CtrlToArrow(Event.KeyCode) of
  2819.       kbUp: NewItem := Focused - 1;
  2820.       kbDown: NewItem := Focused + 1;
  2821.       kbRight: if NumCols > 1 then NewItem := Focused + Size.Y else Exit;
  2822.       kbLeft: if NumCols > 1 then NewItem := Focused - Size.Y else Exit;
  2823.       kbPgDn: NewItem := Focused + Size.Y * NumCols;
  2824.       kbPgUp: NewItem := Focused - Size.Y * NumCols;
  2825.       kbHome: NewItem := TopItem;
  2826.       kbEnd: NewItem := TopItem + (Size.Y * NumCols) - 1;
  2827.       kbCtrlPgDn: NewItem := Range - 1;
  2828.       kbCtrlPgUp: NewItem := 0;
  2829.     else
  2830.       Exit;
  2831.     end;
  2832.     FocusItemNum(NewItem);
  2833.     DrawView;
  2834.     ClearEvent(Event);
  2835.   end else if Event.What = evBroadcast then
  2836.     if Options and ofSelectable <> 0 then
  2837.       if (Event.Command = cmScrollBarClicked) and
  2838.          ((Event.InfoPtr = HScrollBar) or (Event.InfoPtr = VScrollBar)) then
  2839.         Select
  2840.       else if (Event.Command = cmScrollBarChanged) then
  2841.       begin
  2842.         if (VScrollBar = Event.InfoPtr) then
  2843.         begin
  2844.           FocusItemNum(VScrollBar^.Value);
  2845.           DrawView;
  2846.         end else if (HScrollBar = Event.InfoPtr) then DrawView;
  2847.       end;
  2848. end;
  2849.  
  2850. procedure TListViewer.SelectItem(Item: Integer);
  2851. begin
  2852.   Message(Owner, evBroadcast, cmListItemSelected, @Self);
  2853. end;
  2854.  
  2855. procedure TListViewer.SetRange(ARange: Integer);
  2856. begin
  2857.   Range := ARange;
  2858.   if VScrollBar <> nil then
  2859.   begin
  2860.     if Focused > ARange then Focused := 0;
  2861.     VScrollbar^.SetParams(Focused, 0, ARange-1, VScrollBar^.PgStep,
  2862.       VScrollBar^.ArStep);
  2863.   end;
  2864. end;
  2865.  
  2866. procedure TListViewer.SetState(AState: Word; Enable: Boolean);
  2867.  
  2868. procedure ShowSBar(SBar: PScrollBar);
  2869. begin
  2870.   if (SBar <> nil) then
  2871.     if GetState(sfActive) and GetState(sfVisible) then SBar^.Show
  2872.     else SBar^.Hide;
  2873. end;
  2874.  
  2875. begin
  2876.   TView.SetState(AState, Enable);
  2877.   if AState and (sfSelected + sfActive + sfVisible) <> 0 then
  2878.   begin
  2879.     ShowSBar(HScrollBar);
  2880.     ShowSBar(VScrollBar);
  2881.     DrawView;
  2882.   end;
  2883. end;
  2884.  
  2885. procedure TListViewer.Store(var S: TStream);
  2886. begin
  2887.   TView.Store(S);
  2888.   PutPeerViewPtr(S, HScrollBar);
  2889.   PutPeerViewPtr(S, VScrollBar);
  2890.   S.Write(NumCols, SizeOf(Word) * 4);
  2891. end;
  2892.  
  2893. { TGroup }
  2894.  
  2895. constructor TGroup.Init(var Bounds: TRect);
  2896. begin
  2897.   TView.Init(Bounds);
  2898.   Options := Options or (ofSelectable + ofBuffered);
  2899.   GetExtent(Clip);
  2900.   EventMask := $FFFF;
  2901. end;
  2902.  
  2903. constructor TGroup.Load(var S: TStream);
  2904. var
  2905.   FixupSave: PFixupList;
  2906.   Count, I: Integer;
  2907.   P, Q: ^Pointer;
  2908.   V: PView;
  2909.   OwnerSave: PGroup;
  2910. begin
  2911.   TView.Load(S);
  2912.   GetExtent(Clip);
  2913.   OwnerSave := OwnerGroup;
  2914.   OwnerGroup := @Self;
  2915.   FixupSave := FixupList;
  2916.   S.Read(Count, SizeOf(Word));
  2917.   asm
  2918.         MOV     CX,Count
  2919.         SHL     CX,1
  2920.         SHL     CX,1
  2921.         SUB     SP,CX
  2922.         MOV     FixupList.Word[0],SP
  2923.         MOV     FixupList.Word[2],SS
  2924.         MOV     DI,SP
  2925.         PUSH    SS
  2926.         POP     ES
  2927.         XOR     AL,AL
  2928.         CLD
  2929.         REP     STOSB
  2930.   end;
  2931.   for I := 1 to Count do
  2932.   begin
  2933.     V := PView(S.Get);
  2934.     if V <> nil then InsertView(V, nil);
  2935.   end;
  2936.   V := Last;
  2937.   for I := 1 to Count do
  2938.   begin
  2939.     V := V^.Next;
  2940.     P := FixupList^[I];
  2941.     while P <> nil do
  2942.     begin
  2943.       Q := P;
  2944.       P := P^;
  2945.       Q^ := V;
  2946.     end;
  2947.   end;
  2948.   OwnerGroup := OwnerSave;
  2949.   FixupList := FixupSave;
  2950.   GetSubViewPtr(S, V);
  2951.   SetCurrent(V, NormalSelect);
  2952.   if OwnerGroup = nil then Awaken;
  2953. end;
  2954.  
  2955. destructor TGroup.Done;
  2956. var
  2957.   P, T: PView;
  2958. begin
  2959.   Hide;
  2960.   P := Last;
  2961.   if P <> nil then
  2962.   begin
  2963.     repeat
  2964.       P^.Hide;
  2965.       P := P^.Prev;
  2966.     until P = Last;
  2967.     repeat
  2968.       T := P^.Prev;
  2969.       Dispose(P, Done);
  2970.       P := T;
  2971.     until Last = nil;
  2972.   end;
  2973.   FreeBuffer;
  2974.   TView.Done;
  2975. end;
  2976.  
  2977. function TGroup.At(Index: Integer): PView; assembler;
  2978. asm
  2979.         LES     DI,Self
  2980.         LES     DI,ES:[DI].TGroup.Last
  2981.         MOV     CX,Index
  2982. @@1:    LES     DI,ES:[DI].TView.Next
  2983.         LOOP    @@1
  2984.         MOV     AX,DI
  2985.         MOV     DX,ES
  2986. end;
  2987.  
  2988. procedure TGroup.Awaken;
  2989.  
  2990.   procedure DoAwaken(P: PView); far;
  2991.   begin
  2992.     P^.Awaken;
  2993.   end;
  2994.  
  2995. begin
  2996.   ForEach(@DoAwaken);
  2997. end;
  2998.  
  2999. procedure TGroup.ChangeBounds(var Bounds: TRect);
  3000. var
  3001.   D: TPoint;
  3002.  
  3003. procedure DoCalcChange(P: PView); far;
  3004. var
  3005.   R: TRect;
  3006. begin
  3007.   P^.CalcBounds(R, D);
  3008.   P^.ChangeBounds(R);
  3009. end;
  3010.  
  3011. begin
  3012.   D.X := Bounds.B.X - Bounds.A.X - Size.X;
  3013.   D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
  3014.   if Longint(D) = 0 then
  3015.   begin
  3016.     SetBounds(Bounds);
  3017.     DrawView;
  3018.   end else
  3019.   begin
  3020.     FreeBuffer;
  3021.     SetBounds(Bounds);
  3022.     GetExtent(Clip);
  3023.     GetBuffer;
  3024.     Lock;
  3025.     ForEach(@DoCalcChange);
  3026.     Unlock;
  3027.   end;
  3028. end;
  3029.  
  3030. function TGroup.DataSize: Word;
  3031. var
  3032.   T: Word;
  3033.  
  3034. procedure AddSubviewDataSize(P: PView); far;
  3035. begin
  3036.   Inc(T, P^.DataSize);
  3037. end;
  3038.  
  3039. begin
  3040.   T := 0;
  3041.   ForEach(@AddSubviewDataSize);
  3042.   DataSize := T;
  3043. end;
  3044.  
  3045. procedure TGroup.Delete(P: PView);
  3046. var
  3047.   SaveState: Word;
  3048. begin
  3049.   SaveState := P^.State;
  3050.   P^.Hide;
  3051.   RemoveView(P);
  3052.   P^.Owner := nil;
  3053.   P^.Next := nil;
  3054.   if SaveState and sfVisible <> 0 then P^.Show;
  3055. end;
  3056.  
  3057. procedure TGroup.Draw;
  3058. var
  3059.   R: TRect;
  3060. begin
  3061.   if Buffer = nil then
  3062.   begin
  3063.     GetBuffer;
  3064.     if Buffer <> nil then
  3065.     begin
  3066.       Inc(LockFlag);
  3067.       Redraw;
  3068.       Dec(LockFlag);
  3069.     end;
  3070.   end;
  3071.   if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
  3072.   begin
  3073.     GetClipRect(Clip);
  3074.     Redraw;
  3075.     GetExtent(Clip);
  3076.   end;
  3077. end;
  3078.  
  3079. procedure TGroup.DrawSubViews(P, Bottom: PView);
  3080. begin
  3081.   if P <> nil then
  3082.     while P <> Bottom do
  3083.     begin
  3084.       P^.DrawView;
  3085.       P := P^.NextView;
  3086.     end;
  3087. end;
  3088.  
  3089. procedure TGroup.EndModal(Command: Word);
  3090. begin
  3091.   if State and sfModal <> 0 then EndState := Command
  3092.   else TView.EndModal(Command);
  3093. end;
  3094.  
  3095. procedure TGroup.EventError(var Event: TEvent);
  3096. begin
  3097.   if Owner <> nil then Owner^.EventError(Event);
  3098. end;
  3099.  
  3100. function TGroup.Execute: Word;
  3101. var
  3102.   E: TEvent;
  3103. begin
  3104.   repeat
  3105.     EndState := 0;
  3106.     repeat
  3107.       GetEvent(E);
  3108.       HandleEvent(E);
  3109.       if E.What <> evNothing then EventError(E);
  3110.     until EndState <> 0;
  3111.   until Valid(EndState);
  3112.   Execute := EndState;
  3113. end;
  3114.  
  3115. function TGroup.ExecView(P: PView): Word;
  3116. var
  3117.   SaveOptions: Word;
  3118.   SaveOwner: PGroup;
  3119.   SaveTopView: PView;
  3120.   SaveCurrent: PView;
  3121.   SaveCommands: TCommandSet;
  3122. begin
  3123.   if P <> nil then
  3124.   begin
  3125.     SaveOptions := P^.Options;
  3126.     SaveOwner := P^.Owner;
  3127.     SaveTopView := TheTopView;
  3128.     SaveCurrent := Current;
  3129.     GetCommands(SaveCommands);
  3130.     TheTopView := P;
  3131.     P^.Options := P^.Options and not ofSelectable;
  3132.     P^.SetState(sfModal, True);
  3133.     SetCurrent(P, EnterSelect);
  3134.     if SaveOwner = nil then Insert(P);
  3135.     ExecView := P^.Execute;
  3136.     if SaveOwner = nil then Delete(P);
  3137.     SetCurrent(SaveCurrent, LeaveSelect);
  3138.     P^.SetState(sfModal, False);
  3139.     P^.Options := SaveOptions;
  3140.     TheTopView := SaveTopView;
  3141.     SetCommands(SaveCommands);
  3142.   end else ExecView := cmCancel;
  3143. end;
  3144.  
  3145. function TGroup.First: PView;
  3146. begin
  3147.   if Last = nil then First := nil else First := Last^.Next;
  3148. end;
  3149.  
  3150. function TGroup.FirstMatch(AState: Word; AOptions: Word): PView;
  3151.  
  3152. function Matches(P: PView): Boolean; far;
  3153. begin
  3154.   Matches := (P^.State and AState = AState) and
  3155.     (P^.Options and AOptions = AOptions);
  3156. end;
  3157.  
  3158. begin
  3159.   FirstMatch := FirstThat(@Matches);
  3160. end;
  3161.  
  3162. function TGroup.FirstThat(P: Pointer): PView; assembler;
  3163. var
  3164.   ALast: Pointer;
  3165. asm
  3166.         LES     DI,Self
  3167.         LES     DI,ES:[DI].TGroup.Last
  3168.         MOV     AX,ES
  3169.         OR      AX,DI
  3170.         JE      @@3
  3171.         MOV     WORD PTR ALast[2],ES
  3172.         MOV     WORD PTR ALast[0],DI
  3173. @@1:    LES     DI,ES:[DI].TView.Next
  3174.         PUSH    ES
  3175.         PUSH    DI
  3176.         PUSH    ES
  3177.         PUSH    DI
  3178.         PUSH    WORD PTR [BP]
  3179.         CALL    P
  3180.         POP     DI
  3181.         POP     ES
  3182.         OR      AL,AL
  3183.         JNE     @@2
  3184.         CMP     DI,WORD PTR ALast[0]
  3185.         JNE     @@1
  3186.         MOV     AX,ES
  3187.         CMP     AX,WORD PTR ALast[2]
  3188.         JNE     @@1
  3189.         XOR     DI,DI
  3190.         MOV     ES,DI
  3191. @@2:    MOV     SP,BP
  3192. @@3:    MOV     AX,DI
  3193.         MOV     DX,ES
  3194. end;
  3195.  
  3196. function TGroup.FindNext(Forwards: Boolean): PView;
  3197. var
  3198.   P: PView;
  3199. begin
  3200.   FindNext := nil;
  3201.   if Current <> nil then
  3202.   begin
  3203.     P := Current;
  3204.     repeat
  3205.       if Forwards then P := P^.Next else P := P^.Prev;
  3206.     until ((P^.State and (sfVisible + sfDisabled) = sfVisible) and
  3207.       (P^.Options and ofSelectable <> 0)) or (P = Current);
  3208.     if P <> Current then FindNext := P;
  3209.   end;
  3210. end;
  3211.  
  3212. function TGroup.FocusNext(Forwards: Boolean): Boolean;
  3213. var
  3214.   P: PView;
  3215. begin
  3216.   P := FindNext(Forwards);
  3217.   FocusNext := True;
  3218.   if P <> nil then FocusNext := P^.Focus;
  3219. end;
  3220.  
  3221. procedure TGroup.ForEach(P: Pointer); assembler;
  3222. var
  3223.   ALast: Pointer;
  3224. asm
  3225.         LES     DI,Self
  3226.         LES     DI,ES:[DI].TGroup.Last
  3227.         MOV     AX,ES
  3228.         OR      AX,DI
  3229.         JE      @@4
  3230.         MOV     WORD PTR ALast[2],ES
  3231.         MOV     WORD PTR ALast[0],DI
  3232.         LES     DI,ES:[DI].TView.Next
  3233. @@1:    CMP     DI,WORD PTR ALast[0]
  3234.         JNE     @@2
  3235.         MOV     AX,ES
  3236.         CMP     AX,WORD PTR ALast[2]
  3237.         JE      @@3
  3238. @@2:    PUSH    WORD PTR ES:[DI].TView.Next[2]
  3239.         PUSH    WORD PTR ES:[DI].TView.Next[0]
  3240.         PUSH    ES
  3241.         PUSH    DI
  3242.         PUSH    WORD PTR [BP]
  3243.         CALL    P
  3244.         POP     DI
  3245.         POP     ES
  3246.         JMP     @@1
  3247. @@3:    PUSH    WORD PTR [BP]
  3248.         CALL    P
  3249. @@4:
  3250. end;
  3251.  
  3252. procedure TGroup.FreeBuffer;
  3253. begin
  3254.   if (Options and ofBuffered <> 0) and (Buffer <> nil) then
  3255.     DisposeCache(Pointer(Buffer));
  3256. end;
  3257.  
  3258. { Allocate a group buffer if the group is exposed, buffered, and
  3259.   its area is less than 32768 bytes }
  3260.  
  3261. procedure TGroup.GetBuffer; assembler;
  3262. asm
  3263.     LES    DI,Self
  3264.         TEST    ES:[DI].State,sfExposed
  3265.         JZ    @@1
  3266.         TEST    ES:[DI].Options,ofBuffered
  3267.         JZ    @@1
  3268.         MOV    AX,ES:[DI].Buffer.Word[0]
  3269.         OR    AX,ES:[DI].Buffer.Word[2]
  3270.         JNZ    @@1
  3271.         MOV    AX,ES:[DI].TView.Size.X
  3272.     MUL    ES:[DI].TView.Size.Y
  3273.         JO    @@1
  3274.         SHL    AX,1
  3275.         JC    @@1
  3276.         JS    @@1
  3277.         LEA    DI,[DI].TView.Buffer
  3278.         PUSH    ES
  3279.         PUSH    DI
  3280.         PUSH    AX
  3281.         CALL    NewCache
  3282. @@1:
  3283. end;
  3284.  
  3285. procedure TGroup.GetData(var Rec);
  3286. type
  3287.   Bytes = array[0..65534] of Byte;
  3288. var
  3289.   I: Word;
  3290.   V: PView;
  3291. begin
  3292.   I := 0;
  3293.   if Last <> nil then
  3294.   begin
  3295.     V := Last;
  3296.     repeat
  3297.       V^.GetData(Bytes(Rec)[I]);
  3298.       Inc(I, V^.DataSize);
  3299.       V := V^.Prev;
  3300.     until V = Last;
  3301.   end;
  3302. end;
  3303.  
  3304. function TGroup.GetHelpCtx: Word;
  3305. var
  3306.   H: Word;
  3307. begin
  3308.   H:= hcNoContext;
  3309.   if Current <> nil then H := Current^.GetHelpCtx;
  3310.   if H = hcNoContext then H := TView.GetHelpCtx;
  3311.   GetHelpCtx := H;
  3312. end;
  3313.  
  3314. procedure TGroup.GetSubViewPtr(var S: TStream; var P);
  3315. var
  3316.   Index: Word;
  3317. begin
  3318.   S.Read(Index, SizeOf(Word));
  3319.   if Index > 0 then
  3320.     Pointer(P) := At(Index)
  3321.   else
  3322.     Pointer(P) := nil;
  3323. end;
  3324.  
  3325. procedure TGroup.HandleEvent(var Event: TEvent);
  3326.  
  3327. procedure DoHandleEvent(P: PView); far;
  3328. begin
  3329.   if (P = nil) or ((P^.State and sfDisabled <> 0)
  3330.     and (Event.What and (PositionalEvents or FocusedEvents) <> 0)) then Exit;
  3331.   case Phase of
  3332.     phPreProcess: if P^.Options and ofPreProcess = 0 then Exit;
  3333.     phPostProcess: if P^.Options and ofPostProcess = 0 then Exit;
  3334.   end;
  3335.   if Event.What and P^.EventMask <> 0 then P^.HandleEvent(Event);
  3336. end;
  3337.  
  3338. function ContainsMouse(P: PView): Boolean; far;
  3339. begin
  3340.   ContainsMouse := (P^.State and sfVisible <> 0) and
  3341.     P^.MouseInView(Event.Where);
  3342. end;
  3343.  
  3344. begin
  3345.   TView.HandleEvent(Event);
  3346.   if Event.What and FocusedEvents <> 0 then
  3347.   begin
  3348.     Phase := phPreProcess;
  3349.     ForEach(@DoHandleEvent);
  3350.     Phase := phFocused;
  3351.     DoHandleEvent(Current);
  3352.     Phase := phPostProcess;
  3353.     ForEach(@DoHandleEvent);
  3354.   end else
  3355.   begin
  3356.     Phase := phFocused;
  3357.     if (Event.What and PositionalEvents <> 0) then
  3358.       DoHandleEvent(FirstThat(@ContainsMouse)) else
  3359.       ForEach(@DoHandleEvent);
  3360.   end;
  3361. end;
  3362.  
  3363. function TGroup.IndexOf(P: PView): Integer; assembler;
  3364. asm
  3365.         LES     DI,Self
  3366.         LES     DI,ES:[DI].TGroup.Last
  3367.         MOV     AX,ES
  3368.         OR      AX,DI
  3369.         JE      @@3
  3370.         MOV     CX,DI
  3371.         MOV     BX,ES
  3372.         XOR     AX,AX
  3373. @@1:    INC     AX
  3374.         LES     DI,ES:[DI].TView.Next
  3375.         MOV     DX,ES
  3376.         CMP     DI,P.Word[0]
  3377.         JNE     @@2
  3378.         CMP     DX,P.Word[2]
  3379.         JE      @@3
  3380. @@2:    CMP     DI,CX
  3381.         JNE     @@1
  3382.         CMP     DX,BX
  3383.         JNE     @@1
  3384.         XOR     AX,AX
  3385. @@3:
  3386. end;
  3387.  
  3388. procedure TGroup.Insert(P: PView);
  3389. begin
  3390.   InsertBefore(P, First);
  3391. end;
  3392.  
  3393. procedure TGroup.InsertBefore(P, Target: PView);
  3394. var
  3395.   SaveState: Word;
  3396. begin
  3397.   if (P <> nil) and (P^.Owner = nil) and
  3398.     ((Target = nil) or (Target^.Owner = @Self)) then
  3399.   begin
  3400.     if P^.Options and ofCenterX <> 0 then
  3401.       P^.Origin.X := (Size.X - P^.Size.X) div 2;
  3402.     if P^.Options and ofCenterY <> 0 then
  3403.       P^.Origin.Y := (Size.Y - P^.Size.Y) div 2;
  3404.     SaveState := P^.State;
  3405.     P^.Hide;
  3406.     InsertView(P, Target);
  3407.     if SaveState and sfVisible <> 0 then P^.Show;
  3408.     if State and sfActive <> 0 then
  3409.       P^.SetState(sfActive, True);
  3410.   end;
  3411. end;
  3412.  
  3413. procedure TGroup.InsertView(P, Target: PView);
  3414. begin
  3415.   P^.Owner := @Self;
  3416.   if Target <> nil then
  3417.   begin
  3418.     Target := Target^.Prev;
  3419.     P^.Next := Target^.Next;
  3420.     Target^.Next := P;
  3421.   end else
  3422.   begin
  3423.     if Last = nil then P^.Next := P else
  3424.     begin
  3425.       P^.Next := Last^.Next;
  3426.       Last^.Next := P;
  3427.     end;
  3428.     Last := P;
  3429.   end;
  3430. end;
  3431.  
  3432. procedure TGroup.Lock;
  3433. begin
  3434.   if (Buffer <> nil) or (LockFlag <> 0) then Inc(LockFlag);
  3435. end;
  3436.  
  3437. procedure TGroup.PutSubViewPtr(var S: TStream; P: PView);
  3438. var
  3439.   Index: Word;
  3440. begin
  3441.   if P = nil then Index := 0
  3442.   else Index := IndexOf(P);
  3443.   S.Write(Index, SizeOf(Word));
  3444. end;
  3445.  
  3446. procedure TGroup.Redraw;
  3447. begin
  3448.   DrawSubViews(First, nil);
  3449. end;
  3450.  
  3451. procedure TGroup.RemoveView(P: PView); assembler;
  3452. asm
  3453.         PUSH    DS
  3454.         LDS     SI,Self
  3455.         LES     DI,P
  3456.         LDS     SI,DS:[SI].TGroup.Last
  3457.         PUSH    BP
  3458.         MOV     AX,DS
  3459.         OR      AX,SI
  3460.         JE      @@7
  3461.         MOV     AX,SI
  3462.         MOV     DX,DS
  3463.         MOV     BP,ES
  3464. @@1:    MOV     BX,WORD PTR DS:[SI].TView.Next[0]
  3465.         MOV     CX,WORD PTR DS:[SI].TView.Next[2]
  3466.         CMP     CX,BP
  3467.         JE      @@5
  3468. @@2:    CMP     CX,DX
  3469.         JE      @@4
  3470. @@3:    MOV     SI,BX
  3471.         MOV     DS,CX
  3472.         JMP     @@1
  3473. @@4:    CMP     BX,AX
  3474.         JNE     @@3
  3475.         JMP     @@7
  3476. @@5:    CMP     BX,DI
  3477.         JNE     @@2
  3478.         MOV     BX,WORD PTR ES:[DI].TView.Next[0]
  3479.         MOV     CX,WORD PTR ES:[DI].TView.Next[2]
  3480.         MOV     DS:WORD PTR [SI].TView.Next[0],BX
  3481.         MOV     DS:WORD PTR [SI].TView.Next[2],CX
  3482.         CMP     DX,BP
  3483.         JNE     @@7
  3484.         CMP     AX,DI
  3485.         JNE     @@7
  3486.         CMP     CX,BP
  3487.         JNE     @@6
  3488.         CMP     BX,DI
  3489.         JNE     @@6
  3490.         XOR     SI,SI
  3491.         MOV     DS,SI
  3492. @@6:    POP     BP
  3493.         PUSH    BP
  3494.         LES     DI,Self
  3495.         MOV     WORD PTR ES:[DI].TView.Last[0],SI
  3496.         MOV     WORD PTR ES:[DI].TView.Last[2],DS
  3497. @@7:    POP     BP
  3498.         POP     DS
  3499. end;
  3500.  
  3501. procedure TGroup.ResetCurrent;
  3502. begin
  3503.   SetCurrent(FirstMatch(sfVisible, ofSelectable), NormalSelect);
  3504. end;
  3505.  
  3506. procedure TGroup.ResetCursor;
  3507. begin
  3508.   if Current <> nil then Current^.ResetCursor;
  3509. end;
  3510.  
  3511. procedure TGroup.SelectNext(Forwards: Boolean);
  3512. var
  3513.   P: PView;
  3514. begin
  3515.   P := FindNext(Forwards);
  3516.   if P <> nil then P^.Select;
  3517. end;
  3518.  
  3519. procedure TGroup.SetCurrent(P: PView; Mode: SelectMode);
  3520.  
  3521. procedure SelectView(P: PView; Enable: Boolean);
  3522. begin
  3523.   if P <> nil then P^.SetState(sfSelected, Enable);
  3524. end;
  3525.  
  3526. procedure FocusView(P: PView; Enable: Boolean);
  3527. begin
  3528.   if (State and sfFocused <> 0) and (P <> nil) then
  3529.     P^.SetState(sfFocused, Enable);
  3530. end;
  3531.  
  3532. begin
  3533.   if Current <> P then
  3534.   begin
  3535.     Lock;
  3536.     FocusView(Current, False);
  3537.     if Mode <> EnterSelect then SelectView(Current, False);
  3538.     if Mode <> LeaveSelect then SelectView(P, True);
  3539.     FocusView(P, True);
  3540.     Current := P;
  3541.     Unlock;
  3542.   end;
  3543. end;
  3544.  
  3545. procedure TGroup.SetData(var Rec);
  3546. type
  3547.   Bytes = array[0..65534] of Byte;
  3548. var
  3549.   I: Word;
  3550.   V: PView;
  3551. begin
  3552.   I := 0;
  3553.   if Last <> nil then
  3554.   begin
  3555.     V := Last;
  3556.     repeat
  3557.       V^.SetData(Bytes(Rec)[I]);
  3558.       Inc(I, V^.DataSize);
  3559.       V := V^.Prev;
  3560.     until V = Last;
  3561.   end;
  3562. end;
  3563.  
  3564. procedure TGroup.SetState(AState: Word; Enable: Boolean);
  3565.  
  3566. procedure DoSetState(P: PView); far;
  3567. begin
  3568.   P^.SetState(AState, Enable);
  3569. end;
  3570.  
  3571. procedure DoExpose(P: PView); far;
  3572. begin
  3573.   if P^.State and sfVisible <> 0 then P^.SetState(sfExposed, Enable);
  3574. end;
  3575.  
  3576. begin
  3577.   TView.SetState(AState, Enable);
  3578.   case AState of
  3579.     sfActive, sfDragging:
  3580.       begin
  3581.         Lock;
  3582.         ForEach(@DoSetState);
  3583.         Unlock;
  3584.       end;
  3585.     sfFocused:
  3586.       if Current <> nil then Current^.SetState(sfFocused, Enable);
  3587.     sfExposed:
  3588.       begin
  3589.         ForEach(@DoExpose);
  3590.         if not Enable then FreeBuffer;
  3591.       end;
  3592.   end;
  3593. end;
  3594.  
  3595. procedure TGroup.Store(var S: TStream);
  3596. var
  3597.   Count: Integer;
  3598.   OwnerSave: PGroup;
  3599.  
  3600. procedure DoPut(P: PView); far;
  3601. begin
  3602.   S.Put(P);
  3603. end;
  3604.  
  3605. begin
  3606.   TView.Store(S);
  3607.   OwnerSave := OwnerGroup;
  3608.   OwnerGroup := @Self;
  3609.   Count := IndexOf(Last);
  3610.   S.Write(Count, SizeOf(Word));
  3611.   ForEach(@DoPut);
  3612.   PutSubViewPtr(S, Current);
  3613.   OwnerGroup := OwnerSave;
  3614. end;
  3615.  
  3616. procedure TGroup.Unlock;
  3617. begin
  3618.   if LockFlag <> 0 then
  3619.   begin
  3620.     Dec(LockFlag);
  3621.     if LockFlag = 0 then DrawView;
  3622.   end;
  3623. end;
  3624.  
  3625. function TGroup.Valid(Command: Word): Boolean;
  3626.  
  3627. function IsInvalid(P: PView): Boolean; far;
  3628. begin
  3629.   IsInvalid := not P^.Valid(Command);
  3630. end;
  3631.  
  3632. begin
  3633.   Valid := True;
  3634.   if Command = cmReleasedFocus then
  3635.   begin
  3636.     if (Current <> nil) and (Current^.Options and ofValidate <> 0) then
  3637.       Valid := Current^.Valid(Command);
  3638.   end
  3639.   else
  3640.     Valid := FirstThat(@IsInvalid) = nil;
  3641. end;
  3642.  
  3643. { TWindow }
  3644.  
  3645. constructor TWindow.Init(var Bounds: TRect; ATitle: TTitleStr;
  3646.   ANumber: Integer);
  3647. begin
  3648.   TGroup.Init(Bounds);
  3649.   State := State or sfShadow;
  3650.   Options := Options or (ofSelectable + ofTopSelect);
  3651.   GrowMode := gfGrowAll + gfGrowRel;
  3652.   Flags := wfMove + wfGrow + wfClose + wfZoom;
  3653.   Title := NewStr(ATitle);
  3654.   Number := ANumber;
  3655.   Palette := wpBlueWindow;
  3656.   InitFrame;
  3657.   if Frame <> nil then Insert(Frame);
  3658.   GetBounds(ZoomRect);
  3659. end;
  3660.  
  3661. constructor TWindow.Load(var S: TStream);
  3662. begin
  3663.   TGroup.Load(S);
  3664.   S.Read(Flags, SizeOf(Byte) + SizeOf(TRect) + 2 * SizeOf(Integer));
  3665.   GetSubViewPtr(S, Frame);
  3666.   Title := S.ReadStr;
  3667. end;
  3668.  
  3669. destructor TWindow.Done;
  3670. begin
  3671.   TGroup.Done;
  3672.   DisposeStr(Title);
  3673. end;
  3674.  
  3675. procedure TWindow.Close;
  3676. begin
  3677.   if Valid(cmClose) then Free;
  3678. end;
  3679.  
  3680. function TWindow.GetPalette: PPalette;
  3681. const
  3682.   P: array[wpBlueWindow..wpGrayWindow] of string[Length(CBlueWindow)] =
  3683.     (CBlueWindow, CCyanWindow, CGrayWindow);
  3684. begin
  3685.   GetPalette := @P[Palette];
  3686. end;
  3687.  
  3688. function TWindow.GetTitle(MaxSize: Integer): TTitleStr;
  3689. begin
  3690.   if Title <> nil then GetTitle := Title^
  3691.   else GetTitle := '';
  3692. end;
  3693.  
  3694. procedure TWindow.HandleEvent(var Event: TEvent);
  3695. var
  3696.   Limits: TRect;
  3697.   Min, Max: TPoint;
  3698. begin
  3699.   TGroup.HandleEvent(Event);
  3700.   if (Event.What = evCommand) then
  3701.     case Event.Command of
  3702.       cmResize:
  3703.         if Flags and (wfMove + wfGrow) <> 0 then
  3704.         begin
  3705.           Owner^.GetExtent(Limits);
  3706.           SizeLimits(Min, Max);
  3707.           DragView(Event, DragMode or (Flags and (wfMove + wfGrow)),
  3708.             Limits, Min, Max);
  3709.           ClearEvent(Event);
  3710.         end;
  3711.       cmClose:
  3712.         if (Flags and wfClose <> 0) and
  3713.           ((Event.InfoPtr = nil) or (Event.InfoPtr = @Self)) then
  3714.         begin
  3715.           ClearEvent(Event);
  3716.           if State and sfModal = 0 then Close else
  3717.           begin
  3718.             Event.What := evCommand;
  3719.             Event.Command := cmCancel;
  3720.             PutEvent(Event);
  3721.             ClearEvent(Event);
  3722.           end;
  3723.         end;
  3724.       cmZoom:
  3725.         if (Flags and wfZoom <> 0) and
  3726.           ((Event.InfoPtr = nil) or (Event.InfoPtr = @Self)) then
  3727.         begin
  3728.           Zoom;
  3729.           ClearEvent(Event);
  3730.         end;
  3731.     end
  3732.   else if Event.What = evKeyDown then
  3733.     case Event.KeyCode of
  3734.       kbTab:
  3735.         begin
  3736.           FocusNext(False);
  3737.           ClearEvent(Event);
  3738.         end;
  3739.       kbShiftTab:
  3740.         begin
  3741.           FocusNext(True);
  3742.           ClearEvent(Event);
  3743.         end;
  3744.     end
  3745.   else if (Event.What = evBroadcast) and (Event.Command = cmSelectWindowNum)
  3746.          and (Event.InfoInt = Number) and (Options and ofSelectable <> 0) then
  3747.   begin
  3748.     Select;
  3749.     ClearEvent(Event);
  3750.   end;
  3751. end;
  3752.  
  3753. procedure TWindow.InitFrame;
  3754. var
  3755.   R: TRect;
  3756. begin
  3757.   GetExtent(R);
  3758.   Frame := New(PFrame, Init(R));
  3759. end;
  3760.  
  3761. procedure TWindow.SetState(AState: Word; Enable: Boolean);
  3762. var
  3763.   WindowCommands: TCommandSet;
  3764. begin
  3765.   TGroup.SetState(AState, Enable);
  3766.   if AState = sfSelected then
  3767.     SetState(sfActive, Enable);
  3768.   if (AState = sfSelected) or ((AState = sfExposed) and
  3769.     (State and sfSelected <> 0)) then
  3770.   begin
  3771.     WindowCommands := [cmNext, cmPrev];
  3772.     if Flags and wfGrow + wfMove <> 0 then
  3773.       WindowCommands := WindowCommands + [cmResize];
  3774.     if Flags and wfClose <> 0 then
  3775.       WindowCommands := WindowCommands + [cmClose];
  3776.     if Flags and wfZoom <> 0 then
  3777.       WindowCommands := WindowCommands + [cmZoom];
  3778.     if Enable then EnableCommands(WindowCommands)
  3779.     else DisableCommands(WindowCommands);
  3780.   end;
  3781. end;
  3782.  
  3783. function TWindow.StandardScrollBar(AOptions: Word): PScrollBar;
  3784. var
  3785.   R: TRect;
  3786.   S: PScrollBar;
  3787. begin
  3788.   GetExtent(R);
  3789.   if AOptions and sbVertical = 0 then
  3790.     R.Assign(R.A.X + 2, R.B.Y-1, R.B.X-2, R.B.Y) else
  3791.     R.Assign(R.B.X-1,R.A.Y+1,R.B.X,R.B.Y-1);
  3792.   S := New(PScrollBar, Init(R));
  3793.   Insert(S);
  3794.   if AOptions and sbHandleKeyboard <> 0 then
  3795.     S^.Options := S^.Options or ofPostProcess;
  3796.   StandardScrollBar := S;
  3797. end;
  3798.  
  3799. procedure TWindow.SizeLimits(var Min, Max: TPoint);
  3800. begin
  3801.   TView.SizeLimits(Min, Max);
  3802.   Min.X := MinWinSize.X;
  3803.   Min.Y := MinWinSize.Y;
  3804. end;
  3805.  
  3806. procedure TWindow.Store(var S: TStream);
  3807. begin
  3808.   TGroup.Store(S);
  3809.   S.Write(Flags, SizeOf(Byte) + SizeOf(TRect) + 2 * SizeOf(Integer));
  3810.   PutSubViewPtr(S, Frame);
  3811.   S.WriteStr(Title);
  3812. end;
  3813.  
  3814. procedure TWindow.Zoom;
  3815. var
  3816.   R: TRect;
  3817.   Max, Min: TPoint;
  3818. begin
  3819.   SizeLimits(Min, Max);
  3820.   if Longint(Size) <> Longint(Max) then
  3821.   begin
  3822.     GetBounds(ZoomRect);
  3823.     Longint(R.A) := 0;
  3824.     R.B := Max;
  3825.     Locate(R);
  3826.   end else Locate(ZoomRect);
  3827. end;
  3828.  
  3829. { Message dispatch function }
  3830.  
  3831. function Message(Receiver: PView; What, Command: Word;
  3832.   InfoPtr: Pointer): Pointer;
  3833. var
  3834.   Event: TEvent;
  3835. begin
  3836.   Message := nil;
  3837.   if Receiver <> nil then
  3838.   begin
  3839.     Event.What := What;
  3840.     Event.Command := Command;
  3841.     Event.InfoPtr := InfoPtr;
  3842.     Receiver^.HandleEvent(Event);
  3843.     if Event.What = evNothing then Message := Event.InfoPtr;
  3844.   end;
  3845. end;
  3846.  
  3847. { Views registration procedure }
  3848.  
  3849. procedure RegisterViews;
  3850. begin
  3851.   RegisterType(RView);
  3852.   RegisterType(RFrame);
  3853.   RegisterType(RScrollBar);
  3854.   RegisterType(RScroller);
  3855.   RegisterType(RListViewer);
  3856.   RegisterType(RGroup);
  3857.   RegisterType(RWindow);
  3858. end;
  3859.  
  3860. end.
  3861.