TJvDockServer and dockable controls - delphi

I'm programming in Delphi (BDS 2006) and the JVCL library, using the docking modules. I have one problem - if the control has properties DragKind = dkDock and DragMode = dmAutomatic, then inexplicably TJvDockServer component takes the controls are both clients and provides docking. This is wrong, because, as I found out, JVCL's docking functions normally only control class TForm which contain a component class TJvDockClient. I would like to know whether it is possible in some way to prevent TJvDockServer from docking controls whose class is different from TForm? During a typical docking in Delphi for each event is called OnGetSiteInfo dock and it is possible to filter clients, but there is no such event in TJvDockServer.

The property DragKind and DragMode are standard VCL properties. Docking is built into the VCL, and from looking at it, it seems to work pretty good without any Jedi Code involved.
The ability to dock something other than a form, is already built into the VCL. Therefore that you find this inexplicable suggests to me that you thought Jedi added docking to the VCL. No, it just added some pretty things like "tabbed notebook docking" and "conjoined areas" with fake window titlebars.
That being said, Forms are also inheriting from TCustomControl, and any TCustomControl can in fact, be docked. And just like the VCl lets you drag and dock and land on top of TPanels. Okay it's a quirky feature, that your panel can turn into a form on you at runtime, but if you don't believe me, try it. It's the VCL doing this to you, not Jedi.
If in your wisdom, you want to block anything that is not a TForm, I thought that you can.
Surely you can right? Update. Yes you can. OnDockOver works fine to block docking on any panel you want to block docking on. The trick with the Jedi JvDockPanels is that you don't see them at designtime, so you need to access their events by hooking them up in code, at runtime.
Just like regular TPanels, JvDockPanels have a TPanel.OnDockOver event, and if you want to check the thing you're docking, and set the Accept to false, it will be prevented from docking.
Okay, this works:
type
TCustomControlAccess = class(TCustomControl);
procedure TMainForm.FormCreate(Sender: TObject);
begin
TCustomControlAccess(dockServer.TopDockPanel).OnDockOver := MyDockOverEvent;
TCustomControlAccess(dockServer.CustomDockPanel).OnDockOver := MyDockOverEvent;
...
end;
The JvDockPanel.OnDockOver panel events DO fire, but you need to resort to a hack like the above hack, to actually handle the events yourself.
Update previously thought there was no way to block this. But I was wrong. Figured it out.

