The Road to Delphi

Delphi – Free Pascal – Oxygene


1 Comment

New VCL Styles from DelphiStyles.com

A few days ago KSDev launched a new site, DelphiStyles.com,  this new place offers new FMX and VCL Styles.   I tested the VCL Styles  bundle and are just great,  the themes  looks modern, sleek  and polished.

So if you are looking  for a  professional looking FMX/VCL styles for you application this is the place to go.

Check out the  TOpenDialog component styled using the VCL Style Utils and the  DelphiStyles themes.

Material Black Pearl

Material Oxford Blue

Windows 10 Black Pearl

Windows 10 Oxford Blue

Thanks very much to the guys from DelphiStyle (KSDev) which kindly donated a VCL Styles bundle to The Road to Delphi.

Rodrigo.


3 Comments

TSMBIOS now supports Linux via Delphi 10.2 Tokyo.

I just uploaded a new version of the TSMBIOS library with support for Linux via Delphi 10.2 Tokyo. You can found a full description of the project in the Github site.

Check these screenshots of the demo applications running under ubuntu 16.04 LTS

rruz@ubuntu^% ~-PAServer-scratch-dir-RRUZ-Linux Ubuntu-ProcessorInformation_001rruz@ubuntu^% ~-PAServer-scratch-dir-RRUZ-Linux Ubuntu-ProcessorInformation_002rruz@ubuntu^% ~-PAServer-scratch-dir-RRUZ-Linux Ubuntu-ProcessorInformation_003

 

Now just a small note, the TSMBIOS  library access to the SMBIOS data reading the /dev/mem device file (which  provides direct access to system physical memory). So the applications which uses this library require being executed by an user with access to such file, typically a superuser.

Rodrigo.


5 Comments

TListView OwnerDraw compat with Windows UI & VCL Styles

There is a lot of resources of how ownerdraw a Delphi TListView, but most of them are deprecated and don’t take into account the VCL Styles and the StyleServices.

So on this post I will show you how you can ownerdraw a TListView to be compatible with the native Windows Look and feel and  the VCL Styles.

First,  there is lot of ways  to ownerdraw a TListView , but on this post we will focus only in the OnDrawItem event, because offers more flexibility than the OnCustomDrawXXX events  handlers .

The OnDrawItem is an event handler of type Vcl.ComCtrls.TLVDrawItemEvent

This is the definition of such event

TLVDrawItemEvent = procedure(Sender: TCustomListView;
Item: TListItem; Rect: TRect; State: TOwnerDrawState) of object;

Parameters

  • Sender : The ListView which is raising the event.
  • Item  : The list item which need to be drawn. (you can use this object to read the data of the ListView).
  • Rect : The bounds of the item (including the subitems).
  • State : The current state of item.

Note: Before to use the OnDrawItem event you must set the value of the property TListView.ownerdraw to True.


Ok, So I’m planning create a TListview in report mode and draw some controls like a checkbox and progressbar. These controls must looks perfect under the Windows UI and the VCL Styles.

I will start creating the columns of the TListview in runtime (just for personal preference.). I’m using a TDictionary to hold the columns reference in that way I prevent create one variable per column and also I can access the columns by a Name.

procedure TFrmMain.AddColumns;

  Procedure AddColumn(const AColumnName : String; AWidth : Integer; AColumnType : TColumnType);
  begin
   FColumns.Add(AColumnName, LvSampleData.Columns.Add());
   FColumns[AColumnName].Caption := AColumnName;
   FColumns[AColumnName].Width   := AWidth;
   FColumns[AColumnName].Tag     := Integer(AColumnType);
  end;

begin
   FColumns  := TDictionary<string, TListColumn>.Create();
   AddColumn('Text', 150, ctText);
   AddColumn('Porc', 100, ctProgress);
   AddColumn('Text2', 150, ctText);
   AddColumn('Enabled', 100, ctCheck);
end;

Please pay attention to the Tag property of the Columns, I’m using this to store the type of the column (TColumnType is a custom type).

 TColumnType = (ctText, ctCheck, ctProgress);

Next we need fill the listview with some sample data (This doesn’t requires much explanation right?).

const
 MaxItems = 100;
var
 LItem : TListItem;
 i : Integer;
begin
  Randomize;
  LvSampleData.Items.BeginUpdate;
  try
    for i := 0 to MaxItems - 1 do
    begin
      LItem := LvSampleData.Items.Add;
      LItem.Caption:= Format('Sample text', []);
      LItem.SubItems.Add(IntToStr(Random(101)));
      LItem.SubItems.Add(Format('Sample text 2', []));
      LItem.SubItems.Add(IntToStr(Random(2)));
    end;
  finally
    LvSampleData.Items.EndUpdate;
  end;
end;

And now I can start to  draw the TListView items using the the OnDrawItem event.

First I will store a reference to the StyleServices function (In this way I’m avoiding call the same function again and again).

Note  : The StyleServices  method returns an instance of a TCustomStyleServices type, which allow to gain access to all the styling functionality of the current active style (Windows or VCL Style).

Next I will erase any previous content of the current row by filling with the current clWindow color.

Check how the clWindow const is used in the TCustomStyleServices.GetSystemColor function to return the current Window Background color.

procedure TFrmMain.LvSampleDataDrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
...
...
begin
  LStyleService  := StyleServices;
  if not LStyleService.Enabled then exit;

  Sender.Canvas.Brush.Style := bsSolid;
  Sender.Canvas.Brush.Color := LStyleService.GetSystemColor(clWindow);
  Sender.Canvas.FillRect(Rect);

  LRect := Rect;

Now I will iterate over all the columns of the Listview resolving the current column type, the text stored in the current item and calculating the bounds of the current item.

...
...
  for i := 0 to TListView(Sender).Columns.Count - 1 do
  begin
    LColummnType := TColumnType(TListView(Sender).Columns[i].Tag);
    LRect.Right  := LRect.Left + Sender.Column[i].Width;

    LText := '';
    if i = 0 then
      LText := Item.Caption
    else
    if (i - 1) <= Item.SubItems.Count - 1 then
      LText := Item.SubItems[i - 1];
....
....

Note : The OnDrawItem event is raised once per each row of the ListView, So you must draw all the items and subitems yourself).

Now depending of the column type (Text, CheckBox or ProgressBar) I will draw the item.

Text

For the columns of type text (ctText), I check if the State of the item is Selected or Hot and Draw the highlight bar (using the  TCustomStyleServices.DrawElement method) and finally the text is rendered using the TCustomStyleServices.DrawText function.

