Delphi Broncode
Starten van een externe applicatie (en wachten)Steeds weer krijg ik dezelfde vraag: hoe start je een extern programma vanuit een Delphi programma? En: hoe laat ik het Delphi programma wachten tot het externe programma gestopt is? Als je alleen maar een externe applicatie wil starten (of een geregistreerd bestand openen, een map openen, een bestand afdrukken, enzovoort), dan kan je uit verschillende functies kiezen. Meestal wordt hiervoor de Windows API-functie ShellExecute gebruikt, want die laat een zekere mate van controle toe en is toch niet te gecompliceerd. Enkele voorbeelden:
Het starten van een extern programma en daarna wachten tot het stopt, is dan weer een heel ander verhaal.We kunnen zien of een proces afgelopen is door zijn process handle te bekijken. Die "process handle" krijg je via een Win32 API-functie waarmee je de applicatie start: ofwel CreateProcess, ofwel ShellExecuteEx. De eenvoudigste methode gaat als volgt: start de externe applicatie via ShellExecuteEx en kijk vervolgens in een "lus" naar zijn "process handle" met WaitForSingleObject. Een volledig uitgewerkt voorbeeld van alle voornoemde functies staat als gebruiksklaar project in EXEWAIT.ZIP, in onze Engelstalige download sectie, onder "Mini Tutorial Projects". |
|
De functie FileAge() geeft de zogenaamde date/time stamp van een bestand. Dit is een geheel getal (integer), dat je dus moet omzetten naar Delphi's TDateTime formaat (een floating point getal) vooraleer je het kan gebruiken. Een voorbeeld:
procedure TForm1.Button1Click(Sender: TObject); var File_Name: string; DateTimeStamp: integer; Date_Time: TDateTime; begin File_Name := 'c:\mydocuments\test.doc'; DateTimeStamp := FileAge(File_Name); // FileAge geeft -1 indien het bestand niet gevonden is if DateTimeStamp < 0 then ShowMessage('Bestand niet gevonden') else begin // Converteer naar formaat TDateTime Date_Time := FileDateToDateTime(DateTimeStamp); Label1.Caption := DateToStr(Date_Time); Label2.Caption := TimeToStr(Date_Time); end; end;
De volgende procedure doorzoekt een directory en alle subdirectories naar een gegeven bestand. Elk gevonden "pad" wordt toegevoegd aan een stringlist. Merk op dat hier van recursie gebruik gemaakt wordt: indien niet alle subdirectories doorzocht zijn, roept FindFiles zichzelf opnieuw aan.
Voordat je FindFiles aanroept, moet de stringlist gecreëerd worden; daarna moet je die weer vernietigen.
In StartDir geef je de directory waar gestart wordt, inclusief de naam van de schijf. In FileMask geef je de naam van het gezochte bestand, ofwel een "masker". Bijvoorbeeld:
FindFiles('c:\', 'letter01.doc')
FindFiles('d:\', 'euronl??.dpr')
FindFiles('d:\projects', '*.dpr')
Om de procedure te testen, plaats je enkele componenten op de form: twee Edits, een Button, een Label en een ListBox.
implementation .... var FilesList: TStringList; ... procedure FindFiles(StartDir, FileMask: string); var SR: TSearchRec; DirList: TStringList; IsFound: Boolean; i: integer; begin if StartDir[length(StartDir)] <> '\' then StartDir := StartDir + '\'; { Maak een lijst van de bestanden (geen directories) die in directory StartDir zitten } IsFound := FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0; while IsFound do begin FilesList.Add(StartDir + SR.Name); IsFound := FindNext(SR) = 0; end; FindClose(SR); // Maak een lijst van subdirectories DirList := TStringList.Create; IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0; while IsFound do begin if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') then DirList.Add(StartDir + SR.Name); IsFound := FindNext(SR) = 0; end; FindClose(SR); // Ga door de lijst van subdirectories for i := 0 to DirList.Count-1 do FindFiles(DirList[i], FileMask); DirList.Free; end; procedure TForm1.ButtonFindClick(Sender: TObject); begin FilesList := TStringList.Create; FindFiles(EditStartDir.Text, EditFileMask.Text); ListBox1.Items.Assign(FilesList); LabelCount.Caption := 'Gevonden bestanden: ' + IntToStr(FilesList.Count); FilesList.Free; end;
Voor wat robuustere code, zou je minimaal toch moeten nagaan of de limiet van de stringlist niet
bereikt is alvorens je er iets aan toevoegt (je kan ook een try...except toepassen).
Iemand zou immers kunnen zoeken naar *.* in C:\
Je kan dan de gebruiker best verwittigen: "Te veel bestanden. Niet alle bestanden worden weergegeven."
Als je de input van een TEdit wil beperken tot alleen maar numerieke strings, dan kan je de ongeldige toetsen onderdrukken in zijn OnKeyPress event handler.
Laat ons beginnen met een Edit die alleen positieve gehele getallen accepteert. De code in de OnKeyPress event handler is dan als volgt:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin // #8 is Backspace if not (Key in [#8, '0'..'9']) then begin ShowMessage('Ongeldige toets'); // onderdruk de key Key := #0; end; end;
Als je ook getallen met "cijfers na de komma" wil, moet je ook een PUNT of een KOMMA toelaten, maar dan slechts EEN per getal! Hier is een codevoorbeeld voor een internationale versie, die naar het correcte decimale teken kijkt:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin if not (Key in [#8, '0'..'9', DecimalSeparator]) then begin ShowMessage('Ongeldige toets: ' + Key); Key := #0; end else if (Key = DecimalSeparator) and (Pos(Key, Edit1.Text) > 0) then begin ShowMessage('Ongeldige toets: tweemaal ' + Key); Key := #0; end; end;
Nog vollediger is de volgende versie, die zowel een decimaal teken als negatieve getallen accepteert. Let op, slechts EEN minteken, en dat moet dan nog op de eerste plaats staan:
procedure TForm1.Edit1_10KeyPress(Sender: TObject; var Key: Char); begin if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then begin ShowMessage('Ongeldige toets: ' + Key); Key := #0; end else if ((Key = DecimalSeparator) or (Key = '-')) and (Pos(Key, Edit1.Text) > 0) then begin ShowMessage('Ongeldige toets: tweemaal ' + Key); Key := #0; end else if (Key = '-') and (Edit1.SelStart <> 0) then begin ShowMessage('Een minteken mag alleen vooraan staan!'); Key := #0; end; end;
Hoe geef je dat zelfde gedrag mee aan meerdere TEdits op dezelfde form? In de Object Inspector wijzig je voor alle duidelijkheid de naam van de event handler van Edit1KeyPress in Edit1_10KeyPress of zoiets. Delphi zorgt ervoor dat in de broncode de naam eveneens aangepast wordt.
Daarna selecteer je elke TEdit, in de Object Inspector selecteer je zijn OnKeyPress event en je kiest Edit1_10KeyPress uit de listbox die naast de event staat.
Tenslotte moeten we de code enigszins wijzigen. In plaats van te verwijzen naar Edit1 moeten we verwijzen naar "de Edit die de event genereerde", met andere woorden: de edit-box waarin de cursor zich bevond toen er op een toets gedrukt werd.
In de parameter Sender geeft Delphi ons een verwijzing naar de component die verantwoordelijk was voor de event. We mogen die echter niet zomaar gebruiken in onze code, we moeten erbij zeggen dat het om een component van het type TEdit gaat. Dat zeggen we met de code Sender as TEdit. Kijk eens naar het voorbeeld hieronder:
procedure TForm1.Edit1_10KeyPress(Sender: TObject; var Key: Char); begin if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then begin ShowMessage('Ongeldige toets: ' + Key); Key := #0; end else if ((Key = DecimalSeparator) or (Key = '-')) and (Pos(Key, (Sender as TEdit).Text > 0) then begin ShowMessage('Ongeldige toets: tweemaal ' + Key); Key := #0; end else if (Key = '-') and ((Sender as TEdit).SelStart <> 0) then begin ShowMessage('Een minteken mag alleen vooraan staan!'); Key := #0; end; end;
Let op: schrijf dus niet Sender.Text maar wel (Sender as TEdit).Text !!
Zeker bij wat uitgebreidere projecten is het aan te raden van je 'algemene' functies en procedures in een aparte unit onder te brengen. Aan die algemene unit is dan geen form gekoppeld. In alle andere units die van de algemene routines gebruik maken, plaats je een verwijzing naar je algemene unit via een USES-clause. Een voorbeeld van zo'n algemene unit kan er als volgt uit zien:
unit Algemeen; interface uses SysUtils, Forms, Buttons, StdCtrls, Graphics, ..., ...; procedure SetDateTime(Year, Month, Day, Hour, Minu, Sec, MSec: Word); ... var Var1, Var2, Var3: string; DoIt: Boolean; ... implementation procedure SetDateTime(Year, Month, Day, Hour, Minu, Sec, MSec: Word); begin ... end; ... end.
Merk op dat je alle variabelen, procedures en functies die je vanuit de andere units wil oproepen VOOR de IMPLEMENTATION moet definieren!
Met de procedure SETDATETIME kan je vanuit je Delphi-programma de systeemdatum en -tijd instellen.
In de interface-sectie definieer je de procedure als volgt:
procedure SetDateTime(Year, Month, Day, Hour, Minu, Sec, MSec: Word);
En vervolgens de 'implementation'...:
{ SetDateTime stelt datum en tijd in van het operating system } procedure SetDateTime(Year, Month, Day, Hour, Minu, Sec, MSec: Word); var NewDateTime: TSystemTime; begin FillChar(NewDateTime, sizeof(NewDateTime), #0); NewDateTime.wYear := Year; NewDateTime.wMonth := Month; NewDateTime.wDay := Day; NewDateTime.wHour := Hour; NewDateTime.wMinute := Minu; NewDateTime.wSecond := Sec; NewDateTime.wMilliseconds := MSec; SetLocalTime(NewDateTime); end;
Om de kleur van het lettertype van alle labels van een form te wijzigen, roep je de volgende procedure aan. Wanneer je de procedure aanroept, vervang je NewColor door een bestaande kleur, bijvoorbeeld: SetLabelsFontColor(clRed) zet het font van alle labels in het rood.
procedure TForm1.SetLabelsFontColor(NewColor: TColor); var i: Integer; begin for i := 0 to ComponentCount - 1 do if Components[i] is TLabel then TLabel(Components[i]).Font.Color := NewColor; end;
Deze techniek kan je natuurlijk ook gebruiken om andere eigenschappen van andere componenten te wijzigen. Om bijvoorbeeld de kleur van alle edits te wijzigen, schrijf je de volgende code:
procedure TForm1.SetEditsColor(NewColor: TColor); var i: Integer; begin for i := 0 to ComponentCount - 1 do if Components[i] is TEdit then TEdit(Components[i]).Color := NewColor; end;
© Copyright 1999-2016
Studiebureau Festraets