The Road to Delphi

Delphi – Free Pascal – Oxygene


7 Comments

A new way to select and apply a VCL Style in Runtime

Typically we use a combobox or listbox to allow to the final user select and appy a VCL Style, Today I will show you a new way using the system menu of the form.

First you need to use the GetSystemMenu WinApi function  to get a  handle to the system menu of the form. Then using the AppendMenu or the InsertMenuItem methods you can customize the system menu, from here you must store the identifier of the new menu item added and finally process the WM_SYSCOMMAND message to launch an action.

Check the next commented code

uses
  System.Rtti,
  System.Classes,
  System.Generics.Collections,
  WinApi.Windows,
  WinApi.Messages,
  Vcl.Themes,
  Vcl.Styles,
  Vcl.Forms;

type
  TMethodInfo=class;

  TProcCallback = reference to procedure(Info : TMethodInfo);
  TMethodInfo=class
   Value1 : TValue;
   Value2 : TValue;
   Method : TProcCallback;
  end;
  TVclStylesSystemMenu=class(TComponent)
  strict private
    FVCLStylesMenu : HMenu;
    FOrgWndProc: TWndMethod;
    FForm : TForm;
    FMethodsDict : TObjectDictionary<NativeUInt, TMethodInfo>;
    procedure CreateMenus;
    procedure DeleteMenus;
    procedure CreateMenuStyles;
    procedure WndProc(var Message: TMessage);
  public
    constructor Create(AOwner: TForm); reintroduce;
    destructor Destroy; override;
  end;

implementation

uses
  Vcl.Controls,
  System.SysUtils;

const
 VCLStylesMenu=WM_USER + 666;

//Add a new Menu Item
function InsertMenuHelper(hMenu: HMENU; uPosition: UINT; uIDNewItem: UINT_PTR; lpNewItem, IconName: LPCWSTR) : BOOL;
var
  LMenuItem : TMenuItemInfo;
begin
  ZeroMemory(@LMenuItem, SizeOf(TMenuItemInfo));
  LMenuItem.cbSize := SizeOf(TMenuItemInfo);
  LMenuItem.fMask  := MIIM_FTYPE or MIIM_ID or MIIM_BITMAP or MIIM_STRING;
  LMenuItem.fType  := MFT_STRING;
  LMenuItem.wID    := uIDNewItem;
  LMenuItem.dwTypeData := lpNewItem;
  Result:=InsertMenuItem(hMenu, uPosition, True, LMenuItem);
end;

//Add a new separator
procedure AddMenuSeparatorHelper(hMenu : HMENU; var MenuIndex : Integer);
var
  LMenuInfo    : TMenuItemInfo;
  Buffer       : array [0..79] of char;
begin
  ZeroMemory(@LMenuInfo, SizeOf(TMenuItemInfo));
  LMenuInfo.cbSize := sizeof(LMenuInfo);
  LMenuInfo.fMask  := MIIM_TYPE;
  LMenuInfo.dwTypeData := Buffer;
  LMenuInfo.cch := SizeOf(Buffer);
  if GetMenuItemInfo(hMenu, MenuIndex-1, True, LMenuInfo) then
  begin
    if (LMenuInfo.fType and MFT_SEPARATOR) = MFT_SEPARATOR then
    else
    begin
      InsertMenu(hMenu, MenuIndex, MF_BYPOSITION or MF_SEPARATOR, 0, nil);
      inc(MenuIndex);
    end;
  end;
end;

{ TVclStylesSystemMenu }

constructor TVclStylesSystemMenu.Create(AOwner: TForm);
begin
  inherited Create(AOwner);
  //Get an instance to the form
  FForm:=AOwner;
  //Init the collection to store the menu ids and callbacks
  FMethodsDict:=TObjectDictionary<NativeUInt, TMethodInfo>.Create([doOwnsValues]);
  //store the original WndProc
  FOrgWndProc := FForm.WindowProc;
  //replace the WndProc of the form 
  FForm.WindowProc := WndProc;
  //Modify the system menu
  CreateMenus;
end;

