How do I pass a message from an object to another object in Free Pascal - lazarus

I have a form and then I have a 'TPageControl' object (named 'MyPages') and a 'TButton' object (named 'MyButton') placed on it at design time.
Then I have a new class called 'TTab' which extends 'TTabSheet'. 'TTab' class has a 'TButton' object as one of its member variables like below.
class TTab = class(TTabSheet)
private
m_btnCloseTab: TButton;
end;
When I click on the 'MyButton', it would create a new 'TTab' object, init the tab (like instantiating the 'm_btnCloseTab') and add it to 'MyPages' at run time.
Procedure TForm1.MyButtonClick(Sender:TObject);
var
newTab: TTab;
newCaption: AnsiString;
begin
newCaption:= 'Tab' + IntToStr(count); //count is a global var
inc(count);
newTab:= TTab.Create(nil);
newTab.Init(newCaption);
newTab.Parent(MyPages);
end;
This is what the TTab.Init(newCaption: AnsiString) Procedure looks like.
Procedure TTab.Init(newCaption: AnsiString);
begin
Self.Caption:= newCaption;
m_btnCloseTab:= TButton.Create(nil);
with m_btnCloseTab do begin
Parent:= Self;
Left:= 10;
Top:= 10;
Caption:= 'Close Tab';
Visible:= True;
OnClick:= #closeTab;
end;
end;
That adds a new tab alright. The close button is also shown on each tab.
How do I click on the 'm_btnCloseTab' on each tab to close that particular tab?
If I define a destructor (by overriding the destructor of the TTabSheet) for TTab like below, I can call it from outside.
Destructor TTab.Destroy;
begin
if m_btnCloseTab <> nil then begin
m_btnCloseTab.Destroy;
m_btnCloseTab:= nil;
end;
inherited;
end;
But I cannot call the Destructor from inside the tab (well, you can). If I do it, I cannot free the m_btnCloseTab object as it would give an exception, because we are still its event handler. If I don't free it, the tab gets closed fine, but the memory gets leaked (because we did not free m_btnCloseTab).
I believe I have to trigger an event so that the destructor can be called from the outside of 'TTab'. I don't know how to do it.
Any help would be appreciated.
Thanks.

You can find Notification methods all over the LCL sources (and in Delphi as well, of course). A simple example is a TLabeledEdit: this is some kind of "TEdit" which contains a TLabel. If the Label is destroyed the LabeledEdit is notified of this because it must set the reference to the label to nil. Otherwise the destructor of TLabeledEdit would attempt to destroy the label again - BOOM. Here the method is like this (pasted from ExtCtrls):
procedure TCustomLabeledEdit.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = FEditLabel) and (Operation = opRemove) then
FEditLabel := nil;
end;
And here you can see what you have to do in your case:
procedure TTab.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = m_BtnCloseTab) and (Operation = opRemove) then
m_BtnCloseTab := nil;
end;
Please note that Notification is a virtual method and must be declared with the attribute "override" in the protected section of the component.