Check how the color of the text is selected depending of the state of the item.

      ctText:  begin

                  LDetails := LStyleService.GetElementDetails(tgCellNormal);
                  LColor := LStyleService.GetSystemColor(clWindowText);
                  if ([odSelected, odHotLight] * State <> []) then
                  begin
                     LDetails := LStyleService.GetElementDetails(tgCellSelected);
                     LColor := LStyleService.GetSystemColor(clHighlightText);
                     LStyleService.DrawElement(Sender.Canvas.Handle, LDetails, LRect);
                  end;

                  LRect2 := LRect;
                  LRect2.Left := LRect2.Left + ListView_Padding;

                  LTextFormat := TTextFormatFlags(DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS);
                  LStyleService.DrawText(Sender.Canvas.Handle, LDetails, LText, LRect2, LTextFormat, LColor);
               end;

CheckBox

For the checkbox columns, the process start in the same way, first check if the item is highlighted and then the bar is drawn.

Then I calculate the bounds of the checkbox and get the text for the column. (for this sample the Value 1 means checked otherwise means unchecked).

Now according to the value and the state of the checkbox is draw.

Please pay attention to how the the element to be drawn is selected depending of the current state and the current text.

      ctCheck: begin
                  if ([odSelected, odHotLight] * State <> []) then
                  begin
                     LDetails := LStyleService.GetElementDetails(tgCellSelected);
                     LStyleService.DrawElement(Sender.Canvas.Handle, LDetails, LRect);
                  end;

                  LSize.cx := GetSystemMetrics(SM_CXMENUCHECK);
                  LSize.cy := GetSystemMetrics(SM_CYMENUCHECK);

                  LRect2.Top    := Rect.Top + (Rect.Bottom - Rect.Top - LSize.cy) div 2;
                  LRect2.Bottom := LRect2.Top + LSize.cy;
                  LRect2.Left   := LRect.Left + ((LRect.Width - LSize.cx) div 2);
                  LRect2.Right  := LRect2.Left + LSize.cx;

                  if (LText = '1') then
                  begin
                    if ([odSelected, odHotLight] * State <> []) then
                      LDetails := LStyleService.GetElementDetails(tbCheckBoxCheckedHot)
                    else
                      LDetails := LStyleService.GetElementDetails(tbCheckBoxCheckedNormal);
                  end
                  else
                  begin
                    if ([odSelected, odHotLight] * State <> []) then
                      LDetails := LStyleService.GetElementDetails(tbCheckBoxUncheckedHot)
                    else
                      LDetails := LStyleService.GetElementDetails(tbCheckBoxUncheckedNormal);
                  end;
                  LStyleService.DrawElement(Sender.Canvas.Handle, LDetails, LRect2);
               end;

ProgressBar

Finally for the progressbar columns, after of check the current state I draw the frame of the progress bar by using the tpBar element, then getting the current value for the column I calculate the bounds of the chunks to be draw. Then depending of the value I fill the progress bar with a solid color or with the element of the current style.

      ctProgress:
               begin
                  if ([odSelected, odHotLight] * State <> []) then
                  begin
                     LDetails := LStyleService.GetElementDetails(tgCellSelected);
                     LStyleService.DrawElement(Sender.Canvas.Handle, LDetails, LRect);
                  end;

                  LRect2   := ResizeRect(LRect, 2, 2, 2, 2);
                  LDetails := LStyleService.GetElementDetails(tpBar);
                  LStyleService.DrawElement(Sender.Canvas.Handle, LDetails, LRect2);

                  if not TryStrToInt(LText, p) then  p := 0;

                  InflateRect(LRect2, -1, -1);
                  LRect2.Right := LRect2.Left + Round(LRect2.Width * p / 100);

                  if p < 20 then
                  begin
                    Sender.Canvas.Brush.Style := bsSolid;
                    Sender.Canvas.Brush.Color := clWebFirebrick;
                    Sender.Canvas.FillRect(LRect2);
                  end
                  else
                  if p < 50 then
                  begin
                    Sender.Canvas.Brush.Style := bsSolid;
                    Sender.Canvas.Brush.Color := clWebGold;
                    Sender.Canvas.FillRect(LRect2);
                  end
                  else
                  begin
                    LDetails := LStyleService.GetElementDetails(tpChunk);
                    LStyleService.DrawElement(Sender.Canvas.Handle, LDetails, LRect2);
                  end;
                end;

This is the final result of the code

Glow

Windows10Dark

WindowsUI

As you can see the list view is draw consistently under Windows or when a custom Style is used.

The full source code is available on Github.


4 Comments

Using the Network List Manager (NLM) API from Delphi

Network-Internet-Connection-iconThe Network List Manager (NLM) API (introduced on Windows Vista) allows you to retrieve a list of available connections and properties of each network .Also the  NLM API  support notifications (events) about the availability of new network connections or changes to existing network connections. This API is useful for  filter networks, based on his attributes and signatures. Also  you can use this API in your own  Application to adjust their logic depending on: which network they are connected to; or what the network properties are.

 

Ok, So the first step to use this API from Delphi is import the Network List Manager Type Library (C:\WINDOWS\system32\netprofm.dll) from the option Component-> Import Component as is show below.

 

Wizard1

Wizard2

After of this the NETWORKLIST_TLB unit will be created containing all the Interfaces, Types and Enumerations of the NLM API.

Note: Depending of  your Windows version the content of the imported type library can change, because some additional Interfaces and types was added in Windows 8.

INetworkListManager

The INetworkListManager is the main interface to access the methods to perform  NLM API functions Like enumerate Networks, Connections and check the overall connectivity state of the current machine.

This is the definition of the INetworkListManager interface.

  INetworkListManager = interface(IDispatch)
    ['{DCB00000-570F-4A9B-8D69-199FDBA5723B}']
    function GetNetworks(Flags: NLM_ENUM_NETWORK): IEnumNetworks; safecall;
    function GetNetwork(gdNetworkId: TGUID): INetwork; safecall;
    function GetNetworkConnections: IEnumNetworkConnections; safecall;
    function GetNetworkConnection(gdNetworkConnectionId: TGUID): INetworkConnection; safecall;
    function Get_IsConnectedToInternet: WordBool; safecall;
    function Get_IsConnected: WordBool; safecall;
    function GetConnectivity: NLM_CONNECTIVITY; safecall;
    procedure SetSimulatedProfileInfo(var pSimulatedInfo: NLM_SIMULATED_PROFILE_INFO); safecall; //Introduced on Windows 8.1
    procedure ClearSimulatedProfileInfo; safecall; //Introduced on Windows 8.1
    property IsConnectedToInternet: WordBool read Get_IsConnectedToInternet;
    property IsConnected: WordBool read Get_IsConnected;
  end;

In order to access to this interface you must declare a INetworkListManager variable and call the CoNetworkListManager.Create; method to get an instance to such Interface.

