How to create a custom webbrowser in minutes with many added features.

It took me several months to create this tutorial so I hope many people will find it useful. Every care has been taken to make this code as accurate as possible, should there still be any mistake then please let me know via this forum.

Every feature added, is a project itself, so you can download each chapter separately if only interested in one particular feature

These are all the demo's of each follow up tutorial, in the right order. So if you download the last one, it contains all the previous features. These concern the Delphi project files, units, forms, resources but not the compiled exe since of restrictions. Full source code is present of course. No restrictions apply, use it however you want, to myself it has been a great help in understanding delphi more. :cool:

There is no need to visit my site, all the files will be posted here eventually but that is going to take a while.

Attached are files necessary if you create a browser from scratch but still want to add the features described here. They are for delphi7 but work for later versions as well

Thanks fly out to many people for helping me out, too many to mention here but they are named in the source code.

This will become a lengthy thread so please be patient and do not reply yet, so that the chapters can follow up in a convenient way, thank you.

Overview of chapters

• 1. Creating a progressbar - start here
• 2. Download - create a button that enables to download current url
• 3. Copy / Paste - enable the copy paste function in your webbrowser
• 4. Find - add a windows like menu with Find button etc
• 5. Edit current page - use a checkbox to make the opened document editable
• 6. Print - add a print button, a printer setup and page setup button
• 7. List links - list and save all the valid links in the currently opened window
• 8. Are we online - checks connection to the internet and shows the result
• 9. Change color - change the color of the progressbar into virtually any color
• 10. Over Statusbar - TProgressbar over TStatusbar like in IE
• 11. MAC address - populate statusbar with MAC address
• 12. Network Group Name - retrieve Network Group Name and show it
• 13. Local IP address - display the local IP on the statusbar
• 14. Populate TPanel - fill up the last TPanel with some info
• 15. Screen capture - create screen capture of url and save it to disk
• 16. Navigation - add standard navigation and more features


01. How to create a custom progressbar in 2 minutes

1. Start a new project

2. Drop a TWebBrowser component

3. Drop a TEdit component

In the object inspector change its Text property in:

http://www.google.com

4. Drop a TButton component, double click it and add:

...
procedure TForm1.Button1Click(Sender: TObject);
begin
  FDownCount:=0;
  Webbrowser1.Navigate(Edit1.Text);
end;
...

5. Drop a TProgressBar

6. In the private section add:

...
    procedure Webbrowser1ProgressChange(Sender: TObject; Progress, ProgressMax: Integer);
    procedure Button1Click(Sender: TObject);
  private
   FDownCount:    Integer;
  public
    { Public declarations }
  end;
...

7. Select the Webbrowser component, and go to the property inspector and click the tab Events:

Double click OnDownloadBegin [in the dropdownbox] add:

...
procedure TForm1.Webbrowser1DownloadBegin(Sender: TObject);
begin
  Inc(FDownCount);
  Progressbar1.Position:=0;
end;
...

8. Double click OnDownloadComplete [in the dropdownbox] add:

...
procedure TForm1.Webbrowser1DownloadComplete(Sender: TObject);
begin
  Dec(FDownCount);
  Progressbar1.Position:=0;
end;
...

9. Double click OnProgressChange [in the dropdownbox] add:

...
procedure TForm1.Webbrowser1ProgressChange(Sender: TObject; Progress, ProgressMax: Integer);
begin
  if (ProgressMax > 0) and (Progress > 0) and (FDownCount > 0) then
   begin
     Progressbar1.Position:=Trunc(Progress / ProgressMax) * 100;
     Progressbar1.Update;
     Sleep(100);
     Application.ProcessMessages;
  end;
end;
...
pritaeas commented: Interesting +13

02. Adding a download current url button

Sometimes when browsing, I come across a site that I would like to save to my hard disk, for instance a freeware delphi programming site, with lots of useful small pieces of code that are ready to be used. For that purpose let's add a button that will save the currently opened webpage to disk with just one click. Note that this way does not save images as well, it is only meant for largely text based pages, with for instance code on it

