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 / BSP14.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-17  |  4KB  |  195 lines
  1. program Beispiel14;
  2.  
  3. uses GDecl,
  4.      GApp,
  5.      GEvent,
  6.      GViews,
  7.      GDrivers,
  8.      GText,
  9.      GDlg,
  10.      graph;
  11.  
  12.  
  13. const cmList = 101;
  14.  
  15. type TApplication=object(TApp)
  16.        procedure InitMenuBar; virtual;
  17.        procedure HandleEvent; virtual;
  18.        procedure NewWindow;
  19.      end;
  20.  
  21.      PNewScroller=^TNewScroller;
  22.  
  23.      PScrollWindow=^TScrollWindow;
  24.      TScrollWindow=object(TWindow)
  25.        Scroller:PNewScroller;
  26.        procedure InitWindowScroller; virtual;
  27.        procedure InitBackground; virtual;
  28.        destructor Done; virtual;
  29.      end;
  30.  
  31.      TNewScroller=object(TScroller)
  32.        procedure CreateData;
  33.        procedure ScrollDraw; virtual;
  34.        procedure Draw; virtual;
  35.      end;
  36.  
  37.      PScrollBgrd=^TScrollBgrd;
  38.      TScrollBgrd=object(TBackground)
  39.        procedure Draw; virtual;
  40.      end;
  41.  
  42. var MyApp:TApplication;
  43.  
  44. procedure TApplication.InitMenuBar;
  45. var R:TRect;
  46. begin
  47.   MainMenu('~F~enster',0);
  48.    SubMenu('~Q~elltext-Lister',cmList,0,0,false,false);
  49.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  50. end;
  51.  
  52. procedure TApplication.HandleEvent;
  53. begin
  54.   Heap^.ShowHeapStatus(523,8,White);
  55.   TProgram.HandleEvent;
  56.   case Event.Command of
  57.    cmList : NewWindow;
  58.   end; {case}
  59. end;
  60.  
  61. procedure TApplication.NewWindow;
  62. var R:TRect;
  63.     Window:PScrollWindow;
  64.     x,y:integer;
  65. begin
  66.   R.Assign(60,80,540,380);
  67.   Window:=new(PScrollWindow, Init(R,'ScrollWindow / Quelltext-Lister',winDouble+winPanel+winMenu));
  68.   with Window^ do Frame^.DragMode:=dmNoMove;
  69.   InsertDesktop(Window);
  70. end;
  71.  
  72. {Implementation TScrollWindow}
  73.  
  74. procedure TScrollWindow.InitWindowScroller;
  75. var R:TRect;
  76.     i:byte;
  77.     SBH1,SBV1:PScrollBar;
  78. begin
  79.   R:=Frame^.Area;
  80.   R.Grow(-120,-30);
  81.   R.Move(30,15);
  82.   SBH1:=new(PScrollBar, Init(R,HorizDir));
  83.   SBV1:=new(PScrollBar, Init(R,VertDir));
  84.   with SBH1^ do
  85.    begin
  86.      Palette[1]:=#0;
  87.      Palette[3]:=#2;  {Tastenfarbe}
  88.      Palette[4]:=#14; {BalkenFarbe}
  89.      Palette[5]:=#14; {Randfarbe Taste}
  90.      Palette[7]:=#4;  {Pfeile}
  91.    end;
  92.   with SBV1^ do
  93.    begin
  94.      Palette[1]:=#0;
  95.      Palette[3]:=#2;  {Tastenfarbe}
  96.      Palette[4]:=#14; {BalkenFarbe}
  97.      Palette[5]:=#14; {Randfarbe Taste}
  98.      Palette[7]:=#4;  {Pfeile}
  99.    end;
  100.  
  101.   Scroller:=new(PNewScroller, Init(R,SBH1,SBV1));
  102.   Scroller^.CreateData;
  103.   Scroller^.Palette[1]:=#0;
  104.   Scroller^.Palette[2]:=#11;
  105.   List^.InsertItem(Scroller);
  106. end;
  107.  
  108. procedure TScrollWindow.InitBackground;
  109. var R:TRect;
  110. begin
  111.   R:=Frame^.Area;
  112.   Bgrd:=new(PScrollBgrd, Init(R));
  113.   List^.InsertItem(Bgrd);
  114. end;
  115.  
  116. destructor TScrollWindow.Done;
  117. begin
  118.   TWindow.Done;
  119.   dispose(Scroller, Done);
  120. end;
  121.  
  122. {Implementation TNewScroller}
  123.  
  124. procedure TNewScroller.CreateData;
  125. var f:text;
  126.     LfdPtr:PLine;
  127. begin
  128.   assign(f,'BSP13.PAS');
  129.   reset(f);
  130.   while not EOF(f) do
  131.    begin
  132.      LfdPtr:=new(PLine, Init);
  133.      readln(f,LfdPtr^.Eintrag);
  134.      Liste^.InsertItem(LfdPtr);
  135.    end;
  136.   SetLimit(25,Liste^.AnzElem-1,8,16);
  137. end;
  138.  
  139. procedure TNewScroller.ScrollDraw;
  140. var i:integer;
  141.     LfdPtr:PGroup;
  142.  
  143. function clip(p,n:byte;z:string):string;
  144. begin
  145.   clip:=copy(z,p,n);
  146. end;
  147.  
  148. begin
  149.   SetFontColor(GetPalColor(1),GetPalColor(2));
  150.   Mouse.HideMouse;
  151.   with Border do
  152.    begin
  153.      SetFillStyle(SolidFill,GetPalColor(1));
  154.      SetColor(GetPalColor(2));
  155.      for i:=Delta.y to WDelta.y do
  156.       begin
  157.         LfdPtr:=Liste^.GetItems(i);
  158.         Bar(A.x,A.y+(i-Delta.y)*Py+10,B.x,A.y+(i-Delta.y)*Py+10+Py);
  159.         WriteText(A.x+20,A.y+(i-Delta.y)*Py+10,clip(Delta.x,Spalten*8 div 8-5,PLine(LfdPtr)^.Eintrag));
  160.       end;
  161.      if VertiScrollBar<>nil then
  162.       for i:=(WDelta.y-Delta.y)+1 to Zeilen do
  163.        Bar(A.x,A.y+i*Py+10,B.x,A.y+i*Py+10+Py);
  164.    end;
  165.   Mouse.ShowMouse;
  166. end;
  167.  
  168. procedure TNewScroller.Draw;
  169. begin
  170.   TScroller.Draw;
  171.   SetColor(GetPalColor(6));
  172.   with Border do
  173.    RectAngle(A.x-1,A.y-1,B.x+16,B.y+16);
  174. end;
  175.  
  176. {Implementation TScrollBgrd}
  177.  
  178. procedure TScrollBgrd.Draw;
  179. begin
  180.   with Border do
  181.    begin
  182.      SetFillStyle(HatchFill,LightRed);
  183.      Bar(A.x,A.y,B.x,B.y);
  184.    end;
  185. end;
  186.  
  187. {Hauptprogramm}
  188.  
  189. begin
  190.   MyApp.Init('Beispiel 14');
  191.   MyApp.Run;
  192.   MyApp.Done;
  193. end.
  194.  
  195.