Check the next sample console application which shows the current connectivity of the machine and if the internet connection is available.

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ActiveX,
  ComObj,
  Windows,
  NETWORKLIST_TLB in 'NETWORKLIST_TLB.pas';


//https://msdn.microsoft.com/en-us/library/windows/desktop/aa370795(v=vs.85).aspx
function GetNetworkConnectivity(Connectivity : NLM_CONNECTIVITY) : string;
begin
 Result:='';
    if NLM_CONNECTIVITY_DISCONNECTED and Connectivity <> 0 then  Result := Result+ 'Disconnected, ';
    if NLM_CONNECTIVITY_IPV4_NOTRAFFIC and Connectivity <> 0 then  Result := Result+ 'Connected but not ipv4 traffic, ';
    if NLM_CONNECTIVITY_IPV6_NOTRAFFIC  and Connectivity <> 0 then  Result := Result+  'Connected but not ipv6 traffic, ';
    if NLM_CONNECTIVITY_IPV4_SUBNET  and Connectivity <> 0 then  Result := Result+  'Subnet ipv4, ';
    if NLM_CONNECTIVITY_IPV4_LOCALNETWORK  and Connectivity <> 0 then  Result := Result+  'LocalNetwork ipv4, ';
    if NLM_CONNECTIVITY_IPV4_INTERNET  and Connectivity <> 0 then  Result := Result+  'Internet ipv4, ';
    if NLM_CONNECTIVITY_IPV6_SUBNET  and Connectivity <> 0 then  Result := Result+  'Subnet ipv6, ';
    if NLM_CONNECTIVITY_IPV6_LOCALNETWORK  and Connectivity <> 0 then  Result := Result+ 'LocalNetwork ipv6, ';
    if NLM_CONNECTIVITY_IPV6_INTERNET  and Connectivity <> 0 then  Result := Result+'Internet ipv6, ';

    Result:= StringReplace('['+Result+']', ', ]', ']', [rfReplaceAll]);
end;


procedure GetNetworkListManagerInfo;
var
  NetworkListManager: INetworkListManager;
begin
  NetworkListManager := CoNetworkListManager.Create;
  Writeln(Format('Connected       : %s', [boolToStr(NetworkListManager.IsConnected, True)]));
  Writeln(Format('Internet        : %s', [boolToStr(NetworkListManager.IsConnectedToInternet, True)]));
  Writeln(Format('Connectivity    : %s', [GetNetworkConnectivity(NetworkListManager.GetConnectivity)]));
end;

begin
 try
  //Check is Windows Vista at least
  if TOSVersion.Check(6) then
   begin
      CoInitialize(nil);
      try
        GetNetworkListManagerInfo;
      finally
        CoUninitialize;
      end;
   end
   else
   Writeln('This windows version doesn''t support the NLM API');
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message, E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

Enumerating Connections

The NLM API allow you to enumerate network connections using the INetworkListManager.GetNetworkConnections method, this function returns an instance to the IEnumNetworkConnections interface that enumerates all network connections on the machine, each element returned by the IEnumNetworkConnections.Next method represents a INetworkConnection object.

  INetworkConnection = interface(IDispatch)
    ['{DCB00005-570F-4A9B-8D69-199FDBA5723B}']
    function GetNetwork: INetwork; safecall;
    function Get_IsConnectedToInternet: WordBool; safecall;
    function Get_IsConnected: WordBool; safecall;
    function GetConnectivity: NLM_CONNECTIVITY; safecall;
    function GetConnectionId: TGUID; safecall;
    function GetAdapterId: TGUID; safecall;
    function GetDomainType: NLM_DOMAIN_TYPE; safecall;
    property IsConnectedToInternet: WordBool read Get_IsConnectedToInternet;
    property IsConnected: WordBool read Get_IsConnected;
  end;

Check the next sample console application which shows how enumerate the connections with his connectivity, domain type, network adapters associated and so on.

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ActiveX,
  ComObj,
  Windows,
  NETWORKLIST_TLB in 'NETWORKLIST_TLB.pas';


//https://msdn.microsoft.com/en-us/library/windows/desktop/aa370796(v=vs.85).aspx
function GetNetworkDomainType(DomainType : NLM_DOMAIN_TYPE) : string;
begin
 Result:='';
  case DomainType of
    NLM_DOMAIN_TYPE_NON_DOMAIN_NETWORK   : Result := 'Non Domain Network'; //The Network is not an Active Directory Network
    NLM_DOMAIN_TYPE_DOMAIN_NETWORK       : Result := 'Domain Network';//The Network is an Active Directory Network, but this machine is not authenticated against it.
    NLM_DOMAIN_TYPE_DOMAIN_AUTHENTICATED : Result := 'Domain Network Authenticated';//The Network is an Active Directory Network, and this machine is authenticated against it.
  end;
end;


//https://msdn.microsoft.com/en-us/library/windows/desktop/aa370795(v=vs.85).aspx
function GetNetworkConnectivity(Connectivity : NLM_CONNECTIVITY) : string;
begin
 Result:='';
    if NLM_CONNECTIVITY_DISCONNECTED and Connectivity <> 0 then  Result := Result+ 'Disconnected, ';
    if NLM_CONNECTIVITY_IPV4_NOTRAFFIC and Connectivity <> 0 then  Result := Result+ 'Connected but not ipv4 traffic, ';
    if NLM_CONNECTIVITY_IPV6_NOTRAFFIC  and Connectivity <> 0 then  Result := Result+  'Connected but not ipv6 traffic, ';
    if NLM_CONNECTIVITY_IPV4_SUBNET  and Connectivity <> 0 then  Result := Result+  'Subnet ipv4, ';
    if NLM_CONNECTIVITY_IPV4_LOCALNETWORK  and Connectivity <> 0 then  Result := Result+  'LocalNetwork ipv4, ';
    if NLM_CONNECTIVITY_IPV4_INTERNET  and Connectivity <> 0 then  Result := Result+  'Internet ipv4, ';
    if NLM_CONNECTIVITY_IPV6_SUBNET  and Connectivity <> 0 then  Result := Result+  'Subnet ipv6, ';
    if NLM_CONNECTIVITY_IPV6_LOCALNETWORK  and Connectivity <> 0 then  Result := Result+ 'LocalNetwork ipv6, ';
    if NLM_CONNECTIVITY_IPV6_INTERNET  and Connectivity <> 0 then  Result := Result+'Internet ipv6, ';

    Result:= StringReplace('['+Result+']', ', ]', ']', [rfReplaceAll]);
end;


