home *** CD-ROM | disk | FTP | other *** search
/ TopWare 18: Liquid / Image.iso / liquid / top1143 / gepackt.exe / BSPQTSW.EXE / LIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-28  |  7.0 KB  |  301 lines
  1. (***************************************
  2. * WG-VISION 1.0   BEISPIELPROGRAMM     *
  3. ****************************************
  4. *                                      *
  5. * Quelltextlister mit Veränderung des  *
  6. * Zeichensatzes zur Laufzeit           *
  7. *                                      *
  8. *--------------------------------------*
  9. * Achtung: Nur VGA !                   *
  10. ****************************************
  11. * (c) 1993 Dipl.Phys. Mathias Scholz   *
  12. ***************************************)
  13.  
  14. {$I COMPILER.INC}
  15.  
  16. program List;
  17.  
  18. uses WApp,
  19.      WEvent,
  20.      WDecl,
  21.      WViews,
  22.      WDriver,
  23.      WDlg,
  24.      WFileDlg,
  25.      WUtils,
  26.      WText,
  27.      Graph;
  28.  
  29.  
  30. const cmOpen    = 101;
  31.       cmSetFont = 102;
  32.  
  33.       msgDraw   = 100;
  34.  
  35. type TApplication=object(TApp)
  36.        procedure InitMenuBar; virtual;
  37.        procedure SetDialogData; virtual;
  38.        procedure HandleEvent; virtual;
  39.        procedure LoadFile;
  40.        procedure ListWindow;
  41.        procedure SetFont;
  42.      end;
  43.  
  44.      PNewScroller=^TNewScroller;
  45.  
  46.      PScrollWindow=^TScrollWindow;
  47.      TScrollWindow=object(TWindow)
  48.        Scroller:PNewScroller;
  49.        procedure InitWindowScroller; virtual;
  50.        procedure HandleEvent; virtual;
  51.        destructor Done; virtual;
  52.      end;
  53.  
  54.      TNewScroller=object(TScroller)
  55.        procedure CreateData;
  56.        procedure ScrollDraw; virtual;
  57.      end;
  58.  
  59.      PSetFontWindow=^TSetFontWindow;
  60.      TSetFontWindow=object(TDlgWindow)
  61.       DFont:GraficFont;
  62.       constructor Init(X,Y:integer);
  63.       procedure DrawClientArea; virtual;
  64.       procedure HandleEvent; virtual;
  65.      end;
  66.  
  67. {Dialog-Record}
  68.  
  69.      tFontDataRec=record
  70.                     Schalter:string[8];
  71.                   end;
  72.  
  73.  
  74. var MyApp:TApplication;
  75.     FontDataRec:tFontDataRec;
  76.  
  77.  
  78. {Implementation TApplication}
  79.  
  80. procedure TApplication.InitMenuBar;
  81. begin
  82.   MainMenu('~F~enster',0);
  83.    SubMenu('~D~atei Laden',cmOpen,0,0,false,false);
  84.    SubMenu('~Z~eichensatz wechseln',cmSetFont,0,0,true,false);
  85.    NewLine;
  86.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  87. end;
  88.  
  89. procedure TApplication.SetDialogData;
  90. begin
  91.   FontDataRec.Schalter:='TGrrrrRr';
  92. end;
  93.  
  94. procedure TApplication.HandleEvent;
  95. begin
  96.   Heap^.ShowHeapStatus(523,8,White);
  97.   TProgram.HandleEvent;
  98.   case Event.Command of
  99.    cmOpen    : LoadFile;
  100.    cmSetFont : SetFont;
  101.   end; {case}
  102.   if Event.Message=msgLoadFile then
  103.    begin
  104.      ListWindow;
  105.      ClearMessage;
  106.    end;
  107.   if WinAnz=0 then MMenu[1]^.sbMenu[2]^.Aktiviere
  108.    else MMenu[1]^.sbMenu[2]^.DeAktiviere;
  109. end;
  110.  
  111. procedure TApplication.LoadFile;
  112. var Window:PInputDialog;
  113. begin
  114.   Window:=New(PInputDialog, Init('Dateiauswahl','*.PAS'));
  115.   InsertDesktop(Window);
  116. end;
  117.  
  118. procedure TApplication.ListWindow;
  119. var R:TRect;
  120.     Window:PScrollWindow;
  121. begin
  122.   R.Assign(20,60,616,446);
  123.   Window:=New(PScrollWindow, Init(R,'ScrollWindow / Quelltext-Lister',winDouble+winPanel+winMenu+winKey));
  124.   InsertDesktop(Window);
  125. end;
  126.  
  127. procedure TApplication.SetFont;
  128. var Window:PSetFontWindow;
  129. begin
  130.   Window:=New(PSetFontWindow, Init(60,80));
  131.   InsertDesktop(Window);
  132. end;
  133.  
  134. {Implementation TScrollWindow}
  135.  
  136. procedure TScrollWindow.InitWindowScroller;
  137. var R:TRect;
  138.     SBH1,SBV1:PScrollBar;
  139. begin
  140.   R:=Frame^.Area;
  141.   SBH1:=New(PScrollBar, Init(R,HorizDir));
  142.   SBV1:=New(PScrollBar, Init(R,VertDir));
  143.   Scroller:=New(PNewScroller, Init(R,SBH1,SBV1));
  144.   Scroller^.CreateData;
  145.   List^.InsertItem(Scroller);
  146. end;
  147.  
  148. procedure TScrollWindow.HandleEvent;
  149. begin
  150.   TWindow.HandleEvent;
  151.   if Event.Message=msgDraw then
  152.    begin
  153.      Scroller^.ScrollDraw;
  154.      ClearMessage;
  155.    end;
  156. end;
  157.  
  158. destructor TScrollWindow.Done;
  159. begin
  160.   TWindow.Done;
  161.   Dispose(Scroller, Done);
  162. end;
  163.  
  164. {Implementation TNewScroller}
  165.  
  166. procedure TNewScroller.CreateData;
  167. var dat:text;
  168.     LfdPtr:PLine;
  169. begin
  170.   SetFont(Wndw19);
  171.   Assign(dat,Event.InfoString);
  172.   Reset(dat);
  173.   while not Eof(dat) do
  174.    begin
  175.      LfdPtr:=New(PLine, Init);
  176.      ReadLn(dat,LfdPtr^.Eintrag);
  177.      Liste^.InsertItem(LfdPtr);
  178.    end;
  179.   SetLimit(25,Liste^.AnzElem-1,8,16);
  180. end;
  181.  
  182. procedure TNewScroller.ScrollDraw;
  183. var I:integer;
  184.     LfdPtr:PGroup;
  185.  
  186. function Clip(P,N:byte;z:string):string;
  187. begin
  188.   Clip:=Copy(z,P,N);
  189. end;
  190.  
  191. {------}
  192.  
  193. begin
  194.   SetFontColor(White,Blue);
  195.   Mouse.HideMouse;
  196.   with Border do
  197.    begin
  198.      SetFillStyle(SolidFill,GetPalColor(1));
  199.      SetColor(GetPalColor(2));
  200.      for I:=Delta.Y to WDelta.Y do
  201.       begin
  202.         LfdPtr:=Liste^.GetItems(I);
  203.         Bar(A.X,A.Y+(I-Delta.Y)*Py+10,B.X,A.Y+(I-Delta.Y)*Py+10+Py);
  204.         WriteText(A.X+20,A.Y+(I-Delta.Y)*Py+10,Clip(Delta.X,
  205.                   Spalten*8 div 8-5,PLine(LfdPtr)^.Eintrag));
  206.       end;
  207.      if VertiScrollBar<>nil then
  208.       for I:=(WDelta.Y-Delta.Y)+1 to Zeilen do
  209.        Bar(A.X,A.Y+I*Py+10,B.X,A.Y+I*Py+10+Py);
  210.    end;
  211.   Mouse.ShowMouse;
  212. end;
  213.  
  214. {Implementation TSetFontWindow}
  215.  
  216. constructor TSetFontWindow.Init(X,Y:integer);
  217. var RR:TRect;
  218.     I:integer;
  219. begin
  220.   RR.Assign(X,Y,X+455,Y+265);
  221.   TDlgWindow.Init(RR,'Zeichensätze',winDouble+winPanel+winMenu);
  222.   SetPushButton(55,210,80,22,'OK',cmCloseWindow);
  223.   SetGroupFrame(25,55,150,125,'Zeichensätze',NormWidth);
  224.   SetRadioButton(45,80, '~T~hin8   8x12',1);
  225.   SetRadioButton(45,95, 'T~h~in14  8x14',1);
  226.   SetRadioButton(45,110,'Th~i~n16  8x16',1);
  227.   SetRadioButton(45,125,'~B~rdwy19 8x19',1);
  228.   SetRadioButton(45,140,'~W~ndw19  8x19',1);
  229.   SetRadioButton(45,155,'~S~ans19  8x19',1);
  230.   SetData(FontDataRec);
  231.   for I:=3 to 8 do
  232.    if FontDataRec.Schalter[I]='R' then
  233.     case I of
  234.       3 : DFont:=Thin8;
  235.       4 : DFont:=Thin14;
  236.       5 : DFont:=Thin16;
  237.       6 : DFont:=Brdwy19;
  238.       7 : DFont:=Wndw19;
  239.       8 : DFont:=Sans19;
  240.     end; {case}
  241.   SetFont(DFont);
  242.   SetFontColor(White,Green);
  243. end;
  244.  
  245. procedure TSetFontWindow.DrawClientArea;
  246. var z:array[1..6] of string;
  247.     I:integer;
  248. begin
  249.   z[1]:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  250.   z[2]:='abcdefghijklmnopqrstuvwxyz';
  251.   z[3]:='ÄÖÜäöü?=)(/&%$"!^°²ⁿ{[]}\';
  252.   z[4]:='12345678901234567890123456';
  253.   z[5]:='{}[]\~ÇüéâäàåçêëèïîìÄÅÉæôö';
  254.   z[6]:='òûùÿÖÜ¢£¥₧ƒáíóúñѪº¿⌐¬½¼─«';
  255.   with Origin do
  256.    begin
  257.      SetColor(Black);
  258.      Mouse.HideMouse;
  259.      FBar(X+205,Y+60,X+425,Y+188,White);
  260.      SetLineStyle(SolidLn,0,ThickWidth);
  261.      Rectangle(X+200,Y+55,X+427,Y+190);
  262.      SetLineStyle(SolidLn,0,NormWidth);
  263.      for I:=1 to 6 do WriteText(X+215,Y+45+I*20,z[I]);
  264.      Mouse.ShowMouse;
  265.    end;
  266. end;
  267.  
  268. procedure TSetFontWindow.HandleEvent;
  269. var I:byte;
  270. begin
  271.   with FontDataRec do
  272.    for I:=3 to 8 do
  273.     if Schalter[I]='R' then
  274.      begin
  275.        case I of
  276.         3 : DFont:=Thin8;
  277.         4 : DFont:=Thin14;
  278.         5 : DFont:=Thin16;
  279.         6 : DFont:=Brdwy19;
  280.         7 : DFont:=Wndw19;
  281.         8 : DFont:=Sans19;
  282.        end; {case}
  283.      end;
  284.   if DFont<>Font then
  285.    begin
  286.      SetFont(DFont);
  287.      DrawClientArea;
  288.      Event.Message:=msgDraw;
  289.    end;
  290.   TDlgWindow.HandleEvent;
  291. end;
  292.  
  293. {Hauptprogramm}
  294.  
  295. begin
  296.   MyApp.Init('Quelltext-Lister mit Fontwechsel');
  297.   MyApp.Run;
  298.   MyApp.Done;
  299. end.
  300.  
  301.