destructor TVclStylesSystemMenu.Destroy;
begin
  DeleteMenus;
  FForm.WindowProc := FOrgWndProc;
  FMethodsDict.Free;
  inherited;
end;

procedure TVclStylesSystemMenu.CreateMenus;
begin
  CreateMenuStyles;
end;

procedure TVclStylesSystemMenu.DeleteMenus;
begin
   if IsMenu(FVCLStylesMenu) then
   while GetMenuItemCount(FVCLStylesMenu)>0 do
     DeleteMenu(FVCLStylesMenu, 0, MF_BYPOSITION);

   FMethodsDict.Clear;
end;

procedure TVclStylesSystemMenu.CreateMenuStyles;
var
 LSysMenu : HMenu;
 LMenuItem: TMenuItemInfo;
 s : string;
 uIDNewItem, LSubMenuIndex : Integer;
 LMethodInfo : TMethodInfo;
begin
  LSysMenu := GetSystemMenu(FForm.Handle, False);

  LSubMenuIndex:=GetMenuItemCount(LSysMenu);
  AddMenuSeparatorHelper(LSysMenu,  LSubMenuIndex);

  FVCLStylesMenu   := CreatePopupMenu();
  s:='VCL Styles';

  uIDNewItem := VCLStylesMenu;
  ZeroMemory(@LMenuItem, SizeOf(TMenuItemInfo));
  LMenuItem.cbSize := SizeOf(TMenuItemInfo);
  LMenuItem.fMask  := MIIM_SUBMENU or MIIM_FTYPE or  MIIM_ID or MIIM_BITMAP or MIIM_STRING;
  LMenuItem.fType  := MFT_STRING;
  LMenuItem.wID    := VCLStylesMenu;
  LMenuItem.hSubMenu := FVCLStylesMenu;
  LMenuItem.dwTypeData := PWideChar(s);
  LMenuItem.cch := Length(s);
  //Add the new menu item to the system menu
  InsertMenuItem(LSysMenu, GetMenuItemCount(LSysMenu), True, LMenuItem);
  inc(uIDNewItem);
  LSubMenuIndex:=0;

  //Iterate over the registered styles and create a new menu entry for each style 
  for s in TStyleManager.StyleNames do
  begin
    InsertMenuHelper(FVCLStylesMenu, LSubMenuIndex, uIDNewItem,  PChar(s), nil);
    if SameText(TStyleManager.ActiveStyle.Name, s) then
      CheckMenuItem(FVCLStylesMenu, LSubMenuIndex, MF_BYPOSITION or MF_CHECKED);
    inc(LSubMenuIndex);
    inc(uIDNewItem);
    LMethodInfo:=TMethodInfo.Create;
    LMethodInfo.Value1:=s;
    //set the method to execute when the item is clicked
    LMethodInfo.Method:=procedure(Info : TMethodInfo)
                        begin
                          TStyleManager.SetStyle(Info.Value1.AsString);
                        end;
    //register the menu id and the callback function.
    FMethodsDict.Add(uIDNewItem-1, LMethodInfo);
  end;
end;

procedure TVclStylesSystemMenu.WndProc(var Message: TMessage);
var
  LVerb : NativeUInt;
begin
  case Message.Msg of
    //Detect when the window handle is recreated
    CM_RECREATEWND: begin
                      DeleteMenus;
                      FOrgWndProc(Message);
                      CreateMenus;
                    end;
    //Track the system menu calls
    WM_SYSCOMMAND : begin
                     if FMethodsDict.ContainsKey(TWMSysCommand(Message).CmdType) then
                     begin
                      LVerb:=TWMSysCommand(Message).CmdType;
                      FMethodsDict.Items[LVerb].Method(FMethodsDict.Items[LVerb]);
                     end
                     else
                      FOrgWndProc(Message);
                    end
  else
    FOrgWndProc(Message);
  end;
end;

end.

And this the result

Windows

Amakritz

Cobalt

To use this class, only you need create an new instance passing a reference to the form.

procedure TForm1.FormCreate(Sender: TObject);
begin
  TVclStylesSystemMenu.Create(Self);
end;

