I am using PNGImage library in my project, which entire GUI is made up of .png images, which i loaded to TImages at run-time. For some purposes i have to dynamically create plenty of components groups that are similar to each other. Every group consists of some TImages and have a button that lets user proceed to another page with more details about clicked item.
The code i am using:
procedure TMain_Frame.selection_click(Sender: TObject);
var id: string;
begin
id := StringReplace(TLabel(sender).Name, 'label_item_select_', '', [rfReplaceAll]);
hide_created_components; // It does Free all components
show_details(id);
end; // (1)
Access violation error occurs at (1). The odd thing is that it happenes completly random: error may happen at the very first click or may not happen for 10 clicks. If no error occured, F8 leads me inside PNGImage library where some stuff is done. However when error occurs, F7/8 immediately throws it without doing what it has to. This problem happenes only when i go from dynamicaly created objects to static.
CPU window shows that error occured at this ASM code:
movzx ecx, [edi]
ecx value is 755A2E09, edi is 00000000
Is it correct to .Free all dynamically created components? Or should be .Destroy used instead? And why does PNGImage goes inside itself on procedure end;?
Demo:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, pngimage, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure selection_click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure create_label;
var Button: TLabel;
begin
Button := TLabel.Create(Form1);
with Button do
begin
Name := 'dynamic_label_1';
Parent := Form1;
Autosize := false;
Left := 100;
Top := 100;
Width := 150;
Height := 20;
Caption := 'Dynamic Label: Click Me';
BringToFront;
Cursor := crHandPoint;
end;
Button.OnClick := Form1.selection_click;
end;
procedure hide_dyn_label(L: TLabel; mode: boolean);
begin
if mode then
begin
L.Free;
Form1.Image1.Picture.LoadFromFile(PAnsiChar('button_close.png'));
Form1.Image1.Visible := true;
end
else
create_label;
end;
procedure TForm1.selection_click(Sender: TObject);
var id: string;
begin
id := StringReplace(TLabel(Sender).Name, 'dynamic_label_', '', [rfReplaceAll]);
Form1.Button1.Visible := true;
hide_dyn_label(Form1.FindComponent('dynamic_label_1') as TLabel, true);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
create_label;
Form1.Image1.Visible := false;
Form1.Button1.Visible := false;
end;
end.
You are freeing the TLabel while still in its OnClick event handler, Selection_Click which calls hide_dyn_label() which calls L.Free. You can't do that. Use some kind of delayed destruction, f.ex. with a boolean variable FreeDynLabels which you can check in Application.OnIdle. Or post a custom message to the form.
Related
I have created a simple Delphi form with a button that, when pressed, creates a label object in run time. I have created an on double click event for the label that shows a message to the screen. The problem is that after creating the label, I have to double click on the form before the double click event works on the label. Obviously this is not ideal as I would like to be able to double click on the label and trigger the event without having to first double click the form.
Here is the code for my form:
unit Unit4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm4 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDblClick(Sender: TObject);
procedure MyLabelDblClick(Sender:TObject);
private
{ Private declarations }
LabelObject: TLabel;
public
{ Public declarations }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
procedure TForm4.Button1Click(Sender: TObject);
begin
LabelObject := TLabel.Create(Self);
LabelObject.Left := 100;
LabelObject.Top := 100;
LabelObject.Width := 200;
LabelObject.Height := 20;
LabelObject.Visible := True;
LabelObject.Parent := Self;
LabelObject.Caption := 'My Run Time Label';
LabelObject.Cursor := crHandPoint;
end;
procedure TForm4.FormDblClick(Sender: TObject);
begin
LabelObject.OnDblClick := MyLabelDblClick;
end;
procedure TForm4.MyLabelDblClick(Sender: TObject);
begin
showmessage('You double clicked My Run Time Label');
end;
end.
Thanks in advance for any help with this matter.
The problem is that after creating the label, I have to double click on the form before the double click event works on the label.
Assign LabelObject.OnDblClick when creating the label, i.e. inside the Button1Click event.
I am looking to create an effect similar to the lightbox effect seen on many website where the background of the screen fades out and the content you want to emphasize does not. What would be the best way to go about creating such an effect in delphi ?
The content I want to emphasize in this case is a movable panel located on my form and basically all I want to do is to fade out any area of the screen that is not directly under that panel.
Thanks.
Oscar
Create a new form and add this code to the FormCreate method. You could also change the properties using the properties inspector, but I'm choosing to show you the relevant properties using code:
unit Unit1;
// This is a full screen partially transparent black form.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
Self.WindowState := wsMaximized;
AlphaBlend := true;
Alphablendvalue := 127;
Color := clBlack;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm1.FormClick(Sender: TObject);
begin
Close;
end;
end.
Here's a second form which has no border, which I am showing over top. It does not have alpha blending turned on, and the form style should be fsStayOnTop, or else you should use the ParentWindow property (on versions of Delphi that support that).
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm2 = class(TForm)
Label1: TLabel;
procedure FormDeactivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FAutoDeactivate: Boolean;
FCounter: Integer;
procedure WMUser1(var Message:TMessage); message WM_USER+1;
public
property AutoDeactivate:Boolean read FAutoDeactivate write FAutoDeactivate;
end;
var
Form2: TForm2;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm2.FormDeactivate(Sender: TObject);
begin
if Self.Visible and FAutoDeactivate then
begin
FAutoDeactivate := false;
Form1.Close;
end;
end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form1.Close;
end;
procedure TForm2.FormActivate(Sender: TObject);
begin
PostMessage(Self.Handle, WM_USER+1, 0, 0);
end;
procedure TForm2.WMUser1(var Message: TMessage);
begin
FAutoDeactivate := true;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
Color := clWhite;
FormStyle := fsStayOnTop; // or set parent
end;
end.
That addresses how to make the whole screen "go dim", and then show something on top of that "dimmed area", but what you describe as "showing a panel in your main form" would require you to move that content out of your main form, or else clip a region out of form1, or use a combination of alpha blend plus transparency, but I don't have any code for those to show you.
If I was doing it, I would just float the thing I want not to be dimmed, above the full screen borderless 50% alpha form, as shown below.
But as you see, the screen isn't dimmed (screen brightness is not reduced), it's merely that we've done a 50% transparent layer of black which has blended in and darkened the overall screen appearance.
I have the same need as Oscar. After some search on the net, I found what is shown here.
It has helped me to do this, since it works. You can move what is emphasized in a Form instead of a Panel.
I use two forms. The first is use as "fader" and the second as dialogbox.
First
unit uFormFaded;
interface
uses
...
type
TFormFaded = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormFaded: TFormFaded;
implementation
{$R *.dfm}
procedure TFormFaded.FormCreate(Sender: TObject);
begin
Align := alClient;
AlphaBlend := true;
AlphaBlendValue := 100;
BorderStyle := bsNone;
Color := clBlack;
Enabled := false;
FormStyle := fsStayOnTop;
end;
end.
Second
unit UFormDlgBox;
interface
uses
...
type
TFormDlgBox = class(TForm)
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormDlgBox: TFormDlgBox;
implementation
{$R *.dfm}
uses uFormFaded;
procedure TFormDlgBox.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FormFaded.Close;
end;
procedure TFormDlgBox.FormShow(Sender: TObject);
begin
FormFaded.Show;
end;
end.
The use
FormDlgBox.ShowModal;
I tried to reproduce this schema creating the forms in run-time an make the TFormDlgBox Owns and create the TFormFaded but it doesn't work. It seems it works only with forms created in design-time.
I am looking to create an effect similar to the lightbox effect seen on many website where the background of the screen fades out and the content you want to emphasize does not. What would be the best way to go about creating such an effect in delphi ?
The content I want to emphasize in this case is a movable panel located on my form and basically all I want to do is to fade out any area of the screen that is not directly under that panel.
Thanks.
Oscar
Create a new form and add this code to the FormCreate method. You could also change the properties using the properties inspector, but I'm choosing to show you the relevant properties using code:
unit Unit1;
// This is a full screen partially transparent black form.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
Self.WindowState := wsMaximized;
AlphaBlend := true;
Alphablendvalue := 127;
Color := clBlack;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm1.FormClick(Sender: TObject);
begin
Close;
end;
end.
Here's a second form which has no border, which I am showing over top. It does not have alpha blending turned on, and the form style should be fsStayOnTop, or else you should use the ParentWindow property (on versions of Delphi that support that).
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm2 = class(TForm)
Label1: TLabel;
procedure FormDeactivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FAutoDeactivate: Boolean;
FCounter: Integer;
procedure WMUser1(var Message:TMessage); message WM_USER+1;
public
property AutoDeactivate:Boolean read FAutoDeactivate write FAutoDeactivate;
end;
var
Form2: TForm2;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm2.FormDeactivate(Sender: TObject);
begin
if Self.Visible and FAutoDeactivate then
begin
FAutoDeactivate := false;
Form1.Close;
end;
end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form1.Close;
end;
procedure TForm2.FormActivate(Sender: TObject);
begin
PostMessage(Self.Handle, WM_USER+1, 0, 0);
end;
procedure TForm2.WMUser1(var Message: TMessage);
begin
FAutoDeactivate := true;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
Color := clWhite;
FormStyle := fsStayOnTop; // or set parent
end;
end.
That addresses how to make the whole screen "go dim", and then show something on top of that "dimmed area", but what you describe as "showing a panel in your main form" would require you to move that content out of your main form, or else clip a region out of form1, or use a combination of alpha blend plus transparency, but I don't have any code for those to show you.
If I was doing it, I would just float the thing I want not to be dimmed, above the full screen borderless 50% alpha form, as shown below.
But as you see, the screen isn't dimmed (screen brightness is not reduced), it's merely that we've done a 50% transparent layer of black which has blended in and darkened the overall screen appearance.
I have the same need as Oscar. After some search on the net, I found what is shown here.
It has helped me to do this, since it works. You can move what is emphasized in a Form instead of a Panel.
I use two forms. The first is use as "fader" and the second as dialogbox.
First
unit uFormFaded;
interface
uses
...
type
TFormFaded = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormFaded: TFormFaded;
implementation
{$R *.dfm}
procedure TFormFaded.FormCreate(Sender: TObject);
begin
Align := alClient;
AlphaBlend := true;
AlphaBlendValue := 100;
BorderStyle := bsNone;
Color := clBlack;
Enabled := false;
FormStyle := fsStayOnTop;
end;
end.
Second
unit UFormDlgBox;
interface
uses
...
type
TFormDlgBox = class(TForm)
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormDlgBox: TFormDlgBox;
implementation
{$R *.dfm}
uses uFormFaded;
procedure TFormDlgBox.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FormFaded.Close;
end;
procedure TFormDlgBox.FormShow(Sender: TObject);
begin
FormFaded.Show;
end;
end.
The use
FormDlgBox.ShowModal;
I tried to reproduce this schema creating the forms in run-time an make the TFormDlgBox Owns and create the TFormFaded but it doesn't work. It seems it works only with forms created in design-time.
Sometimes a keystroke on a form can have different recipents, depending on the state of the application. See the following sample:
unit Unit1;
interface
uses
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
ComCtrls,
Buttons;
type
TForm1 = class(TForm)
private
ListView1: TListView;
ButtonOK: TBitBtn;
ButtonCancel: TBitBtn;
procedure ButtonClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TForm1.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
ClientWidth := 300;
ClientHeight := 240;
ListView1 := TListView.Create(Self);
ListView1.Name := 'ListView1';
ListView1.Parent := Self;
ListView1.Height := 200;
ListView1.Align := alTop;
ListView1.AddItem('aaaaa', nil);
ListView1.AddItem('bbbbb', nil);
ListView1.AddItem('ccccc', nil);
ButtonOK := TBitBtn.Create(Self);
ButtonOK.Parent := Self;
ButtonOK.Left := 8;
ButtonOK.Top := 208;
ButtonOK.Kind := bkOK;
ButtonOK.OnClick := ButtonClick;
ButtonCancel := TBitBtn.Create(Self);
ButtonCancel.Parent := Self;
ButtonCancel.Left := 90;
ButtonCancel.Top := 208;
ButtonCancel.Kind := bkCancel;
ButtonCancel.OnClick := ButtonClick;
end;
procedure TForm1.ButtonClick(Sender: TObject);
begin
ShowMessage((Sender as TBitBtn).Caption);
Application.Terminate;
end;
end.
(To run this, create a standard VCL app and replace the contents of Unit1.pas with the above.)
If one starts the app and presses Enter or Esc, the appropriate button are "clicked". However when one starts editing the listview (by clicking one and a half time on an item) Enter and Esc should accept or cancel the editing which they don't - they still "click" the buttons.
Similar scenarios exist if one has actions with shortcuts F2 or F4 on a form containing a cxGrid, which by default uses these shortcuts to start edit mode or drop down combobox editors.
Do you have an idea how I can continue do use the comfort of TButton.Default/Cancel and actions, while not having to reimplement the key handling of all the components I use?
I guess you have bad luck with the controls you use. TMemo handles it correctly, but indeed an editable TListView does not. The problem seems to originate from win32 rather then the VCL wrapper around it. So it eems that you have to reimplement the key handling on TListView if you do not like its current behavior.
procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
procedure TMyListView.WMGetDlgCode(var Message: TMessage);
begin
inherited;
if IsEditing then
Message.Result := Message.Result or DLGC_WANTALLKEYS;
end;
Since all controls behave different and it is the controls themselves that decide which keys they are interested in, I can't see how you could fix it without having to change unwanted behavior.
I have to create an array and place all controls there in order to access them.Here's a short example:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
const Test:Array[0..2] of TButton = (Button1,Button2,Button3);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
end.
Undeclarated idenitifier 'Button1' at the line where I declarated my array.But it's declarated three lines above.
Where's the problem,how to put all controls in an array?
EDIT:
Thank you for your answers,but I've got problems:
var TestA:TObjectList<TButton>;
var index:TComponent;
begin
TestA := TObjectList<TButton>.Create(false);
for index in Form7 do
if pos(index.name, 'Button') = 1 then
TestA.add(TButton(index));
TestA[0].Caption := 'Test'; //Exception out of range.
Ben's right. You can't set up a control array in the form designer. But if you have 110 images, for this specific case you can put them into a TImageList component and treat its collection of images as an array.
If you've got a bunch of more normal controls, like buttons, you'll have to create an array and load them into it in code. There are two ways to do this. The simple way, for small arrays at least, is Ben's answer. For large control sets, or ones that change frequently, (where your design is not finished, for example,) as long as you make sure to give them all serial names (Button1, Button2, Button3...), you can try something like this:
var
index: TComponent;
list: TObjectList;
begin
list := TObjectList.Create(false); //DO NOT take ownership
for index in frmMyForm do
if pos('Button', index.name) = 1 then
list.add(index);
//do more stuff once the list is built
end;
(Use a TObjectList<TComponent>, or something even more specific, if you're using D2009.) Build the list, based on the code above, then write a sorting function callback that will sort them based on name and use it to sort the list, and you've got your "array."
You may not be able to reference public properties of your form in an array constant like that. Try doing it in your form constructor/OnCreate event instead.
procedure TForm1.FormCreate(Sender: TObject);
begin
Test[0] := Button1;
Test[1] := Button2;
Test[2] := Button3;
end;
This function will iterate over all the controls on a specified container, like a particular TPanel or even the entire form, and populate a specified TObjectList with your TImage controls.
procedure TForm1.AddImageControlsToList(AParent: TWinControl; AList: TObjectList; Recursive: boolean);
var
Index: integer;
AChild: TControl;
begin
for Index := 0 to AParent.ControlCount - 1 do
begin
AChild := AParent.Controls[Index];
if AChild is TImage then // Or whatever test you want to use
AList.Add(AChild)
else if Recursive and (AChild is TWinControl) then
AddImageControlsToList(TWinControl(AChild), AList, True);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Call like this or similar to get your list of images
// (assumes MyImageList is declared in Form)
MyImageList := TObjectList.Create(False);
AddImageControlsToList(Self, MyImageList, True);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// Destroy the list
FreeAndNil(MyImageList);
end;
How about this?
procedure TForm1.FormCreate(Sender: TObject);
begin
for b := 1 to 110 do
Test[b] := FindComponent('Button' + IntToStr(b)) as TButton;
end;
You'll have to declare the array as a variable rather than a constant and it will have to go from 1 to 110 rather than 0 to 109 but that's no problem.
I use this all the time - it is simple and fast (despite Mr Wheeler's comment)- declare the maxbuttons as a constant
var
Form1: TForm1;
pbutton:array[1..maxbuttons] of ^tbutton;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
(* Exit *)
var k:integer;
begin
for k:=1 to maxbuttons do dispose(pbutton[k]);
close;
end;
procedure TForm1.FormActivate(Sender: TObject);
var k:integer;
begin
(*note the buttons must be Button1, Button2 etc in sequence or you need to
allocate them manually eg pbutton[1]^:=exitbtn etc *)
for k:=1 to maxbuttons do
begin
new(pbutton[k]);
pbutton[k]^:= tbutton(FindComponent('Button'+IntToStr(k)));
end;
end;
procedure TForm1.ButtonMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var k:integer;
b:boolean;
begin
b:=false;
k:=1;
while (k<= maxbuttons) and (not b) do
begin
if pbutton[k]^ = sender then (Note sender indicates which button has been clicked)
begin
{ found it so do something}
b:=true;
end;
k:=k+1;
end;
end;
Try this
var
TestA:TObjectList;
index:TComponent;
begin
TestA := TObjectList<TButton>.Create(false);
try
for index in Form7 do
if (pos is TButton) OR {or/and} (pos.tag and 8=8) then
TestA.add(TButton(index));
if TestA.Count>0 then //Fix:Exception out of range.
TestA[0].Caption := 'Test';
finally
TestA.Free;
end;
end;