Delphi Broncode

Datum en tijd van of creatie/wijziging van een bestand

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;

Een bestand zoeken

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."

Alleen maar numerieke input in een TEdit

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 !!

Een algemene UNIT met functies en procedures

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!

Systeemdatum en -tijd instellen

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;

Wijzigen van de properties van alle componenten van een bepaald type

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