home *** CD-ROM | disk | FTP | other *** search
- program Beispiel13;
-
- uses GDecl,
- GApp,
- GEvent,
- GViews,
- GDrivers,
- GDlg,
- graph;
-
-
- const cmList = 101;
-
- type TApplication=object(TApp)
- procedure InitMenuBar; virtual;
- procedure HandleEvent; virtual;
- procedure NewWindow;
- end;
-
- PNewScroller=^TNewScroller;
-
- PScrollWindow=^TScrollWindow;
- TScrollWindow=object(TWindow)
- Scroller:PNewScroller;
- procedure InitWindowScroller; virtual;
- destructor Done; virtual;
- end;
-
- TNewScroller=object(TScroller)
- procedure CreateData;
- procedure ScrollDraw; virtual;
- end;
-
-
- var MyApp:TApplication;
-
- procedure TApplication.InitMenuBar;
- var R:TRect;
- begin
- MainMenu('~F~enster',0);
- SubMenu('~Q~elltext-Lister',cmList,0,0,false,false);
- SubMenu('E~x~it Alt-X',cmCloseApplication,0,altX,false,false);
- end;
-
- procedure TApplication.HandleEvent;
- begin
- Heap^.ShowHeapStatus(523,8,White);
- TProgram.HandleEvent;
- case Event.Command of
- cmList : NewWindow;
- end; {case}
- end;
-
- procedure TApplication.NewWindow;
- var R:TRect;
- Window:PScrollWindow;
- x,y:integer;
- begin
- R.Assign(60,80,440,280);
- Window:=new(PScrollWindow, Init(R,'ScrollWindow / Quelltext-Lister',winDouble+winPanel+winMenu+winKey));
- InsertDesktop(Window);
- end;
-
- {Implementation TScrollWindow}
-
- procedure TScrollWindow.InitWindowScroller;
- var R:TRect;
- i:byte;
- SBH1,SBV1:PScrollBar;
- begin
- R:=Frame^.Area;
- SBH1:=new(PScrollBar, Init(R,HorizDir));
- SBV1:=new(PScrollBar, Init(R,VertDir));
- Scroller:=new(PNewScroller, Init(R,SBH1,SBV1));
- Scroller^.CreateData;
- List^.InsertItem(Scroller);
- end;
-
- destructor TScrollWindow.Done;
- begin
- TWindow.Done;
- dispose(Scroller, Done);
- end;
-
- {Implementation TNewScroller}
-
- procedure TNewScroller.CreateData;
- var f:text;
- LfdPtr:PLine;
- begin
- assign(f,'BSP13.PAS');
- reset(f);
- while not EOF(f) do
- begin
- LfdPtr:=new(PLine, Init);
- readln(f,LfdPtr^.Eintrag);
- Liste^.InsertItem(LfdPtr);
- end;
- SetLimit(25,Liste^.AnzElem-1,8,16);
- end;
-
- procedure TNewScroller.ScrollDraw;
- var i:integer;
- LfdPtr:PGroup;
-
- function clip(p,n:byte;z:string):string;
- begin
- clip:=copy(z,p,n);
- end;
-
- begin
- Mouse.HideMouse;
- with Border do
- begin
- SetFillStyle(SolidFill,GetPalColor(1));
- SetColor(GetPalColor(2));
- for i:=Delta.y to WDelta.y do
- begin
- LfdPtr:=Liste^.GetItems(i);
- Bar(A.x,A.y+(i-Delta.y)*Py+10,B.x,A.y+(i-Delta.y)*Py+10+Py);
- OutTextXY(A.x+20,A.y+(i-Delta.y)*Py+10,clip(Delta.x,Spalten*8 div 8-5,PLine(LfdPtr)^.Eintrag));
- end;
- if VertiScrollBar<>nil then
- for i:=(WDelta.y-Delta.y)+1 to Zeilen do
- Bar(A.x,A.y+i*Py+10,B.x,A.y+i*Py+10+Py);
- end;
- Mouse.ShowMouse;
- end;
-
- begin
- MyApp.Init('Beispiel 13');
- MyApp.Run;
- MyApp.Done;
- end.
-
-