Error in TParamListBox, when using VCL style

VCL TMS VCL UI Pack
1

Hello!


I got the error when I tried to use TParamListBox and VCL custom styles are enabled.
First time I click the ParamListBox dropdown it work fine.
On second time it always raises EInvalidOperation with message "Control '' has no parent window".

Best regards,
Maxim Ivannikov.
2

Test project to reproduce the bug:




unit Unit1;


interface


uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, ParamListbox,
  System.Generics.Collections, Vcl.AppEvnts;


type
  TForm1 = class(TForm)
    cbbVclStyles: TComboBox;
    ParamListBox1: TParamListBox;
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ParBoxParamChanged(Sender: TObject; idx: Integer; href, oldvalue: string; var newvalue: string);
    procedure cbbVclStylesChange(Sender: TObject);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
  end;


var
  Form1: TForm1;


implementation


uses Vcl.Themes;


{$R *.dfm}


procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
begin
  if E is EInvalidOperation then
    if EInvalidOperation(E).Message = 'Control '''' has no parent window' then
      Exit;
end;


procedure TForm1.cbbVclStylesChange(Sender: TObject);
begin
  TStyleManager.SetStyle(cbbVclStyles.Text);
end;


procedure TForm1.FormCreate(Sender: TObject);
var
  StyleName: string;
begin
  for StyleName in TStyleManager.StyleNames do
    cbbVclStyles.Items.Add(StyleName);
  cbbVclStyles.ItemIndex := cbbVclStyles.Items.IndexOf(TStyleManager.ActiveStyle.name);
end;


procedure TForm1.ParBoxParamChanged(Sender: TObject; idx: Integer; href, oldvalue: string; var newvalue: string);
begin
  if href = 'preset' then
    if newvalue = 'First preset' then
    begin
      ParamListBox1.OnParamChanged := nil;
      ParamListBox1.Parameter['par1'] := '500';
      ParamListBox1.Parameter['par2'] := '19.5';
      ParamListBox1.Parameter['par3'] := '35';
      ParamListBox1.OnParamChanged := ParBoxParamChanged;
    end
    else
    if newvalue = 'Second preset' then
    begin
      ParamListBox1.OnParamChanged := nil;
      ParamListBox1.Parameter['par1'] := '200';
      ParamListBox1.Parameter['par2'] := '3.9';
      ParamListBox1.Parameter['par3'] := '75';
      ParamListBox1.OnParamChanged := ParBoxParamChanged;
    end
    else
    if newvalue = 'Default preset' then
    begin
      ParamListBox1.OnParamChanged := nil;
      ParamListBox1.Parameter['par1'] := '0';
      ParamListBox1.Parameter['par2'] := '0.00';
      ParamListBox1.Parameter['par3'] := '5';
      ParamListBox1.OnParamChanged := ParBoxParamChanged;
    end;
end;


end.
3

DFM for Unit1.pas:




object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 305
  ClientWidth = 369
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object cbbVclStyles: TComboBox
    Left = 8
    Top = 8
    Width = 128
    Height = 21
    Style = csDropDownList
    TabOrder = 0
    OnChange = cbbVclStylesChange
  end
  object ParamListBox1: TParamListBox
    Left = 8
    Top = 35
    Width = 354
    Height = 266
    HelpContext = 120
    Items.Strings = (
      
        '<FONT color="#FF0000" size="10"><B>Preset : </B> <a href="preset' +
        '" class="LIST" props="First preset|Second preset|Default preset"' +
        '>?</A></FONT>'
      
        '<p bgcolor="clGray" bgcolorto=""><IMG src="idx:1" align="top"><F' +
        'ONT color="#FFFFFF">Params</FONT></p>'
      
        '  Param <B>1  : </B> <a href="par1" class="SPIN">995</A>  items ' +
        ' <BR>'
      
        '  Param <B>2  : </B> <a href="par2" class="MASK" props="99,9">2,' +
        '9</A> pnd<BR>'
      
        '  Param <B>3  : </B><a href="par3" class="MASK" props="#99,9">-6' +
        ',5</A> '#176'C<BR>')
    ParentColor = True
    TabOrder = 1
    AdvanceOnReturn = False
    EmptyParam = '?'
    Multiline = False
    ParamHint = False
    ShadowColor = clGray
    ShadowOffset = 1
    ShowSelection = False
    Version = '1.3.3.5'
    OnParamChanged = ParBoxParamChanged
  end
end
4

I got the error both in Delphi X and Berlin.

5

We have traced & fixed this issue. The next update will address this.

6

The error isn't fixed still :(

I have tested it with v8.3.3.0 (TParamListBox version is 1.3.3.8)



It's very easy to reproduce the bug. Just try to change a preset in ParamListBox1 two times.

7

I have made a short investigation :)



The situation looks like a bug in ParHTML.pas in TPopupListBox.WMLButtonUp.



The code is:


procedure TPopupListBox.WMLButtonUp(var Message: TWMLButtonDown);
begin
  inherited;

  Parent.SetFocus;
  Visible := False;
  Parent := nil;

  if ItemIndex >= 0 then
  begin
    if Assigned(OnUpdate) then
      OnUpdate(self,Param,Items[ItemIndex]);
  end;
end;


When we hide the control and detach it from the parent, we destroy the control's window handle, that was connected to the parent control's window handle.

But when we are accessing ItemIndex and Items[] properties (to call OnUpdate event handler), we are creating the window handle again. Of course the new handle isn't connected to any parent window, because Parent property contains nil.

But VCL looks for parent window when painting TPopupListBox instance with styles.
TScrollingStyleHook creates new TScrollWindow instance as a child window. 

FVertScrollWnd := TScrollWindow.CreateParented(GetParent(Control.Handle));


As result the painting code raises "Control '' has no parent window" exception.



It's easy to fix the error. We just should to get necessary values for OnUpdate parameters before destroying the window.


procedure TPopupListBox.WMLButtonUp(var Message: TWMLButtonDown);
var
  CallUpdateEvent: Boolean;
  Str: string;
begin
  inherited;

  CallUpdateEvent := Assigned(OnUpdate) and (ItemIndex >= 0);
  if CallUpdateEvent then
    Str := Items[ItemIndex]
  else
    Str := '';

  Parent.SetFocus;
  Visible := False;
  Parent := nil;

  if CallUpdateEvent then
    OnUpdate(self,Param,Str);
end;


Hope it will help you to fix the bug.
8

Thanks for this extra information and suggested fix. We can confirm this will be applied for the next update.

9

Hello again :)

Thanks for the fix.



I have found another possible problem.



The TPopupListBox.OnUpdate handler, calls OnParamSelect and OnParamChanged event handlers. It is possible that the developer would access TParamListBox.ListBox property. For example the developer wants to work with its Items or ItemIndex properties. As result the event handler code will make TPopupListBox to get the window handle, when TPopupListBox disconnected from its parent control that producing the error.



Fortunately the solution is very simple. We should destroy TPopupListBox window after the OnUpdate call.



procedure TPopupListBox.WMLButtonUp(var Message: TWMLButtonDown);
var
  CallUpdateEvent: Boolean;
  Str: string;
begin
  inherited;
  CallUpdateEvent := Assigned(OnUpdate) and (ItemIndex >= 0);
  if CallUpdateEvent then
    Str := Items[ItemIndex]
  else
    Str := '';
  Parent.SetFocus;
  Visible := False;
  if CallUpdateEvent then
    OnUpdate(self,Param,Str);
  if Visible then  
    Visible := False;
  Parent := nil;
end;
10


I mean the developer can access the ListBox property in the OnParamSelect or OnParamChanged handlers code.
11

We could move the event handler indeed to allow further actions on the listbox from the OnParamSelect / OnParamChanged event. We'll update this accordingly.