home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 13.ddi / RTLTV.ZIP / VIEWS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-10-28  |  93.1 KB  |  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. type
  623.   PFixupList = ^TFixupList;
  624.   TFixupList = array[1..4096] of Pointer;
  625.  
  626. const
  627.   OwnerGroup: PGroup = nil;
  628.   FixupList: PFixupList = nil;
  629.   TheTopView: PView = nil;
  630.  
  631. const
  632.  
  633. { Bit flags to determine how to draw the frame icons }
  634.  
  635.   fmCloseClicked = $0001;
  636.   fmZoomClicked  = $0002;
  637.  
  638. { Current command set. All but window commands are active by default }
  639.  
  640.   CurCommandSet: TCommandSet =
  641.     [0..255] - [cmZoom, cmClose, cmResize, cmNext, cmPrev];
  642.  
  643. { Convert color into attribute                          }
  644. { In    AL = Color                                      }
  645. { Out   AL = Attribute                                  }
  646.  
  647. procedure MapColor; near; assembler;
  648. const
  649.   Self = 6;
  650.   TView_GetPalette = vmtHeaderSize + $2C;
  651. asm
  652.         OR      AL,AL
  653.         JE      @@3
  654.         LES     DI,[BP].Self
  655. @@1:    PUSH    ES
  656.         PUSH    DI
  657.         PUSH    AX
  658.         PUSH    ES
  659.         PUSH    DI
  660.         MOV     DI,ES:[DI]
  661.         CALL    DWORD PTR [DI].TView_GetPalette
  662.         MOV     BX,AX
  663.         MOV     ES,DX
  664.         OR      AX,DX
  665.         POP     AX
  666.         POP     DI
  667.         POP     DX
  668.         JE      @@2
  669.         CMP     AL,ES:[BX]
  670.         JA      @@3
  671.         SEGES   XLAT
  672.         OR      AL,AL
  673.         JE      @@3
  674. @@2:    MOV     ES,DX
  675.         LES     DI,ES:[DI].TView.Owner
  676.         MOV     SI,ES
  677.         OR      SI,DI
  678.         JNE     @@1
  679.         JMP     @@4
  680. @@3:    MOV     AL,ErrorAttr
  681. @@4:
  682. end;
  683.  
  684. { Convert color pair into attribute pair                }
  685. { In    AX = Color pair                                 }
  686. { Out   AX = Attribute pair                             }
  687.  
  688. procedure MapCPair; near; assembler;
  689. asm
  690.         OR      AH,AH
  691.         JE      @@1
  692.         XCHG    AL,AH
  693.         CALL    MapColor
  694.         XCHG    AL,AH
  695. @@1:    CALL    MapColor
  696. end;
  697.  
  698. { Write to view                                         }
  699. { In    AX    = Y coordinate                            }
  700. {       BX    = X coordinate                            }
  701. {       CX    = Count                                   }
  702. {       ES:DI = Buffer Pointer                          }
  703.  
  704. procedure WriteView; near; assembler;
  705. const
  706.   Self   =   6;
  707.   Target =  -4;
  708.   Buffer =  -8;
  709.   BufOfs = -10;
  710. asm
  711.         MOV     [BP].BufOfs,BX
  712.         MOV     [BP].Buffer[0],DI
  713.         MOV     [BP].Buffer[2],ES
  714.         ADD     CX,BX
  715.         XOR     DX,DX
  716.         LES     DI,[BP].Self
  717.         OR      AX,AX
  718.         JL      @@3
  719.         CMP     AX,ES:[DI].TView.Size.Y
  720.         JGE     @@3
  721.         OR      BX,BX
  722.         JGE     @@1
  723.         XOR     BX,BX
  724. @@1:    CMP     CX,ES:[DI].TView.Size.X
  725.         JLE     @@2
  726.         MOV     CX,ES:[DI].TView.Size.X
  727. @@2:    CMP     BX,CX
  728.         JL      @@10
  729. @@3:    RET
  730. @@10:   TEST    ES:[DI].TView.State,sfVisible
  731.         JE      @@3
  732.         CMP     ES:[DI].TView.Owner.Word[2],0
  733.         JE      @@3
  734.         MOV     [BP].Target[0],DI
  735.         MOV     [BP].Target[2],ES
  736.         ADD     AX,ES:[DI].TView.Origin.Y
  737.         MOV     SI,ES:[DI].TView.Origin.X
  738.         ADD     BX,SI
  739.         ADD     CX,SI
  740.         ADD     [BP].BufOfs,SI
  741.         LES     DI,ES:[DI].TView.Owner
  742.         CMP     AX,ES:[DI].TGroup.Clip.A.Y
  743.         JL      @@3
  744.         CMP     AX,ES:[DI].TGroup.Clip.B.Y
  745.         JGE     @@3
  746.         CMP     BX,ES:[DI].TGroup.Clip.A.X
  747.         JGE     @@11
  748.         MOV     BX,ES:[DI].TGroup.Clip.A.X
  749. @@11:   CMP     CX,ES:[DI].TGroup.Clip.B.X
  750.         JLE     @@12
  751.         MOV     CX,ES:[DI].TGroup.Clip.B.X
  752. @@12:   CMP     BX,CX
  753.         JGE     @@3
  754.         LES     DI,ES:[DI].TGroup.Last
  755. @@20:   LES     DI,ES:[DI].TView.Next
  756.         CMP     DI,[BP].Target[0]
  757.         JNE     @@21
  758.         MOV     SI,ES
  759.         CMP     SI,[BP].Target[2]
  760.         JNE     @@21
  761.         JMP     @@40
  762. @@21:   TEST    ES:[DI].TView.State,sfVisible
  763.         JE      @@20
  764.         MOV     SI,ES:[DI].TView.Origin.Y
  765.         CMP     AX,SI
  766.         JL      @@20
  767.         ADD     SI,ES:[DI].TView.Size.Y
  768.         CMP     AX,SI
  769.         JL      @@23
  770.         TEST    ES:[DI].TView.State,sfShadow
  771.         JE      @@20
  772.         ADD     SI,ShadowSize.Y
  773.         CMP     AX,SI
  774.         JGE     @@20
  775.         MOV     SI,ES:[DI].TView.Origin.X
  776.         ADD     SI,ShadowSize.X
  777.         CMP     BX,SI
  778.         JGE     @@22
  779.         CMP     CX,SI
  780.         JLE     @@20
  781.         CALL    @@30
  782. @@22:   ADD     SI,ES:[DI].TView.Size.X
  783.         JMP     @@26
  784. @@23:   MOV     SI,ES:[DI].TView.Origin.X
  785.         CMP     BX,SI
  786.         JGE     @@24
  787.         CMP     CX,SI
  788.         JLE     @@20
  789.         CALL    @@30
  790. @@24:   ADD     SI,ES:[DI].TView.Size.X
  791.         CMP     BX,SI
  792.         JGE     @@25
  793.         CMP     CX,SI
  794.         JLE     @@31
  795.         MOV     BX,SI
  796. @@25:   TEST    ES:[DI].TView.State,sfShadow
  797.         JE      @@20
  798.         PUSH    SI
  799.         MOV     SI,ES:[DI].TView.Origin.Y
  800.         ADD     SI,ShadowSize.Y
  801.         CMP     AX,SI
  802.         POP     SI
  803.         JL      @@27
  804.         ADD     SI,ShadowSize.X
  805. @@26:   CMP     BX,SI
  806.         JGE     @@27
  807.         INC     DX
  808.         CMP     CX,SI
  809.         JLE     @@27
  810.         CALL    @@30
  811.         DEC     DX
  812. @@27:   JMP     @@20
  813. @@30:   PUSH    [BP].Target.Word[2]
  814.         PUSH    [BP].Target.Word[0]
  815.         PUSH    [BP].BufOfs.Word[0]
  816.         PUSH    ES
  817.         PUSH    DI
  818.         PUSH    SI
  819.         PUSH    DX
  820.         PUSH    CX
  821.         PUSH    AX
  822.         MOV     CX,SI
  823.         CALL    @@20
  824.         POP     AX
  825.         POP     CX
  826.         POP     DX
  827.         POP     SI
  828.         POP     DI
  829.         POP     ES
  830.         POP     [BP].BufOfs.Word[0]
  831.         POP     [BP].Target.Word[0]
  832.         POP     [BP].Target.Word[2]
  833.         MOV     BX,SI
  834. @@31:   RET
  835. @@40:   LES     DI,ES:[DI].TView.Owner
  836.         MOV     SI,ES:[DI].TGroup.Buffer.Word[2]
  837.         OR      SI,SI
  838.         JE      @@44
  839.         CMP     SI,ScreenBuffer.Word[2]
  840.         JE      @@41
  841.         CALL    @@50
  842.         JMP     @@44
  843. @@41:   CLI
  844.         CMP     AX,MouseWhere.Y
  845.         JNE     @@42
  846.         CMP     BX,MouseWhere.X
  847.         JA      @@42
  848.         CMP     CX,MouseWhere.X
  849.         JA      @@43
  850. @@42:   MOV     MouseIntFlag,0
  851.         STI
  852.         CALL    @@50
  853.         CMP     MouseIntFlag,0
  854.         JE      @@44
  855. @@43:   STI
  856.         CALL    HideMouse
  857.         CALL    @@50
  858.         CALL    ShowMouse
  859. @@44:   CMP     ES:[DI].TGroup.LockFlag,0
  860.         JNE     @@31
  861.         JMP     @@10
  862. @@50:   PUSH    ES
  863.         PUSH    DS
  864.         PUSH    DI
  865.         PUSH    CX
  866.         PUSH    AX
  867.         MUL     ES:[DI].TView.Size.X.Byte[0]
  868.         ADD     AX,BX
  869.         SHL     AX,1
  870.         ADD     AX,ES:[DI].TGroup.Buffer.Word[0]
  871.         MOV     DI,AX
  872.         MOV     ES,SI
  873.         XOR     AL,AL
  874.         CMP     SI,ScreenBuffer.Word[2]
  875.         JNE     @@51
  876.         MOV     AL,CheckSnow
  877. @@51:   MOV     AH,ShadowAttr
  878.         SUB     CX,BX
  879.         MOV     SI,BX
  880.         SUB     SI,[BP].BufOfs
  881.         SHL     SI,1
  882.         ADD     SI,[BP].Buffer.Word[0]
  883.         MOV     DS,[BP].Buffer.Word[2]
  884.         CLD
  885.         OR      AL,AL
  886.         JNE     @@60
  887.         OR      DX,DX
  888.         JNE     @@52
  889.         REP     MOVSW
  890.         JMP     @@70
  891. @@52:   LODSB
  892.         INC     SI
  893.         STOSW
  894.         LOOP    @@52
  895.         JMP     @@70
  896. @@60:   PUSH    DX
  897.         PUSH    BX
  898.         OR      DX,DX
  899.         MOV     DX,03DAH
  900.         JNE     @@65
  901. @@61:   LODSW
  902.         MOV     BX,AX
  903. @@62:   IN      AL,DX
  904.         TEST    AL,1
  905.         JNE     @@62
  906.         CLI
  907. @@63:   IN      AL,DX
  908.         TEST    AL,1
  909.         JE      @@63
  910.         MOV     AX,BX
  911.         STOSW
  912.         STI
  913.         LOOP    @@61
  914.         JMP     @@68
  915. @@65:   LODSB
  916.         MOV     BL,AL
  917.         INC     SI
  918. @@66:   IN      AL,DX
  919.         TEST    AL,1
  920.         JNE     @@66
  921.         CLI
  922. @@67:   IN      AL,DX
  923.         TEST    AL,1
  924.         JE      @@67
  925.         MOV     AL,BL
  926.         STOSW
  927.         STI
  928.         LOOP    @@65
  929. @@68:   POP     BX
  930.         POP     DX
  931. @@70:   MOV     SI,ES
  932.         POP     AX
  933.         POP     CX
  934.         POP     DI
  935.         POP     DS
  936.         POP     ES
  937.         RET
  938. end;
  939.  
  940. { TView }
  941.  
  942. constructor TView.Init(var Bounds: TRect);
  943. begin
  944.   TObject.Init;
  945.   Owner := nil;
  946.   State := sfVisible;
  947.   SetBounds(Bounds);
  948.   DragMode := dmLimitLoY;
  949.   HelpCtx := hcNoContext;
  950.   EventMask := evMouseDown + evKeyDown + evCommand;
  951. end;
  952.  
  953. constructor TView.Load(var S: TStream);
  954. begin
  955.   TObject.Init;
  956.   S.Read(Origin,
  957.     SizeOf(TPoint) * 3 +
  958.     SizeOf(Byte) * 2 +
  959.     SizeOf(Word) * 4);
  960. end;
  961.  
  962. destructor TView.Done;
  963. begin
  964.   Hide;
  965.   if Owner <> nil then Owner^.Delete(@Self);
  966. end;
  967.  
  968. procedure TView.Awaken;
  969. begin
  970. end;
  971.  
  972. procedure TView.BlockCursor;
  973. begin
  974.   SetState(sfCursorIns, True);
  975. end;
  976.  
  977. procedure TView.CalcBounds(var Bounds: TRect; Delta: TPoint);
  978. var
  979.   S, D: Integer;
  980.   Min, Max: TPoint;
  981.  
  982. procedure Grow(var I: Integer);
  983. begin
  984.   if GrowMode and gfGrowRel = 0 then Inc(I, D) else
  985.     I := (I * S + (S - D) shr 1) div (S - D);
  986. end;
  987.  
  988. function Range(Val, Min, Max: Integer): Integer;
  989. begin
  990.   if Val < Min then Range := Min else
  991.     if Val > Max then Range := Max else
  992.       Range := Val;
  993. end;
  994.  
  995. begin
  996.   GetBounds(Bounds);
  997.   S := Owner^.Size.X;
  998.   D := Delta.X;
  999.   if GrowMode and gfGrowLoX <> 0 then Grow(Bounds.A.X);
  1000.   if GrowMode and gfGrowHiX <> 0 then Grow(Bounds.B.X);
  1001.   if Bounds.B.X - Bounds.A.X > MaxViewWidth then
  1002.     Bounds.B.X := Bounds.A.X + MaxViewWidth;
  1003.   S := Owner^.Size.Y;
  1004.   D := Delta.Y;
  1005.   if GrowMode and gfGrowLoY <> 0 then Grow(Bounds.A.Y);
  1006.   if GrowMode and gfGrowHiY <> 0 then Grow(Bounds.B.Y);
  1007.   SizeLimits(Min, Max);
  1008.   Bounds.B.X := Bounds.A.X + Range(Bounds.B.X - Bounds.A.X, Min.X, Max.X);
  1009.   Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y - Bounds.A.Y, Min.Y, Max.Y);
  1010. end;
  1011.  
  1012. procedure TView.ChangeBounds(var Bounds: TRect);
  1013. begin
  1014.   SetBounds(Bounds);
  1015.   DrawView;
  1016. end;
  1017.  
  1018. procedure TView.ClearEvent(var Event: TEvent);
  1019. begin
  1020.   Event.What := evNothing;
  1021.   Event.InfoPtr := @Self;
  1022. end;
  1023.  
  1024. function TView.CommandEnabled(Command: Word): Boolean;
  1025. begin
  1026.   CommandEnabled := (Command > 255) or (Command in CurCommandSet);
  1027. end;
  1028.  
  1029. function TView.DataSize: Word;
  1030. begin
  1031.   DataSize := 0;
  1032. end;
  1033.  
  1034. procedure TView.DisableCommands(Commands: TCommandSet);
  1035. begin
  1036.   CommandSetChanged := CommandSetChanged or (CurCommandSet * Commands <> []);
  1037.   CurCommandSet := CurCommandSet - Commands;
  1038. end;
  1039.  
  1040. procedure TView.DragView(Event: TEvent; Mode: Byte;
  1041.   var Limits: TRect; MinSize, MaxSize: TPoint);
  1042. var
  1043.   P, S: TPoint;
  1044.   SaveBounds: TRect;
  1045.  
  1046. function Min(I, J: Integer): Integer;
  1047. begin
  1048.   if I < J then Min := I else Min := J;
  1049. end;
  1050.  
  1051. function Max(I, J: Integer): Integer;
  1052. begin
  1053.   if I > J then Max := I else Max := J;
  1054. end;
  1055.  
  1056. procedure MoveGrow(P, S: TPoint);
  1057. var
  1058.   R: TRect;
  1059. begin
  1060.   S.X := Min(Max(S.X, MinSize.X), MaxSize.X);
  1061.   S.Y := Min(Max(S.Y, MinSize.Y), MaxSize.Y);
  1062.   P.X := Min(Max(P.X, Limits.A.X - S.X + 1), Limits.B.X - 1);
  1063.   P.Y := Min(Max(P.Y, Limits.A.Y - S.Y + 1), Limits.B.Y - 1);
  1064.   if Mode and dmLimitLoX <> 0 then P.X := Max(P.X, Limits.A.X);
  1065.   if Mode and dmLimitLoY <> 0 then P.Y := Max(P.Y, Limits.A.Y);
  1066.   if Mode and dmLimitHiX <> 0 then P.X := Min(P.X, Limits.B.X - S.X);
  1067.   if Mode and dmLimitHiY <> 0 then P.Y := Min(P.Y, Limits.B.Y - S.Y);
  1068.   R.Assign(P.X, P.Y, P.X + S.X, P.Y + S.Y);
  1069.   Locate(R);
  1070. end;
  1071.  
  1072. procedure Change(DX, DY: Integer);
  1073. begin
  1074.   if (Mode and dmDragMove <> 0) and (GetShiftState and $03 = 0) then
  1075.   begin
  1076.     Inc(P.X, DX);
  1077.     Inc(P.Y, DY);
  1078.   end else
  1079.   if (Mode and dmDragGrow <> 0) and (GetShiftState and $03 <> 0) then
  1080.   begin
  1081.     Inc(S.X, DX);
  1082.     Inc(S.Y, DY);
  1083.   end;
  1084. end;
  1085.  
  1086. procedure Update(X, Y: Integer);
  1087. begin
  1088.   if Mode and dmDragMove <> 0 then
  1089.   begin
  1090.     P.X := X;
  1091.     P.Y := Y;
  1092.   end;
  1093. end;
  1094.  
  1095. begin
  1096.   SetState(sfDragging, True);
  1097.   if Event.What = evMouseDown then
  1098.   begin
  1099.     if Mode and dmDragMove <> 0 then
  1100.     begin
  1101.       P.X := Origin.X - Event.Where.X;
  1102.       P.Y := Origin.Y - Event.Where.Y;
  1103.       repeat
  1104.         Inc(Event.Where.X, P.X);
  1105.         Inc(Event.Where.Y, P.Y);
  1106.         MoveGrow(Event.Where, Size);
  1107.       until not MouseEvent(Event, evMouseMove);
  1108.     end else
  1109.     begin
  1110.       P.X := Size.X - Event.Where.X;
  1111.       P.Y := Size.Y - Event.Where.Y;
  1112.       repeat
  1113.         Inc(Event.Where.X, P.X);
  1114.         Inc(Event.Where.Y, P.Y);
  1115.         MoveGrow(Origin, Event.Where);
  1116.       until not MouseEvent(Event, evMouseMove);
  1117.     end;
  1118.   end else
  1119.   begin
  1120.     GetBounds(SaveBounds);
  1121.     repeat
  1122.       P := Origin;
  1123.       S := Size;
  1124.       KeyEvent(Event);
  1125.       case Event.KeyCode and $FF00 of
  1126.         kbLeft: Change(-1, 0);
  1127.         kbRight: Change(1, 0);
  1128.         kbUp: Change(0, -1);
  1129.         kbDown: Change(0, 1);
  1130.         kbCtrlLeft: Change(-8, 0);
  1131.         kbCtrlRight: Change(8, 0);
  1132.         kbHome: Update(Limits.A.X, P.Y);
  1133.         kbEnd: Update(Limits.B.X - S.X, P.Y);
  1134.         kbPgUp: Update(P.X, Limits.A.Y);
  1135.         kbPgDn: Update(P.X, Limits.B.Y - S.Y);
  1136.       end;
  1137.       MoveGrow(P, S);
  1138.     until (Event.KeyCode = kbEnter) or (Event.KeyCode = kbEsc);
  1139.     if Event.KeyCode = kbEsc then Locate(SaveBounds);
  1140.   end;
  1141.   SetState(sfDragging, False);
  1142. end;
  1143.  
  1144. procedure TView.Draw;
  1145. var
  1146.   B: TDrawBuffer;
  1147. begin
  1148.   MoveChar(B, ' ', GetColor(1), Size.X);
  1149.   WriteLine(0, 0, Size.X, Size.Y, B);
  1150. end;
  1151.  
  1152. procedure TView.DrawCursor;
  1153. begin
  1154.   if State and sfFocused <> 0 then ResetCursor;
  1155. end;
  1156.  
  1157. procedure TView.DrawHide(LastView: PView);
  1158. begin
  1159.   DrawCursor;
  1160.   DrawUnderView(State and sfShadow <> 0, LastView);
  1161. end;
  1162.  
  1163. procedure TView.DrawShow(LastView: PView);
  1164. begin
  1165.   DrawView;
  1166.   if State and sfShadow <> 0 then DrawUnderView(True, LastView);
  1167. end;
  1168.  
  1169. procedure TView.DrawUnderRect(var R: TRect; LastView: PView);
  1170. begin
  1171.   Owner^.Clip.Intersect(R);
  1172.   Owner^.DrawSubViews(NextView, LastView);
  1173.   Owner^.GetExtent(Owner^.Clip);
  1174. end;
  1175.  
  1176. procedure TView.DrawUnderView(DoShadow: Boolean; LastView: PView);
  1177. var
  1178.   R: TRect;
  1179. begin
  1180.   GetBounds(R);
  1181.   if DoShadow then
  1182.   begin
  1183.     Inc(R.B.X, ShadowSize.X);
  1184.     Inc(R.B.Y, ShadowSize.Y);
  1185.   end;
  1186.   DrawUnderRect(R, LastView);
  1187. end;
  1188.  
  1189. procedure TView.DrawView;
  1190. begin
  1191.   if Exposed then
  1192.   begin
  1193.     Draw;
  1194.     DrawCursor;
  1195.   end;
  1196. end;
  1197.  
  1198. procedure TView.EnableCommands(Commands: TCommandSet);
  1199. begin
  1200.   CommandSetChanged := CommandSetChanged or
  1201.     (CurCommandSet * Commands <> Commands);
  1202.   CurCommandSet := CurCommandSet + Commands;
  1203. end;
  1204.  
  1205. procedure TView.EndModal(Command: Word);
  1206. var
  1207.   P: PView;
  1208. begin
  1209.   P := TopView;
  1210.   if TopView <> nil then TopView^.EndModal(Command);
  1211. end;
  1212.  
  1213. function TView.EventAvail: Boolean;
  1214. var
  1215.   Event: TEvent;
  1216. begin
  1217.   GetEvent(Event);
  1218.   if Event.What <> evNothing then PutEvent(Event);
  1219.   EventAvail := Event.What <> evNothing;
  1220. end;
  1221.  
  1222. procedure TView.GetBounds(var Bounds: TRect); assembler;
  1223. asm
  1224.         PUSH    DS
  1225.         LDS     SI,Self
  1226.         ADD     SI,OFFSET TView.Origin
  1227.         LES     DI,Bounds
  1228.         CLD
  1229.         LODSW                           {Origin.X}
  1230.         MOV     CX,AX
  1231.         STOSW
  1232.         LODSW                           {Origin.Y}
  1233.         MOV     DX,AX
  1234.         STOSW
  1235.         LODSW                           {Size.X}
  1236.         ADD     AX,CX
  1237.         STOSW
  1238.         LODSW                           {Size.Y}
  1239.         ADD     AX,DX
  1240.         STOSW
  1241.         POP     DS
  1242. end;
  1243.  
  1244. function TView.Execute: Word;
  1245. begin
  1246.   Execute := cmCancel;
  1247. end;
  1248.  
  1249. function TView.Exposed: Boolean; assembler;
  1250. var
  1251.   Target: Pointer;
  1252. asm
  1253.         LES     DI,Self
  1254.         TEST    ES:[DI].TView.State,sfExposed
  1255.         JE      @@2
  1256.         XOR     AX,AX
  1257.         CMP     AX,ES:[DI].TView.Size.X
  1258.         JGE     @@2
  1259.         CMP     AX,ES:[DI].TView.Size.Y
  1260.         JGE     @@2
  1261. @@1:    XOR     BX,BX
  1262.         MOV     CX,ES:[DI].TView.Size.X
  1263.         PUSH    AX
  1264.         CALL    @@11
  1265.         POP     AX
  1266.         JNC     @@3
  1267.         LES     DI,Self
  1268.         INC     AX
  1269.         CMP     AX,ES:[DI].TView.Size.Y
  1270.         JL      @@1
  1271. @@2:    MOV     AL,0
  1272.         JMP     @@30
  1273. @@3:    MOV     AL,1
  1274.         JMP     @@30
  1275. @@8:    STC
  1276. @@9:    RETN
  1277. @@10:   LES     DI,ES:[DI].TView.Owner
  1278.         CMP     ES:[DI].TGroup.Buffer.Word[2],0
  1279.         JNE     @@9
  1280. @@11:   MOV     Target.Word[0],DI
  1281.         MOV     Target.Word[2],ES
  1282.         ADD     AX,ES:[DI].TView.Origin.Y
  1283.         MOV     SI,ES:[DI].TView.Origin.X
  1284.         ADD     BX,SI
  1285.         ADD     CX,SI
  1286.         LES     DI,ES:[DI].TView.Owner
  1287.         MOV     SI,ES
  1288.         OR      SI,DI
  1289.         JE      @@9
  1290.         CMP     AX,ES:[DI].TGroup.Clip.A.Y
  1291.         JL      @@8
  1292.         CMP     AX,ES:[DI].TGroup.Clip.B.Y
  1293.         JGE     @@8
  1294.         CMP     BX,ES:[DI].TGroup.Clip.A.X
  1295.         JGE     @@12
  1296.         MOV     BX,ES:[DI].TGroup.Clip.A.X
  1297. @@12:   CMP     CX,ES:[DI].TGroup.Clip.B.X
  1298.         JLE     @@13
  1299.         MOV     CX,ES:[DI].TGroup.Clip.B.X
  1300. @@13:   CMP     BX,CX
  1301.         JGE     @@8
  1302.         LES     DI,ES:[DI].TGroup.Last
  1303. @@20:   LES     DI,ES:[DI].TView.Next
  1304.         CMP     DI,Target.Word[0]
  1305.         JNE     @@21
  1306.         MOV     SI,ES
  1307.         CMP     SI,Target.Word[2]
  1308.         JE      @@10
  1309. @@21:   TEST    ES:[DI].TView.State,sfVisible
  1310.         JE      @@20
  1311.         MOV     SI,ES:[DI].TView.Origin.Y
  1312.         CMP     AX,SI
  1313.         JL      @@20
  1314.         ADD     SI,ES:[DI].TView.Size.Y
  1315.         CMP     AX,SI
  1316.         JGE     @@20
  1317.         MOV     SI,ES:[DI].TView.Origin.X
  1318.         CMP     BX,SI
  1319.         JL      @@22
  1320.         ADD     SI,ES:[DI].TView.Size.X
  1321.         CMP     BX,SI
  1322.         JGE     @@20
  1323.         MOV     BX,SI
  1324.         CMP     BX,CX
  1325.         JL      @@20
  1326.         STC
  1327.         RETN
  1328. @@22:   CMP     CX,SI
  1329.         JLE     @@20
  1330.         ADD     SI,ES:[DI].TView.Size.X
  1331.         CMP     CX,SI
  1332.         JG      @@23
  1333.         MOV     CX,ES:[DI].TView.Origin.X
  1334.         JMP     @@20
  1335. @@23:   PUSH    Target.Word[2]
  1336.         PUSH    Target.Word[0]
  1337.         PUSH    ES
  1338.         PUSH    DI
  1339.         PUSH    SI
  1340.         PUSH    CX
  1341.         PUSH    AX
  1342.         MOV     CX,ES:[DI].TView.Origin.X
  1343.         CALL    @@20
  1344.         POP     AX
  1345.         POP     CX
  1346.         POP     BX
  1347.         POP     DI
  1348.         POP     ES
  1349.         POP     Target.Word[0]
  1350.         POP     Target.Word[2]
  1351.         JC      @@20
  1352.         RETN
  1353. @@30:
  1354. end;
  1355.  
  1356. function TView.Focus: Boolean;
  1357. var
  1358.   Result: Boolean;
  1359. begin
  1360.   Result := True;
  1361.   if State and (sfSelected + sfModal) = 0 then
  1362.   begin
  1363.     if Owner <> nil then
  1364.     begin
  1365.       Result := Owner^.Focus;
  1366.       if Result then
  1367.         if ((Owner^.Current = nil) or
  1368.           (Owner^.Current^.Options and ofValidate = 0) or
  1369.           (Owner^.Current^.Valid(cmReleasedFocus))) then
  1370.           Select
  1371.         else
  1372.           Result := False;
  1373.     end;
  1374.   end;
  1375.   Focus := Result;
  1376. end;
  1377.  
  1378. procedure TView.GetClipRect(var Clip: TRect);
  1379. begin
  1380.   GetBounds(Clip);
  1381.   if Owner <> nil then Clip.Intersect(Owner^.Clip);
  1382.   Clip.Move(-Origin.X, -Origin.Y);
  1383. end;
  1384.  
  1385. function TView.GetColor(Color: Word): Word; assembler;
  1386. asm
  1387.         MOV     AX,Color
  1388.         CALL    MapCPair
  1389. end;
  1390.  
  1391. procedure TView.GetCommands(var Commands: TCommandSet);
  1392. begin
  1393.   Commands := CurCommandSet;
  1394. end;
  1395.  
  1396. procedure TView.GetData(var Rec);
  1397. begin
  1398. end;
  1399.  
  1400. procedure TView.GetEvent(var Event: TEvent);
  1401. begin
  1402.   if Owner <> nil then Owner^.GetEvent(Event);
  1403. end;
  1404.  
  1405. procedure TView.GetExtent(var Extent: TRect); assembler;
  1406. asm
  1407.         PUSH    DS
  1408.         LDS     SI,Self
  1409.         ADD     SI,OFFSET TView.Size
  1410.         LES     DI,Extent
  1411.         CLD
  1412.         XOR     AX,AX
  1413.         STOSW
  1414.         STOSW
  1415.         MOVSW
  1416.         MOVSW
  1417.         POP     DS
  1418. end;
  1419.  
  1420. function TView.GetHelpCtx: Word;
  1421. begin
  1422.   if State and sfDragging <> 0 then
  1423.     GetHelpCtx := hcDragging else
  1424.     GetHelpCtx := HelpCtx;
  1425. end;
  1426.  
  1427. function TView.GetPalette: PPalette;
  1428. begin
  1429.   GetPalette := nil;
  1430. end;
  1431.  
  1432. procedure TView.GetPeerViewPtr(var S: TStream; var P);
  1433. var
  1434.   Index: Integer;
  1435. begin
  1436.   S.Read(Index, SizeOf(Word));
  1437.   if (Index = 0) or (OwnerGroup = nil) then Pointer(P) := nil
  1438.   else
  1439.   begin
  1440.     Pointer(P) := FixupList^[Index];
  1441.     FixupList^[Index] := @P;
  1442.   end;
  1443. end;
  1444.  
  1445. function TView.GetState(AState: Word): Boolean;
  1446. begin
  1447.   GetState := State and AState = AState;
  1448. end;
  1449.  
  1450. procedure TView.GrowTo(X, Y: Integer);
  1451. var
  1452.   R: TRect;
  1453. begin
  1454.   R.Assign(Origin.X, Origin.Y, Origin.X + X, Origin.Y + Y);
  1455.   Locate(R);
  1456. end;
  1457.  
  1458. procedure TView.HandleEvent(var Event: TEvent);
  1459. begin
  1460.   if Event.What = evMouseDown then
  1461.     if (State and (sfSelected + sfDisabled) = 0) and
  1462.        (Options and ofSelectable <> 0) then
  1463.       if not Focus or (Options and ofFirstClick = 0) then
  1464.         ClearEvent(Event);
  1465. end;
  1466.  
  1467. procedure TView.Hide;
  1468. begin
  1469.   if State and sfVisible <> 0 then SetState(sfVisible, False);
  1470. end;
  1471.  
  1472. procedure TView.HideCursor;
  1473. begin
  1474.   SetState(sfCursorVis, False);
  1475. end;
  1476.  
  1477. procedure TView.KeyEvent(var Event: TEvent);
  1478. begin
  1479.   repeat GetEvent(Event) until Event.What = evKeyDown;
  1480. end;
  1481.  
  1482. procedure TView.Locate(var Bounds: TRect);
  1483. var
  1484.   R: TRect;
  1485.   Min, Max: TPoint;
  1486.  
  1487. function Range(Val, Min, Max: Integer): Integer;
  1488. begin
  1489.   if Val < Min then Range := Min else
  1490.     if Val > Max then Range := Max else
  1491.       Range := Val;
  1492. end;
  1493.  
  1494. begin
  1495.   SizeLimits(Min, Max);
  1496.   Bounds.B.X := Bounds.A.X + Range(Bounds.B.X - Bounds.A.X, Min.X, Max.X);
  1497.   Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y - Bounds.A.Y, Min.Y, Max.Y);
  1498.   GetBounds(R);
  1499.   if not Bounds.Equals(R) then
  1500.   begin
  1501.     ChangeBounds(Bounds);
  1502.     if (Owner <> nil) and (State and sfVisible <> 0) then
  1503.     begin
  1504.       if State and sfShadow <> 0 then
  1505.       begin
  1506.         R.Union(Bounds);
  1507.         Inc(R.B.X, ShadowSize.X);
  1508.         Inc(R.B.Y, ShadowSize.Y);
  1509.       end;
  1510.       DrawUnderRect(R, nil);
  1511.     end;
  1512.   end;
  1513. end;
  1514.  
  1515. procedure TView.MakeFirst;
  1516. begin
  1517.   PutInFrontOf(Owner^.First);
  1518. end;
  1519.  
  1520. procedure TView.MakeGlobal(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.         ADD     AX,Source.X
  1532.         ADD     DX,Source.Y
  1533.         LES     DI,Dest
  1534.         CLD
  1535.         STOSW
  1536.         XCHG    AX,DX
  1537.         STOSW
  1538. end;
  1539.  
  1540. procedure TView.MakeLocal(Source: TPoint; var Dest: TPoint); assembler;
  1541. asm
  1542.         LES     DI,Self
  1543.         XOR     AX,AX
  1544.         MOV     DX,AX
  1545. @@1:    ADD     AX,ES:[DI].TView.Origin.X
  1546.         ADD     DX,ES:[DI].TView.Origin.Y
  1547.         LES     DI,ES:[DI].TView.Owner
  1548.         MOV     SI,ES
  1549.         OR      SI,DI
  1550.         JNE     @@1
  1551.         NEG     AX
  1552.         NEG     DX
  1553.         ADD     AX,Source.X
  1554.         ADD     DX,Source.Y
  1555.         LES     DI,Dest
  1556.         CLD
  1557.         STOSW
  1558.         XCHG    AX,DX
  1559.         STOSW
  1560. end;
  1561.  
  1562. function TView.MouseEvent(var Event: TEvent; Mask: Word): Boolean;
  1563. begin
  1564.   repeat GetEvent(Event) until Event.What and (Mask or evMouseUp) <> 0;
  1565.   MouseEvent := Event.What <> evMouseUp;
  1566. end;
  1567.  
  1568. function TView.MouseInView(Mouse: TPoint): Boolean;
  1569. var
  1570.   Extent: TRect;
  1571. begin
  1572.   MakeLocal(Mouse, Mouse);
  1573.   GetExtent(Extent);
  1574.   MouseInView := Extent.Contains(Mouse);
  1575. end;
  1576.  
  1577. procedure TView.MoveTo(X, Y: Integer);
  1578. var
  1579.   R: TRect;
  1580. begin
  1581.   R.Assign(X, Y, X + Size.X, Y + Size.Y);
  1582.   Locate(R);
  1583. end;
  1584.  
  1585. function TView.NextView: PView;
  1586. begin
  1587.   if @Self = Owner^.Last then NextView := nil else NextView := Next;
  1588. end;
  1589.  
  1590. procedure TView.NormalCursor;
  1591. begin
  1592.   SetState(sfCursorIns, False);
  1593. end;
  1594.  
  1595. function TView.Prev: PView; assembler;
  1596. asm
  1597.         LES     DI,Self
  1598.         MOV     CX,DI
  1599.         MOV     BX,ES
  1600. @@1:    MOV     AX,DI
  1601.         MOV     DX,ES
  1602.         LES     DI,ES:[DI].TView.Next
  1603.         CMP     DI,CX
  1604.         JNE     @@1
  1605.         MOV     SI,ES
  1606.         CMP     SI,BX
  1607.         JNE     @@1
  1608. end;
  1609.  
  1610. function TView.PrevView: PView;
  1611. begin
  1612.   if @Self = Owner^.First then PrevView := nil else PrevView := Prev;
  1613. end;
  1614.  
  1615. procedure TView.PutEvent(var Event: TEvent);
  1616. begin
  1617.   if Owner <> nil then Owner^.PutEvent(Event);
  1618. end;
  1619.  
  1620. procedure TView.PutInFrontOf(Target: PView);
  1621. var
  1622.   P, LastView: PView;
  1623.  
  1624. procedure MoveView;
  1625. begin
  1626.   Owner^.RemoveView(@Self);
  1627.   Owner^.InsertView(@Self, Target);
  1628. end;
  1629.  
  1630. begin
  1631.   if (Owner <> nil) and (Target <> @Self) and (Target <> NextView) and
  1632.     ((Target = nil) or (Target^.Owner = Owner)) then
  1633.     if State and sfVisible = 0 then MoveView else
  1634.     begin
  1635.       
  1636.       LastView := NextView;
  1637.       if LastView <> nil then
  1638.       begin
  1639.         P := Target;
  1640.         while (P <> nil) and (P <> LastView) do P := P^.NextView;
  1641.         if P = nil then LastView := Target;
  1642.       end;
  1643.       State := State and not sfVisible;
  1644.       if LastView = Target then DrawHide(LastView);
  1645.       MoveView;
  1646.       State := State or sfVisible;
  1647.       if LastView <> Target then DrawShow(LastView);
  1648.       if Options and ofSelectable <> 0 then
  1649.       begin
  1650.         Owner^.ResetCurrent;
  1651.         Owner^.ResetCursor;
  1652.       end;
  1653.     end;
  1654. end;
  1655.  
  1656. procedure TView.PutPeerViewPtr(var S: TStream; P: PView);
  1657. var
  1658.   Index: Integer;
  1659. begin
  1660.   if (P = nil) or (OwnerGroup = nil) then Index := 0
  1661.   else Index := OwnerGroup^.IndexOf(P);
  1662.   S.Write(Index, SizeOf(Word));
  1663. end;
  1664.  
  1665. procedure TView.ResetCursor; assembler;
  1666. asm
  1667.         LES     DI,Self
  1668.         MOV     AX,ES:[DI].TView.State
  1669.         NOT     AX
  1670.         TEST    AX,sfVisible+sfCursorVis+sfFocused
  1671.         JNE     @@4
  1672.         MOV     AX,ES:[DI].TView.Cursor.Y
  1673.         MOV     DX,ES:[DI].TView.Cursor.X
  1674. @@1:    OR      AX,AX
  1675.         JL      @@4
  1676.         CMP     AX,ES:[DI].TView.Size.Y
  1677.         JGE     @@4
  1678.         OR      DX,DX
  1679.         JL      @@4
  1680.         CMP     DX,ES:[DI].TView.Size.X
  1681.         JGE     @@4
  1682.         ADD     AX,ES:[DI].TView.Origin.Y
  1683.         ADD     DX,ES:[DI].TView.Origin.X
  1684.         MOV     CX,DI
  1685.         MOV     BX,ES
  1686.         LES     DI,ES:[DI].TView.Owner
  1687.         MOV     SI,ES
  1688.         OR      SI,DI
  1689.         JE      @@5
  1690.         TEST    ES:[DI].TView.State,sfVisible
  1691.         JE      @@4
  1692.         LES     DI,ES:[DI].TGroup.Last
  1693. @@2:    LES     DI,ES:[DI].TView.Next
  1694.         CMP     CX,DI
  1695.         JNE     @@3
  1696.         MOV     SI,ES
  1697.         CMP     BX,SI
  1698.         JNE     @@3
  1699.         LES     DI,ES:[DI].TView.Owner
  1700.         JMP     @@1
  1701. @@3:    TEST    ES:[DI].TView.State,sfVisible
  1702.         JE      @@2
  1703.         MOV     SI,ES:[DI].TView.Origin.Y
  1704.         CMP     AX,SI
  1705.         JL      @@2
  1706.         ADD     SI,ES:[DI].TView.Size.Y
  1707.         CMP     AX,SI
  1708.         JGE     @@2
  1709.         MOV     SI,ES:[DI].TView.Origin.X
  1710.         CMP     DX,SI
  1711.         JL      @@2
  1712.         ADD     SI,ES:[DI].TView.Size.X
  1713.         CMP     DX,SI
  1714.         JGE     @@2
  1715. @@4:    MOV     CX,2000H
  1716.         JMP     @@6
  1717. @@5:    MOV     DH,AL
  1718.         XOR     BH,BH
  1719.         MOV     AH,2
  1720.         INT     10H
  1721.         MOV     CX,CursorLines
  1722.         LES     DI,Self
  1723.         TEST    ES:[DI].TView.State,sfCursorIns
  1724.         JE      @@6
  1725.         MOV     CH,0
  1726.         OR      CL,CL
  1727.         JNE     @@6
  1728.         MOV     CL,7
  1729. @@6:    MOV     AH,1
  1730.         INT     10H
  1731. end;
  1732.  
  1733. procedure TView.Select;
  1734. begin
  1735.   if Options and ofSelectable <> 0 then
  1736.     if Options and ofTopSelect <> 0 then MakeFirst else
  1737.       if Owner <> nil then Owner^.SetCurrent(@Self, NormalSelect);
  1738. end;
  1739.  
  1740. procedure TView.SetBounds(var Bounds: TRect); assembler;
  1741. asm
  1742.         PUSH    DS
  1743.         LES     DI,Self
  1744.         LDS     SI,Bounds
  1745.         MOV     AX,[SI].TRect.A.X
  1746.         MOV     ES:[DI].Origin.X,AX
  1747.         MOV     AX,[SI].TRect.A.Y
  1748.         MOV     ES:[DI].Origin.Y,AX
  1749.         MOV     AX,[SI].TRect.B.X
  1750.         SUB     AX,[SI].TRect.A.X
  1751.         MOV     ES:[DI].Size.X,AX
  1752.         MOV     AX,[SI].TRect.B.Y
  1753.         SUB     AX,[SI].TRect.A.Y
  1754.         MOV     ES:[DI].Size.Y,AX
  1755.         POP     DS
  1756. end;
  1757.  
  1758. procedure TView.SetCmdState(Commands: TCommandSet; Enable: Boolean);
  1759. begin
  1760.   if Enable then EnableCommands(Commands)
  1761.   else DisableCommands(Commands);
  1762. end;
  1763.  
  1764. procedure TView.SetCommands(Commands: TCommandSet);
  1765. begin
  1766.   CommandSetChanged := CommandSetChanged or (CurCommandSet <> Commands);
  1767.   CurCommandSet := Commands;
  1768. end;
  1769.  
  1770. procedure TView.SetCursor(X, Y: Integer);
  1771. begin
  1772.   Cursor.X := X;
  1773.   Cursor.Y := Y;
  1774.   DrawCursor;
  1775. end;
  1776.  
  1777. procedure TView.SetData(var Rec);
  1778. begin
  1779. end;
  1780.  
  1781. procedure TView.SetState(AState: Word; Enable: Boolean);
  1782. var
  1783.   Command: Word;
  1784. begin
  1785.   if Enable then
  1786.     State := State or AState else
  1787.     State := State and not AState;
  1788.   if Owner <> nil then
  1789.     case AState of
  1790.       sfVisible:
  1791.         begin
  1792.           if Owner^.State and sfExposed <> 0 then
  1793.             SetState(sfExposed, Enable);
  1794.           if Enable then DrawShow(nil) else DrawHide(nil);
  1795.           if Options and ofSelectable <> 0 then Owner^.ResetCurrent;
  1796.         end;
  1797.       sfCursorVis, sfCursorIns:
  1798.         DrawCursor;
  1799.       sfShadow:
  1800.         DrawUnderView(True, nil);
  1801.       sfFocused:
  1802.         begin
  1803.           ResetCursor;
  1804.           if Enable then
  1805.             Command := cmReceivedFocus else
  1806.             Command := cmReleasedFocus;
  1807.           Message(Owner, evBroadcast, Command, @Self);
  1808.         end;
  1809.     end;
  1810. end;
  1811.  
  1812. procedure TView.Show;
  1813. begin
  1814.   if State and sfVisible = 0 then SetState(sfVisible, True);
  1815. end;
  1816.  
  1817. procedure TView.ShowCursor;
  1818. begin
  1819.   SetState(sfCursorVis, True);
  1820. end;
  1821.  
  1822. procedure TView.SizeLimits(var Min, Max: TPoint);
  1823. begin
  1824.   Longint(Min) := 0;
  1825.   if Owner <> nil then
  1826.     Max := Owner^.Size else
  1827.     Longint(Max) := $7FFF7FFF;
  1828. end;
  1829.  
  1830. procedure TView.Store(var S: TStream);
  1831. var
  1832.   SaveState: Word;
  1833. begin
  1834.   SaveState := State;
  1835.   State := State and not (sfActive + sfSelected + sfFocused + sfExposed);
  1836.   S.Write(Origin,
  1837.     SizeOf(TPoint) * 3 +
  1838.     SizeOf(Byte) * 2 +
  1839.     SizeOf(Word) * 4);
  1840.   State := SaveState;
  1841. end;
  1842.  
  1843. function TView.TopView: PView;
  1844. var
  1845.   P: PView;
  1846. begin
  1847.   if TheTopView = nil then
  1848.   begin
  1849.     P := @Self;
  1850.     while (P <> nil) and (P^.State and sfModal = 0) do P := P^.Owner;
  1851.     TopView := P;
  1852.   end
  1853.   else TopView := TheTopView;
  1854. end;
  1855.  
  1856. function TView.Valid(Command: Word): Boolean;
  1857. begin
  1858.   Valid := True;
  1859. end;
  1860.  
  1861. procedure TView.WriteBuf(X, Y, W, H: Integer; var Buf); assembler;
  1862. var
  1863.   Target: Pointer; {Variables used by WriteView}
  1864.   Buffer: Pointer;
  1865.   Offset: Word;
  1866. asm
  1867.         CMP     H,0
  1868.         JLE     @@2
  1869. @@1:    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.