Site hosted by Angelfire.com: Build your free website today!

| Home | Tutorials | Hints & Tips  | Downloads | Links | Guest Book | Vote | Delphi Books | Contact Us | 

Hints & Tips

 

 

 

Browse For Folder

The following function lets the user browse for a folder in a treeview, that starts at the desktop. If a folder is selected, the function returns TRUE and the name of the selected folder is placed in variable Foldr; otherwise, it returns FALSE.

Don't let the code scare you, because it uses some exotic types of variables and the Windows API-function SHBrowseForFolder... just copy it and use it. Like all the other code on DelphiLand, it has been fully tested :) 

function BrowseForFolder(var Foldr: string; Title: string): Boolean;
var
  BrowseInfo: TBrowseInfo;
  ItemIDList: PItemIDList;
  DisplayName: array[0..MAX_PATH] of Char;
begin
  Result := False;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
  with BrowseInfo do begin
    hwndOwner := Application.Handle;
    pszDisplayName := @DisplayName[0];
    lpszTitle := PChar(Title);
    ulFlags := BIF_RETURNONLYFSDIRS;
  end;
  ItemIDList := SHBrowseForFolder(BrowseInfo);
  if Assigned(ItemIDList) then
    if SHGetPathFromIDList(ItemIDList, DisplayName) then begin
      Foldr := DisplayName;
      Result := True;
    end;
end;

IMPORTANT: the function above will only work if you add SHLOBJ to the uses-directive in your unit. For example, if it is:
    uses Windows, Messages, SysUtils, ..., StdCtrls;

change it to:
    uses Windows, Messages, SysUtils, ..., StdCtrls, SHLOBJ;

How to use the function? Here's an example: let the user browse for a folder and display it in the label Label1; if no folder was selected, we display "Nothing was selected".

procedure TForm1.Button1Click(Sender: TObject);
var
  Foldr: string;
begin
  if BrowseForFolder(Foldr, 'Select a folder') then 
    Label1.Caption := Foldr
  else 
    Label1.Caption := 'Nothing was selected';
end;

Saving to a text file, reading from a text file


For saving one or more strings to a text file, you code the following steps:

  1. Declare a variable of the type TextFile.
  2. Use the command AssignFile to connect the TextFile variable to a physical file on disk.
  3. "Open" the text file for writing with the command Rewrite. This means, that a new text file will be created on the disk. If there is already a file with the same name, it will be overwritten.
  4. Write a string to the file with WriteLn. You can repeat this step as many times as you want.
  5. Finally, "close" the text file with CloseFile.

The example below shows how to save the contents of two Edit-components to a text file C:\Test\Data.txt

  

procedure TForm1.btnWriteClick(Sender: TObject);
var
  F: TextFile;
begin
  AssignFile(F, 'C:\Test\Data.txt');
  Rewrite(F);
  WriteLn(F, Edit1.Text);
  WriteLn(F, Edit2.Text);
  CloseFile(F);
end;

Reading strings from a text file is very similar, but in order to be on the safe side, you need an extra step. Before trying to read, you have to check if the file exists. You also need an extra variable to receive the strings that you read from the file. This are the steps:

  1. Declare two variables, one of the type TextFile and one of the type String.
  2. If the file exists, continue with step 3. If not, it ends here. Optionally, you can show an error message to the user.
  3. Use AssignFile to connect the TextFile variable to a physical file.
  4. "Open" the text file for reading with the command Reset.
  5. Read a string from the file into the string variable, with the command ReadLn. Repeat this step to read the next line(s) of the file.
  6. Finally, "close" the text file with CloseFile.

Here's an example that loads the contents of the two Edits from the text file C:\Test\Data.txt 

procedure TForm1.btnReadClick(Sender: TObject);
var
  F: TextFile;
  S: string;
begin
  if FileExists('C:\Test\Data.txt') then begin
    AssignFile(F, 'C:\Test\Data.txt');
    Reset(F);
    ReadLn(F, S);
    Edit1.Text := S;
    ReadLn(F, S);
    Edit2.Text := S;
    CloseFile(F);    
  end
  else
    ShowMessage('File C:\Test\Data.txt not found');
end;

Date and time of creation/modification of a file

The function FileAge() returns the date/time stamp of a file. The returned value is an integer number; it has to be converted to Delphi's TDateTime format (a floating point number) before you can use it. You can use the following code to test the functions involved:

  

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 returns -1 if file not found
  if DateTimeStamp < 0 then
    ShowMessage('File not found')
  else begin
    // Convert to TDateTime format
    Date_Time := FileDateToDateTime(DateTimeStamp);
    Label1.Caption := DateToStr(Date_Time);
    Label2.Caption := TimeToStr(Date_Time);
  end;