Create a new webbrowser program or use the initial project files accompanied in the zip file webbrowser.zip and continue from there

1. Add WinInet to your uses clause

...
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, OleCtrls, SHDocVw, WinInet;
...

2. Drop a TButton on your webbrowser form, if you continued the guide then this button is called Button2, if not it will be Button1 and then the rest of the code will look a bit different

3. Double click it to add the OnClick event, and change it to:

...
procedure TForm1.Button2Click(Sender: TObject);
var
  BytesRead: DWord;// data read
  sUrl, S: string;//Url to browse to in the address TEdit
  Nethandle, UrlHandle: Pointer;
  M: TMemoryStream;// save data to memory stream
  htmlFile : String; //html page to save the webpage to
  Buffer: array[0..8191] of Char;
begin
  sUrl := edit1.Text;
  NetHandle := InternetOpen('Mozilla 4.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    if Assigned(NetHandle) then
    begin
      UrlHandle := InternetOpenUrl(NetHandle, PChar(sUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
      if Assigned(UrlHandle) then
      begin
        M := TMemoryStream.Create;
        try
          repeat
            FillChar(Buffer, SizeOf(Buffer), 0)
            InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
            if BytesRead > 0 then
              M.Write(Buffer, BytesRead);
          until
          BytesRead = 0;// all data was read
          M.Position := 0;
          SetLength(S, M.Size);
          M.Read(S[1], M.Size);
          InternetCloseHandle(UrlHandle);
          M.Position := 0;
          htmlFile := ChangeFileExt(ParamStr(0), '.html');//actual name of file to save
          M.SaveToFile(htmlFile);// save it
          ShowMessage('Webpage '+Edit1.Text+' saved as '+htmlFile+'');
        finally
          M.Free;
        end;
      end;
    end;
  finally
    InternetCloseHandle(NetHandle);
  end;
end;
...

Notes

The line below makes sure that we do not write an empty page to buffer

if BytesRead > 0 then  M.Write(Buffer, BytesRead);

By using

htmlFile := ChangeFileExt(ParamStr(0), '.html');

We change the name of your program by extension, so regardless of what the name is of your program the file saved will be 'your_program_name.html'. Note that the program saves the URL to the program directory where your main project is being executed from

That is it!

03. Enable copy and paste in your webbrowser

On a daily basis I copy and paste throughout my surfing here and there, so it was kind of disappointing that each time I started my custom webbrowser, that it would not copy and paste anything at all! Luckily this was easy to fix...

To enable the copy and paste feature in the right click menu do the following

1. In the unit1.pas source code add ActiveX to the user clause

...
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, OleCtrls, SHDocVw, WinInet, ActiveX;
...

2. At the bottom section of your program, in unit1.pas add the following code just before the 'End.':

...
  initialization
   OleInitialize(nil);
  finalization
   OleUnInitialize;
end.
...

04. Adding the standard IE Find menu

We are going to add the standard IE find menu, that will enables us to easily search for words, with or without capitals, and an option of highlighting the results

Especially when browsing huge text based websites, it can be handy if you are easily able to invoke the internet explorer menu that let's you find anything in your custom webbrowser...

Add the standard find menu to your webbrowser, here is how to

1. First add ActiveX to the uses clause it was added in the previous step but if you started from scratch make sure it is added

...
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, OleCtrls, SHDocVw, WinInet, ActiveX;
...

2. Add the procedure to the interface

...
type
    procedure FindIE;
...

3. Add the complete procedure and the following 3 constants

...
const
  HTMLID_FIND = 1;
  HTMLID_VIEWSOURCE = 2;
  HTMLID_OPTIONS = 3;

var
  Form1: TForm1;
implementation

{$R *.dfm}

procedure TForm1.FindIE;
const
  CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
var
  CmdTarget: IOleCommandTarget;
  vaIn, vaOut: OleVariant;
  PtrGUID: PGUID;
begin
  New(PtrGUID);
  PtrGUID^ := CGID_WebBrowser;
  if WebBrowser1.Document <> nil then
  try
    WebBrowser1.Document.QueryInterface(IOleCommandTarget, CmdTarget);
    if CmdTarget <> nil then
    try
      CmdTarget.Exec(PtrGUID, HTMLID_FIND, 0, vaIn, vaOut);
    finally
      CmdTarget._Release;
    end;
  except
    {Nothing}
  end;
  Dispose(PtrGUID);
end;
...

4. Drop a TButton on your form, if you followed the guide then this will be TButton3, add the OnClick event and change it accordingly

...
procedure TForm1.Button3Click(Sender: TObject);
begin
 FindIE;
end;
...

05. Enable editing the url you are going to visit

It is easy to do and maybe useful if you can edit the current url opened in your webbrowser.

I have added a checkbox that enables you to choose whether you want the next page you open to be editable or just like the normal read-only for browsing.

To be able to do this you could use the following approach. You will be needing a typelibrary, which you need to import:

Start up Delphi. On the Component menu in the main toolbar select Import ActiveX Control...

Import the typelibrary

In the list box scroll and then select Microsoft HTML Object Library. The Class names should then list TScriptlet.

Installing the ms html control

Click Install.... Then click OK and Yes on the confirm prompt.

Or use the added mshtml_tlb for delphi 7 but note that this is from a windows 7 system, I do not know whether this is important

1. Then add IniFiles and MSHTML_TLB to your uses clause:

...
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, OleCtrls, SHDocVw, WinInet, ActiveX, MSHTML_TLB,
  IniFiles;
...

2. Add IniFile to the private section

...
private
   FDownCount:    Integer;
   IniFile: TIniFile;
...

3. Drop a TCheckBox on your form, and give it a decent name like "EditMode" for instance

4. Select the TWebbrowser component and move to the tab events in the property
inspector, and then double click OnDocumentComplete and change it to the code below:

...
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
 const pDisp: IDispatch; var URL: OleVariant);
var
  CurrentWB: IWebBrowser;
  EditYes: Boolean;
begin
  Inifile := TIniFile.Create( Changefileext( application.exename, '.ini' ) );
  with Inifile do
  try
  CurrentWB := pDisp as IWebBrowser;
  EditYes := ReadBool( 'EditMode', 'LastChoice', False );
  CheckBox1.Checked := EditYes;
  if EditYes then
  (CurrentWB.Document as IHTMLDocument2).DesignMode := 'On'
  else
    (CurrentWB.Document as IHTMLDocument2).DesignMode := 'Off' 
   finally
      Free;
  end;
  end;
...

5. Let's create the procedure that writes the value to the inifile. We are going to alter the Button1Click event for that, change it into the following:

...
procedure TForm1.Button1Click(Sender: TObject);
var
  EditYes  : Boolean;
begin
FDownCount:=0;
Webbrowser1.Navigate(Edit1.Text);
  Inifile := TIniFile.Create( Changefileext( application.exename, '.ini' ) );
  EditYes := Checkbox1.Checked;
  with Inifile do
   try
      WriteBool( 'EditMode', 'LastChoice', EditYes );
    finally
      Free;
    end;
end;
...

Some notes, we are going to use an IniFile to store the choice of using editmode to open webpages or using the normal mode to surf. This will be a boolean value that can be true [1] or false [0]. We will name the inifile after the main program file, regardless of how you call your program later on, the inifile will automatically be named 'your_program.ini' by using the following line and will be saved in the directory from where your program is executed.

Changefileext( application.exename, '.ini' ) );

After the document download is complete, page is loaded in other words, we will try to read the value from that inifile:

EditYes := ReadBool( 'EditMode', 'LastChoice', False );

Where EditYes is the name of the variable to store the value EditMode is just the section name in the inifile and LastChoice is the identifier.

And in this case False is the default value. And ReadBool is the function to read values that are either True or False

CheckBox1.Checked := EditYes;

 if EditYes then

A checkbox can either be checked or not checked, True if checked and False if not checked in this case.

So "if EditYes then" means if the value EditYes is True, the checkbox is checked, we want to enter the EditMode with:

(CurrentWB.Document as IHTMLDocument2).DesignMode := 'On'

And if not, then we don't want to use it by

(CurrentWB.Document as IHTMLDocument2).DesignMode := 'Off'

Our inifile will look something like this:

[EditMode]
LastChoice=0

06. Adding the printer setup and page setup features

Always good to have the option of printing any page, and setting it up as well as chosing the default printer.

Here is how to add a print button, that directly prints the document, and also how to add a print preview button that invokes the preview setup dialog, as well as a button that invokes the page setup dialog.

1. Add a TButton to your form, it will be named Button4 if you followed the tutorial otherwise change it of course. Double click the OnClick event in the events tab of the object inspector and add:

...
procedure TForm1.Button4Click(Sender: TObject);
var
  vaIn, vaOut: OleVariant;
begin
  WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER,vaIn, vaOut);