procedure GetConnections;
var
  NetworkListManager: INetworkListManager;
  EnumNetworkConnections: IEnumNetworkConnections;
  NetworkConnection : INetworkConnection;
  pceltFetched: ULONG;
begin
   NetworkListManager := CoNetworkListManager.Create;
   EnumNetworkConnections :=  NetworkListManager.GetNetworkConnections();
   while true do
   begin
     EnumNetworkConnections.Next(1, NetworkConnection, pceltFetched);
     if (pceltFetched>0)  then
     begin
        Writeln(Format('Adapter Id      : %s', [GuidToString(NetworkConnection.GetAdapterId)]));
        Writeln(Format('Connection Id   : %s', [GuidToString(NetworkConnection.GetConnectionId)]));
        Writeln(Format('Domain Type     : %s', [GetNetworkDomainType(NetworkConnection.GetDomainType)]));
        Writeln(Format('Connected       : %s', [boolToStr(NetworkConnection.IsConnected, True)]));
        Writeln(Format('Internet        : %s', [boolToStr(NetworkConnection.IsConnectedToInternet, True)]));
        Writeln(Format('Network         : %s', [NetworkConnection.GetNetwork.GetName]));
        Writeln(Format('Connectivity    : %s', [GetNetworkConnectivity(NetworkConnection.GetConnectivity)]));
     end
     else
     Break;
   end;
end;

begin
 try
   //Check is Windows Vista at least
   if TOSVersion.Check(6) then
   begin
      CoInitialize(nil);
      try
        GetConnections;
      finally
        CoUninitialize;
      end;
   end
   else
   Writeln('This windows version doesn''t support the NLM API');
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

Enumerating Networks

For enumerate the networks available on the local machine you must use the INetworkListManager.GetNetworks method passing a valid NLM_ENUM_NETWORK value.

  • NLM_ENUM_NETWORK_CONNECTED Returns connected networks
  • NLM_ENUM_NETWORK_DISCONNECTED Returns disconnected networks
  • NLM_ENUM_NETWORK_ALL Returns connected and disconnected networks

from here you can gain access to several elements related to the network like Name, Description, Connectivity, Network Category and the local date and time when the network was created and connected.

Sample code to enumerate the networks using the NLM API

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ActiveX,
  ComObj,
  Windows,
  NETWORKLIST_TLB in 'NETWORKLIST_TLB.pas';


//https://msdn.microsoft.com/en-us/library/windows/desktop/aa370796(v=vs.85).aspx
function GetNetworkDomainType(DomainType : NLM_CONNECTIVITY) : string;
begin
 Result:='';
  case DomainType of
    NLM_DOMAIN_TYPE_NON_DOMAIN_NETWORK   : Result := 'Non Domain Network'; //The Network is not an Active Directory Network
    NLM_DOMAIN_TYPE_DOMAIN_NETWORK       : Result := 'Domain Network';//The Network is an Active Directory Network, but this machine is not authenticated against it.
    NLM_DOMAIN_TYPE_DOMAIN_AUTHENTICATED : Result := 'Domain Network Authenticated';//The Network is an Active Directory Network, and this machine is authenticated against it.
  end;
end;

function GetNetworkCategory(Category : NLM_NETWORK_CATEGORY) : string;
begin
 Result:='';
  case Category of
    NLM_NETWORK_CATEGORY_PUBLIC               : Result := 'Public';
    NLM_NETWORK_CATEGORY_PRIVATE              : Result := 'Private';
    NLM_NETWORK_CATEGORY_DOMAIN_AUTHENTICATED : Result := 'Authenticated';
  end;
end;

procedure GetNetworks;
var
  NetworkListManager: INetworkListManager;
  EnumNetworks: IEnumNetworks;

  EnumNetworksConnections: IEnumNetworkConnections;
  NetworkConnection : INetworkConnection;

  Network: INetwork;
  fetched, pceltFetched: ULONG;

  pdwLowDateTimeCreated: LongWord;
  pdwHighDateTimeCreated: LongWord;
  pdwLowDateTimeConnected: LongWord;
  pdwHighDateTimeConnected: LongWord;

  lpFileTime : TFileTime;
  lpSystemTime: TSystemTime;
  LDateTime : TDateTime;
begin
   NetworkListManager := CoNetworkListManager.Create;
   EnumNetworks :=  NetworkListManager.GetNetworks(NLM_ENUM_NETWORK_CONNECTED);
   while true do
   begin
     EnumNetworks.Next(1, Network, fetched);
     if (fetched>0)  then
     begin
       Writeln(Format('%s - %s', [Network.GetName, Network.GetDescription]));
       Writeln(Format('Network Id  : %s', [GuidToString(Network.GetNetworkId)]));
       Writeln(Format('Domain Type : %s', [GetNetworkDomainType(Network.GetDomainType)]));
       Writeln(Format('Category    : %s', [GetNetworkCategory(Network.GetCategory)]));

       //https://msdn.microsoft.com/en-us/library/windows/desktop/aa370787(v=vs.85).aspx
       Network.GetTimeCreatedAndConnected(pdwLowDateTimeCreated, pdwHighDateTimeCreated, pdwLowDateTimeConnected, pdwHighDateTimeConnected);

       lpFileTime.dwLowDateTime := pdwLowDateTimeCreated;
       lpFileTime.dwHighDateTime := pdwHighDateTimeCreated;
       if FileTimeToSystemTime(lpFileTime, lpSystemTime) then
       begin
          LDateTime := SystemTimeToDateTime(lpSystemTime);
          Writeln('Created         : '+FormatDateTime('dd/mm/yyyy hh:nn', LDateTime));
       end;

       lpFileTime.dwLowDateTime := pdwLowDateTimeConnected;
       lpFileTime.dwHighDateTime := pdwHighDateTimeConnected;
       if FileTimeToSystemTime(lpFileTime, lpSystemTime) then
       begin
          LDateTime := SystemTimeToDateTime(lpSystemTime);
          Writeln('Last Connection : '+FormatDateTime('dd/mm/yyyy hh:nn', LDateTime));
       end;

       Writeln(Format('Connected       : %s', [boolToStr(Network.IsConnected, True)]));
       Writeln(Format('Internet        : %s', [boolToStr(Network.IsConnectedToInternet, True)]));

         EnumNetworksConnections := Network.GetNetworkConnections();

         Writeln;
         Writeln('Connections');
         Writeln('-----------');
         while true do
         begin
            EnumNetworksConnections.Next(1, NetworkConnection, pceltFetched);
              if (pceltFetched>0)  then
              begin
                Writeln(Format('  Adapter Id    : %s', [GuidToString(NetworkConnection.GetAdapterId)]));
                Writeln(Format('  Connection Id : %s', [GuidToString(NetworkConnection.GetConnectionId)]));
              end
              else
              break;
         end;
       Writeln;
     end
     else
     Break;
   end;