end;

Find files

The procedure FindFiles locates files in a given directory (folder) and its subdirectories, and adds their complete path to a stringlist. Note that recursion is used: FindFiles calls itself at the end of the procedure!

The meaning of the parameters of FindFiles(FilesList, StartDir, FileMask) is as follows:

Examples of use:

Find all files on the entire C: disk with the name 'letter1.doc' :
   FindFiles('c:\', 'letter01.doc');
Find all files on the entire C: disk, with a name starting with 'euroen', followed by zero, one or two other characters, and ending with the extension '.dpr' :
   FindFiles('d:\', 'euroen??.dpr');
Find all Delphi project files in directory d:\projects and its subdirectories :
   FindFiles('d:\projects', '*.dpr');

If you want to test this procedure, start a new project and add some components to the form: two Edits (one for the starting directory, one for the mask), a Button, a Label and a ListBox.

implementation
....

// Recursive procedure to build a list of files
procedure FindFiles(FilesList: TStringList; StartDir, FileMask: string);
var
  SR: TSearchRec;
  DirList: TStringList;
  IsFound: Boolean;
  i: integer;
begin
  if StartDir[length(StartDir)] <> '\' then
    StartDir := StartDir + '\';

  { Build a list of the files in directory StartDir
     (not the directories!)                         }

  IsFound :=
    FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
  while IsFound do begin
    FilesList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);

  // Build a list of 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);

  // Scan the list of subdirectories
  for i := 0 to DirList.Count - 1 do
    FindFiles(FilesList, DirList[i], FileMask);

  DirList.Free;
end;

// Example: how to use FindFiles
procedure TForm1.ButtonFindClick(Sender: TObject);
var
  FilesList: TStringList;
begin
  FilesList := TStringList.Create;
  try
    FindFiles(FilesList, EditStartDir.Text, EditFileMask.Text);
    ListBox1.Items.Assign(FilesList);
    LabelCount.Caption := 'Files found: ' + IntToStr(FilesList.Count);
  finally 
    FilesList.Free;
  end;
end;

 

Only numerical input in a TEdit

 

If you want to limit the input of a TEdit to numerical strings only, you can discard the "invalid" characters in its OnKeyPress event handler.

 

Let's assume that you only want to allow positive integer numbers. The code for the OnKeyPress event handler is as follows:

  

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  // #8 is Backspace
  if not (Key in [#8, '0'..'9']) then begin
    ShowMessage('Invalid key');
    // Discard the key
    Key := #0;
  end;
end;

If you also want numbers with a decimal fraction, you must allow a POINT or a COMMA, but only once. For an international version that looks at the correct decimal separator, the code could be as follows:

  

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in [#8, '0'..'9', DecimalSeparator]) then begin
    ShowMessage('Invalid key: ' + Key);
    Key := #0;
  end
  else if (Key = DecimalSeparator) and
          (Pos(Key, Edit1.Text) > 0) then begin
    ShowMessage('Invalid Key: twice ' + Key);
    Key := #0;
  end;
end;

And here's a full blown version of the event handler, accepting a decimal separator and negative numbers (minus sign: only accepted once, has to be the first character):
 		 
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
    ShowMessage('Invalid key: ' + Key);
    Key := #0;
  end
  else if ((Key = DecimalSeparator) or (Key = '-')) and 
          (Pos(Key, Edit1.Text) > 0) then begin
    ShowMessage('Invalid Key: twice ' + Key);
    Key := #0;
  end
  else if (Key = '-') and 
          (Edit1.SelStart <> 0) then begin
    ShowMessage('Only allowed at beginning of number: ' + Key);
    Key := #0;
  end;
end;

How about giving that same behaviour to several TEdits on the same form, say 10 of them? In the Object Inspector, you change the name of the event handler of Edit1 from Edit1KeyPress to Edit1_10KeyPress or something similar. Delphi automatically changes the name in the code editor, don't worry.

Then, for each next TEdit, you select its OnKeyPress event and you select Edit1_10KeyPress from the listbox next to the event.

Finally, we have to slightly adapt the code. Intead of pointing to Edit1, we must point to "the TEdit that generated the event", in other words: the edit-box where the cursor was when a key was depressed. When you look at the template for the event handler that Delphi made, you see the parameter Sender: that's a pointer to the component that generated the event. But we are not allowed to use it straight away in our code, we must specify that we're dealing with a component of the type TEdit. That's done with the code Sender as TEdit:

  

procedure TForm1.Edit1_10KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
    ShowMessage('Invalid key: ' + Key);
    Key := #0;
  end
  else if ((Key = DecimalSeparator) or (Key = '-')) and 
          (Pos(Key, (Sender as TEdit).Text) > 0) then begin
    ShowMessage('Invalid Key: twice ' + Key);
    Key := #0;
  end
  else if (Key = '-') and 
          ((Sender as TEdit).SelStart <> 0) then begin
    ShowMessage('Only allowed at beginning of number: ' + Key);
    Key := #0;
  end;

Global UNIT with functions and procedures

 

For complex projects, I advise you to put your "general" (globally used) variables, constants, functions and procedures in a separate unit. Such a "global" unit does not have a corresponding form. All other units that use your general routines, have to refer to your global unit through a USES-clause. An example of such a unit might look like this:

unit GlobalRoutines;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ..., ...;

procedure SetDateTime(Year, Month, Day, Hour, Minu, Sec, MSec: Word);
...
var
  Var1, Var2, Var3: string;
  DoIt: Boolean;
  ...
const
  CR = #13;       // "Enter" key, "Carriage Return"
  CRLF = #13#10;  // Carriage Return + LineFeed

implementation

procedure SetDateTime(Year, Month, Day, Hour, Minu, Sec, MSec: Word);
begin
  ...
end;

...
end.

Note that you have to define all constants, variables, procedures and functions that you want to call from other units, in the interface section of the unit !

 

Set system date and time

With the procedure SetDateTime you can set the date and time of the operating system, from within your Delphi application.

In the interface-section you define the procedure: 

procedure SetDateTime(Year, Month, Day, Hour, Minu, Sec, MSec: Word);

In the 'implementation' you write...: 

{ SetDateTime sets the date and time of the 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;

Changing properties for all components of a certain type

To change the font color of all the labels of a form to a certain color, call the following procedure. In the call itself, you have to replace NewColor with an existing color, e.g. SetLabelsFontColor(clRed) sets all the labels' font color to red:

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;

Of course, you can use this technique to change other properties of other components. To change the color of all the edit components, use the following 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;

   
Implementing a sleep procedure

In Delphi 2 and 3 this is easy, you just use:

  Windows.Sleep(TimeInMilliseconds);

Whilst in Delphi 1 you would need:

procedure Sleep(milliseconds: LongInt);
var
  iTemp : Longint;
begin
  iTemp :=  GetTickCount + milliseconds;
  while GetTickCount <  iTemp do
    Application.ProcessMessages;
end; 

 
How to create shortcuts

  To Create shortcuts in Delphi you have to use the com engine. Fortunately this is not too difficult. The following code shows you how:

var
  slTemp: IShellLink;
  pfTemp: IPersistFile;
  sTarget: String;  { This is the path and name of the file that the  
                      shortcut is to point too }
  sIconFile : String; { This is the path and name of the file that contains
                        the icon (it can be an .exe or .ico file) }
  iIconIndex : Integer { The index of which icon to use in the specified file }
  sName : String  { The name for the shortcut including the path}

begin
  // initialize the COM engine
  CoInitialize(nil);
  try
    // create an uninitialized IShellLink (a shortcut)
    if CoCreateInstance(CLSID_ShellLink,
                        nil,
                        CLSCTX_INPROC_SERVER,
                        IShellLink, slTemp) = S_OK then
    begin
      slTemp.SetPath(PChar(sTarget));
      slTemp.SetIconLocation(PChar(sIconFile), iIconIndex);
    //Get an IPersistFile interface (needed to specify the name of the Shortcut)
      if slTemp.QueryInterface(IPersistFile, pfTemp) = S_OK then
        if pfTemp.Save(StringToOleStr(sName), True) <> S_OK then
          ShowMessage('could not save the shortcut');
    // do not Release slTemp, it is done automatically by Delphi
    end;
  // deinitialize COM
  finally
    CoUninitialize;
end; 

 end;

How to show CPU debug window

 

   Built into Delphi there is a hidden Debug window that shows you a disassembly of your code and also the registers, flags, stack, and data dump. To enable it, use Regedit and go to the following folder:

  HKEY_CURRENT_USER\Software\Borland\Delphi\3.0\Debugging

In this folder add a new string value called EnableCPU and set its value to 1. Now next time you run Delphi you will have a new menu item on the view menu called CPU which will bring up this new window.

 

Hiding the taskbar in Windows

To hide the task bar use
   ShowWindow( FindWindow( 'Shell_TrayWnd',nil), SW_HIDE);

To show the task bar use
   ShowWindow( FindWindow( 'Shell_TrayWnd',nil), SW_SWOWNA