while i cannot reproduce exactly your behaviour in Delphi XE2, generally i seem manage to block VCL-frag-n-drop for JediVCL components.
Maybe it is not the best possible way, but i don't know which were original ideas of the framework creator.
http://wiki.delphi-jedi.org/wiki/JVCL_Help:TJvDockServer claims only forms should be docked. Did not enforced that, just hardwired JVCL check routine to be always called.
unit JvDockSupportControl;
....
TJvDockCustomControl = class(TJvCustomControl)
....
protected
procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
MousePos: TPoint; var CanDock: Boolean); override;
...........
function TJvDockCustomControl.GetJvDockManager: IJvDockManager;
begin
// Result := IJvDockManager(DockManager);
DockManager.QueryInterface(IJvDockManager, Result);
end;
procedure TJvDockCustomControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
var jdm: IJvDockManager; idm: IDockManager;
begin
idm := DockManager;
if nil <> idm then
idm.QueryInterface(IJvDockManager, jdm);
if nil = jdm
then CanDock := false
else jdm.GetSiteInfo(Client,InfluenceRect, MousePos, CanDock);
end;
unit JvDockTree;
.....
procedure TJvDockTree.GetSiteInfo(Client: TControl;
var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
begin
CanDock := IsDockable(DockSite, Client);
If CanDock then begin
GetWindowRect(DockSite.Handle, InfluenceRect);
InflateRect(InfluenceRect, DefExpandoRect, DefExpandoRect);
end;
end;
http://issuetracker.delphi-jedi.org/view.php?id=5271
http://issuetracker.delphi-jedi.org/view.php?id=5974

Related

How to properly publish an event executed from the 'Loaded' procedure?

In a runtime only package, I've defined a TFrame descendant which publishes the OnLoaded event:
type
TMyMethod = procedure() of object;
TMyFrame = class(TFrame)
protected
FOnLoaded : TMyMethod;
procedure Loaded(); override;
published
property OnLoaded : TMyMethod read FOnLoaded write FOnLoaded;
end;
implementation
{$R *.dfm}
procedure TMyFrame.Loaded();
begin
inherited;
if(Assigned(FOnLoaded))
then FOnLoaded();
end;
In a designtime only package, I've registered TMyFrame component as follows:
unit uMyRegistrations;
interface
uses
Classes, uMyFrame;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyTestComponents', [
TMyFrame
]);
end;
I've installed the designtime package, I can find TMyFrame in the tool palette and its OnLoaded event is shown in the object inspector.
I've dragged a TMyFrame into a form, then I've assigned the OnLoaded event by doubleclicking from the object inspector.
After assigning the event, I noticed that an access violation error message appears each time I try to open the form's file in Delphi (It let me open the ".pas" file, but I can't switch to visual designer view).
Did I correctly published the OnLoaded event? If so, what else is wrong?
Further Informations:
I'm using Delphi 2007 (don't know if it matters).
The error also appears by doing the same thing with different parent classes (Not only for TFrame descendants).
Updated (somewhat less bogus) answer
You accepted my original answer, but what I wrote was not correct. Rob Kennedy pointed to an article by former Embarcadero developer Allen Bauer on the topic of Assigned.
Allen explains that the Assigned function only tests one pointer of the two pointers in a method pointer. The IDE at design time takes advantage of this by assigning sentinel values to any published method properties (i.e. events). These sentinel values have nil for one of the two pointers in the method pointer (the one that Assigned checks), and an index identifying the property value in the other pointer.
All this means that False is returned when you call Assigned at design time. So long as you check published method pointers with Assigned before calling them, then you will never call them at design time.
So what I originally wrote cannot be true.
So I dug a bit deeper. I used the following very simple code, testing with XE7:
type
TMyControl = class(TGraphicControl)
protected
FSize: Integer;
procedure Loaded; override;
end;
....
procedure TMyControl.Loaded;
begin
inherited;
FSize := InstanceSize;
end;
....
procedure Register;
begin
RegisterComponents('MyTestComponents', [TMyControl]);
end;
This was enough to cause an AV in the IDE at design time whenever the Loaded method was executed.
My conclusion is that the IDE does some rather underhand things when streaming, and your objects are not in a fit state to use when the Loaded method is called. But I don't really have a better understanding than that.
Original (very bogus) answer
You must not execute event handlers at design time, and your code does just that. The reason being that at design time the event handler's code is not available.
The control's code is available, the IDE has loaded it – but the code that implements the event handler is not. That code is not part of the design time package, it is part of the project that is currently open in the IDE. After all, it might not even compile yet!
The Loaded method should defend against this like so:
procedure TMyFrame.Loaded();
begin
inherited;
if not (csDesigning in ComponentState) and Assigned(FOnLoaded) then
FOnLoaded();
end;

Display a warning when dropping a component on a form at design time