end;

begin
 try
   //Check is Windows Vista at least
   if TOSVersion.Check(6) then
   begin
      CoInitialize(nil);
      try
        GetNetworks;
      finally
        CoUninitialize;
      end;
   end
   else
   Writeln('This windows version doesn''t support the NLM API');
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

Events

The NML API exposes several events (notifications) that you Application must implements to get network related events. These callback functions that are called automatically when the respective events are raised.

These are the notifications interfaces available on the NLM API

Note : The next sample shows how subscribe to the INetworkEvents only. I will leave it as reader’s exercise the implementation of the another events.

The INetworkEvents interface can inform when a Network was added, deleted or modified. To receive the notifications related to these events you must inherit a class from this interface and implement the next methods.

  INetworkEvents = interface(IUnknown)
    ['{DCB00004-570F-4A9B-8D69-199FDBA5723B}']
    function NetworkAdded(networkId: TGUID): HResult; stdcall;
    function NetworkDeleted(networkId: TGUID): HResult; stdcall;
    function NetworkConnectivityChanged(networkId: TGUID; newConnectivity: NLM_CONNECTIVITY): HResult; stdcall;
    function NetworkPropertyChanged(networkId: TGUID; Flags: NLM_NETWORK_PROPERTY_CHANGE): HResult; stdcall;
  end;

then you need get an instance to the IConnectionPointContainer interface, after using the IConnectionPointContainer.FindConnectionPoint return a connection point for the interface and finally call the IConnectionPoint.Advise method to establish the connection with the event.

   NetworkListManager := CoNetworkListManager.Create;
    if Succeeded(NetworkListManager.QueryInterface(IID_IConnectionPointContainer, LConnectionPointContainer)) then
      if Succeeded(LConnectionPointContainer.FindConnectionPoint(IID_INetworkEvents, LConnectionPoint)) then
        LConnectionPoint.Advise(Self as IUnknown, dwCookie);

When you not longer need to use the event, you must to terminate the advisory connection previously established with the connection point using the IConnectionPoint.Unadvise method.

  if Succeeded(NetworkListManager.QueryInterface(IID_IConnectionPointContainer, LConnectionPointContainer)) then
    if Succeeded(LConnectionPointContainer.FindConnectionPoint(IID_INetworkEvents, LConnectionPoint)) then
    begin
      LConnectionPoint.Unadvise(dwCookie);
      LConnectionPoint := nil;
    end;

Check the next sample console application which implements the INetworkEvents interface.

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  {$IF CompilerVersion > 18.5}
  Vcl.Forms,
  {$IFEND }
  System.SysUtils,
  Winapi.ActiveX,
  System.Win.ComObj,
  NETWORKLIST_TLB in 'NETWORKLIST_TLB.pas';

 type
  TNetworkEvents = class(TInterfacedObject, INetworkEvents)
  private
   NetworkListManager :  INetworkListManager;
   dwCookie : Integer;
  public
    function NetworkAdded(networkId: TGUID): HResult; stdcall;
    function NetworkDeleted(networkId: TGUID): HResult; stdcall;
    function NetworkConnectivityChanged(networkId: TGUID; newConnectivity: NLM_CONNECTIVITY): HResult; stdcall;
    function NetworkPropertyChanged(networkId: TGUID; Flags: NLM_NETWORK_PROPERTY_CHANGE): HResult; stdcall;
    constructor Create;
    procedure Start;
    procedure Stop;
  end;

//Detect when a key was pressed in the console window
function KeyPressed:Boolean;
var
  lpNumberOfEvents     : DWORD;
  lpBuffer             : TInputRecord;
  lpNumberOfEventsRead : DWORD;
  nStdHandle           : THandle;
begin
  Result:=false;
  nStdHandle := GetStdHandle(STD_INPUT_HANDLE);
  lpNumberOfEvents:=0;
  GetNumberOfConsoleInputEvents(nStdHandle, lpNumberOfEvents);
  if (lpNumberOfEvents<> 0) then
  begin
    PeekConsoleInput(nStdHandle, lpBuffer, 1, lpNumberOfEventsRead);
    if lpNumberOfEventsRead <> 0 then
    begin
      if lpBuffer.EventType = KEY_EVENT then
      begin
        if lpBuffer.Event.KeyEvent.bKeyDown then
          Result:=true
        else
          FlushConsoleInputBuffer(nStdHandle);
      end
      else
      FlushConsoleInputBuffer(nStdHandle);
    end;
  end;
end;

//https://msdn.microsoft.com/en-us/library/windows/desktop/aa370795(v=vs.85).aspx
function GetNetworkConnectivity(Connectivity : NLM_CONNECTIVITY) : string;
begin
 Result:='';
    if NLM_CONNECTIVITY_DISCONNECTED and Connectivity <> 0 then  Result := Result+ 'Disconnected, ';
    if NLM_CONNECTIVITY_IPV4_NOTRAFFIC and Connectivity <> 0 then  Result := Result+ 'Connected but not ipv4 traffic, ';
    if NLM_CONNECTIVITY_IPV6_NOTRAFFIC  and Connectivity <> 0 then  Result := Result+  'Connected but not ipv6 traffic, ';
    if NLM_CONNECTIVITY_IPV4_SUBNET  and Connectivity <> 0 then  Result := Result+  'Subnet ipv4, ';
    if NLM_CONNECTIVITY_IPV4_LOCALNETWORK  and Connectivity <> 0 then  Result := Result+  'LocalNetwork ipv4, ';
    if NLM_CONNECTIVITY_IPV4_INTERNET  and Connectivity <> 0 then  Result := Result+  'Internet ipv4, ';
    if NLM_CONNECTIVITY_IPV6_SUBNET  and Connectivity <> 0 then  Result := Result+  'Subnet ipv6, ';
    if NLM_CONNECTIVITY_IPV6_LOCALNETWORK  and Connectivity <> 0 then  Result := Result+ 'LocalNetwork ipv6, ';
    if NLM_CONNECTIVITY_IPV6_INTERNET  and Connectivity <> 0 then  Result := Result+'Internet ipv6, ';

    Result:= StringReplace('['+Result+']', ', ]', ']', [rfReplaceAll]);
end;

