TopWare 18: Liquid/Image.iso/liquid/top1143/gepackt.exe/BSPQTSW.EXE/EMSLIST.PAS

Pascal/Delphi Source File | 1993-07-01 | 4.9 KB | 218 lines

(***************************************
* WG-VISION 1.0   BEISPIELPROGRAMM     *
****************************************
*                                      *
* Quelltext-Lister unter Verwendung    *
* von Expanded Memory                  *
*                                      *
* Erläuterungen siehe Handbuch         *
*------------------------------------- *
* EMS-Treiber muß geladen sein !       *
* Funktioniert nicht in den Super-VGA- *
* Modi (Sonderzeichensatz)             *
****************************************
* (c) 1993 Dipl.Phys. Mathias Scholz   *
***************************************)

{$I COMPILER.INC}

program Lister;

uses WApp,
     WEvent,
     WDecl,
     WViews,
     WDriver,
     WDlg,
     WFileDlg,
     WUtils,
     WEMS,
     WText,
     Graph;


const cmOpen    = 101;

type str128=string[128];
     pStr=^str128;         {String-Pointer}

type TApplication=object(TApp)
       procedure InitMenuBar; virtual;
       procedure HandleEvent; virtual;
       procedure LoadFile;
       procedure ListWindow;
     end;

     PNewScroller=^TNewScroller;

     PScrollWindow=^TScrollWindow;
     TScrollWindow=object(TWindow)
       Scroller:PNewScroller;
       procedure InitWindowScroller; virtual;
       destructor Done; virtual;
     end;

     TNewScroller=object(TScroller)
       EMSHandle:word;
       Eintrag:array[1..3072] of pStr;
       destructor Done; virtual;
       procedure CreateData;
       procedure ScrollDraw; virtual;
     end;

var MyApp:TApplication;

procedure TApplication.InitMenuBar;
begin
  MainMenu('~F~enster',0);
   SubMenu('~D~atei Laden',cmOpen,0,0,false,false);
   NewLine;
   SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
end;

procedure TApplication.HandleEvent;
begin
  EMS^.ShowEMSStatus(453,8,White);
  TProgram.HandleEvent;
  case Event.Command of
   cmOpen    : LoadFile;
  end; {case}
  if Event.Message=msgLoadFile then
   begin
     ListWindow;
     ClearMessage;
   end;
end;

procedure TApplication.LoadFile;
var Window:PInputDialog;
begin
  Window:=New(PInputDialog, Init('Dateiauswahl','*.PAS'));
  InsertDesktop(Window);
end;

procedure TApplication.ListWindow;
var R:TRect;
    Window:PScrollWindow;
begin
  R.Assign(20,60,616,446);
  Window:=New(PScrollWindow, Init(R,'ScrollWindow / Quelltext-Lister',winDouble+winPanel+winMenu+winKey));
  InsertDesktop(Window);
end;

{Implementation TScrollWindow}

procedure TScrollWindow.InitWindowScroller;
var R:TRect;
    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}

destructor TNewScroller.Done;
begin
  DeAllocatePages(EMSHandle);
  TScroller.Done;
end;

procedure TNewScroller.CreateData;
var dat:text;
    LfdPtr:PLine;
    I,k,S,AnzPages:word;
    zz:string[120];
    z:string[4];
begin
  SetFont(Wndw19);
  k:=1; S:=0;
  Assign(dat,Event.InfoString);
  Reset(dat);
  AnzPages:=GetFreePages;
  if AnzPages<=24 then
   begin
     {Hier eventuell Fehlermitteilung einsetzen}
   end
   else
   begin
     EMSHandle:=AllocatePages(24);
     MapHandlePages(EMSHandle,0,0);
     for I:=1 to 3072 do
      begin
        if I mod 128=0 then
         begin
           k:=1;
           MapHandlePages(EMSHandle,0,I div 128);
         end
         else Inc(k);
         Eintrag[I]:=Ptr(PageFrame,(k-1)*128);
         if (I<=3071) and (not Eof(dat)) then
          begin
            ReadLn(dat,zz);
            Str(I:4,z);
            Eintrag[I]^:=z+'  '+zz
          end
         else
          begin
            SetLimit(65,I-1,8,18);
            Close(dat);
            Exit;
          end;
      end;
   end;
end;

procedure TNewScroller.ScrollDraw;
var I:integer;
    Max:word;
    LfdPtr:PGroup;

function Clip(P,N:byte;z:string):string;
begin
  Clip:=Copy(z,P,N);
end;

{--------}

begin
  SetFontColor(White,Red);
  Max:=GetHandlePages(EMSHandle);
  Mouse.HideMouse;
  with Border do
   begin
     SetFillStyle(SolidFill,GetPalColor(1));
     SetColor(GetPalColor(2));
     for I:=Delta.Y to WDelta.Y do
      begin
        MapHandlePages(EMSHandle,0,I div 128);
        Bar(A.X,A.Y+(I-Delta.Y)*Py+10,B.X,A.Y+(I-Delta.Y)*Py+10+Py);
        WriteText(A.X+20,A.Y+(I-Delta.Y)*Py+10,Clip(Delta.X,
                  Spalten*8 div 8-5,Eintrag[I]^));
      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;

{Hauptprogramm}

begin
  MyApp.Init('LISTER mit Text in EMS');
  MyApp.Run;
  MyApp.Done;
end.