home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / wgraph1 / beispiel / bsp15.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-17  |  7.4 KB  |  321 lines
  1. program Beispiel15;
  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.       cmSetFont = 20;
  15.  
  16.       msgDraw = 10;
  17.  
  18. type TApplication=object(TApp)
  19.        procedure InitMenuBar; virtual;
  20.        procedure SetDialogData; virtual;
  21.        procedure HandleEvent; virtual;
  22.        procedure NewWindow;
  23.        procedure SetFont;
  24.      end;
  25.  
  26.      PNewScroller=^TNewScroller;
  27.  
  28.      PScrollWindow=^TScrollWindow;
  29.      TScrollWindow=object(TDlgWindow)
  30.        Scroller:PNewScroller;
  31.        procedure InitWindowScroller; virtual;
  32.        procedure InitBackground; virtual;
  33.        destructor Done; virtual;
  34.        procedure HandleEvent; virtual;
  35.      end;
  36.  
  37.      TNewScroller=object(TScroller)
  38.        procedure CreateData;
  39.        procedure ScrollDraw; virtual;
  40.        procedure Draw; virtual;
  41.      end;
  42.  
  43.      PScrollBgrd=^TScrollBgrd;
  44.      TScrollBgrd=object(TBackground)
  45.        procedure Draw; virtual;
  46.      end;
  47.  
  48.      PSetFontWindow=^TSetFontWindow;
  49.      TSetFontWindow=object(TDlgWindow)
  50.        DFont:GraficFont;
  51.        procedure WriteTextBlock;
  52.        procedure Draw; virtual;
  53.        procedure HandleEvent; virtual;
  54.      end;
  55.  
  56. {--------------------------------------}
  57.  
  58.      tFontDataRec=record
  59.                     Schalter:string[9];
  60.                   end;
  61.  
  62.  
  63. var MyApp:TApplication;
  64.     FontDataRec:tFontDataRec;
  65.  
  66. procedure TApplication.InitMenuBar;
  67. var R:TRect;
  68. begin
  69.   MainMenu('~F~enster',0);
  70.    SubMenu('~Q~elltext-Lister',cmList,0,0,false,false);
  71.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  72. end;
  73.  
  74. procedure TApplication.SetDialogData;
  75. begin
  76.   with FontDataRec do Schalter:='TGrrrrRrG';
  77. end;
  78.  
  79. procedure TApplication.HandleEvent;
  80. begin
  81.   Heap^.ShowHeapStatus(523,8,White);
  82.   TProgram.HandleEvent;
  83.   case Event.Command of
  84.    cmList    : NewWindow;
  85.    cmSetFont : SetFont;
  86.   end; {case}
  87. end;
  88.  
  89. procedure TApplication.NewWindow;
  90. var R:TRect;
  91.     Window:PScrollWindow;
  92.     x,y:integer;
  93. begin
  94.   R.Assign(60,80,540,380);
  95.   Window:=new(PScrollWindow, Init(R,'ScrollWindow / Quelltext-Lister',winDouble+winPanel+winMenu));
  96.   with Window^ do
  97.    begin
  98.      Frame^.DragMode:=dmNoMove;
  99.      SetPushButton(386,40,80,22,'~F~ont',cmSetFont);
  100.      DlgInput:=false;
  101.    end;
  102.   InsertDesktop(Window);
  103. end;
  104.  
  105. procedure TApplication.SetFont;
  106. var K:TRect;
  107.     Window:PSetFontWindow;
  108. begin
  109.   K.Assign(110,125,565,390);
  110.   Window:=new(PSetFontWindow, Init(K,'Zeichensätze',winDouble+winPanel+winMenu));
  111.   with Window^ do
  112.    begin
  113.      SetPushButton(55,210,80,22,'OK',cmCloseWindow);
  114.      SetGroupFrame(25,55,150,125,'Zeichensätze',NormWidth);
  115.      SetRadioButton(45,80, '~T~hin8   8x12',1);
  116.      SetRadioButton(45,95, 'T~h~in14  8x14',1);
  117.      SetRadioButton(45,110,'Th~i~n16  8x16',1);
  118.      SetRadioButton(45,125,'~B~rdwy19 8x19',1);
  119.      SetRadioButton(45,140,'~W~ndW19  8x19',1);
  120.      SetRadioButton(45,155,'~S~ans19  8x19',1);
  121.      SetData(FontDataRec);
  122.      SetGroupFrame(200,55,230,140,'',ThickWidth);
  123.    end;
  124.   InsertDesktop(Window);
  125. end;
  126.  
  127. {Implementation TScrollWindow}
  128.  
  129. procedure TScrollWindow.InitWindowScroller;
  130. var RR:TRect;
  131.     i:byte;
  132.     SBH1,SBV1:PScrollBar;
  133. begin
  134.   RR:=Frame^.Area;
  135.   RR.Grow(-130,-30);
  136.   RR.Move(30,15);
  137.   SBH1:=new(PScrollBar, Init(RR,HorizDir));
  138.   SBV1:=new(PScrollBar, Init(RR,VertDir));
  139.   with SBH1^ do
  140.    begin
  141.      Palette[1]:=#0;  {Hintergrund Scrollbereich}
  142.      Palette[3]:=#2;  {Tastenfarbe}
  143.      Palette[4]:=#14; {BalkenFarbe}
  144.      Palette[5]:=#14; {Randfarbe Taste}
  145.      Palette[7]:=#4;  {Pfeile}
  146.    end;
  147.   with SBV1^ do
  148.    begin
  149.      Palette[1]:=#0;
  150.      Palette[3]:=#2;  {Tastenfarbe}
  151.      Palette[4]:=#14; {BalkenFarbe}
  152.      Palette[5]:=#14; {Randfarbe Taste}
  153.      Palette[7]:=#4;  {Pfeile}
  154.    end;
  155.  
  156.   Scroller:=new(PNewScroller, Init(RR,SBH1,SBV1));
  157.   Scroller^.CreateData;
  158.   Scroller^.Palette[1]:=#0;
  159.   Scroller^.Palette[2]:=#11;
  160.   List^.InsertItem(Scroller);
  161. end;
  162.  
  163. procedure TScrollWindow.InitBackground;
  164. var RR:TRect;
  165. begin
  166.   RR:=Frame^.Area;
  167.   Bgrd:=new(PScrollBgrd, Init(RR));
  168.   List^.InsertItem(Bgrd);
  169. end;
  170.  
  171. destructor TScrollWindow.Done;
  172. begin
  173.   TWindow.Done;
  174.   dispose(Scroller, Done);
  175. end;
  176.  
  177. procedure TScrollWindow.HandleEvent;
  178. begin
  179.   TDlgWindow.HandleEvent;
  180.   if Event.Message=msgDraw then
  181.    begin
  182.      Scroller^.ScrollDraw;
  183.      Event.Message:=msgNothing;
  184.    end;
  185. end;
  186.  
  187. {Implementation TNewScroller}
  188.  
  189. procedure TNewScroller.CreateData;
  190. var f:text;
  191.     LfdPtr:PLine;
  192. begin
  193.   SetFont(Wndw19);
  194.   assign(f,'BSP5.PAS');
  195.   reset(f);
  196.   while not EOF(f) do
  197.    begin
  198.      LfdPtr:=new(PLine, Init);
  199.      readln(f,LfdPtr^.Eintrag);
  200.      Liste^.InsertItem(LfdPtr);
  201.    end;
  202.   SetLimit(35,Liste^.AnzElem-1,CharLength,CharHeight);
  203. end;
  204.  
  205. procedure TNewScroller.ScrollDraw;
  206. var i:integer;
  207.     LfdPtr:PGroup;
  208.  
  209. function clip(p,n:byte;z:string):string;
  210. begin
  211.   clip:=copy(z,p,n);
  212. end;
  213.  
  214. begin
  215.   SetFontColor(GetPalColor(1),GetPalColor(2));
  216.   Mouse.HideMouse;
  217.   with Border do
  218.    begin
  219.      SetFillStyle(SolidFill,GetPalColor(1));
  220.      SetColor(GetPalColor(2));
  221.      for i:=Delta.y to WDelta.y do
  222.       begin
  223.         LfdPtr:=Liste^.GetItems(i);
  224.         Bar(A.x,A.y+(i-Delta.y)*Py+10,B.x,A.y+(i-Delta.y)*Py+10+Py);
  225.         WriteText(A.x+20,A.y+(i-Delta.y)*Py+10,clip(Delta.x,Spalten*8 div 8-5,PLine(LfdPtr)^.Eintrag));
  226.       end;
  227.      if VertiScrollBar<>nil then
  228.       for i:=(WDelta.y-Delta.y)+1 to Zeilen do
  229.        Bar(A.x,A.y+i*Py+10,B.x,A.y+i*Py+10+Py);
  230.    end;
  231.   Mouse.ShowMouse;
  232. end;
  233.  
  234. procedure TNewScroller.Draw;
  235. begin
  236.   TScroller.Draw;
  237.   SetColor(GetPalColor(6));
  238.   with Border do
  239.    RectAngle(A.x-1,A.y-1,B.x+16,B.y+16);
  240. end;
  241.  
  242.  
  243. {Implementation TScrollBgrd}
  244.  
  245. procedure TScrollBgrd.Draw;
  246. begin
  247.   with Border do
  248.    begin
  249.      SetFillStyle(HatchFill,LightRed);
  250.      Bar(A.x,A.y,B.x,B.y);
  251.    end;
  252. end;
  253.  
  254. {Implementation TSetFontWindow}
  255.  
  256. procedure TSetFontWindow.WriteTextBlock;
  257. var z:string;
  258. begin
  259.   Mouse.HideMouse;
  260.   SetFillStyle(SolidFill,White);
  261.   Bar(Origin.x+205,Origin.y+60,Origin.x+425,Origin.y+190);
  262.   z:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  263.   WriteText(Origin.x+210,Origin.y+67,z);
  264.   z:='abcdefghijklmnopqrstuvwxyz';
  265.   WriteText(Origin.x+210,Origin.y+87,z);
  266.   z:='ÄÖÜäöü?!"$%&/()=?+#*,.:;_-';
  267.   WriteText(Origin.x+210,Origin.y+107,z);
  268.   z:='01234567890123456789012345';
  269.   WriteText(Origin.x+210,Origin.y+127,z);
  270.   z:='{}[]\~ÇüéâàåçêëèïîìÅÉæÆôöò';
  271.   WriteText(Origin.x+210,Origin.y+147,z);
  272.   z:='ûùÿÖÜ¢£¥₧ƒáíóúñѪº¿⌐¬½¼¡«»';
  273.   WriteText(Origin.x+210,Origin.y+167,z);
  274.   Mouse.ShowMouse;
  275. end;
  276.  
  277. procedure TSetFontWindow.Draw;
  278. begin
  279.   TDlgWindow.Draw;
  280.   DFont:=Font;
  281.   SetFont(DFont); SetFontColor(White,Green);
  282.   WriteTextBlock;
  283.   SetFontColor(Black,LightCyan);
  284. end;
  285.  
  286. procedure TSetFontWindow.HandleEvent;
  287. var z:string;
  288.     i:byte;
  289. begin
  290.   with FontDataRec do
  291.    for i:=1 to length(Schalter) do
  292.     if Schalter[i]='R' then
  293.      begin
  294.        case i of
  295.         3 : DFont:=Thin8;
  296.         4 : DFont:=Thin14;
  297.         5 : DFont:=Thin16;
  298.         6 : DFont:=Brdwy19;
  299.         7 : DFont:=Wndw19;
  300.         8 : DFont:=Sans19;
  301.        end; {case}
  302.      end;
  303.   if DFont<>Font then
  304.    begin
  305.      SetFont(DFont); SetFontColor(White,Green);
  306.      WriteTextBlock;
  307.      SetFontColor(Black,LightCyan);
  308.      Event.Message:=msgDraw;
  309.    end;
  310.   TDlgWindow.HandleEvent;
  311. end;
  312.  
  313. {Hauptprogramm}
  314.  
  315. begin
  316.   MyApp.Init('Beispiel 15');
  317.   MyApp.Run;
  318.   MyApp.Done;
  319. end.
  320.  
  321.