//https://msdn.microsoft.com/en-us/library/windows/desktop/aa370801(v=vs.85).aspx
function GetNetworkPropertyChange(PropertyChange : NLM_NETWORK_PROPERTY_CHANGE) : string;
begin
 Result:='';
    if NLM_NETWORK_PROPERTY_CHANGE_CONNECTION and PropertyChange <> 0 then  Result := Result+ 'Connection, ';
    if NLM_NETWORK_PROPERTY_CHANGE_DESCRIPTION and PropertyChange <> 0 then  Result := Result+ 'Description, ';
    if NLM_NETWORK_PROPERTY_CHANGE_NAME  and PropertyChange <> 0 then  Result := Result+  'Name, ';
    if NLM_NETWORK_PROPERTY_CHANGE_ICON  and PropertyChange <> 0 then  Result := Result+  'Icon, ';
    if NLM_NETWORK_PROPERTY_CHANGE_CATEGORY_VALUE  and PropertyChange <> 0 then  Result := Result+  'Category value, ';

    Result:= StringReplace('['+Result+']', ', ]', ']', [rfReplaceAll]);

end;

{ TNetworkEvents }
const
  IID_IConnectionPointContainer: TGUID = (
    D1:$B196B284;D2:$BAB4;D3:$101A;D4:($B6,$9C,$00,$AA,$00,$34,$1D,$07));

constructor TNetworkEvents.Create;
begin
  dwCookie := 0;
end;

function TNetworkEvents.NetworkAdded(networkId: TGUID): HResult;
begin
  Writeln(Format('Network Added : %s', [GuidToString(networkId)]));
  Result := S_OK;
end;

function TNetworkEvents.NetworkConnectivityChanged(networkId: TGUID;
  NewConnectivity: NLM_CONNECTIVITY): HResult;
begin
  Writeln(Format('Network Connectivity Changed : %s - %s', [GuidToString(networkId), GetNetworkConnectivity(NewConnectivity)]));
  Result := S_OK;
end;

function TNetworkEvents.NetworkDeleted(networkId: TGUID): HResult;
begin
  Writeln(Format('Network Deleted : %s', [GuidToString(networkId)]));
  Result := S_OK;
end;

function TNetworkEvents.NetworkPropertyChanged(networkId: TGUID; Flags: NLM_NETWORK_PROPERTY_CHANGE): HResult;
begin
  Writeln(Format('Network Property Changed : %s - %s', [GuidToString(networkId), GetNetworkPropertyChange(Flags)]));
  Result := S_OK;
end;

procedure TNetworkEvents.Start;
var
  LConnectionPointContainer: IConnectionPointContainer;
  LConnectionPoint: IConnectionPoint;
begin
  if dwCookie > 0 then exit;
   NetworkListManager := CoNetworkListManager.Create;
    if Succeeded(NetworkListManager.QueryInterface(IID_IConnectionPointContainer, LConnectionPointContainer)) then
    begin
      if Succeeded(LConnectionPointContainer.FindConnectionPoint(IID_INetworkEvents, LConnectionPoint)) then
      begin
        LConnectionPoint.Advise(Self as IUnknown, dwCookie);
        LConnectionPoint := nil;
      end;
    end;
end;

procedure TNetworkEvents.Stop;
var
  LConnectionPointContainer: IConnectionPointContainer;
  LConnectionPoint: IConnectionPoint;
begin
  if dwCookie = 0 then exit;
  if Succeeded(NetworkListManager.QueryInterface(IID_IConnectionPointContainer, LConnectionPointContainer)) then
    if Succeeded(LConnectionPointContainer.FindConnectionPoint(IID_INetworkEvents, LConnectionPoint)) then
    begin
      LConnectionPoint.Unadvise(dwCookie);
      LConnectionPoint := nil;
    end;
end;

var
   NLMEvents : TNetworkEvents;
begin
 try
    //Check is Windows Vista at least
   if TOSVersion.Check(6) then
   begin
    NLMEvents:=TNetworkEvents.Create;
    try
      NLMEvents.Start;
      Writeln('Listening NLM events - press any key to stop');
      //The next loop is only necessary on this sample console App
      //In VCL forms Apps you don't need use a loop
      while not KeyPressed do
      begin
          Sleep(100);
          Application.ProcessMessages;
      end;
    finally
      NLMEvents.Stop;
      Writeln('NLM events - Done');
    end;
   end
   else
   Writeln('This windows version doesn''t support the NLM API');
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;

 Readln;
end.

All the source code posted on this article is available on Github.

Rodrigo.


6 Comments

Getting the getter and setter of a property using RTTI

Introduction

One of the limitations of the TRttiProperty class is which not expose any direct relation between the property and the getter and setters. On this post we will check out how we can access to such info using the RTTI. So the aim is obtain a TRttiField and/or TRttiMethod instance to the getter and setter of the property. This will be done using a class helper like so.

  type
     TRttiPropertyHelper = class helper for TRttiProperty
  private
    function GetSetterField  : TRttiField;
    function GetGetterField  : TRttiField;
  public
    property SetterField : TRttiField read GetSetterField;
    property GetterField : TRttiField read GetGetterField;
    function SetterMethod (Instance : TObject) : TRttiMethod;
    function GetterMethod (Instance : TObject) : TRttiMethod;
  end;

Getting the address of the getter and setters.

The System.TypInfo.TPropInfo type contains two fields which holds the address of the getter and setters members

  PPropInfo = ^TPropInfo;
  TPropInfo = packed record
    PropType: PPTypeInfo;
    GetProc: Pointer;
    SetProc: Pointer;
    StoredProc: Pointer;
    Index: Integer;
                                                                                 
    Default: Integer;
    NameIndex: SmallInt;
    Name: TSymbolName;
    function NameFld: TTypeInfoFieldAccessor; inline;
    function Tail: PPropInfo; inline;
  end;

We need to examine such addresses to determine if represents a field or a method. So I will define a set of sample classes and dump the address of the getter and setter.

type
  TBar = class
  private
    FReadOnlyProp: string;
    FWriteOnlyProp: string;
    function GetReadBaseProp: string; virtual;
    procedure SetWriteBaseProp(const Value: string); virtual;
  public
    property ReadBaseProp: string read GetReadBaseProp;
    property WriteBaseProp: string write SetWriteBaseProp;
  end;

  TFoo = class(TBar)
  private
    function GetReadOnlyPropwGet: string;
    procedure SetWriteOnlyPropwSet(const Value: string);
    function GetReadBaseProp: string; override;
  public
    property ReadOnlyProp: string read FReadOnlyProp;
    property WriteOnlyProp: string Write FWriteOnlyProp;
    property ReadOnlyPropwGet: string read GetReadOnlyPropwGet;
    property WriteOnlyPropwSet: string write SetWriteOnlyPropwSet;
  end;

And now to obtain the addresses we will access the PropInfo member of each property in the class.

procedure DumpPropInfo(AClass: TObject);
var
  LContext: TRttiContext;
  LType: TRttiType;
  LProp: TRttiProperty;
  LPropInfo: PPropInfo;
