home *** CD-ROM | disk | FTP | other *** search
/ Best of German Only 1 / romside_best_of_german_only_1.iso / wissen / dos / wgraph / entpack.exe / WGBSP!.EXE / BSP13.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-05  |  3KB  |  136 lines
  1. program Beispiel13;
  2.  
  3. uses GDecl,
  4.      GApp,
  5.      GEvent,
  6.      GViews,
  7.      GDrivers,
  8.      GDlg,
  9.      graph;
  10.  
  11.  
  12. const cmList = 101;
  13.  
  14. type TApplication=object(TApp)
  15.        procedure InitMenuBar; virtual;
  16.        procedure HandleEvent; virtual;
  17.        procedure NewWindow;
  18.      end;
  19.  
  20.      PNewScroller=^TNewScroller;
  21.  
  22.      PScrollWindow=^TScrollWindow;
  23.      TScrollWindow=object(TWindow)
  24.        Scroller:PNewScroller;
  25.        procedure InitWindowScroller; virtual;
  26.        destructor Done; virtual;
  27.      end;
  28.  
  29.      TNewScroller=object(TScroller)
  30.        procedure CreateData;
  31.        procedure ScrollDraw; virtual;
  32.      end;
  33.  
  34.  
  35. var MyApp:TApplication;
  36.  
  37. procedure TApplication.InitMenuBar;
  38. var R:TRect;
  39. begin
  40.   MainMenu('~F~enster',0);
  41.    SubMenu('~Q~elltext-Lister',cmList,0,0,false,false);
  42.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  43. end;
  44.  
  45. procedure TApplication.HandleEvent;
  46. begin
  47.   Heap^.ShowHeapStatus(523,8,White);
  48.   TProgram.HandleEvent;
  49.   case Event.Command of
  50.    cmList : NewWindow;
  51.   end; {case}
  52. end;
  53.  
  54. procedure TApplication.NewWindow;
  55. var R:TRect;
  56.     Window:PScrollWindow;
  57.     x,y:integer;
  58. begin
  59.   R.Assign(60,80,440,280);
  60.   Window:=new(PScrollWindow, Init(R,'ScrollWindow / Quelltext-Lister',winDouble+winPanel+winMenu+winKey));
  61.   InsertDesktop(Window);
  62. end;
  63.  
  64. {Implementation TScrollWindow}
  65.  
  66. procedure TScrollWindow.InitWindowScroller;
  67. var R:TRect;
  68.     i:byte;
  69.     SBH1,SBV1:PScrollBar;
  70. begin
  71.   R:=Frame^.Area;
  72.   SBH1:=new(PScrollBar, Init(R,HorizDir));
  73.   SBV1:=new(PScrollBar, Init(R,VertDir));
  74.   Scroller:=new(PNewScroller, Init(R,SBH1,SBV1));
  75.   Scroller^.CreateData;
  76.   List^.InsertItem(Scroller);
  77. end;
  78.  
  79. destructor TScrollWindow.Done;
  80. begin
  81.   TWindow.Done;
  82.   dispose(Scroller, Done);
  83. end;
  84.  
  85. {Implementation TNewScroller}
  86.  
  87. procedure TNewScroller.CreateData;
  88. var f:text;
  89.     LfdPtr:PLine;
  90. begin
  91.   assign(f,'BSP13.PAS');
  92.   reset(f);
  93.   while not EOF(f) do
  94.    begin
  95.      LfdPtr:=new(PLine, Init);
  96.      readln(f,LfdPtr^.Eintrag);
  97.      Liste^.InsertItem(LfdPtr);
  98.    end;
  99.   SetLimit(25,Liste^.AnzElem-1,8,16);
  100. end;
  101.  
  102. procedure TNewScroller.ScrollDraw;
  103. var i:integer;
  104.     LfdPtr:PGroup;
  105.  
  106. function clip(p,n:byte;z:string):string;
  107. begin
  108.   clip:=copy(z,p,n);
  109. end;
  110.  
  111. begin
  112.   Mouse.HideMouse;
  113.   with Border do
  114.    begin
  115.      SetFillStyle(SolidFill,GetPalColor(1));
  116.      SetColor(GetPalColor(2));
  117.      for i:=Delta.y to WDelta.y do
  118.       begin
  119.         LfdPtr:=Liste^.GetItems(i);
  120.         Bar(A.x,A.y+(i-Delta.y)*Py+10,B.x,A.y+(i-Delta.y)*Py+10+Py);
  121.         OutTextXY(A.x+20,A.y+(i-Delta.y)*Py+10,clip(Delta.x,Spalten*8 div 8-5,PLine(LfdPtr)^.Eintrag));
  122.       end;
  123.      if VertiScrollBar<>nil then
  124.       for i:=(WDelta.y-Delta.y)+1 to Zeilen do
  125.        Bar(A.x,A.y+i*Py+10,B.x,A.y+i*Py+10+Py);
  126.    end;
  127.   Mouse.ShowMouse;
  128. end;
  129.  
  130. begin
  131.   MyApp.Init('Beispiel 13');
  132.   MyApp.Run;
  133.   MyApp.Done;
  134. end.
  135.  
  136.