The Road to Delphi – a Blog about programming

Delphi – Free Pascal – Oxygene


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


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
  VclStyleOptions:=TVclStylesSystemMenu.Create(Self);
end;

You can check the full source code here.


3 Comments

VCL Styles for NSIS

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


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

Follow

Get every new post delivered to your Inbox.

Join 588 other followers