I'm tidying up components used in a large legacy project, I've eliminated about 90 of 220 custom components, replacing them with standard Delphi controls. Some of the remaining components require a significant amount work to remove which I don't have available. I would like to prevent anyone from making additional use of some of these components and was wondering if there was a way of showing a message if the component is dropped on the form at design time - something like "Don't use this control, use x or y instead".
Another possibility would to hide the control on the component pallet (but still have the control correctly render on the form at design time).
There is protected dynamic method TComponent.PaletteCreated, which is called only in one case: when we add this component to a form from component palette.
Responds when the component is created from the component palette.
PaletteCreated is called automatically at design time when the component has just been created from the component palette. Component writers can override this method to perform adjustments that are required only when the component is created from the component palette.
As implemented in TComponent, PaletteCreated does nothing.
You can override this method to show warning, so it will alert the user just one time, when he tries to put it to form.
UPDATE
I couldn't make this procedure work in Delphi 7, XE2 and Delphi 10 Seattle (trial version), so it seems that call to PaletteCreated from IDE is not implemented.
I sent report to QC:http://qc.embarcadero.com/wc/qcmain.aspx?d=135152
maybe developers will make it work some day.
UPDATE 2
There are some funny workarounds, I've tried them all this time, works normally. Suppose that TOldBadButton is one of components that shouldn't be used. We override 'Loaded' procedure and WMPaint message handler:
TOldBadButton=class(TButton)
private
fNoNeedToShowWarning: Boolean; //false when created
//some other stuff
protected
procedure Loaded; override;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
//some other stuff
end;
and implementation:
procedure TBadOldButton.Loaded;
begin
inherited;
fNoNeedToShowWarning:=true;
end;
procedure TOldBadButton.WMPaint(var Message: TWMPAINT);
begin
inherited;
if (csDesigning in ComponentState) and not fNoNeedToShowWarning then begin
Application.MessageBox('Please, don''t use this component','OldBadButton');
fNoNeedToShowWarning:=true;
end;
end;
The problem is, this works only for visual components. If you have custom dialogs, imagelists etc, they never get WMPaint message. In that case we can add another property, so when it is shown in object inspector, it calls getter and here we display warning. Something like this:
TStupidOpenDialog = class(TOpenDialog)
private
fNoNeedToShowWarning: boolean;
function GetAawPlease: string;
procedure SetAawPlease(value: string);
//some other stuff
protected
procedure Loaded; override;
//some other stuff
published
//with name like this, probably will be on top in property list
property Aaw_please: string read GetAawPlease write SetAawPlease;
end;
implementation:
procedure TStupidOpenDialog.Loaded;
begin
inherited;
fNoNeedToShowWarning:=true; //won't show warning when loading form
end;
procedure TStupidOpenDialog.SetAawPlease(value: string);
begin
//nothing, we need this empty setter, otherwise property won't appear on object
//inspector
end;
function TStupidOpenDialog.GetAawPlease: string;
begin
Result:='Don''t use this component!';
if (csDesigning in ComponentState) and not fNoNeedToShowWarning then begin
Application.MessageBox('Please, don''t use this component','StupidOpenDialog');
fNoNeedToShowWarning:=true;
end;
end;
Older versions of Delphi always scroll object inspector to the top when new component is added from palette, so our Aaw_please property will surely work. Newer versions tend to start with some chosen place in property list, but non-visual components usually have quite a few properties, so it shouldn't be a problem.
To determine when the component is first created (dropped on the form)?
Override "CreateWnd" and use the following if statement in it:
if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
// We have first create
More detail here >>
Link

How to capture the active control in Firemonkey?

I am migrating a VCL application to FMX. I need to know the class of a control that has focus. The application works with various dynamically created frames with numerous input controls.
In VCL I use the VCL.Forms.TScreen.OnActiveControlChange as this is the one place to consistently capture the active control. This event is not available in FMX.Forms.TScreen. What would be an alternative approach in FMX?
The most similar approach in FMX would be to listen to the TForm.OnFocusChanged event. From within the event handler you could then look up theTForm.Focused property.
Sadly in Delphi 10.3, the approach outlined by #iamjoosy fails spectacularly with an 'Access Violation' under certain circumstances (especially when TabControls / TabItems are used as containers for other controls).
The code I am using:
procedure TForm1.FormFocusChanged(Sender: TObject);
var
Control : iControl;
MyControl : TFMXObject;
begin
Control := form1.focused;
try
MyControl := TFmxObject(Control.GetObject);
form1.Caption := MyControl.Name + ' of type ' + MyControl.ClassName;
finally
MyControl := nil;
Control := nil;
end;
end;
Yet to add some intrigue, the above approach reverts to working fine if:
1) There's no TabControl/TabItem objects
2) If I add the following event handler to each child button (e.g. setting focus back to its parent TabItem):
procedure TForm1.Button2Click(Sender: TObject);
begin
TabItem1.SetFocus;
end;
Hoping someone can offer advice as to whether I'm doing something stupid, or whether I've run into an FMX bug.

Firemonkey message handling using TMessageManager and TThread.Queue

