home *** CD-ROM | disk | FTP | other *** search
/ TopWare 18: Liquid / Image.iso / liquid / top1143 / gepackt.exe / BSPQTSW.EXE / LBOXTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-28  |  3.1 KB  |  138 lines
  1. (***************************************
  2. * WG-VISION 1.0   BEISPIELPROGRAMM     *
  3. ****************************************
  4. *                                      *
  5. * Listbox in ein Dialogfenster ein-    *
  6. * binden. Dateinamen auflisten         *
  7. *                                      *
  8. ****************************************
  9. * (c) 1993 Dipl.Phys. Mathias Scholz   *
  10. ***************************************)
  11.  
  12. {$I COMPILER.INC}
  13.  
  14. program LBoxTest;
  15.  
  16. uses WDecl,
  17.      WEvent,
  18.      WApp,
  19.      WViews,
  20.      WDlg,
  21.      Dos;
  22.  
  23.  
  24. const cmNewWindow=101;
  25.  
  26. type TApplication=object(TApp)
  27.       procedure InitMenuBar; virtual;
  28.       procedure SetDialogData; virtual;
  29.       procedure HandleEvent; virtual;
  30.       procedure NewWindow;
  31.      end;
  32.  
  33.      PNewWindow=^TNewWindow;
  34.      TNewWindow=object(TDlgWindow)
  35.       constructor Init;
  36.       procedure SetListBox(X,Y,xl,yl:integer;Bez:str25;LScroller:word); virtual;
  37.      end;
  38.  
  39.      PDateiListBox=^TDateiListBox;
  40.      TDateiListBox=object(TListBox)
  41.       procedure CreateDataList;
  42.      end;
  43.  
  44.      tLBoxData=record
  45.                   Schalter:string[2];
  46.                   DName:string[12];
  47.                end;
  48.  
  49.  
  50. var MyApp:TApplication;
  51.     LBoxData:tLBoxData;
  52.  
  53.  
  54. {Implementation TApplication}
  55.  
  56. procedure TApplication.InitMenuBar;
  57. begin
  58.   MainMenu('~F~enster',0);
  59.    SubMenu('~D~ialogfenster',cmNewWindow,0,0,false,false);
  60.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  61. end;
  62.  
  63. procedure TApplication.SetDialogData;
  64. begin
  65.   with LBoxData do
  66.    begin
  67.      Schalter:='TB';
  68.      FillChar(DName,SizeOf(DName),' ');
  69.    end;
  70. end;
  71.  
  72. procedure TApplication.HandleEvent;
  73. var I:byte;
  74. begin
  75.   TProgram.HandleEvent;
  76.   case Event.Command of
  77.    cmNewWindow:NewWindow;
  78.   end; {case}
  79. end;
  80.  
  81. procedure TApplication.NewWindow;
  82. var Window:PNewWindow;
  83. begin
  84.   Window:=New(PNewWindow, Init);
  85.   InsertDesktop(Window);
  86. end;
  87.  
  88. {Implementation TNewWindow}
  89.  
  90. constructor TNewWindow.Init;
  91. var RR:TRect;
  92. begin
  93.   RR.Assign(60,80,230,340);
  94.   TDlgWindow.Init(RR,'Datei-Auswahl',winDouble+winPanel+winMenu+winKey);
  95.   SetPushButton(36,210,100,22,'OK',cmCloseWindow);
  96.   SetListBox(23,65,127,118,'~D~atei',VScrBar);
  97.   SetData(LBoxData);
  98. end;
  99.  
  100. procedure TNewWindow.SetListBox(X,Y,xl,yl:integer;Bez:str25;LScroller:word);
  101. var LBox:PDateiListBox;
  102. begin
  103.   TDlgWindow.SetListBox(X,Y,xl,yl,Bez,LScroller);
  104.   LBox:=New(PDateiListBox, Init(R,Bez,SBH,SBV));
  105.   with LBox^ do
  106.    begin
  107.      CreateDataList;
  108.      P.X:=X; P.Y:=Y;
  109.    end;
  110.   DlgList^.InsertItem(LBox);
  111. end;
  112.  
  113. {Implementation TDateiListBox}
  114.  
  115. procedure TDateiListBox.CreateDataList;
  116. var SRec:SearchRec;
  117.     LfdPtr:PLine;
  118. begin
  119.   FindFirst('\*.*',Archive,SRec);
  120.   if SRec.Name<>'' then
  121.    repeat
  122.      LfdPtr:=New(PLine, Init);
  123.      LfdPtr^.Eintrag:=SRec.Name;
  124.      Liste^.InsertItem(LfdPtr);
  125.      FindNext(SRec);
  126.    until DosError=18;
  127.   DataLen:=12;  {sehr wichtig ! Wird in der Methode TDlgWindow.SetData benötigt !}
  128.   SetLimit(12,Liste^.AnzElem,8,11);
  129. end;
  130.  
  131. {Hauptprogramm}
  132.  
  133. begin
  134.   MyApp.Init('Dialogfenster mit Listbox');
  135.   MyApp.Run;
  136.   MyApp.Done;
  137. end.
  138.