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

Pascal/Delphi Source File | 1993-06-28 | 6.4 KB | 272 lines

(***************************************
* WG-VISION 1.0   BEISPIELPROGRAMM     *
****************************************
*                                      *
* Programmlister mit Druckerdialog     *
*                                      *
*                                      *
****************************************
* (c) 1993 Dipl.Phys. Mathias Scholz   *
***************************************)

{$I COMPILER.INC}

program Lister;

{Programmlister mit WGraph}

uses  WDecl,
      WApp,
      WFileDlg,
      WEvent,
      WDlg,
      WViews,
      WUtils,
      WPrint,
      WDriver,
      Printer,
      Graph;

const cmLoad         = 101;
      cmDruckOptionen= 102;
      cmDruck        = 103;
      msgPrint       = 20;
      msgPrintError  = 21;

type  TApplication=object(TApp)
        procedure InitVideoDevice; virtual;
        procedure InitMenuBar; virtual;
        procedure HandleEvent; virtual;
        procedure CM_Load;
        procedure CM_DruckOptionen;
        procedure CM_Druck;
      end;

      PNewScroller=^TNewScroller;

      PListWindow=^TListWindow;
      TListWindow=object(TWindow)
       Scroller:PNewScroller;
       procedure InitWindowScroller; virtual;
       destructor Done; virtual;
       procedure HandleEvent; virtual;
      end;

      TPrintLine=object(TLinePrint)
       procedure SetParameters; virtual;
      end;

      TNewScroller=object(TScroller)
       PR:TPrintLine;
       constructor Init(R:TRect;HScroller,VScroller:PScrollBar);
       procedure CreateData;
       procedure ScrollDraw;virtual;
       procedure Print;
      end;


var   MyApp : TApplication;

{Implementation TApplication}

procedure TApplication.InitVideoDevice;
begin
  Video.Init(VESA,M640x480);
end;

procedure TApplication.InitMenuBar;
begin
  Palette[1]:=#14;
  Palette[5]:=#14;
  Palette[4]:=#4;
  Palette[12]:=#4;
  MainMenu('~D~atei',0);
   SubMenu('~L~aden         F3',cmLoad,0,kbF3,false,false);
   SubMenu('~D~ruckoptionen   ',cmDruckOptionen,0,0,false,false);
   SubMenu('~D~rucken       F5',cmDruck,0,kbF4,false,false);
   NewLine;
   SubMenu('E~x~it    <ALT><X>',cmCloseApplication,0,altX,false,false);
end;

procedure TApplication.HandleEvent;
begin
  Heap^.ShowHeapStatus(523,8,White);
  EMS^.ShowEMSStatus(50,8,White);
  TProgram.HandleEvent;
  case Event.Command of
   cmLoad         : CM_Load;
   cmDruck        : Event.Message:=msgPrint;
   cmDruckOptionen: CM_DruckOptionen;
  end; {case}
  if Event.Message=msgLoadFile then    {übergeben aus Fileauswahlfenster}
   begin
     CM_Druck;
     Event.Message:=msgNothing;
   end;
end;

procedure TApplication.CM_Load;
var Window:PInputDialog;
begin
  Window:=New(PInputDialog, Init('Textdateien','*.pas'));
  InsertDesktop(Window);
end;

procedure TApplication.CM_DruckOptionen;
var Window:PDruckOptionen;
begin
  Window:=New(PDruckOptionen, Init);
  InsertDesktop(Window);
end;

procedure TApplication.CM_Druck;
var Window:PListWindow;
    R:TRect;
    X,Y:integer;
begin
  R.Assign(20,60,620,460);
  Window:=New(PListWindow, Init(R,'Anzeigefenster',winDouble+winPanel+winMenu+winKey));
  InsertDesktop(Window);
end;

{Implementation TListWindow}

procedure  TListWindow.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;

procedure TListWindow.HandleEvent;
begin
  TWindow.HandleEvent;
  if Event.Message=msgPrint then
   begin
     Scroller^.Print;
     if Event.Message=msgPrint then Event.Message:=msgNothing;
   end;
end;

destructor TListWindow.Done;
begin
 TWindow.Done;
 Dispose(Scroller,Done);
end;

{Implementation TPrintLine}

procedure TPrintLine.SetParameters;
var  Err:integer;
begin
  KopfZeile:=OptData.Header;
  Val(OptData.LRand,RLinks,Err);
  Val(OptData.RRand,RRechts,Err);
  Val(OptData.ORand,ORand,Err);
  if OptData.Schalter[7]='R' then SetLine:=true else SetLine:=false;
  if OptData.Schalter[11]='C' then WNumber:=true else WNumber:=false;
  if OptData.Schalter[12]='C' then SetDate:=true else SetDate:=false;
  if DruckData.Schalter[8]='R' then Breite:=132 else Breite:=80;
  if Breite=132 then Write(Lst,#15) else Write(Lst,#18);
  if DruckData.Schalter[4]='R' then
   begin
     Val(Trim(DruckData.VonSeite),FromPage,Err);
     Val(Trim(DruckData.BisSeite),ToPage,Err);
   end;
  if DruckData.Schalter[3]='R' then
   begin
     FromPage:=1;
     ToPage:=999;
   end;
end;

{Implementation TNewScroller}

constructor TNewScroller.Init(R:TRect;HScroller,VScroller:PScrollBar);
begin
  TScroller.Init(R,HScroller,VScroller);
  PR.Init('Programmausdruckprogramm V 1.0' );
end;

procedure TNewScroller.CreateData;
var F:text;
    LfdPtr:PLine;
begin
  Assign(F,Event.InfoString);
  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;

procedure TNewScroller.Print;
var LfdPtr:PGroup;
    I:integer;
begin
  with Liste^ do
   begin
     for I:=1 to AnzElem do
      begin
        LfdPtr:=GetItems(I);
        if PR.PrinterOK then PR.Print(PLine(LfdPtr)^.Eintrag)
        else
        begin
          Event.Message:=msgPrintError;
          PR.Done;
          Exit;
        end;
      end;
     PR.Eject;
     PR.Done;
   end;
end;

{Hauptprogramm}

begin
  MyApp.Init('Datei Lister');
  MyApp.Run;
  MyApp.Done;
end.