Like many other Firemonkey developers, I need a general multi-platform solution to send messages from a thread to the main thread (to replace PostMessage). I need it to also work on iOS.
There is a solution by François Piette that is implemented for Android and Windows, but not for iOS:
TMessagingSystem.
However, I think it can be done much more simple by using the "new" TMessageManager in combination with TThread.Queue(). But no one have published code, using this aproach, that actually works (e.g. this one is not complete).
Do you have a tested implementation you would like to share with the community (or maybe just suggestions how to implement it right)?
Ok, here is my implementation. I did not use TMessagingSystem as it seems to just add complexity (for my situation at least). It works so far, but if anyone have suggestions for improvements, I will be happy to improve it.
I looked at the solution by Uwe Raabe but I wanted to make it more straightforward and easy to implement in the large codebase that I am converting to FMX.
With the solution below I can simply replace all PostMessage() with gMessageHandler.PostMessage (removing the win handle argument), and add the message functions in the form to tMainForm.MessageCallBack.
I created a small unit that I can include everywhere I need the PostMessage function. Those places does not need to know about the form:
unit MessageHandler
interface
tAllOSMessage = procedure(aMessageID, aData1, aData2: integer) of object;
tAllOSMessageHandler = class
private
fOnMessage : tAllOSMessage;
public
constructor Create(aMessageCallBack: tAllOSMessage);
procedure PostMessage(aMessageID, aData1, aData2: integer; aSourceThread: TThread = nil);
end;
var
gMessageHandler: tAllOSMessageHandler;
implementation
constructor tAllOSMessageHandler.Create(aMessageCallBack: tAllOSMessage);
begin
fOnMessage := aMessageCallBack;
end;
procedure tAllOSMessageHandler.PostMessage(aMessageID, aData1, aData2: integer; aSourceThread: TThread);
begin
if aSourceThread=nil then
aSourceThread := TThread.CurrentThread;
aSourceThread.Queue(nil, procedure
begin
if Assigned(fOnMessage) then
fOnMessage(aMessageID, aData1, aData2);
end );
end;
end.
Then I add these lines to the main form unit:
//Added to main form:
tMainForm = class(TForm)
...
procedure MessageCallBack(aMessageID, aData1, aData2: integer);
//Added to MainFormCreate
gMessageHandler := tAllOSMessageHandler.Create(MessageCallBack);
//Added to MainFormDestroy
FreeAndNil(gMessageHandler)
procedure tMainForm.MessageCallBack(aMessageID, aData1, aData2: integer);
begin
case aMessageID of
MyMessage1 : MyFunction1(aData1,aData2);
...
end;
end;

Create an exact copy of TPanel on Delphi5

I have a TPanel pnlMain, where several dynamic TPanels are created (and pnlMain is their Parent) according to user actions, data validations, etc. Every panel contains one colored grid full of strings. Apart from panels, there are some open source arrows components and a picture. Whole bunch of stuff.
Now I want user to be able to print this panel (I asked how to do it on this question), but before printing, user must be presented with a new form, containing copy of pnlMain. On this form user has to do some changes, add few components and then print his customized copy of pnlMain. After printing user will close this form and return to original form with original pnlMain. And – as you can guess – original pnlMain must remain intact.
So is there any clever way to copy whole TPanel and it’s contents? I know I can make it manually iterating through pnlMain.Controls list.
Code based as iterating on child controls, but not bad in anyway ;-)
procedure TForm1.btn1Click(Sender: TObject);
function CloneComponent(AAncestor: TComponent): TComponent;
var
XMemoryStream: TMemoryStream;
XTempName: string;
begin
Result:=nil;
if not Assigned(AAncestor) then
exit;
XMemoryStream:=TMemoryStream.Create;
try
XTempName:=AAncestor.Name;
AAncestor.Name:='clone_' + XTempName;
XMemoryStream.WriteComponent(AAncestor);
AAncestor.Name:=XTempName;
XMemoryStream.Position:=0;
Result:=TComponentClass(AAncestor.ClassType).Create(AAncestor.Owner);
if AAncestor is TControl then TControl(Result).Parent:=TControl(AAncestor).Parent;
XMemoryStream.ReadComponent(Result);
finally
XMemoryStream.Free;
end;
end;
var
aPanel: TPanel;
Ctrl, Ctrl_: TComponent;
i: integer;
begin
//handle the Control (here Panel1) itself first
TComponent(aPanel) := CloneComponent(pnl1);
with aPanel do
begin
Left := 400;
Top := 80;
end;
//now handle the childcontrols
for i:= 0 to pnl1.ControlCount-1 do begin
Ctrl := TComponent(pnl1.Controls[i]);
Ctrl_ := CloneComponent(Ctrl);
TControl(Ctrl_).Parent := aPanel;
TControl(Ctrl_).Left := TControl(Ctrl).Left;
TControl(Ctrl_).top := TControl(Ctrl).top;
end;
end;
code from Delphi3000 article
Too much code... ObjectBinaryToText and ObjectTextToBinary do the job nicely using streaming.
Delphi 7 have a code example, don't know 2009 (or 2006, never bothered to look) still have it.
See D5 help file for those functions (don't have d5 available here).
I'd do it by using RTTI to copy all the properties. You'd still have to iterate over all the controls, but when you need to set up the property values, RTTI can help automate the process. You can get an example towards the bottom of this article, where you'll find a link to some helper code, including a CopyObject routine.

Resources