You can check the full source code here.


2 Comments

VCL Styles Utils – New feature

I just uploaded a new release of the VCL Styles Utils project improving the support for ListViews and TreeView controls. When you uses a TListView setting the CheckBoxes property to True and with the VCL Styles enabled the control will look like so

ListView_NoHook

As you can see the Checkboxes is using the Windows native look and feel, this is because the OS draw these controls directly and not the VCL. Some time ago I show a workaround for this owner-drawing the TListView, unfortunately this implies modify the source code for each TListView in the project which means a lot of work in some scenarios. But now with this new addition to the VCL Styles Utils only adding the VCL.Styles.Hooks unit to your project the checkbox control is properly drawn using the current active VCL Style.

ListView_Hook

The same improvement goes for the TTreeview controls, by default the opened and closed glyphs are draw using the native look and feel

TreeView_NoHook

And now using the VCL.Styles.Hooks unit

TreeView_Hook

Remember which this unit also include a fix for the system colors when the VCL Styles are enabled as is show on this article.

Without Vcl.Styles.Hooks

List_Hook

With Vcl.Styles.Hooks

List_Hook

Note : The VCL.Styles.Hooks unit works hooking the UxTheme dll, this means which using this unit on your project will cause which all the calls to the DrawThemeBackground and DrawThemeBackgroundEx methods with the BP_RADIOBUTTON, BP_CHECKBOX, TVP_GLYPH, TVP_HOTGLYPH parts will be affected.


13 Comments

VCL Styles Utils, Embarcadero Agreement and Delphi XE6

Embarcadero Agreement

As probably you know, a small part of the VCL Styles utils project was licensed to Embarcadero, via a non-exclusive proprietary license. This means which they can use, modify and distribute the code as part of the VCL, but the Copyright and the Open Source version of the project still belong us. So you can continue using this library in all the Delphi versions supported (XE2-XE6).

Delphi XE6

The VCL Styles utils was updated to support and avoid conflicts with Delphi XE6. Check the next image which show the Open Dialog styled using the New XE6 style Table Dark

Tabla_Dark_Open

Since now the main difference is that you can use the menu style hook which is included as part of the Delphi XE6 VCL Styles, or continue using the menu hook of the library, this is described in the Vcl.Styles.Utils.Menus unit.

{$DEFINE UseVCLStyleUtilsMenu}
{$IF CompilerVersion >= 27} // Use the XE6 menu syshooks by default
  {$UNDEF UseVCLStyleUtilsMenu} // comment this line if you want to use the VCL Styles Utils Menus Hooks instead
{$IFEND}

About the Styled Dialogs

Using the library is the only way to style the system dialogs, currently we support all the Common Dialog Box Types (Color, Find, Font, Open, Page Setup, Print, Replace, Save As).

Check the Common Dialogs styled using the Premium VCL Style Jet.

Jet