end;
...

As you only can print a page when the document is fully loaded, we need to set this button to False in the property Active in the object inspector. And we will set it to True after a document has been loaded.

Pushing this button will directly print the page!

2. So we go to the Webbrowser1.DocumentComplete event and change it to:

...
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  CurrentWB: IWebBrowser;
  EditYes: Boolean;
begin
  Button4.Enabled := True;
  Inifile := TIniFile.Create( Changefileext( application.exename, '.ini' ) );
  with Inifile do
  try
  CurrentWB := pDisp as IWebBrowser;
  EditYes := ReadBool( 'EditMode', 'LastChoice', False );
  CheckBox1.Checked := EditYes;
  if EditYes then
  (CurrentWB.Document as IHTMLDocument2).DesignMode := 'On'
  else
    (CurrentWB.Document as IHTMLDocument2).DesignMode := 'Off'
 
   finally
      Free;
  end;
  end;
...

3. To add a printer setup and page setup button we follow the same approach roughly.

Drop two buttons on your forms, if you followed this tutorial they will be named Button5 and Button6, otherwise the procedure will be called differently of course.

Double click on the OnClick event of Button5 and add:

...
procedure TForm1.Button5Click(Sender: TObject);
var
  vaIn, vaOut: OleVariant;
begin
  WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, 
