home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / delite / doc1 / doc1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-01  |  5.2 KB  |  169 lines
  1. PROGRAM doc1;
  2. (*****************************************************************************
  3. Name:              DOC1
  4. Version:           1.0
  5. Edit Datum:        1. April 1992
  6. Autor:             Andreas Schumm
  7. Kurzbeschreibung:  Beispieldialog aus der Dokumentation
  8. *****************************************************************************)
  9.  
  10. USES  Kernel, API, Dialogs, DOS;
  11.  
  12. CONST ProjektName  = 'doc1';               { so heissen alle Dateien  }
  13.       Maske        = '*.*' ;
  14.  
  15. VAR   LaunchResult      : integer;
  16.       MyEvent           : EventTyp;         { eine Botschaft        }
  17.       StillRunning      : boolean;
  18.       MyRec             : SearchRec;        { für GetFirst/GetNext  }
  19.       HiddenToo         : boolean;
  20.  
  21.  
  22.   Procedure GetNextFile(Var Item: ListString; Var eol: boolean); far;
  23.   var dir: dirstr;
  24.       name: namestr;
  25.       ext : extstr;
  26.   begin
  27.     FindNext(MyRec);
  28.     If DosError = 0  then eol := false
  29.              else eol := true;
  30.     Item := MyRec.name;
  31.     if not eol then fsplit(Item, dir, name, ext);
  32.   end;
  33.  
  34.  
  35.   Procedure GetFirstFile(Var Item: ListString; Var eol: boolean); far;
  36.   var dir : dirstr;
  37.       name: namestr;
  38.       ext : extstr;
  39.       attr: word;
  40.   begin
  41.     MyRec.Name := '';
  42.     attr := AnyFile - Directory - Hidden - VolumeID; { nur normale Dateien  }
  43.     if HiddenToo then attr := attr + Hidden;         { ggf. auch versteckte }
  44.     FindFirst(Maske, attr, MyRec);
  45.     If DosError <> 0 then
  46.       eol := true
  47.     else
  48.       begin
  49.         eol := false;
  50.         Item := MyRec.name;
  51.         fsplit(Item, dir, name, ext);
  52.       end;
  53.   end;
  54.  
  55.  
  56. procedure MyFirstEventProc(TheEvent: EventTyp); far;
  57. var  MyCheckBox : PCheckBox;
  58.      MyEditor   : PEditField;
  59.      MyListBox  : PListBox;
  60.      MyDLG      : PDialog;
  61. begin
  62.   MyDLG := TheEvent.DlgAdr;    { Adresse des Dialoges }
  63.   if TheEvent.Class = DialogEvent then With TheEvent Do
  64.     Case Msg of
  65.       DLG_OK          : begin
  66.                           MyEditor := MyDLG^.FindDlgItem(2);   { Adresse ermitteln }
  67.                           if MyEditor^.GetString <> '' then
  68.                             MyDLG^.DestroyDialog               { falls mit Inhalt, beenden }
  69.                           else MyDLG^.SetTheFocus(2);          { sonst fokussieren  }
  70.                         end;
  71.       DLG_CANCEL      : begin
  72.                           MyDLG^.Flags := MyDLG^.Flags or MF_CANCELLED; { Cancel-Flag setzen }
  73.                           MyDLG^.DestroyDialog;
  74.                         end;
  75.       DLG_LISTSELECT  : begin
  76.                           MyListBox  := MyDLG^.FindDlgItem(3);
  77.                           MyEditor   := MyDLG^.FindDlgItem(2);
  78.                           MyEditor^.SetString(MyListBox^.GetSelected);
  79.                         end;
  80.       DLG_CHECKED,
  81.       DLG_UNCHECKED   : begin
  82.                           MyCheckBox := MyDLG^.FindDlgItem(6);
  83.                           MyListBox  := MyDLG^.FindDlgItem(3);
  84.                           HiddenToo  := MyCheckBox^.IsChecked;
  85.                           MyListBox^.Update;
  86.                         end;
  87.     end;
  88. end;
  89.  
  90.  
  91. procedure Beispiel1;
  92. var MyDialog  : Dialog;
  93.     MyButton  : PButton;
  94.     MyLabel   : PLabelText;
  95.     MyEditor  : PEditField;
  96.     MyListBox : PListBox;
  97.     MyCheckBox: PCheckBox;
  98. begin
  99.   MyDialog.Init(35*FontX, 13*FontY, MF_NOCAPTION, MyFirstEventProc);
  100.   MyDialog.SetTopic('Beispiel');
  101.  
  102.   new(MyLabel, Init(FontX,FontY, 1, 'Dateiname:'));
  103.   MyDialog.AddItem(MyLabel);
  104.  
  105.   new(MyEditor, Init(FontX, 2*FontY+4, 13, 12, 2, ''));
  106.   MyDialog.AddItem(MyEditor);
  107.  
  108.   new(MyListBox, Init(FontX, 4*FontY, 12, 8, 3, GetFirstFile, GetNextFile));
  109.   MyDialog.AddItem(MyListBox);
  110.  
  111.   new(MyCheckBox, Init(20*FontX,11*FontY, 6, 'auch HIDDEN'));
  112.   MyDialog.AddItem(MyCheckBox);
  113.   if HiddenToo then MyCheckbox^.Check;
  114.  
  115.   new(MyButton, Init(25*FontX, FontY, 9*FontX, 2*FontY,  4, 'Ok'));
  116.   MyDialog.AddItem(MyButton);
  117.   MyButton^.MakeDefaultItem;
  118.  
  119.   new(MyButton, Init(25*FontX, 4*FontY, 9*FontX, 2*FontY,  5, 'Abbruch'));
  120.   MyDialog.AddItem(MyButton);
  121.   MyButton^.MakeCancelItem;
  122.  
  123.   MyDialog.Show;
  124.   MyDialog.DoDialog;
  125.   if MyDialog.WasNotCancelled then
  126.     begin
  127.       MyEditor := MyDialog.FindDlgItem(2);
  128.       ErrWindow(100,100,MyEditor^.GetString);
  129.     end;
  130.   MyDialog.Done;
  131. end;
  132.  
  133.  
  134. Procedure HandleMsg(MyMessage: EventTyp); far;
  135. { Hier werden die Botschaften behandelt. }
  136. Begin
  137.   With MyMessage Do
  138.     Case Class Of
  139.       Menu    : begin
  140.                   Case MenuItemID of
  141.                      0       : StillRunning := false;  { Ende }
  142.                      101     : Beispiel1;
  143.                   end;
  144.                 end;
  145.     end; { Case Class }
  146. End;
  147.  
  148.  
  149. Begin
  150.   StillRunning := true;
  151.   HiddenToo    := false;
  152.   LaunchResult := OpenMainApplication(HandleMsg,
  153.                                           APP_NOFONT+APP_NOHELP,
  154.                                           ProjektName);
  155.  
  156.   If LaunchResult = 0 then                { erfolgreich gestartet }
  157.   begin
  158.     while StillRunning Do
  159.        begin
  160.         GetEvent(MyEvent);
  161.         DispatchMessage(MyEvent);
  162.       end;
  163.     CloseMainApplication;
  164.   end
  165.   Else
  166.     Writeln('Programm kann nicht gestartet werden. Fehler: ',LaunchResult);
  167. End.
  168.  
  169.