begin
  //Get the typeinfo of the class
  LType := LContext.GetType(AClass.ClassInfo);

  for LProp in LType.GetProperties() do
    if LProp is TRttiInstanceProperty then
    begin
      //Get the pointer to the PPropInfo
      LPropInfo := TRttiInstanceProperty(LProp).PropInfo;
      //show the addresses of the getter and setter
      Writeln(Format('%-18s GetProc %p SetProc %p', [LProp.Name, LPropInfo.GetProc, LPropInfo.SetProc]));
    end;
end; 

If we run the above code passing an instance to the TFoo class we will obtain this output

ReadOnlyProp       GetProc FF000004 SetProc 00000000 //Field
WriteOnlyProp      GetProc 00000000 SetProc FF000008 //Field
ReadOnlyPropwGet   GetProc 004CCE70 SetProc 00000000 //Static method
WriteOnlyPropwSet  GetProc 00000000 SetProc 004CCE80 //Static method
ReadBaseProp       GetProc FE000000 SetProc 00000000 //virtual method
WriteBaseProp      GetProc 00000000 SetProc FE000004 //virtual method

Obtaining the TRttiField instance

A visual inspection of the returned values, indicates which the fields offsets are masked with the $FF000000 value. So with this info we can build a couple of helper functions to obtain an instance to the TRttiField .

First we need determine when a getter/setter represents a field.

In the System.TypInfo unit exists a private boolean function called IsField which indicates when a Pointer (GetProc, SetProc) represents a field.

function IsField(P: Pointer): Boolean; inline;
begin
  Result := (IntPtr(P) and PROPSLOT_MASK) = PROPSLOT_FIELD;
end;

Now using the above method and some additional code we can build the next function which returns a TRttiField instance for the getter of a property.

function GetPropGetterField(AProp : TRttiProperty) : TRttiField;
var
  LPropInfo : PPropInfo;
  LField: TRttiField;
  LOffset : Integer;
begin
  Result:=nil;
  //Is a readable property?
  if (AProp.IsReadable) and (AProp.ClassNameIs('TRttiInstancePropertyEx')) then
  begin
    //get the propinfo of the porperty
    LPropInfo:=TRttiInstanceProperty(AProp).PropInfo;
    //check if the GetProc represent a field
    if (LPropInfo<>nil) and (LPropInfo.GetProc<>nil) and IsField(LPropInfo.GetProc) then
    begin
      //get the offset of the field
      LOffset:= IntPtr(LPropInfo.GetProc) and PROPSLOT_MASK_F;
      //iterate over the fields of the class
      for LField in AProp.Parent.GetFields do
         //compare the offset the current field with the offset of the getter
         if LField.Offset=LOffset then
           Exit(LField);
    end;
  end;
end;

To obtain the setter field the code looks very similar but instead we inspect the SetProc member.

function GetPropSetterField(AProp : TRttiProperty) : TRttiField;
var
  LPropInfo : PPropInfo;
  LField: TRttiField;
  LOffset : Integer;
begin
  Result:=nil;
  //Is a writable property?
  if (AProp.IsWritable) and (AProp.ClassNameIs('TRttiInstancePropertyEx')) then
  begin
    //get the propinfo of the porperty
    LPropInfo:=TRttiInstanceProperty(AProp).PropInfo;
    //check if the GetProc represent a field
    if (LPropInfo<>nil) and (LPropInfo.SetProc<>nil) and IsField(LPropInfo.SetProc) then
    begin
      //get the offset of the field
      LOffset:= IntPtr(LPropInfo.SetProc) and PROPSLOT_MASK_F;
      //iterate over the fields of the class
      for LField in AProp.Parent.GetFields do
         //compare the offset the current field with the offset of the setter
         if LField.Offset=LOffset then
           Exit(LField);
    end;
  end;
end;

Obtaining the TRttiMethod instance

To obtain a TRttiMethod instance for the setter and getter, first we need to determine if the GetProc/SetProc represent a static o virtual method, then we need to obtain the real address of the method. Luckily exist the private function GetCodePointer in the System.TypInfo unit which do this task. Note that we need a instance to the object to resolve the code address.

function GetCodePointer(Instance: TObject; P: Pointer): Pointer; inline;
begin
  if (IntPtr(P) and PROPSLOT_MASK) = PROPSLOT_VIRTUAL then // Virtual Method
    Result := PPointer(PNativeUInt(Instance)^ + (UIntPtr(P) and $FFFF))^
  else // Static method
    Result := P;
end;

Now we can create a function to return a TRttiMethod for the getter of a property.

function GetPropGetterMethod(Instance: TObject; AProp : TRttiProperty) : TRttiMethod;
var
  LPropInfo : PPropInfo;
  LMethod: TRttiMethod;
  LCodeAddress : Pointer;
  LType : TRttiType;
  LocalContext: TRttiContext;
begin
  Result:=nil;
  if (AProp.IsReadable) and (AProp.ClassNameIs('TRttiInstancePropertyEx')) then
  begin
    //get the PPropInfo pointer
    LPropInfo:=TRttiInstanceProperty(AProp).PropInfo;
    if (LPropInfo<>nil) and (LPropInfo.GetProc<>nil) and not IsField(LPropInfo.GetProc) then
    begin
      //get the real address of the ,ethod
      LCodeAddress := GetCodePointer(Instance, LPropInfo^.GetProc);
      //get the Typeinfo for the current instance
      LType:= LocalContext.GetType(Instance.ClassType);
      //iterate over the methods of the instance
      for LMethod in LType.GetMethods do
      begin
         //compare the address of the currrent method against the address of the getter
         if LMethod.CodeAddress=LCodeAddress then
           Exit(LMethod);
      end;
    end;
  end;
end;

And for the setter is the same again but we inspect the SetProc instead.

function GetPropSetterMethod(Instance: TObject; AProp : TRttiProperty) : TRttiMethod;
var
  LPropInfo : PPropInfo;
  LMethod: TRttiMethod;
  LCodeAddress : Pointer;
  LType : TRttiType;
  LocalContext: TRttiContext;
begin
  Result:=nil;
  if (AProp.IsWritable) and (AProp.ClassNameIs('TRttiInstancePropertyEx')) then
  begin
    //get the PPropInfo pointer
    LPropInfo:=TRttiInstanceProperty(AProp).PropInfo;
    if (LPropInfo<>nil) and (LPropInfo.SetProc<>nil) and not IsField(LPropInfo.SetProc) then
    begin
      LCodeAddress := GetCodePointer(Instance, LPropInfo^.SetProc);
      //get the Typeinfo for the current instance
      LType:= LocalContext.GetType(Instance.ClassType);
      //iterate over the methods
      for LMethod in LType.GetMethods do
      begin
         //compare the address of the currrent method against the address of the setter
         if LMethod.CodeAddress=LCodeAddress then
           Exit(LMethod);
      end;
    end;
  end;