vaOut);
end;
...

For the page setup button do the same with Button6 and add:

...
procedure TForm1.Button6Click(Sender: TObject);
var
  vaIn, vaOut: OleVariant;
begin
  WebBrowser1.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut);
end;
...

4. Now all we need to do is set the Active property both to False, in the object inspector.

Then go to the Webbrowser1.DocumentComplete event of Webbrowser1 and add:

...
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  CurrentWB: IWebBrowser;
  EditYes: Boolean;
begin
  Button4.Enabled := True;
  Button5.Enabled := True;
  Button6.Enabled := True;
  Inifile := TIniFile.Create( Changefileext( application.exename, '.ini' ) );
  with Inifile do
  try
  CurrentWB := pDisp as IWebBrowser;
  EditYes := ReadBool( 'EditMode', 'LastChoice', False );
  CheckBox1.Checked := EditYes;
  if EditYes then
  (CurrentWB.Document as IHTMLDocument2).DesignMode := 'On'
  else
    (CurrentWB.Document as IHTMLDocument2).DesignMode := 'Off'
 
   finally
      Free;
  end;
  end;
...

We are enabling the print buttons after we have downloaded a webpage, since this webbrowser initially starts with a blank page there is nothing to print yet that is why those buttons are disabled at start

Important 6 and 7 are added to this one, since I accidentally added 5 two times:(

07. Create a menu to extract links from and save them

Sometimes you may wish to get all the valid links from the current page in your webbrowser, and filter out all of the other content. Doing that requires not that much of code and could be done using the approach below

1. Add a TButton to the form, if you followed the tutorial it will be Button7. Double click the OnClick event and change it to:

...
procedure TForm1.Button7Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to Webbrowser1.OleObject.Document.links.Length - 1 do
    Listbox1.Items.Add(Webbrowser1.OleObject.Document.Links.Item(i));
end;
...

2. Add a TListBox to your form

3. Add another TButton to your form to enable hiding the TListBox. But first set the Visible property in the object inspector to False. Then double click the Button8 to add the OnClick event and change the code like so:

...
procedure TForm1.Button8Click(Sender: TObject);
begin
 if  Listbox1.Visible = True then
  begin
    Listbox1.Visible := False;
 end;
end;
...

4. We will make the listbox visible only when we clicked the button for showing the links. Alter the OnClick event of Button7:

...
procedure TForm1.Button7Click(Sender: TObject);
var
  i: Integer;
begin
Listbox1.visible := True;
  for i := 0 to Webbrowser1.OleObject.Document.links.Length - 1 do
    Listbox1.Items.Add(Webbrowser1.OleObject.Document.Links.Item(i));
end;
...


5. As with many buttons, the OnDocumentComplete event is used to enable the Button7. Set its default state of Enabled to False in the property inspector. And alter the OnDocumentComplete event of webbrowser1 as follows:

...
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  CurrentWB: IWebBrowser;
  EditYes: Boolean;
begin
  Button4.Enabled := True;
  Button5.Enabled := True;
  Button6.Enabled := True;
  Button7.Enabled := True;
  Inifile := TIniFile.Create( Changefileext( application.exename, '.ini' ) );
  with Inifile do
  try
  CurrentWB := pDisp as IWebBrowser;
  EditYes := ReadBool( 'EditMode', 'LastChoice', False );
  CheckBox1.Checked := EditYes;
  if EditYes then
  (CurrentWB.Document as IHTMLDocument2).DesignMode := 'On'
  else
    (CurrentWB.Document as IHTMLDocument2).DesignMode := 'Off'
     finally
      Free;
  end;
  end;
...

6. Add another button for saving the links to a txt file, in this tutorial it will be Button9, double click to set the On Click event. I use the try finally in the event that any error occurs, it will end the procedure, which is better for the system resources...

...
procedure TForm1.Button9Click(Sender: TObject);
var
  linksFile : String;
begin
 try
   linksFile := ChangeFileExt(ParamStr(0), '.txt');
   Listbox1.Items.SaveToFile(linksFile);
   ShowMessage('Links from '+Edit1.Text+' saved as '+linksFile+'');
  finally
  end
end;
...

This button its Enabled state is set to False in the FormCreate event since the webbrowser does not have any links to save initially unless you change the start page of course.

...
procedure TForm1.FormCreate(Sender: TObject);
begin
 Button9.Enabled := False;
end;
...

And we set it to Enabled := True after we have populated the listbox with the links click:

...
procedure TForm1.Button7Click(Sender: TObject);
var
  i: Integer;
begin
  Button9.Enabled := True;
  Listbox1.Visible := True;
  for i := 0 to Webbrowser1.OleObject.Document.links.Length - 1 do
  Listbox1.Items.Add(Webbrowser1.OleObject.Document.Links.Item(i));
end;
...

7. Adding another button for clearing the listbox

...
procedure TForm1.Button10Click(Sender: TObject);
begin
 try
  listbox1.Clear;
 finally
 end
end;
...

08. Status of your internet connection and display it

It is always nice to know whether we are connected to the internet or not. To accomplish this I used the method below. It will show a red TLabel with the text Offline if we are not connected and it will show a green TLabel with the text Online if we are. This project looks a bit different than the previous ones if you look at the position of the controls.

1. Drop a TLabel on your form, it will be called Label1

2. Change the Caption text to 'Offline' and the font Color to clMaroon, and set fsBold to True

3. Add the following function to your webbrowser, somewhere at the bottom but before the initialization is where I placed it, as long as you keep ie before the initialization it is ok

...
function InternetConnected: Boolean;
const
  INTERNET_CONNECTION_MODEM = 1; 
  INTERNET_CONNECTION_LAN = 2; 
  INTERNET_CONNECTION_PROXY = 4; 
  INTERNET_CONNECTION_MODEM_BUSY = 8; 
var
  dwConnectionTypes: DWORD;
begin
  dwConnectionTypes :=
    INTERNET_CONNECTION_MODEM +
    INTERNET_CONNECTION_LAN +
    INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;
...

Some additional information about the connection types

INTERNET_CONNECTION_MODEM = 1; // local system uses a modem to connect to the Internet.
  INTERNET_CONNECTION_LAN = 2; // local system uses a local area network to connect to the Internet.
  INTERNET_CONNECTION_PROXY = 4; // local system uses a proxy server to connect to the Internet.
  INTERNET_CONNECTION_MODEM_BUSY = 8; // local system's modem is busy with a non-Internet connection.

4. Double click on the OnCreate event of the form and change it to:

...
procedure TForm1.FormCreate(Sender: TObject);
begin
 Button9.Enabled := False;
 if  InternetConnected then
 begin
  Label1.Caption := 'Online';
  Label1.Font.Color := clGreen;
 end;
end;
...

We are changing the Caption text in Online and the Font Color in clGreen, if that function we just added is True.

09. Change the default color of the TProgressbar

To make the progressbar stand out just a little bit more than the usual stuff, we can for instance begin to alter its color very easily.

1. To change the color of the progressbar you can add the following procedure in which Color needs to be declared as one of clGreen, or clRed and so on.

...
procedure SetBarColor(Component: TProgressBar; Color: TColor);
begin
  SendMessage(Component.Handle, 1033, 0, Color);
end;
...

2. Double click the FormCreate event and change it to the following

...
procedure TForm1.FormCreate(Sender: TObject);
begin
 SetBarColor( Progressbar1,clGreen);
 Button9.Enabled := False;
 if  InternetConnected then
 begin
  Label1.Caption := 'Online';
  Label1.Font.Color := clGreen;
 end;
end;
...

Notice the added line, it only needs the name of a TProgressbar and a color value in the form of clGreen etc

SetBarColor( Progressbar1, clGreen );

10. Placing your progressbar on top of a TStatusbar

Internet explorer has the ability to show a progressbar over a statusbar, we can create that exact same thing too if we want to. This is how.

1. Remove the existing progressbar if you are following this tutorial by deleting it, select it and delete it.

2. Add a standard TStatusbar to your form which will then be called TStatusBar1, and add a few panels to it, I added 4 which will be used later on. You will have to change it's size and position depending on where exactly you want to see it of course, in this tutorial is goes on top of the statusbar vertically aligned.

3. To the public section of the form class declaration, add:

...
public
 ProgressBar1: TProgressBar;
...

4. In the OnCreate event of the form, add and change to the following, if you have followed the tutorial then the code must be almost entirely identical to the code below

...
procedure TForm1.FormCreate(Sender: TObject);
var
  ProgressBarStyle: LongInt;
begin
  {create a run progress bar in the status bar}
  ProgressBar1 := TProgressBar.Create(StatusBar1);
  ProgressBar1.Parent := StatusBar1;
  {remove progress bar border}
  ProgressBarStyle := GetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE);
  ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
  SetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle);
  {set progress bar position and size - put in Panel[2]}
  ProgressBar1.Left := StatusBar1.Panels.Items[0].Width +
  StatusBar1.Panels.Items[1].Width + 4;
  ProgressBar1.Top := 4;
  ProgressBar1.Height := StatusBar1.Height - 6;
  ProgressBar1.Width := StatusBar1.Panels.Items[2].Width - 6;
  {set range and initial state}
  ProgressBar1.Min := 0;
  ProgressBar1.Max := 100;
  ProgressBar1.Step := 1;
  ProgressBar1.Position := 0;
  SetBarColor( Progressbar1,clYellow );
  Button9.Enabled := False;
  if  InternetConnected then
 begin
  Label1.Caption := 'Online';
  Label1.Font.Color := clGreen;
 end;
