home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TVTOOL.ZIP / TVSCROLL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-08  |  6.6 KB  |  71 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 TvScroll;INTERFACE {$I TVDEFS.INC}USES {$IFDEF TVSCROLL}TvConst,{$ENDIF}Objects,Dialogs,Drivers,Views;{$IFNDEF TVSCROLL}
  10. CONST gfGrowXYRel=$80;cmDragView=3000;{$ENDIF}TYPE PScrollView=^TScrollView;TScrollView=Object(TView)
  11. Constructor Init(var Bounds:TRect);Procedure HandleEvent(var Event:TEvent);Virtual;
  12. Procedure SetState(AState:Word;Enable:Boolean);Virtual;end;PScrollInputLine=^TScrollInputLine;
  13. TScrollInputLine=Object(TInputLine)Constructor Init(var Bounds:TRect;AMaxLen:Integer);Function GetPalette:PPalette;Virtual;
  14. end;PScrollGroup=^TScrollGroup;TScrollGroup=Object(TGroup)VScrollBar:PScrollBar;HScrollBar:PScrollBar;OldPos:TPoint;
  15. Constructor Init(var Bounds:TRect;AHScrollBar:PScrollBar;AVScrollBar:PScrollBar);
  16. Procedure HandleEvent(var Event:TEvent);Virtual;end;PScrollWindow=^TScrollWindow;TScrollWindow=Object(TWindow)Limit:TPoint;
  17. VScrollBar:PScrollBar;HScrollBar:PScrollBar;Interior:PScrollGroup;
  18. Constructor Init(var Bounds:TRect;ATitle:String;ANumber:Word);Procedure SetLimit(X,Y:Integer);
  19. Procedure InsertToScroll(P:PView);Procedure SizeLimits(var Min,Max:TPoint);Virtual;
  20. Procedure ChangeBounds(var Bounds:TRect);Virtual;end;PScrollDialog=^TScrollDialog;TScrollDialog=Object(TDialog)Limit:TPoint;
  21. VScrollBar:PScrollBar;HScrollBar:PScrollBar;Interior:PScrollGroup;Constructor Init(var Bounds:TRect;ATitle:String);
  22. Procedure SetLimit(X,Y:Integer);Procedure InsertToScroll(P:PView);Procedure SizeLimits(var Min,Max:TPoint);Virtual;
  23. Procedure ChangeBounds(var Bounds:TRect);Virtual;end;IMPLEMENTATION Constructor TScrollView.Init(var Bounds:TRect);begin
  24. TView.Init(Bounds);Options:=Options OR ofSelectable;DragMode:=dmDragMove OR dmDragGrow;GrowMode:=GrowMode OR gfGrowXYRel;
  25. EventMask:=EventMask OR evBroadcast;end;Procedure TScrollView.SetState(AState:Word;Enable:Boolean);begin
  26. TView.SetState(AState,Enable);if(AState=sfSelected)then SetState(sfActive,Enable)
  27. else if(AState AND(sfDragging OR sfActive)<>0)then DrawView;end;Procedure TScrollView.HandleEvent(var Event:TEvent);
  28. Procedure Drag(Mode:Byte);var Limits:TRect;Min,Max:TPoint;begin if(DragMode and Mode<>0)then begin Owner^.GetExtent(Limits);
  29. SizeLimits(Min,Max);Mode:=Mode OR DragMode AND not dmDragMove AND not dmDragGrow;DragView(Event,Mode,Limits,Min,Max);
  30. ClearEvent(Event);end;end;var Mouse:TPoint;begin TView.HandleEvent(Event);if(Event.What=evCommand)then begin
  31. Case Event.Command of cmDragView:Drag(dmDragMove OR dmDragGrow);end;end else if(Event.What=evBroadcast)then begin
  32. Case Event.Command of cmReceivedFocus,cmReleasedFocus:DrawView;end;end else if(Event.What=evMouseDown)then begin
  33. MakeLocal(Event.Where,Mouse);if(Mouse.Y=0)and(Mouse.X<Size.X-1)then Drag(dmDragMove)
  34. else if(Mouse.X>=Size.X-1)and(Mouse.Y>=Size.Y-1)then Drag(dmDragGrow);end;end;
  35. Constructor TScrollInputLine.Init(var Bounds:TRect;AMaxLen:Integer);begin TInputLine.Init(Bounds,AMaxLen);
  36. GrowMode:=GrowMode OR gfGrowXYRel;end;Function TScrollInputLine.GetPalette:PPalette;const CScrollInputLine=#1#6#7#1;
  37. PScrollInputLine:String[Length(CScrollInputLine)]=CScrollInputLine;begin GetPalette:=@PScrollInputLine;end;
  38. Constructor TScrollGroup.Init(var Bounds:TRect;AHScrollBar:PScrollBar;AVScrollBar:PScrollBar);begin TGroup.Init(Bounds);
  39. HScrollBar:=AHScrollBar;VScrollBar:=AVScrollBar;GrowMode:=GrowMode OR gfGrowHiX OR gfGrowHiY;end;
  40. Procedure TScrollGroup.HandleEvent(var Event:TEvent);var X:Integer;Y:Integer;Procedure Adjust(P:PScrollView);FAR;begin 
  41. if(P^.GrowMode AND gfGrowXYRel<>0)then begin P^.Origin.X:=P^.Origin.X+X;P^.Origin.Y:=P^.Origin.Y+Y;end;end;begin
  42. TGroup.HandleEvent(Event);if(Event.What=evBroadcast)then Case Event.Command of cmScrollBarChanged:begin
  43. if(HScrollBar<>nil)then begin X:=OldPos.X-HScrollBar^.Value;OldPos.X:=HScrollBar^.Value;end else begin X:=0;end;
  44. if(VScrollBar<>nil)then begin Y:=OldPos.Y-VScrollBar^.Value;OldPos.Y:=VScrollBar^.Value;end else begin Y:=0;end;
  45. ForEach(@Adjust);Redraw;EXIT;end;end else if(Event.What=evKeyDown)then Case Event.KeyCode of kbTab:begin SelectNext(False);
  46. ClearEvent(Event);end;kbShiftTab:begin SelectNext(True);ClearEvent(Event);end;end;end;
  47. Constructor TScrollWindow.Init(var Bounds:TRect;ATitle:String;ANumber:Word);var R:TRect;begin
  48. TWindow.Init(Bounds,ATitle,ANumber);HScrollBar:=StandardScrollBar(sbHorizontal OR sbHandleKeyboard);Insert(HScrollBar);
  49. VScrollBar:=StandardScrollBar(sbVertical OR sbHandleKeyboard);Insert(VScrollBar);GetExtent(R);R.Grow(-1,-1);
  50. Interior:=New(PScrollGroup,Init(R,HScrollBar,VScrollBar));Insert(Interior);end;Procedure TScrollWindow.SetLimit(X,Y:Integer);
  51. begin Limit.X:=X;Limit.Y:=Y;if HScrollBar<>nil then HScrollBar^.SetParams(HScrollBar^.Value,0,X-Size.X,Size.X-1,1);
  52. if VScrollBar<>nil then VScrollBar^.SetParams(VScrollBar^.Value,0,Y-Size.Y,Size.Y-1,1);end;
  53. Procedure TScrollWindow.InsertToScroll(P:PView);begin Interior^.Insert(P);end;
  54. Procedure TScrollWindow.SizeLimits(var Min,Max:TPoint);begin TWindow.SizeLimits(Min,Max);Max.X:=Limit.X;Max.Y:=Limit.Y;
  55. if HScrollBar<>nil then Max.X:=Max.X-HScrollBar^.Value;if VScrollBar<>nil then Max.Y:=Max.Y-VScrollBar^.Value;end;
  56. Procedure TScrollWindow.ChangeBounds(var Bounds:TRect);begin TWindow.ChangeBounds(Bounds);if HScrollBar<>nil then
  57. HScrollBar^.SetParams(HScrollBar^.Value,0,Limit.X-Size.X+2,Size.X-1,1);if VScrollBar<>nil then
  58. VScrollBar^.SetParams(VScrollBar^.Value,0,Limit.Y-Size.Y+2,Size.Y-1,1);end;
  59. Constructor TScrollDialog.Init(var Bounds:TRect;ATitle:String);var R:TRect;begin TDialog.Init(Bounds,ATitle);
  60. HScrollBar:=StandardScrollBar(sbHorizontal OR sbHandleKeyboard);Insert(HScrollBar);
  61. VScrollBar:=StandardScrollBar(sbVertical OR sbHandleKeyboard);Insert(VScrollBar);GetExtent(R);R.Grow(-1,-1);
  62. Interior:=New(PScrollGroup,Init(R,HScrollBar,VScrollBar));Insert(Interior);end;Procedure TScrollDialog.SetLimit(X,Y:Integer);
  63. begin Limit.X:=X;Limit.Y:=Y;if HScrollBar<>nil then HScrollBar^.SetParams(HScrollBar^.Value,0,X-Size.X,Size.X-1,1);
  64. if VScrollBar<>nil then VScrollBar^.SetParams(VScrollBar^.Value,0,Y-Size.Y,Size.Y-1,1);end;
  65. Procedure TScrollDialog.InsertToScroll(P:PView);begin Interior^.Insert(P);end;
  66. Procedure TScrollDialog.SizeLimits(var Min,Max:TPoint);begin TDialog.SizeLimits(Min,Max);Max.X:=Limit.X;Max.Y:=Limit.Y;
  67. if HScrollBar<>nil then Max.X:=Max.X-HScrollBar^.Value;if VScrollBar<>nil then Max.Y:=Max.Y-VScrollBar^.Value;end;
  68. Procedure TScrollDialog.ChangeBounds(var Bounds:TRect);begin TDialog.ChangeBounds(Bounds);if HScrollBar<>nil then
  69. HScrollBar^.SetParams(HScrollBar^.Value,0,Limit.X-Size.X+2,Size.X-1,1);if VScrollBar<>nil then
  70. VScrollBar^.SetParams(VScrollBar^.Value,0,Limit.Y-Size.Y+2,Size.Y-1,1);end;END.
  71.