I have some issues with a TToolButton in Delphi XE4.
procedure TForm2.FormCreate(Sender: TObject);
begin
btn1.Style := tbsDropDown;
btn1.DropDownMenu := pmCreateReport1;
btn1.PopupMenu := pmCreateReport1;
FDown := True;
btn1.down := FDown;
end;
procedure TForm2.btn1Click(Sender: TObject);
begin
FDown := not FDown;
btn1.down := FDown;
end;
After FormCreate the down property is set to true and it works, but when I click the button the down property is not working as expected. After the second click on the button the button should be down again.
The debugger says that the property is set to true, which is correct, but I cannot see it on the form.
When I am using a simple TToolButton without the style tbsdropdown its working as expected.
Do you have any ideas?
The documentation explains it:
Tool buttons can remain Down only if Style is tbsCheck.
You'll have to find some other way of achieving the representation you want.
Use ActionList, set AutoCheck property True,
sample code:
const
wm_tlbtnShowClosedClicked = WM_USER + 100;
TForm2 = class(TForm)
.....
private
procedure tlbtnShowClosedClicked(var Msg :TMessage); message wm_tlbtnShowClosedClicked;
end
procedure TForm2.tlbtnShowClosedClicked(var Msg: TMessage);
begin
btn1.Down := (btn1.Action as TAction).Checked;
end;
Related
I have created dynamic Form as the next :
procedure TForm1.Button1Click(Sender: TObject);
var
Frm:TForm2;
begin
frm:=TForm2.Create(nil);
Frm.Left:=5;
Frm.Top:=5;
Frm.Parent:=Self;
Frm.OnCreate:=OncreateFrm;
Frm.Show;
end;
and when am trying to change the AlphaBlend property, the transparency wouldn't change..
procedure TForm1.OncreateFrm(Sender: TObject);
begin
AlphaBlend:=True;
AlphaBlendValue:=200;
end;
Also overriding the constructor it gave the same result ..
Thanks.
Your approach
Frm := TForm2.Create(nil);
Frm.Left := 5;
Frm.Top := 5;
Frm.Parent := Self;
Frm.OnCreate := OncreateFrm;
Frm.Show;
cannot possibly work because you set the OnCreate handler on line 5, which is after the form has been created on line 1; consequently, at the time the form is created (line 1), it sees that OnCreate is nil and so does nothing. Your instruction on line 5 has no effect.
This is like telling your fiend "Please buy some milk on your way home from work" after your friend has already come home from work.
Solutions
1: Set the properties at design time
Of course, you can use the Object Inspector to set the AlphaBlend and AlphaBlendValue properties of TForm2 at design time. But I suspect you want to do it dynamically, because you ask this question.
2: Use the OnCreate handler on TForm2
Just open TForm2 in the form editor and double click it to give it its own OnCreate handler:
// in Unit2.pas
procedure TForm2.FormCreate(Sender: TObject);
begin
AlphaBlend := True;
AlphaBlendValue := 128;
end;
3: Override TForm2's constructor
// in Unit2.pas
constructor TForm2.Create(AOwner: TComponent);
begin
inherited;
AlphaBlend := True;
AlphaBlendValue := 128;
end;
4: Set the properties when you create the object
// in Unit1.pas
procedure TForm1.Button1Click(Sender: TObject);
var
Frm: TForm2;
begin
Frm := TForm2.Create(nil);
Frm.Left := 5;
Frm.Top := 5;
Frm.AlphaBlend := True;
Frm.AlphaBlendValue := 128;
Frm.Show;
end;
Unlike the previous three approaches, this one affects only this instance of TForm2 -- it doesn't affect the class itself.
All these approaches work.
There is a "but"
Your line
Frm.Parent := Self
means that you make this form into a control instead of a top-level window.
And layered windows (the Win32 feature on which the VCL's AlphaBlend feature is based) are only supported as child windows in Windows 8 and later.
Therefore, if you are using Windows 7 or earlier, you cannot use AlphaBlend in this case.
I am facing a strange issue. I have set of buttons in a panel and I want to show tooltip for each button. For that I am using TPopUp, but whenever mouse enter, I can observe that memory is increasing for the application. But if I comment the mouse enter and mouse leave events then memory doesn't increase. Did I miss something?
Whenever the mouse enters the button, I can see 0.3MB increase in my task manager.
TfrmEncode = class(TForm)
pnlTop: TPanel;
btnSaveToJSON: TButton;
procedure FormCreate(Sender: TObject);
procedure btnSaveToJSONMouseEnter(Sender: TObject);
procedure btnSaveToJSONMouseLeave(Sender: TObject);
private
{ Private declarations }
pop : TPopup;
cb : TColorBox;
labelText: TLabel;
public
{ Public declarations }
end;
implementation
{$R *.fmx}
procedure TfrmEncode.btnSaveToJSONMouseEnter(Sender: TObject);
begin
Pop.IsOpen := True;
end;
procedure TfrmEncode.btnSaveToJSONMouseLeave(Sender: TObject);
begin
Pop.IsOpen := False;
end;
procedure TfrmEncode.FormCreate(Sender: TObject);
begin
try
pop := TPopup.Create(self);
pop.Parent:= self;
pop.Width:=200;
cb := TColorBox.Create(pop);
cb.Align := TAlignLayout.Client;
cb.Color := TAlphaColors.White;
pop.AddObject(cb);
labelText := TLabel.Create(pop);
labelText.Align :=TAlignLayout.alClient;
labelText.Parent := pop;
labelText.Text := 'This is the hint This is the hint This is the hint This is the hint This is the hint This is the hint This is the hint This is the hint This is the hint This is the hint';
pop.AddObject(labelText);
pop.PlacementTarget := btnSaveToJSON;
pop.Placement:=TPlacement.BottomCenter;
finally
end;
end;
procedure TfrmEncode.FormDestroy(Sender: TObject);
begin
FreeAndNil(pop);
end;
There is a bug in TPopup control. Reported as RSP-21438
TPopup internally creates new TCustomPopupForm every time popup is open. However, that form does not get released when popup is closed (as it should) but only when popup control itself is destroyed.
There are few workarounds
1. Create new TPopup control on open and free it on close
2. Fix FMX.Controls and FMX.Forms
Error can be fixed in implementation section of the above units. That means you can copy FMX.Controls and FMX.Forms into your project folder and Delphi will use those fixed units instead of default ones.
Fix following code:
FMX.Controls - change constructor parameter from False to True - it means popup form will be automatically released on close.
function TPopup.CreatePopupForm: TFmxObject;
...
NewForm := TCustomPopupForm.Create(Self, NewStyle, PlacementTarget, True);
FMX.Forms - assign AutoFree parameter to field.
constructor TCustomPopupForm.Create(AOwner: TComponent; AStyleBook: TStyleBook = nil; APlacementTarget: TControl = nil;
AutoFree: Boolean = True);
var
NewStyleBook: TStyleBook;
begin
FAutoFree := AutoFree;
....
Is there a Windows API for setting up a custom cursor for the form's title bar, system menu icon and minimize, maximize and close buttons?
I'm having a function for loading and setting cursors for a given control:
type
TFrm_Main = class(TForm)
....
private
procedure SetCursor_For(AControl: TControl; ACursor_FileName: string;
Const ACurIndex: Integer);
...
end;
const
crOpenCursor = 1;
crRotateCursor = 2;
crCursor_Water = 3;
var
Frm_Main: TFrm_Main;
...
procedure TFrm_Main.SetCursor_For(AControl: TControl; ACursor_FileName:
string; const ACurIndex: Integer);
begin
Screen.Cursors[ACurIndex] := Loadcursorfromfile(PWideChar(ACursor_FileName));
AControl.Cursor := ACurIndex;
end;
And I'm using it this way for the form:
SetCursor_For(Frm_Main, 'Cursors\Cursor_Rotate.ani', crRotateCursor);
But I'm missing a way to setup cursor for particular form parts like form title bar, system menu icon and minimize, maximize and close buttons. Is there a way to set cursor for these form parts?
Handle the WM_SETCURSOR message and test the message parameter's HitTest field for one of the following hit test code values, and set the cursor by using SetCursor function returning True to the message Result (Windows API macros TRUE and FALSE coincidentally match to the Delphi's Boolean type values, so you can only typecast there):
HTCAPTION - Title bar
HTSYSMENU - System menu icon
HTMINBUTTON - Minimize button
HTMAXBUTTON - Maximize button
HTCLOSE - Close button
For example:
type
TForm1 = class(TForm)
private
procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
end;
implementation
procedure TForm1.WMSetCursor(var Msg: TWMSetCursor);
begin
case Msg.HitTest of
HTCAPTION:
begin
Msg.Result := LRESULT(True);
Winapi.Windows.SetCursor(Screen.Cursors[crHandPoint]);
end;
HTSYSMENU:
begin
Msg.Result := LRESULT(True);
Winapi.Windows.SetCursor(Screen.Cursors[crHelp]);
end;
HTMINBUTTON:
begin
Msg.Result := LRESULT(True);
Winapi.Windows.SetCursor(Screen.Cursors[crUpArrow]);
end;
HTMAXBUTTON:
begin
Msg.Result := LRESULT(True);
Winapi.Windows.SetCursor(Screen.Cursors[crSizeAll]);
end;
HTCLOSE:
begin
Msg.Result := LRESULT(True);
Winapi.Windows.SetCursor(Screen.Cursors[crNo]);
end;
else
inherited;
end;
end;
I have to open many forms in an application and I'm using a TtoolButton and TActionlist as a menu bar. I coded a procedure to create/show each form. I'm having difficult to trigger Form OnActivate event inside this procedure.
Each form is opened inside a Tpanel which is located in the main form FormHome.
I appreciatte your help !
See my code in Delphi 10.2
procedure TFormHome.PR_OpenForm(Pform : TFormClass);
var
vform : TForm;
begin
vform := Pform.Create(Application);
vform.Parent := PanelCorpo;
vform.Align := alclient;
vform.BorderIcons := [biSystemMenu];
vform.BorderStyle := bsNone;
vform.Show;
vform.SetFocus;
vform.OnActivate(??); // That is the issue, how to call this event ?
end;
Thanks in advance !
**Adding complimentary information to explain why I need one single method to create/open my forms **
This is the code I use to open each particular forms. I have one method to each form with exactly the same code. The only difference is the Form instance itself :
procedure TFormHome.OpenDiretorioExecute(Sender: TObject);
begin
if Not Assigned(FormDiretorio) then
begin
FormDiretorio := TFormDiretorio.Create(Self);
FormDiretorio.Parent := PanelCorpo;
FormDiretorio.Align := alclient;
FormDiretorio.BorderIcons := [biSystemMenu];
FormDiretorio.BorderStyle := bsNone;
FormDiretorio.Show;
FormDiretorio.SetFocus;
FormDiretorio.OnActivate(Sender); // In this way , OnActivate works fine
end;
end;
What I need/want :
I need only one method to open all forms. This TFormHome.PR_OpenForm(Pform : TFormClass) coded above is almost there, except by the OnActivate method that is not working !
Could you help me to fix that ?
Thanks!
Sample Code - Project with Old code and new code
===> Main Form "FormHome"
... // This is the main Form FormHOme which calls FormA, FormB and FormC
// There is a TToolbar with 3 Toolbutton that uses a TActionlist
// FormA and FormB are called by the old style method Action1Execute
// and Action2Execute
// FormC is called by the new method PR_CreateOpenForm , which
// presents the error
var
FormHome: TFormHome;
implementation
uses
UnitFormA,
unitFormB,
UnitFormC;
{$R *.dfm}
procedure TFormHome.Action1Execute(Sender: TObject);
// Action1 : OnExecute event, called from ToolButton1
begin
if Not Assigned(FormA) then
begin
FormA := TFormA.Create(Self);
end;
FormA.Parent := Panelhome;
FormA.Align := alclient;
FormA.BorderIcons := [biSystemMenu];
FormA.BorderStyle := bsNone;
FormA.Show;
FormA.SetFocus;
FormA.OnActivate(Sender); // There is a code in OnActivate event in FormA
end;
procedure TFormHome.Action2Execute(Sender: TObject);
// Action2 : OnExecute event , called from ToolButton2
begin
if Not Assigned(FormB) then
begin
FormB := TFormB.Create(Self);
end;
FormB.Parent := Panelhome;
FormB.Align := alclient;
FormB.BorderIcons := [biSystemMenu];
FormB.BorderStyle := bsNone;
FormB.Show;
FormB.SetFocus;
FormB.OnActivate(Sender); // There is a code in OnActivate event in FormB
end ;
procedure TFormHome.Action3Execute(Sender: TObject);
// Action3 OnExecute event, called from ToolButton3
// This is the desired code to implment in all Action OnExecute event
begin
PR_CreateOpenForm(TFormC); // Fails in the OnActivate event
end;
procedure TFormHome.PR_CreateOpenForm(PClassform : TFormClass);
// This routine should be used to create/open all forms
//
var
vform : TForm;
begin
if Not Assigned(Tform(PClassform)) then
begin
vform := Pclassform.Create(Application);
end;
vform.Parent := PanelHome;
vform.Align := alclient;
vform.BorderIcons := [biSystemMenu];
vform.BorderStyle := bsNone;
vform.Show;
vform.SetFocus;
vform.onActivate(self); // Does not work !! Tried with : vform.Onactivate(nil) - vform.Onactivate(Tform)
end;
end.
FORMA - OnActivate event
procedure TFormA.FormActivate(Sender: TObject);
begin
Edit1.Text := 'content from OnActivate';
end;
FORMB - OnActivate event
procedure TFormB.FormActivate(Sender: TObject);
begin
Edit1.Text := 'content from OnActivate';
end;
FORMC - OnActivate event
procedure TFormC.FormActivate(Sender: TObject);
begin
Edit1.Text := 'content from OnActivate';
end;
Error when calls PR_CreateOpenForm(TFormC)
DEBUG - running step by step reach this event handler error :
procedure TWinControl.MainWndProc(var Message: TMessage);
begin
try
try
WindowProc(Message);
finally
FreeDeviceContexts;
FreeMemoryContexts;
end;
except
Application.HandleException(Self);
end;
end;
Please let me know if I have to provide any other information/code in order to have your suggestions and valuable tips !
Thank you guys !
Update
You asked in a comment
The point is : given a parameter PClassForm of TformClass class, how to check if there is any instance of the such parameter created in the Application ? " ,
You can do this using a function like the FormInstance one below. The Screens object of a VCL application has a Forms property, and you can iterate that, looking to see if one of the forms is a specified class, which is returned as the function's result (which it Nil otherwise). Once you have found the instance, you could of course use a cast to call some specific method of it.
function FormInstance(AClass : TClass) : TForm;
var
i : Integer;
begin
Result := Nil;
for i := 0 to Screen.FormCount - 1 do begin
if Screen.Forms[i].ClassType = AClass then begin
Result := Screen.Forms[i];
Break;
end;
end;
end;
procedure TMyForm.Button1Click(Sender: TObject);
var
F : TForm;
begin
F := FormInstance(TForm2);
if F <> Nil then
Caption := 'Found'
else
Caption := 'Not found';
end;
original answerThe way you've written your q seems to tangle up your actual technical q
vform.OnActivate(??); // That is the issue, how to call this event ?
with a lot of issues which aren't directly related. Rather that try to
invoke the OnActivate handler (If there is one), it may be better
to override the form's Activate procedure to do whatever special handling you want
and then leave it to the code in TForm to decide when to invoke the OnActivate. This is less likely to wrong-foot other form behaviour (like in TScreen).
The code below shows how to do this.
type
TForm1 = class(TForm)
procedure FormActivate(Sender: TObject);
protected
procedure Activate; override;
public
end;
[...]
procedure TForm1.Activate;
begin
inherited;
Caption := Caption + ' called from TForm1.Activate';
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
Caption := 'Activated';
end;
Of course, maybe you could just put the code you want to execute in OnActivate in the OnShow handler instead.
Try change the working OpenDiretorioExecute method to shown code below and tell me if you still get the error. Use vform.OnActivate(Self) inside PR_OpenForm. Please also show the OnActivate event handler for TFormDiretorio.
procedure TFormHome.OpenDiretorioExecute(Sender: TObject);
begin
FormDiretorio:=PR_OpenForm(TFormDiretorio) as TFormDiretorio;
(* if Not Assigned(FormDiretorio) then
begin
FormDiretorio := TFormDiretorio.Create(Self);
FormDiretorio.Parent := PanelCorpo;
FormDiretorio.Align := alclient;
FormDiretorio.BorderIcons := [biSystemMenu];
FormDiretorio.BorderStyle := bsNone;
FormDiretorio.Show;
FormDiretorio.SetFocus;
FormDiretorio.OnActivate(Sender); // In this way , OnActivate works fine
end; *)
end;
Change PR_OpenForm to return vForm. I assume you need the variable FormDiretorio.
The error is in this piece of code:
if Not Assigned(TForm(PClassform)) then
begin
vform := PClassform.Create(Application);
end;
If you look in the source for implementation of Assigned() you will see that it only checks wheter the passed in argument is nil or not. Thus, your code doesn't check for the existence of a form of type PClassForm, as you might think. It only checks whether the parameter PClassForm is nil or not.
In your case Assigned() returns true, the form is not created and subsequently vform contains whatever happens to be on the stack. That it only crashes at the line where you call OnActivate() is just a coincidence. You may have destroyed significant data (and probably have) by accessing the uninitialized vform variable.
To prevent errors like this to become fatal, you should initialize local pointer variables to nil if they might stay uninitialized. You probably also got a compiler warning for this but neglected it.
Already earlier I wanted to ask you where you plan to hold references to the forms that you create, so that you can access them, but I didn't, because it was not your question.
You need to decide on that and then use those references, both to check for existense and to access the forms.
In my Delphi XE2 Project, I am having Form1, Label1 and CheckBox1.
My requirement is to set the CheckBox1.Font.Color := clGreen;.
Thought I have written
procedure TForm1.FormCreate(Sender: TObject);
begin
CheckBox1.Font.Color := clGreen;
end;
yet the Font Color is default Black. So I have defined it in other way as follows:
I have removed the Caption from the CheckBox1 and changed the Width to 17.
Then I have placed Label1 next to CheckBox1 like CleckBox1 Caption.
After that I have written:
procedure TForm1.Label1Click(Sender: TObject);
begin
CheckBox1.Click;
end;
to Toggle the state of CheckBox1.
But I am getting [DCC Error] Unit1.pas(37): E2362 Cannot access protected symbol TCustomCheckBox.Click.
And another question is that whether the OnMouseDown Event of CheckBox1 can be triggered as the following image:
The Click() method merely triggers the contro's OnClick event, nothing else. It does not actually cause the control to perform click-related logic, like updating its internal state.
You can toggle the CheckBox's state like this:
CheckBox1.Checked := not CheckBox1.Checked;
Alternatively, use an accessor class to reach protected members:
type
TCheckBoxAccess = class(TCheckBox)
end;
TCheckBoxAccess(CheckBox1).Toggle;
You can use it like :
procedure TForm1.Label1Click(Sender: TObject);
begin
//either
CheckBox1.Checked := not CheckBox1.Checked; // this trigger onClick event!!
// or
// if you absolutely need it..
CheckBox1Click(Sender); // NOTE this will not check or uncheck CheckBox1
end;
But note you use here a TLabel Object (Sender). If you do not use Sender you can do it Without further attention.
But it's better to put the code for enable and disable other control out of the event. only one line for example doenable() .
procedure TForm1.doEnable(enable: Boolean);
begin
Edit1.Enabled := enable;
Edit2.Enabled := enable;
Edit3.Enabled := NOT enable;
if enable then Label1.Font.Color := clGreen else Label1.Font.Color := clWindowText;
...
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
// NOTE This trigger also CheckBox1 Click event.
CheckBox1.Checked := not CheckBox1.Checked;
// NOT needed.
//if CheckBox1.Checked then doEnable(true) else doEnable(false);
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then doEnable(true) else doEnable(false);
end;