end;
...

5. Double click the OnDestroy event handler of the form, change it to:

...
procedure TForm1.FormDestroy(Sender: TObject);
begin
 ProgressBar1.free;
end;
...

Done, but you can play around with the settings for size and position etc like below:

...
  ProgressBar1.Top := 4;
  ProgressBar1.Height := StatusBar1.Height - 6;
  ProgressBar1.Width := StatusBar1.Panels.Items[2].Width - 6;
  {set range and initial state}
  ProgressBar1.Min := 0;
  ProgressBar1.Max := 100;
  ProgressBar1.Step := 1;
  ProgressBar1.Position := 0;
...

11. Displaying the MAC address in the TStatusbar panel

For some reason uploading the demo is not working, I will try again when I am at my other pc

To populate the TStatusbar panels with some useful and relevant information we can retrieve and display the MAC address of the current machine.

1. Add the NB30 unit to the uses clause, it is included in this archive and free to use for author information please see the last chapter of this tutorial

...
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, OleCtrls, SHDocVw, WinInet, ActiveX, MSHTML_TLB,
  IniFiles, HellConstraints, ExtCtrls, NB30;
...

2. Then add the following function to your program

...
function GetAdapterInfo(Lana: Char): string;
var
  Adapter: TAdapterStatus;
  NCB: TNCB;
