I used to drop TZipForge component on a form so I could use its event handlers. Now, I'm using several thread worker to extract some zip files, therefore I create an instance of the TZipForge class as a local variable. How do I make the event handlers without Event tab in Object Inspector?
To create a event hanlder manually yo must create a procedure with match with the declaration of the target event and then assign the Address of that procedure to the event of the class, for example if you want to create a event handle for the OnFileProgress event you must create a procedure like this inside of your class.
procedure FileProgress(Sender: TObject; FileName: string;
Progress: Double; Operation: TZFProcessOperation;
ProgressPhase: TZFProgressPhase; var Cancel: Boolean);
Check this sample
procedure TForm1.FileProgress(Sender: TObject; FileName: string;
Progress: Double; Operation: TZFProcessOperation;
ProgressPhase: TZFProgressPhase; var Cancel: Boolean);
begin
//do your stuff here
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Archiver : TZipForge;
begin
Archiver := TZipForge.Create(nil);
try
Archiver.OnFileProgress:=FileProgress;//<- Here the event handler is assigned
Archiver.FileName := 'compressedfile.zip';
Archiver.OpenArchive(fmOpenRead);
try
Archiver.BaseDir := 'C\Foo';
Archiver.ExtractFiles('*.*');
finally
Archiver.CloseArchive();
end;
finally
Archiver.Free;
end;
end;
Related
I am making descendant of TTreeview and I want to implement an event in the case, when the TTreeview structure changes. For example, one TTreeNode is moved from one position to another, or it becomes the child of any other TTreenode.
When I call for example: Treeview1.Selected.MoveTo(ADropNode,naAddChildFirst);
no event fires.
How can I catch this?
Thanx.
I have found no message so far, what could respond to the change of structure.
The solution in this case was to make descendand of TTreeNode, where I overwrite dynamical procedure MoveTo and attach an event handler to it:
THierarchyTreeNode = class (TTreeNode)
private
FOnNodeMove:TTVNodeMoveEvent;
public
procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); override;
property OnNodeMove:TTVNodeMoveEvent read FOnNodeMove write FOnNodeMove;
end;
...
procedure THierarchyTreeNode.MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode);
begin
inherited;
if Assigned(FOnNodeMove) then FOnNodeMove(Treeview, Self);
end;
then I have done necessary changes in TTreeview descendand, where the procedure CreateNode is the key, where are THierarchyTreeNodes created instead of TTreenode. It is somewhat dirty, but... just an example:
TTreeViewHierarchy = class(TTreeView)
private
FOnNodeMove : TTVNodeMoveEvent;
protected
function CreateNode: TTreeNode; override;
procedure DoNodeMove(Sender: TObject; Node: TTreeNode);
published
property OnNodeMove: TTVNodeMoveEvent read FOnNodeMove write FOnNodeMove;
function TTreeViewHierarchy.CreateNode: TTreeNode;
var
LClass: TTreeNodeClass;
begin
LClass := THierarchyTreeNode;
if Assigned(OnCreateNodeClass) then
OnCreateNodeClass(Self, LClass);
Result := LClass.Create(Items);
(Result as THierarchyTreeNode).FOnNodeMove := DoNodeMove;
end;
procedure TTreeViewHierarchy.DoNodeMove(Sender: TObject; Node: TTreeNode);
begin
if Assigned(FOnNodeMove) then FOnNodeMove(Sender, Node);
end;
And it works...
In Embarcadero Delphi XE7, I use a component which has a help-button.
In the component (which shows a message dialog), I specify a help context number. If the user clicks on the button, the help should show, but I get an error instead:
Project ... raised exception class $C00000FD with message 'stack overflow at 0x006f089e'.
The command executed when the user clicks on the button is:
Application.HelpContext(HelpContextNumber);
On Launch HTML Help as Separate Process, I read that I should attach an OnHelp event handler to the Application object.
I saved the Help unit but how do I attach it?
Application.OnHelp := ....?
The TApplication.OnHelp event is declared as a THelpEvent:
THelpEvent = function(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean of object;
So, you would need to declare a method in your Form like this:
type
TMyForm = class(TForm)
...
private
function MyOnHelpHandler(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean;
...
end;
And then you can assign that handler to the TApplication.OnHelp event at runtime, eg:
procedure TMyForm.FormCreate(Sender: TObject);
begin
Application.OnHelp := MyOnHelpHandler;
end;
procedure TMyForm.FormDestroy(Sender: TObject);
begin
Application.OnHelp := nil;
end;
function TMyForm.MyOnHelpHandler(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean;
begin
Result := ...;
end;
Alternatively, you can drop a TApplicationEvents component onto your Form at design-time, and then create an OnHelp event handler for it using the Object Inspector.
when a User adds or changes something in the Programm , on the FormQuery I check if there was something modified and no Save done and I warn the user that if he quits all data will be lost .
Problem is I am checking the Components one at a time . Edit has Modified , but DateTimePicker has none for example .
My question is : if possible how can you check with one command perhaps if anything on the Form was altered ? Any Control ?
UPDATE
I was thinking about something universal if such a thing exists , something like this but for every controller that can be altered by the user in any way .
Drop 4 TEdit's on the form and one TLabel .
procedure TForm1.SomethingChanged(Sender: TObject);
begin
Label1.Caption:='SOMETHING CHANGED!';
end;
on TForm.Create I do this :
procedure TForm1.FormCreate(Sender: TObject);
var i : integer;
Child : TComponent;
begin
for i := 0 to ComponentCount-1 do
begin
Child := Components[i];
if Child is TEdit then
TEdit(Child).OnChange:=SomethingChanged;
if Child is TDateTimePicker then
TDateTimePicker(Child).OnChange:=SomethingChanged;
if Child is TComboBox then
TComboBox(Child).OnChange:=SomethingChanged;
end;
end;
I Could make this for all controls like : Editors , DateTimePickers , ComboBoxes etc... but I was thinking that maybe there is some cool "secret" smarter way to do this .
Thank you
UPDATE 2
now I have another problem , dunno if possible . Say one of the TEdit's have a onChange event defined like this :
procedure TForm1.Edit1Change(Sender: TObject);
begin
Label2.Caption:='THIS WAS EDIT1CHANGE';
end;
When the Application starts this is reset to my custom onChange event and this one is never run .
Is it possible to somehow chain onChange events ?
Like I have the one where I only check if something changed ... and yet I allow the TEdit to execute it's "normal" onChange event .
Thank you
I think The key Here is that these components are mostly TWinControl descendant, So why not hook to their OnChange Message CM_CHANGED and this way you will not have a problem with OnChange event chaining as you say it (I wish Delphi had some thing like C# += operator when it comes to events).
you will need the following classes to achieve this
1. TListener
TListener = class
private
FOnChangeHappend: TNotifyEvent;
FWinControl: TWinControl;
FMsgToListen: Cardinal;
FOldWndProc: System.Classes.TWndMethod;
procedure FWindowProc(var Message: TMessage);
public
constructor Create(aWinControl: TWinControl; aMsg: Cardinal);
Destructor Destroy;
property OnChangeHappend: TNotifyEvent read FOnChangeHappend write FOnChangeHappend;
end;
{ TListener }
constructor TListener.Create(aWinControl: TWinControl; aMsg: Cardinal);
begin
FMsgToListen := aMsg;
FWinControl := aWinControl;
FOldWndProc := aWinControl.WindowProc;
aWinControl.WindowProc := FWindowProc;
end;
destructor TListener.Destroy;
begin
if Assigned(FOldWndProc) then
FWinControl.WindowProc := FOldWndProc;
inherited Destroy;
end;
procedure TListener.FWindowProc(var Message: TMessage);
begin
if ((Message.Msg = FMsgToListen) and (Assigned(FOnChangeHappend))) then
begin
FOnChangeHappend(FWinControl);
end;
FOldWndProc(Message);
end;
2. TListenerList
TListenerList = class
private
FListners: TObjectList<TListener>;
FOnChangeHappend: TNotifyEvent;
public
constructor Create;
Destructor Destroy;
procedure ListenTo(aWinControl: TWinControl; aMsg: Cardinal);
property OnChangeHappend: TNotifyEvent read FOnChangeHappend write FOnChangeHappend;
end;
{ TListenerList }
constructor TListenerList.Create;
begin
FListners := TObjectList<TListener>.Create;
FListners.OwnsObjects := True;
end;
destructor TListenerList.Destroy;
begin
FListners.Free;
end;
procedure TListenerList.ListenTo(aWinControl: TWinControl; aMsg: Cardinal);
var
aListener: TListener;
begin
aListener := TListener.Create(aWinControl, aMsg);
aListener.OnChangeHappend := FOnChangeHappend;
Flistners.Add(aListener);
end;
And you can use it like this in your form OnCreate event
procedure TForm8.FormCreate(Sender: TObject);
begin
FListenerList := TListenerList.Create();
FListenerList.OnChangeHappend := TextChanged;
FListenerList.ListenTo(DBEdit1, CM_CHANGED);
FListenerList.ListenTo(DBMemo1, CM_CHANGED);
FListenerList.ListenTo(DBComboBox1, CM_CHANGED);
FListenerList.ListenTo(DBCheckBox1, CM_CHANGED);
FListenerList.ListenTo(DBRichEdit1, CM_CHANGED);
FListenerList.ListenTo(Memo1, CM_CHANGED);
FListenerList.ListenTo(Edit1, CM_CHANGED);
FListenerList.ListenTo(ComboBox1, CM_CHANGED);
FListenerList.ListenTo(DateTimePicker1, CM_CHANGED);
FListenerList.ListenTo(CheckBox1, CM_CHANGED);
end;
procedure TForm8.TextChanged(Sender: TObject);
begin
memo2.Lines.Add(TWinControl(Sender).Name + 'Changed');
end;
but this message has a limitation. For example if the edit control had the text 'Hello' and you wanted to delete it (back key press) the Listener event will be fired five times (one for each letter) so instead you should use the CM_ENTER and CM_EXIT messages were you record the value of each TWinControl when entered (has focus) and compare that to its value when exited (lost focus).
This approach will work with any TWinControl descendant (pretty much any control that the user can interact with)
if you use dbedit,dbcombobax.. you can do control.
because
you must have linked them to a table or query.
you must use datasource for links.
if table1.state=dsedit then
begin
end;
Define a variable if you are using edit.
Assign value to the variable in the onchange event of all fields. Then check this variable.
procedure Tform1.editChange (Sender: TObject);
begin
variable_change:= 'YES';
end;
if variable_change = 'YES' then
begin
end;
I have done a very simply subclass of the TSwitch that will not respond to mouse clicks or even allow setting IsChecked at runtime. I have not created this as a component so its only runtime constructed. It works if I create a TSwitch at runtime but will not work if its my subclassed switch.
TLayoutSwitch = class(TCustomSwitch, ILayoutBaseControl)
The issue appears to be in SendMessage called by TSwitchModel.SetValue. In TMessageSender.SendMessage. I cannot figure out how TSwitchModel is constructed so that the Receiver object is set.
RAD Studio 10 Seattle
TLayoutSwitch = class(TCustomSwitch, ILayoutBaseControl)
private
FGroupID: integer;
procedure SetGroupID(const Value: integer);
function GetIBHeight: Single;
function GetIBWidth: Single;
procedure SetIBHeight(const Value: Single);
procedure SetIBWidth(const Value: Single);
procedure DoSwitchEvent(Sender: TObject);
public
LayoutControlType: TLayoutControlType;
property LFIBGroup_ID: integer read FGroupID write SetGroupID;
property LFIBWidth: Single read GetIBWidth write SetIBWidth;
property LFIBHeight: Single read GetIBHeight write SetIBHeight;
procedure WriteToStream(ms: TStream);
procedure ReadFromStream(ms: TStream; NewWidth: Single = 1; NewHeight: Single = 1);
constructor Create(AOwner: TComponent); override;
end;
Instantiate code
ctrl := TLayoutSwitch.Create(Background);
ctrl.Parent := Background;
ctrl.BringToFront;
(ctrl as ILayoutBaseControl).ReadFromStream(ms, Background.Width/tmpW, Background.Height/tmpH);
Your class name TLayoutSwitch "misguides" FMX to search for a presenter named LayoutSwitch-style which of course doesn't exist in the framework. However, it is possible to change that name to the ordinary Switch-style in the OnPresentationNameChoosing event which is fired directly after the standard name construction.
Declare a TPresenterNameChoosingEvent procedure in your class, for example:
procedure ChoosePresentationName(Sender: TObject; var PresenterName: string);
and assign this to the event in the constructor
constructor TLayoutSwitch.Create(Owner: TComponent);
begin
inherited;
OnPresentationNameChoosing := ChoosePresentationName;
...
end;
Implementation could be as simple as
procedure TLayoutSwitch.ChoosePresentationName(Sender: TObject; var PresenterName: string);
begin
PresenterName := 'Switch-style';
end;
The Switch-style presenter/presentation is the one used by TSwitch. Therefore it now looks and behaves the same.
Delphi XE6 - I have a Unit (EMAIL1.pas) which does related processing. This is meant to be a standalone unit I can incorporate into multiple programs. My initial procedure is called GetDetailsFromEmailAddress. It has two parameters, an email address which I lookup and a "group of data" which will get updated, currently defined as a var. This can be a record or a class, I don't really care. It is just a group of related strings (firstname, last name, city, etc). Let's call this EmpRec.
My challenge is that this procedure creates an instance of a class (JEDI VCL HTMLParser) which uses a method pointer to call a method (TableKeyFound). This routine needs to update EmpRec. I do not want to change this code (HTMLPArser routine) to add additional parameters. There are several other procedures that my UNIT creates. All of them need to read/update EmpRec. How do I do this?
I need a way to "promote" the variable EmpRec which is passed in this one routine (GetDetailsFromEmailAddress) to be GLOBAL within this UNIT so that all the routines can access or change the various elements. How do I go about this? I do NOT really want to have to define this as a GLOBAL / Application wide variable.
Code sample below. So.. How does the routine TableKeyFoundEx get access to the EmpRec variable?
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
begin
...
// Now create the HTML Parser...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
// On event KeyFoundEx, call Parsehandlers.TableKeyFoundEx;
JvHtmlParser1.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
...
end.
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo;
Attributes: TStrings);
begin
..
// NEED ACCESS to EmpRec here, but can't change procedure definition
end;
There are two different ways I would approach this:
use the parser's Tag property:
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
begin
...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
JvHtmlParser1.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
JvHtmlParser1.Tag := NativeInt(#EmpRec);
...
end;
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo; Attributes: TStrings);
var
EmpRec: PEmpRec; // assuming PEmpRec = ^TEmpRec
begin
EmpRec := PEmpRec(TJvHTMLParser(Sender).Tag);
...
end;
use a little TMethod hack to pass the record DIRECTLY to the event handler:
// Note: this is declared as a STANDALONE procedure instead of a class method.
// The extra DATA parameter is where a method would normally pass its 'Self' pointer...
procedure TableKeyFoundEx(Data: Pointer: Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo; Attributes: TStrings);
var
EmpRec: PEmpRec; // assuming PEmpRec = ^TEmpRec
begin
EmpRec := PEmpRec(Data);
...
end;
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
var
M: TMethod;
begin
...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
M.Code := #TableKeyFoundEx;
M.Data := #EmpRec;
JvHtmlParser1.OnKeyFoundEx := TJvKeyFoundExEvent(M);
...
end;
In addition to the two options that Remy offers, you could derive a sub-class of TJvHTMLParser.
type
PEmpRec = ^TEmpRec;
TMyJvHTMLParser = class(TJvHTMLParser)
private
FEmpRec: PEmpRec;
public
constructor Create(EmpRec: PEmpRec);
end;
....
constructor TMyJvHTMLParser.Create(EmpRec: PEmpRec);
begin
inherited Create(nil);
FEmpRec := EmpRec;
end;
When you create the parser, do so like this:
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
var
Parser: TMyJvHTMLParser;
begin
Parser := TMyJvHTMLParser.Create(#EmpRec);
try
Parser.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
....
finally
Parser.Free;
end;
end.
And in your OnKeyFoundEx you cast Sender back to the parser type to gain access to the record:
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; ...);
var
EmpRec: PEmpRec;
begin
EmpRec := (Sender as TMyJvHTMLParser).FEmpRec;
....
end;