home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp11demo.zip / rtlsrc.rar / tv / VIEWS.PAS < prev   
Pascal/Delphi Source File  |  1996-10-08  |  17KB  |  629 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10. {$PureInt+}
  11. unit Views;
  12.  
  13. {$X+,I-,S-,Cdecl-}
  14.  
  15. interface
  16.  
  17. uses Objects, Drivers, Memory, Use32;
  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 = 255;
  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 SmallWord;
  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 SmallWord;
  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. { True if the cursor is currently hidden }
  621.  
  622.   CursorHidden: Boolean = True;
  623.  
  624. implementation
  625.  
  626. uses Os2Def, Os2Base;
  627.  
  628. end.
  629.