begin
  FillChar(NCB, SizeOf(NCB), 0);
  NCB.ncb_command := Char(NCBRESET);
  NCB.ncb_lana_num := Lana;
  if Netbios(@NCB) <> Char(NRC_GOODRET) then
  begin
    Result := 'mac not found';
    Exit;
  end;
 
  FillChar(NCB, SizeOf(NCB), 0);
  NCB.ncb_command := Char(NCBASTAT);
  NCB.ncb_lana_num := Lana;
  NCB.ncb_callname := '*';
 
  FillChar(Adapter, SizeOf(Adapter), 0);
  NCB.ncb_buffer := @Adapter;
  NCB.ncb_length := SizeOf(Adapter);
  if Netbios(@NCB) <> Char(NRC_GOODRET) then
  begin
    Result := 'mac not found';
    Exit;
  end;
  Result :=
    IntToHex(Byte(Adapter.adapter_address[0]), 2) + '-' +
    IntToHex(Byte(Adapter.adapter_address[1]), 2) + '-' +
    IntToHex(Byte(Adapter.adapter_address[2]), 2) + '-' +
    IntToHex(Byte(Adapter.adapter_address[3]), 2) + '-' +
    IntToHex(Byte(Adapter.adapter_address[4]), 2) + '-' +
    IntToHex(Byte(Adapter.adapter_address[5]), 2);
