The Road to Delphi – a Blog about programming

Delphi – Free Pascal – Oxygene


3 Comments

VCL Styles Utils – Now supports the TTaskDialog component

I’m very pleased to introduce a very exciting new feature to the VCL Styles Utils project. This is the support for style the TTaskDialog component and all the TaskDialog based Message dialogs. This control available since RAD Studio 2007 is a wrapper for the Task Dialogs introduced in Windows Vista and allows to create very rich and flexible dialogs.

Take a look to some sample dialogs.

2014-10-09 09_48_43-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_41_40-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_42_31-Greenshot

2014-10-09 09_47_41-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_47_52-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_48_07-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_48_19-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_48_31-VCL Styles Utils - TTaskDialogs Demo

And now enabling the VCL Styles and just adding the Vcl.Styles.Hooks unit to your project…..

2014-10-09 09_57_33-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_58_01-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_58_28-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_58_55-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_52_55-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_54_40-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_55_11-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_55_40-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_56_04-VCL Styles Utils - TTaskDialogs Demo

2014-10-09 09_56_42-VCL Styles Utils - TTaskDialogs Demo

You can download a sample application from the project repository.
Also a compiled demo is available here.

If you found any bug please use the issue page of the project.

For a quick tutorial of how use the TTaskDialog component check this great Inofficial TTaskDialog Documentation.

Rodrigo.


4 Comments

VCL Styles Utils – New Feature : Non Client Area Controls

I’m very pleased to introduce a very cool new feature to the VCL Styles Utils project. This is the support for controls in the Non Client Area of the forms through the TNCControls component.

Check the next form with the Auric Vcl Style applied.

1

Now the same form but with a set of NC Buttons in the title bar.

2

To use in your forms you only need to add the Vcl.Styles.NC and Vcl.Styles.FormStyleHooks units to your project and create a TNCControls component in each form where do you want use the NC Controls.

Check the next sample code

procedure TForm1.FormCreate(Sender: TObject);
begin
 NCControls:=TNCControls.Create(Self);
 //Add a NC Button
 NCControls.List.Add(TNCButton.Create(NCControls));
 //Set the style of the button
 NCControls.List[0].Style := nsSplitButton;
 //Set the style of the image
 NCControls.List[0].ImageStyle := isGrayHot;
 //Set the image list
 NCControls.List[0].Images := ImageList1;
 NCControls.List[0].ImageIndex := 3;
 //Set the bounds
 NCControls.List[0].BoundsRect := Rect(30,5,100,25);
 NCControls.List[0].Caption := 'Menu';
 //Assign the menu and events.
 NCControls.List[0].DropDownMenu:= PopupMenu1;
 NCControls.List[0].OnClick := ButtonNCClick;
end;

And this is the result

4

Screenshots

3

Exist 4 kind of buttons which you can choose.
5

Also you can use a custom Vcl Style to draw the controls.
6

Try the sample application from the project repository.
Also you can download a compiled demo from here.

Remember report any bug o made your suggestions via the issue page of the project.


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

Fix to conflict between the Delphi Dev. Shell Tools and AVG Antivirus.

I just detect a conflict with the AVG Antivirus 2014 Shell extension . This cause which the Delphi Dev. Shell Tools menu is not show. To fix this issue you must disable and enable the AVG Antivirus Shell extension.

Please follow the next steps to fix.

  1. Download and Run the ShellExView utility
  2. Locate the AVG Antivirus Shell extensions and disable it as is shown in the below image.
  3. log-off and log-on or restart Windows
  4. Test the Delphi Dev. Shell Tools extension
  5. Run the ShellExView utility again and enable the AVG Antivirus Shell extensions
  6. log-off and log-on or restart Windows
  7. Now both shell extensions should work normally.

AVG


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.

Follow

Get every new post delivered to your Inbox.

Join 704 other followers