home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TVTOOL.ZIP / TVVIEWS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-10-08  |  25.0 KB  |  232 lines
  1. {*
  2. *
  3. *   Copyright (c) 1992 by Richard W. Hansen
  4. *
  5. *   This source code will compile.
  6. *   Unpacked source is available to registered users.
  7. *
  8. *}
  9. UNIT TvViews;{$X+}{$V-}{$I TVDEFS.INC}INTERFACE USES TvKeys,TvType,TvConst,TvMenus,
  10. App,Drivers,Menus,Objects,Views,TextView,Dos;CONST ActiveFrame1:FrameArray='┌╖╘╝│║─═';ActiveFrame2:FrameArray='╔╗╚╝║║══';
  11. PassiveFrame:FrameArray='┌┐└┘││──';ofPosIndicator=$1000;ofVScrollBar=$2000;ofHScrollBar=$4000;CONST CPosIndicator=#2#1#3;
  12. CMinMax=#3#2#3;C3DFrame=#35#35#33#33#34#36;TYPE PEditView=^TEditView;TEditView=Object(TView)ID:Word;LLabel:PView;
  13. PostEdit:Pointer;EditFlags:Word;Constructor Init(var Bounds:TRect);Procedure HandleEvent(var Event:TEvent);Virtual;
  14. Function Valid(Command:Word):Boolean;Virtual;Procedure SetPostEdit(P:Pointer);Function Empty:Boolean;Virtual;
  15. Procedure SetEditFlag(AFlag:Word;Enable:Boolean);Procedure SetState(AState:Word;Enable:Boolean);Virtual;
  16. Procedure Select;Virtual;Procedure AddLabel(ALabel:PView);Procedure Lock;Procedure UnLock;Procedure SetID(AFieldID:Word);
  17. Function GetID:Word;end;PPosIndicator=^TPosIndicator;TPosIndicator=Object(TView)Pos:Word;Constructor Init(var Bounds:TRect);
  18. Procedure Draw;Virtual;Function GetPalette:PPalette;Virtual;Procedure SetState(AState:Word;Enable:Boolean);Virtual;
  19. Function DataSize:Word;Virtual;Procedure SetData(var Rec);Virtual;Procedure GetData(var Rec);Virtual;end;
  20. PMinMaxButton=^TMinMaxButton;TMinMaxButton=Object(TView)Constructor Init(var Bounds:TRect);Procedure Draw;Virtual;
  21. Function GetPalette:PPalette;Virtual;Procedure HandleEvent(var Event:TEvent);Virtual;Procedure SetState(AState:Word;
  22. Enable:Boolean);Virtual;end;PNewFrame=^TNewFrame;TNewFrame=Object(TFrame)Procedure HandleEvent(var Event:TEvent);Virtual;end;
  23. PNewWindow=^TNewWindow;TNewWindow=Object(TWindow)PMinMax:PMinMaxButton;MinSize:TPoint;MaxRect:TRect;wfSave:Word;
  24. Minimized:Boolean;Constructor Init(var Bounds:TRect;ATitle:TTitleStr;ANumber:Integer);
  25. Procedure HandleEvent(var Event:TEvent);Virtual;Procedure SizeLimits(var Min,Max:TPoint);Virtual;
  26. Procedure SetState(AState:Word;Enable:Boolean);Virtual;Procedure InitFrame;Virtual;Procedure ControlMenu(Mouse:Boolean);end;
  27. PMultiBuffScrollBar=^TMultiBuffScrollBar;TMultiBuffScrollBar=Object(TScrollBar)
  28. Procedure SetState(AState:Word;Enable:Boolean);Virtual;Destructor Done;Virtual;end;PEditBuff=^TEditBuff;
  29. TEditBuff=Object(TScroller)Buf:PByteBuf;BufSize:Word;ItemSize:Byte;Constructor Init(Bounds:TRect;Buff:Pointer;BuffSize:Word;
  30. ItemWidth:Byte;AVScrollBar:PScrollBar);Procedure HandleEvent(var Event:TEvent);Virtual;Procedure SetXY(Pos:TPoint);
  31. Procedure GetXY(var Pos:TPoint);Function GetOffset:Word;end;PAsciiBuff=^TAsciiBuff;TAsciiBuff=Object(TEditBuff)
  32. Constructor Init(Bounds:TRect;Buff:Pointer;BuffSize:Word;AVScrollBar:PScrollBar);
  33. Procedure HandleEvent(var Event:TEvent);Virtual;Procedure Draw;Virtual;end;PHexBuff=^THexBuff;THexBuff=Object(TEditBuff)
  34. Constructor Init(Bounds:TRect;Buff:Pointer;BuffSize:Word;AVScrollBar:PScrollBar);
  35. Procedure HandleEvent(var Event:TEvent);Virtual;Procedure Draw;Virtual;end;PEditBuffWindow=^TEditBuffWindow;
  36. TEditBuffWindow=Object(TWindow)MaxWidth:Word;MaxPos:Word;LView:PEditBuff;RView:PEditBuff;VScrollBar:PMultiBuffScrollBar;
  37. Indicator:PPosIndicator;Constructor Init(Bounds:TRect;ATitle:TTitleStr;ANumber:Integer;AOptions:Word;Buff:Pointer;
  38. BuffSize:Word);Procedure HandleEvent(var Event:TEvent);Virtual;Procedure SizeLimits(var Min,Max:TPoint);Virtual;
  39. Procedure SetState(AState:Word;Enable:Boolean);Virtual;end;PFormattedTextScroller=^TFormattedTextScroller;
  40. TFormattedTextScroller=Object(TScroller)Buffer:PCharBuf;BufSize:Word;Constructor Init(var Bounds:TRect;
  41. AVScrollBar:PScrollBar;Buff:PCharBuf;BuffSize:Word );Procedure Draw;Virtual;Procedure ChangeBounds(var Bounds:TRect);Virtual;
  42. Procedure GetNextLine(First:Word;var Count:Word;var NextCh:Word);Procedure CountLines;end;PTextWindow=^TTextWindow;
  43. TTextWindow=Object(TNewWindow)Interior:PTerminal;HScrollBar:PScrollBar;VScrollBar:PScrollBar;Width:Byte;Height:Byte;
  44. Constructor Init(Bounds:TRect;WinTitle:String;WinNumber:Word;AOptions:Word;AMaxLines:Word );Procedure Clear;
  45. Procedure HandleEvent(var Event:TEvent);Virtual;Procedure Write(St:String);end;P3DFrame=^T3DFrame;T3DFrame=object(TFrame)
  46. Procedure Draw;Virtual;Function GetPalette:PPalette;Virtual;Procedure GetFrame(var F:FrameArray);Virtual;end;
  47. Procedure AssignOutput(var F:Text;AWindow:PTextWindow);IMPLEMENTATION Procedure T3DFrame.Draw;var CFrame:Word;CTitle:Word;
  48. CIcon:Word;X:Word;Y:Word;I:Word;L:Integer;Chars:FrameArray;B:TDrawBuffer;Title:TTitleStr;begin if(State and sfActive=0)then
  49. begin CFrame:=GetColor($0101);CTitle:=GetColor($0002);end else if(State and sfDragging<>0)then begin CIcon:=GetColor($0606);
  50. CFrame:=GetColor($0606);CTitle:=GetColor($0006);end else begin CIcon:=GetColor($0603);CFrame:=GetColor($0305);
  51. CTitle:=GetColor($0004);end;GetFrame(Chars);X:=Size.X-1;L:=Size.X-10;MoveChar(B,Chars[7],WordRec(CFrame).Hi,Size.X);
  52. WordRec(B[X]).Hi:=WordRec(CFrame).Lo;WordRec(B[0]).Lo:=Byte(Chars[1]);WordRec(B[X]).Lo:=Byte(Chars[2]);if(Owner<>nil)then
  53. begin if(State and sfActive<>0)then if(PWindow(Owner)^.Flags and wfClose<>0)then begin MoveCStr(B[2],'[~■~]',CIcon);L:=L-6;
  54. end;Title:=PWindow(Owner)^.GetTitle(L);if(Title<>'')then begin L:=Length(Title);I:=(Size.X-L)shr 1;
  55. MoveChar(B[I-1],' ',CTitle,1);MoveBuf(B[I],Title[1],CTitle,L);MoveChar(B[I+L],' ',CTitle,1);end;end;
  56. WriteLine(0,0,Size.X,1,B);MoveChar(B,Chars[8],WordRec(CFrame).Lo,Size.X);WordRec(B[0]).Hi:=WordRec(CFrame).Hi;
  57. WordRec(B[0]).Lo:=Byte(Chars[3]);WordRec(B[X]).Lo:=Byte(Chars[4]);WriteLine(0,Size.Y-1,Size.X,1,B);
  58. MoveChar(B,' ',WordRec(CFrame).Hi,Size.X);WordRec(B[0]).Lo:=Byte(Chars[5]);WordRec(B[X]).Lo:=Byte(Chars[6]);
  59. WordRec(B[X]).Hi:=WordRec(CFrame).Lo;for Y:=1 to Size.Y-2 do WriteLine(0,Y,Size.X,1,B);end;
  60. Function T3DFrame.GetPalette:PPalette;Const P:String[Length(C3DFrame)]=C3DFrame;begin GetPalette:=@P;end;
  61. Procedure T3DFrame.GetFrame(var F:FrameArray);begin if(State and sfActive=0)or(State and sfDragging<>0)then F:=PassiveFrame
  62. else F:=ActiveFrame2;end;Constructor TEditView.Init(var Bounds:TRect);begin TView.Init(Bounds);PostEdit:=nil;LLabel:=nil;
  63. ID:=0;EditFlags:=0;EventMask:=EventMask or evBroadcast;end;Procedure TEditView.SetEditFlag(AFlag:Word;Enable:Boolean);begin
  64. if Enable then EditFlags:=EditFlags or AFlag else EditFlags:=EditFlags and not AFlag;end;
  65. Procedure TEditView.SetState(AState:Word;Enable:Boolean);begin TView.SetState(AState,Enable);if(AState=sfDisabled)then
  66. if(LLabel<>nil)then LLabel^.SetState(sfDisabled,Enable);end;Procedure TEditView.Select;begin if(Owner^.Current<>@Self)then
  67. begin if(Message(Owner^.Current,evBroadcast,cmLoseFocus,nil)=nil)then TView.Select;end else TView.Select;end;
  68. Procedure TEditView.AddLabel(ALabel:PView);begin LLabel:=ALabel;end;Procedure TEditView.Lock;begin SetState(sfDisabled,True);
  69. end;Procedure TEditView.UnLock;begin SetState(sfDisabled,False);end;Procedure TEditView.SetID(AFieldID:Word);begin
  70. ID:=AFieldID;end;Function TEditView.GetID:Word;begin GetID:=ID;end;Function TEditView.Empty:Boolean;begin Empty:=False;end;
  71. Procedure TEditView.SetPostEdit(P:Pointer);begin PostEdit:=P;end;Function TEditView.Valid(Command:Word):Boolean;begin
  72. Valid:=True;if(Command<>cmCancel)and(Command<>cmValid)then begin if((EditFlags AND efRequired)<>0)and Empty then begin
  73. ErrorMsg:=^M'Field is required.';Message(Owner,evBroadcast,cmFieldError,@ErrorMsg);Valid:=False;Select;end;end else begin
  74. Valid:=TView.Valid(Command);end;end;Procedure TEditView.HandleEvent(var Event:TEvent);begin TView.HandleEvent(Event);
  75. Case Event.What of evMouseDown:begin if(State and sfSelected=0)then ClearEvent(Event);end;evBroadcast:begin
  76. Case Event.Command of cmLoseFocus:begin if(PostEdit<>nil)then begin if PostEditFunc(PostEdit)(@Self,ID)then begin
  77. ClearEvent(Event);Event.InfoPtr:=@Self;end;end else if not Valid(cmOK)then begin ClearEvent(Event);Event.InfoPtr:=@Self;end;
  78. end;cmIdentify:if(Event.InfoWord=ID)then begin ClearEvent(Event);Event.InfoPtr:=@Self;end;end;end;end;end;
  79. Constructor TPosIndicator.Init(var Bounds:TRect);begin TView.Init(Bounds);GrowMode:=gfGrowLoY+gfGrowHiY;Pos:=1;end;
  80. Procedure TPosIndicator.Draw;var Color:Byte;Frame:Char;Tmp:String[5];B:TDrawBuffer;begin if(State AND sfDragging=0)then begin
  81. Color:=GetColor(1);Frame:=#205;end else begin if(State and sfDragging=1)then Color:=GetColor(3)else Color:=GetColor(2);
  82. Frame:=#196;end;Str(Pos,Tmp);MoveChar(B,Frame,Color,Size.X);MoveStr(B,' Pos : '+Tmp+' ',Color);WriteBuf(0,0,Size.X,1,B);end;
  83. Function TPosIndicator.GetPalette:PPalette;const P:String[Length(CPosIndicator)]=CPosIndicator;begin GetPalette:=@P;end;
  84. Procedure TPosIndicator.SetState(AState:Word;Enable:Boolean);begin TView.SetState(AState,Enable);if(AState=sfDragging)then
  85. DrawView;end;Procedure TPosIndicator.SetData(var Rec);begin if(Pos<>Word(Rec))then begin Pos:=Word(Rec);DrawView;end;end;
  86. Procedure TPosIndicator.GetData(var Rec);begin Word(Rec):=Pos;end;Function TPosIndicator.DataSize:Word;begin
  87. DataSize:=SizeOf(Pos);end;Constructor TMinMaxButton.Init(var Bounds:TRect);begin TView.Init(Bounds);
  88. GrowMode:=GrowMode or gfGrowLoX or gfGrowHiX;end;Procedure TMinMaxButton.Draw;var Arrow:Char;R:TRect;begin
  89. if LongInt(PNewWindow(Owner)^.MinSize)=LongInt(Owner^.Size)then Arrow:=''else Arrow:='';Owner^.GetExtent(R);
  90. if(PNewWindow(Owner)^.Flags and wfZoom<>0)then begin R.B.Y:=R.A.Y+1;R.A.X:=R.B.X-8;R.B.X:=R.A.X+3;end else begin
  91. R.B.Y:=R.A.Y+1;R.A.X:=R.B.X-5;R.B.X:=R.A.X+3;end;SetBounds(R);if(State and sfDragging<>0)then WriteStr(0,0,'['+Arrow+']',3)
  92. else begin WriteChar(0,0,'[',2,1);WriteChar(1,0,Arrow,3,1);WriteChar(2,0,']',2,1);end;end;
  93. Function TMinMaxButton.GetPalette:PPalette;const P:String[Length(CMinMax)]=CMinMax;begin GetPalette:=@P;end;
  94. Procedure TMinMaxButton.HandleEvent(var Event:TEvent);begin TView.HandleEvent(Event);
  95. if(Event.What=evMouseDown)and(State and sfActive<>0)then begin Event.What:=evCommand;
  96. if LongInt(PNewWindow(Owner)^.MinSize)=LongInt(Owner^.Size)then Event.Command:=cmMaximize else Event.Command:=cmMinimize;
  97. Event.InfoPtr:=Owner;PutEvent(Event);ClearEvent(Event);end;end;Procedure TMinMaxButton.SetState(AState:Word;Enable:Boolean);
  98. begin TView.SetState(AState,Enable);if(AState and(sfActive+sfDragging)<>0)then DrawView;end;
  99. Procedure TNewFrame.HandleEvent(var Event:TEvent);var Mouse:TPoint;begin
  100. if(Event.What=evMouseDown)and(State and sfActive<>0)then begin MakeLocal(Event.Where,Mouse);if(Mouse.Y=0)then begin
  101. if(PWindow(Owner)^.Flags and wfClose<>0)and (Mouse.X>=2)and(Mouse.X<=4)then begin if(Event.Buttons=mbLeftButton)then begin
  102. Event.What:=evCommand;Event.Command:=cmClose;Event.InfoPtr:=Owner;PutEvent(Event);ClearEvent(Event);end else begin
  103. Event.What:=evCommand;Event.Command:=cmPopMenu;Event.InfoPtr:=Owner;PutEvent(Event);ClearEvent(Event);end;end;end;end;
  104. TFrame.HandleEvent(Event);end;Constructor TNewWindow.Init(var Bounds:TRect;ATitle:TTitleStr;ANumber:Integer);var R:TRect;
  105. begin TWindow.Init(Bounds,ATitle,ANumber);GetExtent(R);R.B.Y:=R.A.Y+1;R.A.X:=R.B.X-8;R.B.X:=R.A.X+3;
  106. PMinMax:=New(PMinMaxButton,Init(R));Insert(PMinMax);MinSize:=MinWinSize;if(Title^<>'')then begin MinSize.X:=Length(Title^)+10;
  107. if(MinSize.X>Owner^.Size.X)then MinSize.X:=Owner^.Size.X;if(MinSize.X>Size.X)then MinSize.X:=Size.X;end;if(MinSize.Y>2)then
  108. MinSize.Y:=2;GetBounds(MaxRect);Minimized:=(LongInt(MinSize)=LongInt(Size));end;
  109. Procedure TNewWindow.ControlMenu(Mouse:Boolean);var R:TRect;P:PMenuBox;E:TEvent;begin if Mouse then R.Assign(0,0,14,12)else
  110. R.Assign(Origin.X,Origin.Y,Origin.X+14,Origin.Y+12);P:=New(PMenuBox,Init(R,NewMenu(
  111. NewItem('~C~lose','',kbNoKey,cmClose,hcNoContext,NewItem('~Z~oom','',kbNoKey,cmZoom,hcNoContext,
  112. NewItem('~M~inimize','',kbNoKey,cmMinimize,hcNoContext,NewItem('Ma~x~imize','',kbNoKey,cmMaximize,hcNoContext,
  113. NewItem('~P~revious','',kbNoKey,cmPrev,hcNoContext,NewItem('~N~ext','',kbNoKey,cmNext,hcNoContext,
  114. NewItem('~R~esize/move','',kbNoKey,cmResize,hcNoContext,NewItem('~T~ile','',kbNoKey,cmTile,hcNoContext,
  115. NewItem('C~a~scade','',kbNoKey,cmCascade,hcNoContext,nil)))))))))),nil));if Mouse then E.Command:=MousePopupMenu(P)else
  116. E.Command:=PopupMenu(P);if(E.Command<>0)then begin E.What:=evCommand;E.InfoPtr:=@Self;PutEvent(E);end;end;
  117. Procedure TNewWindow.HandleEvent(var Event:TEvent);var R:TRect;C:TCommandSet;begin Case Event.What of evKeyDown:
  118. Case Event.KeyCode of kbAltMinus:begin ControlMenu(False);ClearEvent(Event);end;end;evCommand:Case Event.Command of
  119. cmMinimize:begin if not Minimized then begin Minimized:=True;wfSave:=Flags;Flags:=Flags and not(wfZoom or wfGrow);
  120. GetBounds(MaxRect);Owner^.GetExtent(R);R.B.X:=R.A.X+MinSize.X;R.A.Y:=R.B.Y-MinSize.Y;Locate(R);EnableCommands([cmMaximize]);
  121. DisableCommands([cmMinimize,cmResize,cmZoom]);end;ClearEvent(Event);end;cmMaximize:begin if Minimized then begin
  122. Minimized:=False;Flags:=wfSave;Locate(MaxRect);C:=[cmMinimize];if(Flags and wfGrow+wfMove<>0)then C:=C+[cmResize];
  123. if(Flags and wfZoom<>0)then C:=C+[cmZoom];EnableCommands(C);DisableCommands([cmMaximize]);end;ClearEvent(Event);end;cmZoom:
  124. begin if(Flags and wfZoom<>0)then Zoom;ClearEvent(Event);end;cmPopMenu:begin ControlMenu(True);ClearEvent(Event);end;end;end;
  125. TWindow.HandleEvent(Event);if(LongInt(MinSize)<>LongInt(Size))then begin if Minimized then begin Minimized:=False;
  126. Flags:=wfSave;C:=[cmMinimize];if Flags and wfGrow+wfMove<>0 then C:=C+[cmResize];if Flags and wfZoom<>0 then C:=C+[cmZoom];
  127. EnableCommands(C);DisableCommands([cmMaximize]);ReDraw;end;if(LongInt(Size)<>LongInt(Owner^.Size))then GetBounds(MaxRect);
  128. end;end;Procedure TNewWindow.SetState(AState:Word;Enable:Boolean);var C:TCommandSet;begin if(AState=sfActive)then
  129. Case Enable of True:PMinMax^.Show;False:PMinMax^.Hide;end;TWindow.SetState(AState,Enable);if(AState=sfSelected)then begin
  130. if Minimized then C:=[cmMaximize]else C:=[cmMinimize];if Enable then EnableCommands(C)else
  131. DisableCommands([cmMinimize,cmMaximize]);end;end;Procedure TNewWindow.SizeLimits(var Min,Max:TPoint);begin
  132. TWindow.SizeLimits(Min,Max);Min.X:=MinSize.X;Min.Y:=MinSize.Y;end;Procedure TNewWindow.InitFrame;var R:TRect;begin
  133. GetExtent(R);Frame:=New(PNewFrame,Init(R));end;Destructor TMultiBuffScrollBar.Done;begin 
  134. TScrollBar.SetState(sfVisible,False);TScrollBar.Done;end;Procedure TMultiBuffScrollBar.SetState(AState:Word;Enable:Boolean);
  135. begin if(AState=sfVisible)and not Enable then EXIT;TScrollBar.SetState(AState,Enable);end;
  136. Constructor TEditBuff.Init(Bounds:TRect;Buff:Pointer;BuffSize:Word;ItemWidth:Byte;AVScrollBar:PScrollBar);var MaxRow:Word;
  137. begin TScroller.Init(Bounds,nil,AVScrollBar);Options:=Options or ofFramed;Buf:=Buff;BufSize:=BuffSize;ItemSize:=ItemWidth;
  138. ShowCursor;BlockCursor;MaxRow:=(BufSize*ItemSize)DIV Size.X;if((BufSize*ItemSize)MOD Size.X<>0)then Inc(MaxRow);
  139. SetLimit(Size.X,MaxRow);end;Procedure TEditBuff.HandleEvent(var Event:TEvent);var Pos:TPoint;Y:Integer;begin
  140. Case Event.What of evBroadcast:begin Case Event.Command of cmScrollBarChanged:begin if(VScrollBar^.Value<>Delta.Y)then begin
  141. Pos:=Cursor;TScroller.HandleEvent(Event);SetCursor(Pos.X,Pos.Y);Message(Owner,evBroadcast,cmCursorMoved,@Self);end;end;end;
  142. end;evKeyDown:begin Case Event.KeyCode of kbUp:begin Y:=Cursor.Y-1;if(Y<0)then ScrollTo(0,Delta.Y-1)else
  143. SetCursor(Cursor.X,Y);Message(Owner,evBroadcast,cmCursorMoved,@Self);end;kbPgUp:begin if(Delta.Y-Size.Y>=0)then begin
  144. ScrollTo(0,Delta.Y-Size.Y);end else begin ScrollTo(0,0);SetCursor(Cursor.X,0);end;
  145. Message(Owner,evBroadcast,cmCursorMoved,@Self);end;kbLeft:begin if(Cursor.X>0)then begin SetCursor(Cursor.X-1,Cursor.Y);end 
  146. else if(Cursor.Y>0)then begin SetCursor(Size.X-1,Cursor.Y-1);end else if(Delta.Y>0)then begin ScrollTo(0,Delta.Y-1);
  147. SetCursor(Size.X-1,0);end;Message(Owner,evBroadcast,cmCursorMoved,@Self);end;kbRight:begin if(Cursor.X+1<Size.X)then begin
  148. SetCursor(Cursor.X+1,Cursor.Y);end else if(Cursor.Y+1<Size.Y)then begin SetCursor(0,Cursor.Y+1);end 
  149. else if(Delta.Y+Size.Y<Limit.Y)then begin ScrollTo(0,Delta.Y+1);SetCursor(0,Size.Y-1);end;
  150. Message(Owner,evBroadcast,cmCursorMoved,@Self);end;kbDown:begin Y:=Cursor.Y+1;if(Y=Size.Y)then ScrollTo(0,Delta.Y+1)else
  151. SetCursor(Cursor.X,Y);Message(Owner,evBroadcast,cmCursorMoved,@Self);end;kbPgDn:begin if(Delta.Y+Size.Y<Limit.Y)then begin
  152. ScrollTo(0,Delta.Y+Size.Y);end else begin ScrollTo(0,Limit.Y);SetCursor(Cursor.X,Size.Y-1);end;
  153. Message(Owner,evBroadcast,cmCursorMoved,@Self);end;kbCtrlPgDn:begin ScrollTo(0,Limit.Y);SetCursor(Size.X-1,Size.Y-1);
  154. Message(Owner,evBroadcast,cmCursorMoved,@Self);end;kbCtrlPgUp:begin ScrollTo(0,0);SetCursor(0,0);
  155. Message(Owner,evBroadcast,cmCursorMoved,@Self);end;end;end;evMouseDown:begin if MouseInView(Event.Where)then begin
  156. MakeLocal(Event.Where,Pos);SetCursor(Pos.X,Pos.Y);Message(Owner,evBroadcast,cmCursorMoved,@Self);end;end;end;
  157. TScroller.HandleEvent(Event);end;Procedure TEditBuff.SetXY(Pos:TPoint);begin SetCursor(Pos.X*ItemSize,Pos.Y);end;
  158. Procedure TEditBuff.GetXY(var Pos:TPoint);begin Pos.X:=Cursor.X Div ItemSize;Pos.Y:=Cursor.Y;end;
  159. Function TEditBuff.GetOffset:Word;begin GetOffset:=Word((LongInt(Delta.Y*Size.X)+
  160. LongInt(Cursor.Y*Size.X)+Cursor.X)DIV ItemSize );end;Constructor TAsciiBuff.Init(Bounds:TRect;Buff:Pointer;BuffSize:Word;
  161. AVScrollBar:PScrollBar);begin TEditBuff.Init(Bounds,Buff,BuffSize,1,AVScrollBar);end;
  162. Procedure TAsciiBuff.HandleEvent(var Event:TEvent);var X:Word;begin TEditBuff.HandleEvent(Event);if(Event.What=evKeyDown)then
  163. begin Case Event.CharCode of #1..#8,#10..#255:begin X:=GetOffset;if(X<BufSize)then begin Buf^[X]:=Byte(Event.CharCode);
  164. Message(Owner,evBroadcast,cmUpdateView,@Self);Message(Owner,evBroadcast,cmEditView,@Self);
  165. Message(Owner,evKeyDown,kbRight,@Self);ClearEvent(Event);end;end;end;end;end;Procedure TAsciiBuff.Draw;var Color:Byte;i:Word;
  166. j:Word;First:Word;Last:Word;B:Array[1..4096]of Byte;begin Color:=GetColor(1);First:=Delta.Y*Size.X;
  167. Last:=First+(Size.Y*Size.X)-1;if(Last>=BufSize)then Last:=BufSize-1;MoveChar(B,'.',Color,(Size.Y*Size.X));j:=1;
  168. for i:=First to Last do begin B[j]:=Buf^[i];Inc(j);Inc(j);end;WriteBuf(0,0,Size.X,Size.Y,B);end;
  169. Constructor THexBuff.Init(Bounds:TRect;Buff:Pointer;BuffSize:Word;AVScrollBar:PScrollBar);begin
  170. TEditBuff.Init(Bounds,Buff,BuffSize,2,AVScrollBar);end;Procedure THexBuff.HandleEvent(var Event:TEvent);var i:Byte;C:Integer;
  171. X:Word;begin TEditBuff.HandleEvent(Event);if(Event.What=evKeyDown)then begin Case Event.CharCode of '0'..'9','a'..'f',
  172. 'A'..'F':begin X:=GetOffset;if(X<BufSize)then begin Val('$'+Event.CharCode,i,C);if((Cursor.X MOD 2)=0)then
  173. Buf^[X]:=(Buf^[X]AND$0F)OR(i SHL 4)else Buf^[X]:=(Buf^[X]AND$F0)OR i;Message(Owner,evBroadcast,cmUpdateView,@Self);
  174. Message(Owner,evBroadcast,cmEditView,@Self);Message(Owner,evKeyDown,kbRight,@Self);ClearEvent(Event);end;end;end;end;end;
  175. Procedure THexBuff.Draw;const HexDigits:array[0..$F]of Char='0123456789ABCDEF';var Color:Byte;i:Word;j:Word;First:Word;
  176. Last:Word;B:Array[1..4096]of Byte;Width:Word;begin Width:=Size.X Div 2;Color:=GetColor(1);First:=Delta.Y*Width;
  177. Last:=First+(Size.Y*Width)-1;if(Last>=BufSize)then Last:=BufSize-1;MoveChar(B,'.',Color,(Size.Y*Size.X));j:=1;
  178. for i:=First to Last do begin B[j]:=Byte(HexDigits[Buf^[i]SHR 4]);Inc(j);Inc(j);B[j]:=Byte(HexDigits[Buf^[i]AND$F]);Inc(j);
  179. Inc(j);end;WriteBuf(0,0,Size.X,Size.Y,B);end;Constructor TEditBuffWindow.Init(Bounds:TRect;ATitle:TTitleStr;ANumber:Integer;
  180. AOptions:Word;Buff:Pointer;BuffSize:Word);var Width:Word;Base:Word;begin Width:=Bounds.B.X-Bounds.A.X-3;Base:=(Width DIV 3);
  181. Width:=Base*3;Bounds.B.X:=Width+Bounds.A.X+3;TWindow.Init(Bounds,ATitle,ANumber);MaxWidth:=Size.X;GetExtent(Bounds);
  182. Bounds.Assign(Bounds.B.X-1,Bounds.A.Y+1,Bounds.B.X,Bounds.B.Y-1);VScrollBar:=New(PMultiBuffScrollBar,Init(Bounds));
  183. VScrollBar^.GrowMode:=gfGrowHiY;Insert(VScrollBar);GetExtent(Bounds);Bounds.Grow(-1,-1);Bounds.B.X:=Bounds.A.X+(2*Base);
  184. LView:=New(PHexBuff,Init(Bounds,Buff,BuffSize,VScrollBar));LView^.GrowMode:=gfGrowHiY;Insert(LView);GetExtent(Bounds);
  185. Bounds.Grow(-1,-1);Bounds.A.X:=Bounds.B.X-Base;RView:=New(PAsciiBuff,Init(Bounds,Buff,BuffSize,VScrollBar));
  186. RView^.GrowMode:=gfGrowHiY;Insert(RView);if((AOptions and ofPosIndicator)<>0)then begin Bounds.Assign(2,Size.Y-1,15,Size.Y);
  187. Indicator:=New(PPosIndicator,Init(Bounds));Indicator^.Hide;Insert(Indicator);end;end;
  188. Procedure TEditBuffWindow.HandleEvent(var Event:TEvent);var Pos:TPoint;Offset:Word;begin if(Event.What=evBroadcast)then begin
  189. Case Event.Command of cmUpdateView:begin ReDraw;Exit;end;cmEditView:begin if(Event.InfoPtr=LView)then Offset:=LView^.GetOffset
  190. else if(Event.InfoPtr=RView)then Offset:=RView^.GetOffset;Inc(Offset);if(Offset>MaxPos)then MaxPos:=Offset;ClearEvent(Event);
  191. end;cmCursorMoved:begin if(Event.InfoPtr=LView)then begin if(Indicator<>nil)then begin Offset:=LView^.GetOffset;Inc(Offset);
  192. Indicator^.SetData(Offset);Indicator^.DrawView;end;LView^.GetXY(Pos);RView^.SetXY(Pos);ClearEvent(Event);end 
  193. else if(Event.InfoPtr=RView)then begin if(Indicator<>nil)then begin Offset:=RView^.GetOffset;Inc(Offset);
  194. Indicator^.SetData(Offset);Indicator^.DrawView;end;RView^.GetXY(Pos);LView^.SetXY(Pos);ClearEvent(Event);end;end;end;end;
  195. TWindow.HandleEvent(Event);end;Procedure TEditBuffWindow.SizeLimits(var Min,Max:TPoint);begin TWindow.SizeLimits(Min,Max);
  196. Min.X:=MaxWidth;Max.X:=MaxWidth;end;Procedure TEditBuffWindow.SetState(AState:Word;Enable:Boolean);begin
  197. TWindow.SetState(AState,Enable);Case AState of sfActive:begin if(Indicator<>nil)then Indicator^.SetState(sfVisible,Enable);
  198. end;end;end;Constructor TFormattedTextScroller.Init(var Bounds:TRect;AVScrollBar:PScrollBar;Buff:PCharBuf;BuffSize:Word );var
  199. R:TRect;begin TScroller.Init(Bounds,nil,AVScrollBar);Desktop^.GetExtent(R);Buffer:=Buff;BufSize:=BuffSize;
  200. GrowMode:=gfGrowHiX+gfGrowHiY;CountLines;end;Procedure TFormattedTextScroller.CountLines;var First:Word;Count:Word;
  201. NextCh:Word;Y:Word;begin Y:=1;First:=0;While(First<BufSize)do begin GetNextLine(First,Count,NextCh);First:=NextCh;Inc(Y);end;
  202. if Y<>Limit.Y then SetLimit(Size.X,Y);end;Procedure TFormattedTextScroller.GetNextLine(First:Word;var Count:Word;
  203. var NextCh:Word);var i:Word;Begin Count:=0;if(First>=BufSize)then EXIT;i:=First;if(First+Size.X>BufSize)then NextCh:=BufSize
  204. else NextCh:=First+Size.X;While(i<NextCh)and(Buffer^[i]<>#13)Do Inc(i);If(Buffer^[i]=#13)Then Begin NextCh:=i;
  205. if(NextCh<BufSize)and(Buffer^[NextCh+1]=#10)then Inc(NextCh);End Else Begin While(i>First)and(Buffer^[i]<>' ')Do Dec(i);
  206. if(i=First)then i:=NextCh else NextCh:=i;End;if(NextCh<BufSize)then Inc(NextCh);Count:=i-First;End;
  207. Procedure TFormattedTextScroller.Draw;var First:Word;Count:Word;NextCh:Word;Y:Word;B:TDrawBuffer;Color:Byte;begin
  208. Color:=GetColor(1);First:=0;Y:=0;While(Y<Delta.Y-1)do begin GetNextLine(First,Count,NextCh);First:=NextCh;Inc(Y);end;Y:=0;
  209. While(Y<Size.Y)Do Begin MoveChar(B,' ',Color,Size.X);GetNextLine(First,Count,NextCh);MoveBuf(B,Buffer^[First],Color,Count);
  210. WriteLine(0,Y,Size.X,1,B);First:=NextCh;Inc(Y);End;end;Procedure TFormattedTextScroller.ChangeBounds(var Bounds:TRect);begin
  211. TScroller.ChangeBounds(Bounds);CountLines;end;Constructor TTextWindow.Init(Bounds:TRect;WinTitle:String;WinNumber:Word;
  212. AOptions:Word;AMaxLines:Word );var R:TRect;begin TNewWindow.Init(Bounds,WinTitle,WinNumber);HScrollBar:=nil;VScrollBar:=nil;
  213. Desktop^.GetExtent(R);Width:=R.B.X;Height:=AMaxLines;if(Height=0)then Height:=R.B.Y;if((AOptions and ofHScrollBar)<>0)then
  214. begin HScrollBar:=StandardScrollBar(sbHorizontal+sbHandleKeyboard);Insert(HScrollBar);end;
  215. if((AOptions and ofVScrollBar)<>0)then begin VScrollBar:=StandardScrollBar(sbVertical+sbHandleKeyboard);Insert(VScrollBar);
  216. end;GetExtent(Bounds);Bounds.Grow(-1,-1);Interior:=New(PTerminal,Init(Bounds,HScrollBar,VScrollBar,Width*Height));
  217. Insert(Interior);end;Procedure TTextWindow.HandleEvent(var Event:TEvent);begin if(Event.What=evBroadcast)then
  218. Case Event.Command of cmDisplayStr:Write(PString(Event.InfoPtr)^);cmDisplayClr:Clear;end else if(Event.What=evCommand)then
  219. Case Event.Command of cmMinimize:begin if(HScrollBar<>nil)then HScrollBar^.Hide;if(VScrollBar<>nil)then VScrollBar^.Hide;end;
  220. cmMaximize:begin if(HScrollBar<>nil)then HScrollBar^.Show;if(VScrollBar<>nil)then VScrollBar^.Show;end;end;
  221. TNewWindow.HandleEvent(Event);end;Procedure TTextWindow.Write(St:String);var T:TextBuf;Len:Byte Absolute St;x:Byte;i:Byte;
  222. begin i:=0;Repeat x:=0;While(x<SizeOf(TextBuf)-2)and(x<Width)and(i<Len)do begin Inc(i);T[x]:=St[i];Inc(x);end;T[x]:=#13;
  223. Inc(x);T[x]:=#10;Inc(x);Interior^.StrWrite(T,x);Until(i>=Len);end;Procedure TTextWindow.Clear;begin Interior^.QueFront:=0;
  224. Interior^.QueBack:=0;Interior^.SetLimit(0,1);Interior^.SetCursor(0,0);Interior^.ShowCursor;Interior^.DrawView;end;TYPE
  225. WinData=record Device:PTextDevice;Filler:Array[1..12]of Char;end;Function DeviceWrite(var T:TextRec):Integer;FAR;begin
  226. with T do begin WinData(UserData).Device^.StrWrite(BufPtr^,BufPos);BufPos:=0;end;DeviceWrite:=0;end;
  227. Function DoNothing(var T:TextRec):Integer;FAR;begin DoNothing:=0;end;Function DeviceOpen(var T:TextRec):Integer;FAR;begin
  228. with T do begin if(Mode=fmInput)then begin InOutFunc:=@DoNothing;FlushFunc:=@DoNothing;end else begin InOutFunc:=@DeviceWrite;
  229. FlushFunc:=@DeviceWrite;end;CloseFunc:=@DoNothing;DeviceOpen:=0;end;end;Procedure AssignOutput(var F:Text;
  230. AWindow:PTextWindow);begin with TextRec(F)do begin Handle:=$FFFF;Mode:=fmClosed;BufSize:=SizeOf(Buffer);BufPtr:=@Buffer;
  231. OpenFunc:=@DeviceOpen;WinData(UserData).Device:=AWindow^.Interior;end;end;END.
  232.