I use TMS VCL components in my App since a long time.
A bug has never been fixed despite numerous releases.
An Exception is raised after displaying a form on a ButtonBarItem1ElementClick.
//**********************************************************
1) How to reproduce:
- Create a new VCL application this way
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GDIPCustomItem, GDIPButtonBarItem,
CustomItemsContainer, AdvPolyList;
type
TForm1 = class(TForm)
AdvPolyMenu1: TAdvPolyMenu;
ButtonBarItem1: TButtonBarItem;
procedure ButtonBarItem1ElementClick(Sender: TObject; Index: Integer);
private
{ Declarations privees }
public
{ Declarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ButtonBarItem1ElementClick(Sender: TObject; Index: Integer);
begin
case index of
0:showmessage('Exception');
end;
end;
end.
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GDIPCustomItem, GDIPButtonBarItem,
CustomItemsContainer, AdvPolyList;
type
TForm1 = class(TForm)
AdvPolyMenu1: TAdvPolyMenu;
ButtonBarItem1: TButtonBarItem;
procedure ButtonBarItem1ElementClick(Sender: TObject; Index: Integer);
private
{ Declarations privees }
public
{ Declarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ButtonBarItem1ElementClick(Sender: TObject; Index: Integer);
begin
case index of
0:showmessage('Exception');
end;
end;
end.
Run the Application: you get an an Exception
//**********************************************************
2) Why this Exception?
This exception is throwned in procedure TButtonBarItem.DoMouseUp because FDownElement is reset to nil when a new Window Handle has been used.
-> It should be saved before DoElementClick then restored when returning
procedure TButtonBarItem.DoMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; pX, pY: Integer; Interaction: TItemInteraction;
ItemAppearance: TItemAppearance);
begin
inherited;
if Assigned(FDownElement) then
begin
DoElementClick(Self, FDownElement.Index);
if FDownElement.StaySelected then
FDownElement.FDown := not FDownElement.FDownState
else
FDownElement.FDown := False;
FDownElement.FDownState := FDownElement.FDown;
FDownElement := nil;
Changed;
end;
end;
Shift: TShiftState; pX, pY: Integer; Interaction: TItemInteraction;
ItemAppearance: TItemAppearance);
begin
inherited;
if Assigned(FDownElement) then
begin
DoElementClick(Self, FDownElement.Index);
if FDownElement.StaySelected then
FDownElement.FDown := not FDownElement.FDownState
else
FDownElement.FDown := False;
FDownElement.FDownState := FDownElement.FDown;
FDownElement := nil;
Changed;
end;
end;
//**********************************************************
3) How to get rid of this before it gets fixed
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GDIPCustomItem, GDIPButtonBarItem,
CustomItemsContainer, AdvPolyList;
const
WM_MY_MESSAGE = WM_USER + 1;
type
TCmdMsg=(cmdNull,cmdShowMessage);
TForm1 = class(TForm)
AdvPolyMenu1: TAdvPolyMenu;
ButtonBarItem1: TButtonBarItem;
procedure ButtonBarItem1ElementClick(Sender: TObject; Index: Integer);
private
{ D?clarations privees }
public
{ Declarations publiques }
procedure ON_WM_MY_MESSAGE(var Msg:TMessage); message WM_MY_MESSAGE;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ButtonBarItem1ElementClick(Sender: TObject; Index: Integer);
begin
case index of
0:
//showmessage('Exception');
PostMessage(self.Handle,WM_MY_MESSAGE,Ord(TCmdMsg.cmdShowMessage),0);
end;
end;
procedure TForm1.ON_WM_MY_MESSAGE(var Msg: TMessage);
var
aCmd:TCmdMsg;
begin
aCmd:=TCmdMsg(Msg.WParam);
case aCmd of
cmdShowMessage:ShowMessage('No Exception') ;
end;
end;
end.
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GDIPCustomItem, GDIPButtonBarItem,
CustomItemsContainer, AdvPolyList;
const
WM_MY_MESSAGE = WM_USER + 1;
type
TCmdMsg=(cmdNull,cmdShowMessage);
TForm1 = class(TForm)
AdvPolyMenu1: TAdvPolyMenu;
ButtonBarItem1: TButtonBarItem;
procedure ButtonBarItem1ElementClick(Sender: TObject; Index: Integer);
private
{ D?clarations privees }
public
{ Declarations publiques }
procedure ON_WM_MY_MESSAGE(var Msg:TMessage); message WM_MY_MESSAGE;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ButtonBarItem1ElementClick(Sender: TObject; Index: Integer);
begin
case index of
0:
//showmessage('Exception');
PostMessage(self.Handle,WM_MY_MESSAGE,Ord(TCmdMsg.cmdShowMessage),0);
end;
end;
procedure TForm1.ON_WM_MY_MESSAGE(var Msg: TMessage);
var
aCmd:TCmdMsg;
begin
aCmd:=TCmdMsg(Msg.WParam);
case aCmd of
cmdShowMessage:ShowMessage('No Exception') ;
end;
end;
end.