end;

TRttiPropertyHelper

Finally we can implement the methods of our helper for the TRttiProperty class.

function TRttiPropertyHelper.GetGetterField: TRttiField;
begin
 Result:= GetPropGetterField(Self);
end;

function TRttiPropertyHelper.GetSetterField: TRttiField;
begin
 Result:= GetPropSetterField(Self);
end;

function TRttiPropertyHelper.GetterMethod(Instance: TObject): TRttiMethod;
begin
 Result:= GetPropGetterMethod(Instance, Self);
end;

function TRttiPropertyHelper.SetterMethod(Instance: TObject): TRttiMethod;
begin
 Result:= GetPropSetterMethod(Instance, Self);
end;

Now we can use the helper like this

procedure DumpPropInfoExt(AClass: TObject);
var
  LContext: TRttiContext;
  LType: TRttiType;
  LProp: TRttiProperty;
  LPropInfo: PPropInfo;

  LField: TRttiField;
  LMethod: TRttiMethod;
begin
  LType := LContext.GetType(AClass.ClassInfo);
  for LProp in LType.GetProperties() do
    if LProp is TRttiInstanceProperty then
    begin
      LPropInfo := TRttiInstanceProperty(LProp).PropInfo;
      Writeln(Format('%-18s GetProc %p SetProc %p',
        [LProp.Name, LPropInfo.GetProc, LPropInfo.SetProc]));

      if LProp.IsReadable then
      begin
        LField := LProp.GetterField;
        if LField <> nil then
          Writeln(Format('  Getter Field Name %s', [LField.Name]))
        else
        begin
          LMethod := LProp.GetterMethod(AClass);
          if LMethod <> nil then
            Writeln(Format('  Getter Method Name %s', [LMethod.Name]))
        end;
      end;

      if LProp.IsWritable then
      begin
        LField := LProp.SetterField;
        if LField <> nil then
          Writeln(Format('  Setter Field Name %s', [LField.Name]))
        else
        begin
          LMethod := LProp.SetterMethod(AClass);
          if LMethod <> nil then
            Writeln(Format('  Setter Method Name %s', [LMethod.Name]))
        end;
      end;

    end;
end;

Limitations

Exist some limitations to use the above code.

  1. Delphi Array Properties are not supported for the GetProperties method. Instead you must use the GetIndexedProperties method to get a list of TRttiIndexedProperty and from there you can access to the ReadMethod and WriteMethod properties.
  2. The getters and setters methods of the property must emit RTTI info this implies which depending of the visibility of these methods you will need instruct to the compiler generate RTTI info for the methods, adding a sentence like this to your class {$RTTI EXPLICIT METHODS([vcPrivate])}

 

You can download the sample code from Github.

Rodrigo.


1 Comment

Delphi IDE Colorizer Supports RAD Studio 10 Seattle

The Delphi IDE Colorizer plugin now is compatible with RAD Studio 10 Seattle. This new version includes support for the new IDE enhancements like the Community toolbar, Object inspector filter and the Code navigation toolbar (Castalia).

The next screenshot shown the RAD Studio 10 Seattle IDE styled with the Onyx VCL Style.
(click to get a full size image)

MainHandW

You can get more info of the plugin in the github site.

Remember report any issue or suggest a new feature using the issue page of the project.

Rodrigo.


5 Comments

VCL Styles Utils and RAD Studio 10 Seattle

This is a summary of the current state of VCL Styles Utils project and RAD Studio 10 Seattle.

  • The library was updated to support RAD Studio 10 Seattle.
  • RAD Studio 10 Seattle add VCL Styling support for the classic common dialogs and for the TWebBrowser component. Using licensed code from the VCL Styles Utils project to Embarcadero.
  • RAD Studio 10 Seattle includes a new select directory dialog using the IFileDialog interface. This dialog also can be styled using the VCL Styles Utils project.

This is the select folder dialog with the Windows native theme

SelectFolder10Native

Select folder dialog with the the Glow VCL Style applied and using the VCL Styles Utils

SelectFolder10VCLStylesUtils

 

 

You can check more information about the VCL Styles Utils project in Github.

Rodrigo.


3 Comments

DITE supports RAD Studio 10 Seattle

I just updated the Delphi IDE Theme Editor adding support for RAD Studio 10 Seattle.

DITE_10Seattle

DITE_10Seattle_2

Remember which starting with Delphi XE8, DITE allows you edit the values (color and font) of the IDE modern theme. To use it just press the button “Additional Settings” and set values for the Main ToolBar and the IDE Font, finally press the button “Apply”. Also you can restore the default settings pressing the button “Restore”.

DITE_10Seattle_3

You can download the DITE from here.


5 Comments

VCL Styles Utils and NonClient Area – New features

I just added a set of new features to the VCL Styles Utils project

New NC Buttons styles

Two new styles was added to the TNCButton control (nsAlpha and nsGradient). So now you can add Alpha-blended and Gradient buttons to the title bar of the Forms.

NC_AlphaGradient

To add a button in the NC Area, only you need add a TNCControls component to your form and then insert a TNCButton in the collection like so.

  NCControls:=TNCControls.Create(Self);
  NCControls.Add(TNCButton.Create(NCControls));
  NCControls[0].Style       := nsAlpha;
  NCControls[0].ImageStyle  := isNormal;
  NCControls[0].Images      := ImageList1;
  NCControls[0].ImageIndex  := 0;
  NCControls[0].BoundsRect  := Rect(30, 1, 120, 26);
  NCControls[0].Caption     := 'nsAlpha1';
  NCControls[0].Name        := 'nsAlpha1';
  NCControls[0].AlphaColor   := clWebLavender;
  NCControls[0].AlphaHotColor:= clWebAliceBlue;
  NCControls[0].FontColor   := clWhite;
  NCControls[0].HotFontColor:= clYellow;
  NCControls[0].OnClick     := ButtonNCClick;

Support for Custom VCL Styles in the NonClient Area

The TNCControls component was updated to support a different custom VCL Style in the NC Area. Check these screenshots with the glow style (this is the application VCL Style) in the body of the form and a custom VCL Style in the NC Area.

This slideshow requires JavaScript.

To activate a custom style in the NC Area, only you need add a TNCControls component to your form and set the StyleServices property

  NCControls:=TNCControls.Create(Self);
  NCControls.StyleServices := TStyleManager.Style['Sky']; //Set the Sky vcl style to be used to draw the NC Area of the form

You can check the sample application here.