I would use a single button for this task.
Take m_btnCloseTab declaration out of TTab and put it in private main form.
Then on your main form's FormCreate:
m_btnCloseTab := TButton.Create( MyPages );
(the above assumes MyPages is a component placed on the form, if not it must be created first.)
Give the button a top and left that makes sense for your TTab's.
Now m_btnCloseTab will be freed when MyPages is freed which is freed when the form is closed.
Now all you have to do is create your new tabs as you like and when one is focused simply make that tab the parent of your button. You could do this, for instance, in the MyPages OnChange method or whatever it has like that.
When the button is clicked it does something like TTab( Parent ).Free;
However, you may need to store Parent in a local variable in the button's OnClick, say:
TempTab: TTab
Then simply set TempTab := TTab( Parent ), set Button's Parent to nil, then call TempTab.Free;
I would also give your Tabs an owner. That way if the user closes the form with tabs still open (that is, your button hasn't been clicked) the owner will free them.
So declare your tabs like:
newTab:= TTab.Create( MyPages );
This should solve all your problems and, after a bit of fiddling, is quite easy to manage.
One final recommendation I would use the method .Free and/or FreeAndNil( ) rather than calling .destroy directly.

Related

How to use Image1.Bitmap.BitmapChanged;

Bitmap.BitmapChanged; is protected in FMX.Graphics so I cannot use the procedure.
Useing a TImage or TImageControler I am drawing a line but the line does not show.
I am using this snippet:
imgc1.Bitmap.Canvas.BeginScene;
imgc1.Bitmap.Canvas.DrawLine(FStartPoint,FEndPoint, 100);
imgc1.Bitmap.Canvas.EndScene;
imgc1.Bitmap.BitmapChanged; // the original example said that this would redraw the image. In my CE Rio IDE the BitmapChanged is undefind. How can I use it?
Draw the line. IDE cannot find BitmapChanged.
BitmapChanged is a protected member. I need to write some code to handle the OnBitmapChanged event.
I understand now. Almost 30 years of developing in Delphi and this is the first time I have run into protected members. The examples I was using must not have been compiled else the writer would have had the same error that I had.
TBitmap.BitmapChanged() is a virtual method that simply fires the public TBitmap.OnChange event. Since it is protected, you can use an accessor class to reach it:
type
TBitmapAccess = class(TBitmap)
end;
TBitmapAccess(imgc1.Bitmap).BitmapChanged;
However, this is not really needed. TImage assigns its own internal OnChange event handler to its Bitmap. So it should react to changes to the Bitmap automatically. But, if for some reason it does not, the correct way to refresh the TImage is to call its Repaint() method:
imgc1.Repaint;
Which is exactly what TImage's internal OnChange handler does:
constructor TImage.Create(AOwner: TComponent);
begin
inherited;
FBitmap := TBitmap.Create(0, 0);
FBitmap.OnChange := DoBitmapChanged;
...
end;
procedure TImage.DoBitmapChanged(Sender: TObject);
begin
Repaint;
UpdateEffects;
end;

Firemonkey use StylesData to set property of array object in style

I try to set the property of an object when filling a ListBox with ListBoxItems. The object is an ellipse added to the style used by the ListBox. The line of code below raises an exception:
ListBoxItem.StylesData['ellipsestyle.fill.Gradient.Points.Points[0].Color'] := newAlphaColor;
As a workaround, I tried to reach the property by getting the ellipsestyle object with ListBoxItem.FindStyleRessource, but the function returns nil.
Thank you !
StylesData can`t provide access to 'complex' properties.
you can do next workaround:
var
Obj: TObject;
myListBoxItem: TListBoxItem;
begin
// create new item
myListBoxItem:=TListBoxItem.Create(nil);
ListBox1.AddObject(myListBoxItem);
myListBoxItem.StyleLookup:='listboxitembottomdetail';
myListBoxItem.StylesData['ellipsestyle.fill.Kind']:=TValue.From<TBrushKind>(TBrushKind.Gradient);
// access to GradientPoints collection
Obj:=myListBoxItem.StylesData['ellipsestyle.fill.Gradient.Points'].AsObject;
if not (Obj is TGradientPoints) then
Exit;
TGradientPoints(Obj).Points[0].Color:=TAlphaColorRec.Blanchedalmond;
TGradientPoints(Obj).Points[1].Color:=TAlphaColorRec.Alpha;
About FindStyleResource:
First place, where you can get access to style object - OnApplyStyleLookup event of specified ListBoxItem. Before OnApplyStyleLookup (for example - immediatelly after creating Listboxitem) you cannot get access to style.
So, move your code to ListBoxItem.OnApplyStyleLookup and change it like this:
procedure TForm2.ListBoxItem1ApplyStyleLookup(Sender: TObject);
var
FMXObj: TFmxObject;
Ellipse: TEllipse;
begin
if not (Sender is TFmxObject) then
Exit;
FMXObj:=TFMXObject(Sender).FindStyleResource('ellipsestyle');// get object by it`s "StyleName".
if not (FMXObj is TEllipse) then
Exit;
Ellipse:=TEllipse(FMXObj);
Ellipse.Fill.Kind:=TBrushKind.Gradient;
Ellipse.Fill.Gradient.Points.Points[0].Color:=TAlphaColorRec.Blueviolet;
Ellipse.Fill.Gradient.Points.Points[1].Color:=TAlphaColorRec.Greenyellow;
end;
Also, you can force load style (this is not recommended way - by default, style for object loaded at the time of first painting):
var
FMXObj: TFmxObject;
Ellipse: TEllipse;
myListBoxItem: TListBoxItem;
begin
myListBoxItem:=TListBoxItem.Create(nil);
ListBox1.AddObject(myListBoxItem);
myListBoxItem.StyleLookup:='listboxitembottomdetail';
// force load style
myListBoxItem.NeedStyleLookup;
myListBoxItem.ApplyStyleLookup; // this method also call OnApplyStyleLookup event
FMXObj:=myListBoxItem.FindStyleResource('ellipsestyle');
if not (FMXObj is TEllipse) then
Exit;
Ellipse:=TEllipse(FMXObj);
Ellipse.Fill.Kind:=TBrushKind.Gradient;
Ellipse.Fill.Gradient.Points.Points[0].Color:=TAlphaColorRec.Blanchedalmond;
Ellipse.Fill.Gradient.Points.Points[1].Color:=TAlphaColorRec.Alpha;

Create an NSView in an event and return it through a parameter

I'd like to create an NSView derivative in an event and return it to the calling procedure. something like
...
if assigned(FMyEvent) then
FMyEvent(newview)
..
and the event would be assigned something like
procedure TForm6.AssignView(var view: Pointer);
begin
view := Pointer(TNSButton.Wrap(TNSButton.Wrap(TNSButton.OCClass.alloc).initWithFrame(MakeNSRect(200,0,100,50))));
end;
which will return an NSButton in this case.
Now because I want the event to be published I can't use an NSView as a parameter - because NSView is an OSX only definition and the form designer needs to know about the event in Windows as well. So I made it a Pointer type - but this crashes, it looks like a reference counter problem looking at the stack trace.
Could anyone suggest an alternative? or maybe I have to do something to increment the reference count? or if any one can point to some documentation on the delphi/osx interface that would be great.
Update:
I Cheated and just made a container - like this
TNSViewContainer = class
{$IFDEF MACOS}
private
FView: NSView;
procedure SetView(const Value: NSView);
published
property View : NSView read FView write SetView;
{$ENDIF}
end;
and I just pass one of these around - works a treat.

Change checkbox without firing OnChange in firemonkey

There are various tricks in the VCL world to set a checkbox state with out triggering a change event, for example:
yourCheckBox.Perform(BM_SETCHECK, 1, 0)
Or less elegantly removing the event, change the state and restoring the event.
My question is, are there any recognized methods to change the state of a checkbox in firemonkey without causing an OnChange event?
I discovered this answer (Change CheckBox state without calling OnClick Event) that uses helper classes to implement the feature. This is VCL and Firemonkey friendly with the caveat that one can only have one helper class per class. This means if someone else also has a helper class for TCheckbox then only one of the helper classes will be used. The alternative method and one that avoids the helper class issue (pity) is to write a separate method such as:
procedure TfrmMain.setCheckBox (chkBox : TCheckBox; state : boolean);
var OnChangeHandler : TNotifyEvent;
begin
OnChangeHandler := chkBox.OnChange;
chkBox.OnChange := nil;
chkBox.IsChecked := state;
chkBox.OnChange := OnChangeHandler;
end;

TStatusBar flickers when calling Update procedure. Ways to painlessly fix this

So, here is the discussion I have just read:
http://www.mail-archive.com/delphi#delphi.org.nz/msg02315.html
BeginUpdate and EndUpdate is not thi procedures I need ...
Overriding API Call? I tried to get Update procedures code from ComCtrls unit, nut did not found...
Maybe you could post here a code to fix thi flicker of statusbar compoent if the only text changes in it? I mean - something like TextUpdate or some kind of TCanvas method or PanelsRepaint ... ?
The flickering is caused by this code:
Repeat
BlockRead(Fp, BuffArrayDebug[LineIndex], DataCapac, TestByteBuff); // DataCapac = SizeOf(DWORD)
ProgressBar1.StepIt;
if RAWFastMode.Checked then begin // checks for fast mode and modifyies progressbar
if BuffArrayDebug[LineIndex] = 0 then begin ProgressBar2.Max := FileSize(Fp) - DataCapac; ProgressBar2.Position := (LineIndex + 1) * DataCapac; LineDecr := True; end;
end else begin ProgressBar2.Max := FileSize(Fp); ProgressBar2.Position := LineIndex * DataCapac end;
if PreviewOpn.Caption = '<' then begin // starts data copying to preview area if expanded
Memo1.Lines.BeginUpdate;
if (LineIndex mod DataCapac) > 0 then HexMerge := HexMerge + ByteToHex(BuffArrayDebug[LineIndex]) else
begin
Memo1.Lines.Add(HexMerge); HexMerge := '';
end;
Memo1.Lines.EndUpdate;
end;
StatusBar1.Panels[0].Text := 'Line: ' + Format('%.7d',[LineIndex]) + ' | Data: ' + Format('%.3d',[BuffArrayDebug[LineIndex]]) + ' | Time: ' + TimeToStr(Time - TimeVarStart); StatusBar1.Update;
if FindCMDLineSwitch(ParamStr(1)) then begin
TrayIcon.BalloonTitle := 'Processing ' + ExtractFileName(RAWOpenDialog.FileName) + ' and reading ...';
TrayIcon.BalloonHint := 'Current Line: ' + inttostr(LineIndex) + #10#13 + ' Byte Data: ' + inttostr(TestByteBuff) + #10#13 + ' Hex Data: ' + ByteToHex(TestByteBuff);
TrayIcon.ShowBalloonHint;
end;
Inc(LineIndex);
Until EOF(Fp);
Any ideas?
There was comment with this link ( http://www.stevetrefethen.com/blog/UsingTheWSEXCOMPOSITEWindowStyleToEliminateFlickerOnWindowsXP.aspx ) and there is procedure that works ( no flickering whastsoever ), BUT IT IS VVVVVVVEEEEEERRRRRRYYYYYY SLOW!
1 type
2 TMyForm = class(TForm)
3 protected
4 procedure CreateParams(var Params: TCreateParams); override;
5 end;
6
7 ...
8
9 procedure TMyForm.CreateParams(var Params: TCreateParams);
10 begin
11 inherited;
12 // This only works on Windows XP and above
13 if CheckWin32Version(5, 1) then
14 Params.ExStyle := Params.ExStyle or WS_EX_COMPOSITED;
15 end;
16
Also - the target is not the form, but the StatusBar ... how to assign this method to statusbar?
The most important advise I can give you is to limit the number of status bar updates to maybe 10 or 20 per seconds. More will just cause unnecessary flicker, without any benefit for the user - they can't process the information that fast anyway.
OK, with that out of the way: If you want to use the WS_EX_COMPOSITED extended style for the status bar you have basically three options:
Create a descendent class that overrides the CreateParams() method and either install this into your IDE or (if you don't want to have it as its own component in the IDE) create the status bar at runtime.
Create a descendent class with the same name TStatusBar in another unit, override the CreateParams() method, and add this unit after ComCtrls to the form units using status bar controls. This will create an instance of your own TStatusBar class instead of the one in ComCtrls. See this answer for another example of the technique, hopefully its clear enough.
Use the vanilla TStatusBar class and set the WS_EX_COMPOSITED extended style at runtime.
I prefer the third option as the easiest one to experiment with, so here's the sample code:
procedure TForm1.FormCreate(Sender: TObject);
var
SBHandle: HWND;
begin
// This only works on Windows XP and above
if CheckWin32Version(5, 1) then begin
// NOTE: the following call will create all necessary window handles
SBHandle := StatusBar1.Handle;
SetWindowLong(SBHandle, GWL_EXSTYLE,
GetWindowLong(SBHandle, GWL_EXSTYLE) or WS_EX_COMPOSITED);
end;
end;
Edit:
If you want your code to properly support recent Windows versions and visual styles you should not even think of handling WM_ERASEBKGND yourself - the usual technique involves an empty handler for that method, and drawing the background in the WM_PAINT handler. This doesn't really work for standard controls like TStatusBar, as the background has to be drawn somewhere. If you just skip the background drawing in the WM_ERASEBKGND handler you will need to use owner-drawn panels spanning all of the status bar, otherwise the background simply won't be drawn, and the window underneath will shine through. Besides, the code for the owner-drawn panel would probably be very complex.
Again, a much better course of action would be to untangle the mess in your posted code, properly separate worker from display code, and reduce the update speed of your status bar texts to something reasonable. There just isn't any sense at all in going past the number of monitor updates per second, and even this is sensible only for games and similar visualizations.
You should check whether setting the TWinControl.DoubleBuffered property to True of the TStatusBar component will make it work. Also you can try enabling this property to the status bar's parent component (probably TForm). It's a blind shot - don't have access to the compiler from here. Another thought is to override the WM_ERASEBKGND message without calling inherited. First example found after using google: here.
----- Update after author's comment
I finally got access to the compiler and now it's working. We can use the WS_EX_COMPOSITED solution. All you need is is to create your own custom component basing on TCustomStatusBar or just create a class wrapper and create your status bar instance in runtime. Like this:
TMyStatusBar = class( TCustomStatusBar )
protected
{ Flickering work-around }
procedure CreateParams( var Params : TCreateParams ) ; override ;
end ;
TForm1 = class( TForm )
// (...)
private
FStatusBar : TMyStatusBar ;
// (...)
end ;
-------------
procedure TMyStatusBar.CreateParams( var Params : TCreateParams ) ;
begin
inherited ;
if CheckWin32Version( 5,1 ) then
Params.ExStyle := Params.ExStyle or WS_EX_COMPOSITED ;
end ;
-------------
{ Creating component in runtime }
procedure TForm1.FormCreate( Sender : TObject ) ;
begin
FStatusBar := TMyStatusBar.Create( Self ) ;
FStatusBar.Parent := Self ;
FStatusBar.Panels.Add ;
end ;
And it works for me. Good luck!

Resources