home *** CD-ROM | disk | FTP | other *** search
/ Best of German Only 1 / romside_best_of_german_only_1.iso / wissen / dos / wgraph / entpack.exe / WGBSP!.EXE / BSP23.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-11  |  4KB  |  171 lines
  1. program Beispiel23;
  2.  
  3. uses GDecl,
  4.      GApp,
  5.      GDrivers,
  6.      GEvent,
  7.      GViews,
  8.      GDlg,
  9.      dos,
  10.      Graph;
  11.  
  12.  
  13. const cmDialog   = 101;
  14.       cmErgebnis = 102;
  15.  
  16. type TApplication=object(TApp)
  17.        procedure InitMenuBar; virtual;
  18.        procedure SetDialogData; virtual;
  19.        procedure HandleEvent; virtual;
  20.        procedure DialogWindow;
  21.      end;
  22.  
  23.      PDialogWindow=^TDialogWindow;
  24.      TDialogWindow=object(TDlgWindow)
  25.       procedure SetListBox(x,y,xl,yl:integer;Bez:str25;LScroller:word); virtual;
  26.      end;
  27.  
  28.      PDateiListBox=^TDateiListBox;
  29.      TDateiListBox=object(TListBox)
  30.       procedure CreateDataList;
  31.      end;
  32.  
  33.      PDirListBox=^TDirListBox;
  34.      TDirListBox=object(TListBox)
  35.       procedure CreateDataList;
  36.      end;
  37.  
  38.  
  39.      tDialogData=record
  40.                     Schalter:string[3];
  41.                     DName1:string[12];
  42.                     DName2:string[12];
  43.                  end;
  44.  
  45. var MyProg:TApplication;
  46.     DlgData:tDialogData;
  47.  
  48. {Implementation TApplication}
  49.  
  50. procedure TApplication.InitMenuBar;
  51. begin
  52.   Palette[1]:=#14;
  53.   Palette[5]:=#14;
  54.   Palette[4]:=#4;
  55.   Palette[12]:=#4;
  56.   MainMenu('~F~enster',0);
  57.    SubMenu('~D~ialogfenster',cmDialog,0,0,false,false);
  58.    SubMenu('~E~rgebnis',cmErgebnis,0,0,false,false);
  59.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  60. end;
  61.  
  62. procedure TApplication.SetDialogData;
  63. begin
  64.   with DlgData do
  65.    begin
  66.      Schalter:='TBB';
  67.      FillChar(DName1,SizeOf(DName1),' ');
  68.      DName1[0]:=#12;
  69.      FillChar(DName2,SizeOf(DName2),' ');
  70.      DName2[0]:=#12;
  71.    end;
  72. end;
  73.  
  74. procedure TApplication.HandleEvent;
  75. begin
  76.   Heap^.ShowHeapStatus(523,8,White);
  77.   TProgram.HandleEvent;
  78.   case Event.Command of
  79.    cmDialog   : DialogWindow;
  80.    cmErgebnis : Messagebox(0,'Info',DlgData.DName1+'#'+DlgData.DName2);
  81.   end; {case}
  82. end;
  83.  
  84.  
  85. procedure TApplication.DialogWindow;
  86. var R:TRect;
  87.     Window:PDialogWindow;
  88. begin
  89.   R.Assign(60,80,440,360);
  90.   Window:=new(PDialogWindow, Init(R,'Beispiel 23 : Listbox',winDouble+winPanel+winMenu+winKey));
  91.   with Window^ do
  92.    begin
  93.      SetPushButton(15,40,80,22,'OK',cmCloseWindow);
  94.      SetListBox(35,100,127,144,'~L~istbox 1',VScrBar);
  95.      SetListBox(210,100,127,144,'List~b~ox 2',DScrBar);
  96.      SetData(DlgData);
  97.    end;
  98.   InsertDesktop(Window);
  99. end;
  100.  
  101. {Implementation TDialogWindow}
  102.  
  103. procedure TDialogWindow.SetListBox(x,y,xl,yl:integer;Bez:str25;
  104.                                    LScroller:word);
  105. var LBox1:PDateiListBox;
  106.     LBox2:PDirListBox;
  107. begin
  108.   TDlgWindow.SetListBox(x,y,xl,yl,Bez,LScroller);
  109.   if pos('1',Bez)<>0 then
  110.    begin
  111.      LBox1:=new(PDateiListBox, Init(R,Bez,SBH,SBV));
  112.      LBox1^.CreateDataList;
  113.      LBox1^.P.x:=x; LBox1^.P.y:=y;
  114.      DlgList^.InsertItem(LBox1);
  115.    end
  116.    else
  117.    begin
  118.      LBox2:=new(PDirListBox, Init(R,Bez,SBH,SBV));
  119.      LBox2^.CreateDataList;
  120.      LBox2^.P.x:=x; LBox2^.P.y:=y;
  121.      DlgList^.InsertItem(LBox2);
  122.    end;
  123. end;
  124.  
  125. {Implementation TDateiListBox}
  126.  
  127. procedure TDateiListBox.CreateDataList;
  128. var SRec:SearchRec;
  129.     LfdPtr:PLine;
  130. begin
  131.   FindFirst('\*.*',Archive,SRec);
  132.   if SRec.Name<>'' then
  133.    repeat
  134.      LfdPtr:=new(PLine, Init);
  135.      LfdPtr^.Eintrag:=SRec.Name;
  136.      Liste^.InsertItem(LfdPtr);
  137.      FindNext(SRec);
  138.    until DOSError=18;
  139.   DataLen:=12;
  140.   SetLimit(12,Liste^.AnzElem-1,8,11);
  141. end;
  142.  
  143. {Implementation TDirListBox}
  144.  
  145. procedure TDirListBox.CreateDataList;
  146. var SRec:SearchRec;
  147.     LfdPtr:PLine;
  148. begin
  149.   FindFirst('\*.*',Directory,SRec);
  150.   if SRec.Name<>'' then
  151.    repeat
  152.      if SRec.Attr=Directory then
  153.       begin
  154.         LfdPtr:=new(PLine, Init);
  155.         LfdPtr^.Eintrag:=SRec.Name;
  156.         Liste^.InsertItem(LfdPtr);
  157.       end;
  158.      FindNext(SRec);
  159.    until DOSError=18;
  160.   DataLen:=12;
  161.   SetLimit(12,Liste^.AnzElem-1,8,11);
  162. end;
  163.  
  164.  
  165. {--- Hauptprogramm ---}
  166.  
  167. begin
  168.   MyProg.Init('Beispiel 23');
  169.   MyProg.Run;
  170.   MyProg.Done;
  171. end.