But not just the Common dialogs are styled, in fact any dialog (#32770 Class) which uses the windows common controls is supported (of course if the dialog had a owner draw control this cannot be styled). For an example take a look to the next images.

Prompt DataSource Dialog

output_sWoRA1

Select User Dialog

ObjectSelect_4

Note: Some dialogs cannot be styled, because uses the undocumented DirectUIHWND control, these include the new (introduced in windows Vista) Open and Save As dialog and the Task Dialogs

Rodrigo.


3 Comments

VCL Styles for NSIS

Important Update

The new location of this project is https://code.google.com/p/vcl-styles-plugins/

NSIS

The VCL Styles Utils project, now includes  a plugin (dll) to skin the installers created by NSIS (2.46 and 3.0). The current size of the plugin is about 1.6 mb, but when is included (and compressed) in the script only add ~550 Kb to the final installer.

output_A6NOFn

How to use it

To use the plugin in a NSIS installer you must call the LoadVCLStyle function passing the skin name in the .onInit function.

Function .onInit
  InitPluginsDir
  ;Get the skin file to use
  File /oname=$PLUGINSDIR\Amakrits.vsf "..\Styles\Amakrits.vsf"
  ;Load the skin using the LoadVCLStyle function
  NSISVCLStyles::LoadVCLStyle $PLUGINSDIR\Amakrits.vsf
FunctionEnd

To use the plugin in a NSIS Uninstaller you must call the LoadVCLStyle function passing the skin name in the un.onInit function.

Function un.onInit
  InitPluginsDir
  File /oname=$PLUGINSDIR\Amakrits.vsf "..\Styles\Amakrits.vsf"
  ;Load the skin using the LoadVCLStyle function
  NSISVCLStyles::LoadVCLStyle $PLUGINSDIR\Amakrits.vsf
FunctionEnd

For download and more info check the page of the plugin


26 Comments

VCL Styles Utils and Popup Menus – Major Update

As you probably know the VCL Styles doesn’t support  Popup menus, this means if you apply any VCL Style  to your VCL Application  the popup menus will remain with the Windows native look and feel  (exists some workarounds for this like use a TPopupActionBar  as described here, but this only works partially, and doesn’t support the child menus of a TMainMenu) Since Sometime ago the VCL Styles Utils project can help you to overcome this limitation adding support for VCL Styled Popup Menus.

Now we just uploaded a major update to the VCL Styles Utils project. This new version fix all the issues reported via mail and the issue page related the PopUp menus like support for  the Break property, Checkboxes,  Radio Items,  Default items and so on.

Sample images

TMainMenu with VCL Styles

1

TMainMenu with VCL Styles and VCL Styles Utils

2

Popup Menu with VCL Styles

3

Popup Menu with VCL Styles and VCL Styles Utils

4

Right to left Popup Menu with VCL Styles

5

Right to left Popup Menu with VCL Styles and VCL Styles Utils

6

System Menu with VCL Styles

7

System Menu with VCL Styles and VCL Styles Utils

8

To add support for VCL Styled Popup Menus in your Application only you must add these units to your project Vcl.Styles.Utils.Menus, Vcl.Styles.Utils.SysStyleHook and Vcl.Styles.Utils.SysControls.

You can download sample application from here and the source of the Application is here.


49 Comments

VCL Styles for Inno Setup

Introduction

As part of the VCL Styles Utils project, I made a plugin (dll) to skin the installers created by Inno setup. The current size of the plugin is about 1.6 mb, but when is included (and compressed) in the script only add ~490 Kb to the final installer.

output_qkRcra

How to use it

In order to use the plugin you must follow these steps

  1. Add the VclStylesinno.dll file to your inno setup script and the VCL Style file to use.
  2. Import the function LoadVCLStyleW for Unicode versions of Inno setup or the LoadVCLStyleA method for the Ansi version
  3. Import the function UnLoadVCLStyles
  4. In the InitializeSetup function extract the style to use and call the LoadVCLStyle method passing the name of the style file
  5. Finally in the DeinitializeSetup function call the UnLoadVCLStyles method.

Check the next sample script

[Files]
Source: ..\VclStylesinno.dll; DestDir: {app}; Flags: dontcopy
Source: ..\Styles\Amakrits.vsf; DestDir: {app}; Flags: dontcopy

[Code]
// Import the LoadVCLStyle function from VclStylesInno.DLL
procedure LoadVCLStyle(VClStyleFile: String); external 'LoadVCLStyleW@files:VclStylesInno.dll stdcall';
// Import the UnLoadVCLStyles function from VclStylesInno.DLL
procedure UnLoadVCLStyles; external 'UnLoadVCLStyles@files:VclStylesInno.dll stdcall';

function InitializeSetup(): Boolean;
begin
  ExtractTemporaryFile('Amakrits.vsf');
  LoadVCLStyle(ExpandConstant('{tmp}\Amakrits.vsf'));
  Result := True;
end;

procedure DeinitializeSetup();
begin
  UnLoadVCLStyles;
end;

TODO

  • Add support for TFolderTreeView and TStartMenuFolderTreeView components
  • Add support for themed controls in the TNewCheckBoxList component
  • Add support for the npbstMarquee style in the TNewProgressBar component

Source code and Installer

The source code and installer is available on Github.

As always all your comments and feedback is welcome.