end;
 
function GetMACAddress: string;
var
  AdapterList: TLanaEnum;
  NCB: TNCB;
begin
  FillChar(NCB, SizeOf(NCB), 0);
  NCB.ncb_command := Char(NCBENUM);
  NCB.ncb_buffer := @AdapterList;
  NCB.ncb_length := SizeOf(AdapterList);
  Netbios(@NCB);
  if Byte(AdapterList.length) > 0 then
    Result := GetAdapterInfo(AdapterList.lana[0])
  else
    Result := 'mac not found';
end;
...

3. I chose to add the function to the OnFormCreate event but you can as well drop another button that displays the MAC address, or any other way, whichever you like:

...
procedure TForm1.FormCreate(Sender: TObject);
var
  ProgressBarStyle: LongInt;
begin
 {create a run progress bar in the status bar}
  ProgressBar1 := TProgressBar.Create(StatusBar1);
  ProgressBar1.Parent := StatusBar1;
  {remove progress bar border}
  ProgressBarStyle := GetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE);
  ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
  SetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle);
  {set progress bar position and size - put in Panel[2]}
  ProgressBar1.Left := StatusBar1.Panels.Items[0].Width +
    StatusBar1.Panels.Items[1].Width + 4;
  ProgressBar1.Top := 4;
  ProgressBar1.Height := StatusBar1.Height - 6;
  ProgressBar1.Width := StatusBar1.Panels.Items[1].Width - 6;
  {set range and initial state}
  ProgressBar1.Min := 0;
  ProgressBar1.Max := 100;
  ProgressBar1.Step := 1;
  ProgressBar1.Position := 0;
  SetBarColor( Progressbar1,clYellow );
  Button9.Enabled := False;
  StatusBar1.Panels.Items[0].Text := GetMACAddress();
  if  InternetConnected then
 begin
  Label1.Caption := 'Online';
  Label1.Font.Color := clGreen;
 end;
end;
...

That should do the trick

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.