Highlight component while user is dragging - delphi

I'm trying to achieve a simple drag and drop-panel, where a user can drop a file from windows explorer. The basic functionality is already working after I found this Thread.
Now I'm trying to change the color of the panel, while the user is dragging a file over it. I tried to use OnDragOver, but nothing happens. What am I doing wrong?
This is my current code:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShellApi,
Vcl.ExtCtrls, Vcl.Imaging.pngimage;
type
TPanel = class(Vcl.ExtCtrls.TPanel)
protected
procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;
procedure CreateWnd; override;
procedure DestroyWnd; override;
end;
TfrmMain = class(TForm)
panFileDrop: TPanel;
lblFileName: TLabel;
procedure panFileDropDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TPanel.CreateWnd;
begin
inherited;
DragAcceptFiles(Handle, true);
end;
procedure TPanel.DestroyWnd;
begin
DragAcceptFiles(Handle, false);
inherited;
end;
procedure TPanel.WMDropFiles(var Message: TWMDropFiles);
var
c: integer;
fn: array[0..MAX_PATH-1] of char;
begin
c := DragQueryFile(Message.Drop, $FFFFFFFF, fn, MAX_PATH);
if c <> 1 then
begin
MessageBox(Handle, 'Too many files.', 'Drag and drop error', MB_ICONERROR);
Exit;
end;
if DragQueryFile(Message.Drop, 0, fn, MAX_PATH) = 0 then Exit;
frmMain.lblFileName.Caption := fn;
end;
procedure TfrmMain.panFileDropDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
panFileDrop.Color := $00d4d3d2;
end;
end.

The problem
Delphi's concept of Drag'n'drop is not related to COM Drag and drop at all.
Borland implemented a light-weight version for dragging and dropping within the same application.
This works great and very efficient, but does not support DnD operations between applications. COM drag and drop requires you to register a drop target with the OS and accept relevant mouse messages. At no point will a COM drag&drop ever generate an standard OnDragOver event.
I fear the documentation is quite misleading when it does not make clear this source of confusion.
You are mixing Windows message based code TPanel.WMDropFiles(var Message: TWMDropFiles) with Borland's implementation for intra-application use only: TfrmMain.panFileDropDragOver(...)
The two options exist in parallel universes.
If you want to do the COM way you need to go COM all the way.
The solution
The WMDropFiles option is still a 'light-weight' solution before you go full COM and need to implement IDropTarget and all the complexity that entails.
My answer to your question is to not invent your own drag and drop but to go on the intertubes and download: https://github.com/DelphiPraxis/The-Drag-and-Drop-Component-Suite-for-Delphi
This is the up to date version of Anders Melander's famous suite which used to be at: http://melander.dk/delphi/dragdrop/
This implements COM based drag and drop and solves all your problems in one go.
It is also a fine example of beautiful code in its own right.
Take special note of the demos. The shelldragdrop stuff should cover your use case.
Would you like to know more?
http://delphi.about.com/od/vclusing/a/dragdrop.htm

Related

Delphi while loop causing program to stop responding

I'm using Delphi 7 and the program I am writing needs to continuously draw on the screen. While it currently doesn't draw anything important, this is a necessity in the program later on. However, when I put the procedure for drawing the screen in a while loop which can only be stopped by pressing any button the program stops responding completely. I don't understand why this is happening. Surely, as the while loop can be exited, the program should continue to run fine.
Here is the source code:
unit DD04f1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TeCanvas, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Image1OnCreate();
procedure ScreenRender();
procedure OnCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
IsDone : Boolean;
implementation
{$R *.dfm}
procedure TForm1.OnCreate(Sender: TObject);
begin
IsDone := False;
end;
procedure TForm1.Image1OnCreate ();
var
Count:Integer;
begin
image1.canvas.Create();
image1.canvas.Pen.Color:=clBlack;
image1.canvas.rectangle(0,0,640,480);
image1.canvas.Pen.Color:=$ed630e; //bgr instead of rgb
Count:=0;
While (Count <> 640) do
begin
image1.Canvas.moveto(Count,0);
image1.Canvas.LineTo(Count,480);
Count:=Count+1;
end;
end;
procedure TForm1.ScreenRender();
var
Count : Integer;
begin
Count:=0;
While(Count<>640) do
begin
image1.Canvas.moveto(Count,0);
image1.Canvas.LineTo(Count,480);
Count:=Count+1;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1OnCreate();
Button1.Visible := False;
While(IsDone = False) do
begin
ScreenRender();
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
IsDone := True;
end;
end.
procedure TForm1.OnCreate(Sender: TObject);
begin
IsDone := False;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1OnCreate();
Button1.Visible := False;
While(IsDone = False) do
begin
ScreenRender();
end;
end;
Assuming IsDone is always False (because otherwise we would not enter the loop), this loop can not terminate. It is infinite.
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
IsDone := True;
end;
You do not call this procedure from inside TForm1.Button1Click loop, hence it can never be called after you entered that loop. Since you never exit the TForm1.Button1Click procedure you do not allow any outside agent (like messages dispatch loop in VCL) to get executed and call that procedure either. To sum it up as soon as you entered the loop there is no any executable code that can change IsDone value. So, it is not changed.
Event handlers are supposed to be very short procedures, executing almost immediately, and giving up "execution flow control" back to VCL internals. Every long (more so infinite) processing leads to the program becomes irresponsive. No matter how many news Windows might want to tell the program - the program never asks for them.
https://en.wikipedia.org/wiki/Event-driven_programming
https://msdn.microsoft.com/en-us/library/windows/desktop/ms644927.aspx
https://msdn.microsoft.com/en-us/library/windows/desktop/ms632593.aspx
It was once told that Windows windows (GDI objects) are living in the center of the "messages storm" that they have to work out in timely matter. Hundreds of those messages are incoming every second and a Window Procedure (built inside the VCL classes for Delphi 7 forms) should receive, dispatch, and process every one of them before it's too late.
As soon as you blocked that process by making one of event handlers long or even endless - you broke the basic contract between the OS and the application.
You have to do "inversion of control", to break your continuous work into small short chunks and make Windows call those chunks when it sees appropriate.
Try to use TTimer for example.
PS. A VERY remote problem you can look at:
How to use Pipeline pattern in Delphi
How to Stop all Pipeline tasks correctly
Skip all the multithreading stuff there, for your case it only is important that other threads create those "chunks of work" that we have to paint onto our forms when Windows asks us to do so at some reasonable framerate (not too fast and not too slow). Your work chunks are fundamentally different, so all the threading stuff unrelated to you.
And the rendering is made inside TTimer events. So the "framework" of setting up the timer, turning it on and off might be of some interest to you. However the work you are going to do inside the .OnTimer event would be significantly different (just painting something, or even merely invalidating some part of the form and waiting for the Windows to trigger OnPaint event.).
You already got an excellent answer why your current code does not work and in your comments you are mentioning you want to do ray casting and drawing from a players perspective, so I assume some kind of game background.
I'm not sure the VCL is the best basis for a game. Different philosophies and needs. As Arioch 'The explained Delphi's VCL is event driven. Things happen in response to windows messages, even painting. If nothing causes a need to repaint, nothing will be painted anew.
This is very different from how I understand game engines (I'm by no means an expert). Even if nothing happens, they will continuously draw frame after frame to present as fluid as possible. Each frame might include an update to underlying structures based on game rules, physics, player input, animation, but even when they remain the same a new frame will be drawn. Basically three steps happen in a simplified 'game loop'
Input
Update
Presentation
All this happens for every frame. There might be no input, no update of the game's structures or even no presentation is desired. But all three steps belong together, the input causing an update that is later presented happened in the exact same frame as the resulting drawing.
This is something I find hard to fit into the VCL. As a solution must be based on the existing VCL loop and windows messages. You basically attempted to create such a game loop in VCL.
A way to solve your immediate issue - that you want to present something based on a calculation - could be just using the principle of the VCL. You want to have something drawn. VCL controls normally communicate their desire to be drawn by Invalidate, causing their BoundsRect to be invalidated. You could do that after you have done your calculations. In the following example I'll just use a timer to simulate your calculations are done. Just be aware that Invalidate will cause WM_PAINT messages to be generated for the control, but will not cause immediate repainting. There might be messages queued before the WM_PAINT is processed.
I'm using a TPaintBox's OnPaint to actually do the painting work, you might want to have your own control for that in the future when your project progresses.
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
type
TFormMain = class(TForm)
procedure FormCreate(Sender: TObject);
private
Timer1: TTimer;
PaintBox1: TPaintBox;
{ Private declarations }
procedure PaintBox1Paint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
public
{ Public declarations }
end;
implementation
{$R *.dfm}
procedure TFormMain.FormCreate(Sender: TObject);
begin
PaintBox1 := TPaintBox.Create(Self);
PaintBox1.Parent := Self;
PaintBox1.Align := alClient;
PaintBox1.OnPaint := PaintBox1Paint;
Timer1 := TTimer.Create(Self);
Timer1.Interval := 100;
Timer1.OnTimer := Timer1Timer;
Randomize;
end;
procedure TFormMain.PaintBox1Paint(Sender: TObject);
var
AColor: TColor;
I: Integer;
begin
for I := 0 to PaintBox1.ClientWidth - 1 do
begin
AColor := RGB(Random(256), Random(256), Random(256));
PaintBox1.Canvas.Pen.Color := AColor;
PaintBox1.Canvas.MoveTo(I, 0);
PaintBox1.Canvas.LineTo(I, PaintBox1.ClientHeight);
end;
end;
procedure TFormMain.Timer1Timer(Sender: TObject);
begin
PaintBox1.Invalidate;
end;
end.

ShowMessage when open Form (Designer Time)

I want show a notify (eg. ShowMessage) when a programmer open a Form in designer time.
Is possible? How?
Thanks.
PS: Delphi XE7 / VCL
I have a project with more than 700 form's, but when the programmer opens a specific one, I want to be given a notification (eg ShowMessage) stating that there are, for example, comments at the beginning of the .pas file.
This should happen in any form.
If you want to do this for ANY form, there is a straightforward way to do it. (As per David Heffernan's comment, whether your user will thank you it another matter, but anyway ...)
It involves installing a package in the IDE which installs an object which implements the IDesignNotification interface.
To use, create a new form and add a TMemo to it, rename the form to DesignNotifierForm, save it to disk then copy the code below into it. Then create a new package and add the unit to it. Then compile and install the package. In older Delphi versions like D7, there is an install button in the Package Editor, whereas in more recent versions like D10 Seattle, you go to View | Project manager in the IDE, then right-click on the BPL file in the pop-up and select Install from the pop-up context menu.
As you can see, in addition to the form, the unit declares a notifier object, TDesignNotification which implements an interface so that it can be registered with the IDE designer and receive notifications from it. The only one which is of interest from your pov is DesignerOpened, which iswhere you can call ShowMessage or do whatever you want.
The TDesignNotifierForm is included mainly as a simple way to experiment with & observe the notifications that the TDesignNotification receives, The TDesignNotification would work perfectly well without the form, though.
Btw, you might want to take a look at the ToolsAPI.Pas unit, which contains a host of interfaces which can be used to interact with the IDE.
unit DesignNotifierFormu;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, TypInfo, ToolsApi, DesignIntf;
type
TDesignNotifierForm = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
private
public
procedure Log(const Title, Msg : String);
end;
TDesignNotification = class(TInterfacedObject, IDesignNotification)
F : TDesignNotifierForm;
procedure ItemDeleted(const ADesigner: IDesigner; AItem: TPersistent);
procedure ItemInserted(const ADesigner: IDesigner; AItem: TPersistent);
procedure ItemsModified(const ADesigner: IDesigner);
procedure SelectionChanged(const ADesigner: IDesigner;
const ASelection: IDesignerSelections);
procedure DesignerOpened(const ADesigner: IDesigner; AResurrecting: Boolean);
procedure DesignerClosed(const ADesigner: IDesigner; AGoingDormant: Boolean);
constructor Create;
destructor Destroy; override;
end;
var
DesignNotification : TDesignNotification;
implementation
{$R *.dfm}
procedure SetUp;
begin
DesignNotification := TDesignNotification.Create;
RegisterDesignNotification(DesignNotification);
end;
procedure TDesignNotifierForm.Log(const Title, Msg: String);
begin
Memo1.Lines.Add(Title + ': ' + Msg);
end;
constructor TDesignNotification.Create;
begin
inherited Create;
F := TDesignNotifierForm.Create(Nil);
F.Show;
F.Log('Event', 'Notifier created');
end;
procedure TDesignNotification.DesignerClosed(const ADesigner: IDesigner;
AGoingDormant: Boolean);
begin
end;
procedure TDesignNotification.DesignerOpened(const ADesigner: IDesigner;
AResurrecting: Boolean);
var
C : TComponent;
Msg : String;
begin
C := ADesigner.Root;
if C <> Nil then begin
Msg := C.ClassName;
// At this point, you can call ShowMessage or whatever you like
ShowMessage(Msg);
end
else
Msg := 'no root';
F.Log('Designed Opened', Msg);
end;
destructor TDesignNotification.Destroy;
begin
F.Close;
F.Free;
inherited;
end;
procedure TDesignNotification.ItemDeleted(const ADesigner: IDesigner;
AItem: TPersistent);
begin
end;
procedure TDesignNotification.ItemInserted(const ADesigner: IDesigner;
AItem: TPersistent);
begin
end;
procedure TDesignNotification.ItemsModified(const ADesigner: IDesigner);
begin
end;
procedure TDesignNotification.SelectionChanged(const ADesigner: IDesigner;
const ASelection: IDesignerSelections);
begin
end;
initialization
SetUp;
finalization
if DesignNotification <> Nil then begin
UnRegisterDesignNotification(DesignNotification);
// Evidently the following is superfluous and results in a double-free DesignNotification.Free;
end;
end.
I want to be given a notification (eg ShowMessage) stating that there are, for example, comments at the beginning of the .pas file.
Well, the code above shows you how to provide some kind of event when a form is opened. How to do something like extract comments at the beginning of the file is a different technical problem really, and should be raised in a new question if you get stuck trying to do it.
Btw, one of the comments on your q pointed you in the direction of a code snippet by Dr Bob. That's fine as far as showing the technique is concerned, but would only do what you want if you were to install your own form in a package.

Delphi XE8: TEdit TextHint Disappears When Receiving Focus

Basically, I want the TextHint of my TEdits to disappear when the first character is entered and not when they receive focus, like the Edits on this Microsoft page: Sign in to your Microsoft account. Can someone please walk me through on how to achieve this?
Thank you in advance.
The built-in TEdit behavior doesn't allow this, but you can derive a new control from TEdit and override DoSetTextHint. The implementation should be similar to the internal method, but provide a value of 1 for wParam instead of 0.
This is a solution using an interceptor class:
unit EditInterceptor;
uses
Vcl.StdCtrls, System.SysUtils, Winapi.Messages, Windows;
type
TEdit = class(Vcl.StdCtrls.TEdit)
protected
procedure DoSetTextHint(const Value: string); override;
end;
implementation
uses
Vcl.Themes, Winapi.CommCtrl;
procedure TEdit.DoSetTextHint(const Value: string);
begin
if CheckWin32Version(5, 1) and StyleServices.Enabled and HandleAllocated then
SendTextMessage(Handle, EM_SETCUEBANNER, WPARAM(1), Value);
end;
end.
Make sure to place this unit in the interface uses clause after Vcl.StdCtrls.
Based on Uwe Raabe's answer, here is a procedure (for Delphi 2007, should work for newer versions of Delphi as well):
type
TCueBannerHideEnum = (cbhHideOnFocus, cbhHideOnText);
procedure TEdit_SetCueBanner(_ed: TEdit; const _s: WideString; _WhenToHide: TCueBannerHideEnum = cbhHideOnFocus);
const
EM_SETCUEBANNER = $1501;
var
wParam: Integer;
begin
case _WhenToHide of
cbhHideOnText: wParam := 1;
else // cbhHideOnFocus: ;
wParam := 0;
end;
SendMessage(_ed.Handle, EM_SETCUEBANNER, wParam, Integer(PWideChar(_s)));
end;
You call it like this:
constructor TForm1.Create(_Owner: TComponent);
begin
inherited;
TEdit_SetCueBanner(ed_HideOnFocus, 'hide on focus', cbhHideOnFocus);
TEdit_SetCueBanner(ed_HideOnText, 'hide on text', cbhHideOnText);
end;
It doesn't check for the Windows version though, you might want to add the if statement Uwe provided:
if CheckWin32Version(5, 1) and StyleServices.Enabled and _ed.HandleAllocated then
I just tested it with a project where I disabled runtime theming: It didn't work.

How to add support of HTML help files (.chm) on Delphi XE2?

How to add support of HTML help files (.chm) on Delphi XE2? We need to use A-links (A-keywords) on HelpContext property of every control to lookup help pages. Delphi XE2 has native support of HTML help files by unit HTMLHelpViewer. But how to use it?
It's not hard with F1 jump to a context.
Select Edit1 and press F1 . Help opens and Overview.htm is shown.
Prerequisite.
Edit1 Help settings:
sample.chm source settings.
sample.ali
IDH_Overview=Overview.htm
IDH_welcom=FirstTopic.htm
IDH_UsingtheMenus=Overview.htm
sample.h
#define IDH_Creating_Projects_and_Topics 1005
#define IDH_Overview 1003
#define IDH_UsingtheMenus 1009
Unit1.pas
unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, HTMLHelpViewer, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
HHALINKLOOKUP: TButton;
JumpAnchor: TButton;
Edit1: TEdit;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure HHALINKLOOKUPClick(Sender: TObject);
procedure JumpAnchorClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
hpPath : string;
link : HH_AKLINK;
procedure TForm1.FormCreate(Sender: TObject);
begin
hpPath := ExtractFilePath(Application.ExeName) +
'HelpFile\sample.chm';
Application.HelpFile := hpPath;
end;
procedure TForm1.HHALINKLOOKUPClick(Sender: TObject);
var
link : HH_AKLINK;
szUrl,szKey,szMsgText,szMsgTitle,szWindow : AnsiString;
begin
szKey := Edit1.Text; // 'UsingtheMenus';
szUrl :='Overview.htm';
szMsgText :='Error: Can''t find "'+Edit1.Text+'"!';
szMsgTitle :='Error: HH_ALINK_LOOKUP';
szWindow :='main';
with link do begin
cbStruct := sizeof(HH_AKLINK) ;
fReserved := False;
pszKeywords := PChar(szKey);
pszUrl := nil;
pszMsgText := PChar(szMsgText);
pszMsgTitle := PChar(szMsgTitle);
pszWindow := PChar(szWindow);
fIndexOnFail:= False;
end;
HtmlHelpW(0, hpPath+'>main', HH_DISPLAY_TOPIC, DWORD_PTR(nil));
HtmlHelpW(0, hpPath, HH_ALINK_LOOKUP, DWORD_PTR(#link));
end;
procedure TForm1.JumpAnchorClick(Sender: TObject);
begin
HtmlHelpW(0, hpPath+'::/Overview.htm#'+Edit1.Text+'>main', HH_DISPLAY_TOPIC, DWORD(nil));
end;
end.
Here is a ready to use sample.chm and the source Download
There is a trick how to easily, to jump, not only to the .htm file but jumps directly to an anchor.
Change sample.ali
IDH_Overview=Overview.htm
IDH_welcom=FirstTopic.htm
IDH_UsingtheMenus=Overview.htm#UsingtheMenus
Insert an anchor at the place, you want to jump to in Overview.htm
[...]
<A NAME="UsingtheMenus" </A>
<P><STRONG>Using the Menus and Toolbars</STRONG>
<P>The menus and toolbars provide a complete set of tools
[...]
Now it is possible with F1, jump directly to the desired point in overview.htm.
I suspect that to use A-links you need to do the following:
Assign an Application.OnHelp handler as described below.
Assign Application.HelpFile during program startup.
Call Application.HelpKeyword if you wish to invoke the help system with an A-link.
Set the HelpKeyword property for any GUI controls that you wish to respond to context sensitive F1 key presses.
The OnHelp handler looks like this:
function TMainForm.ApplicationHelp(Command: Word;
Data: THelpEventData; var CallHelp: Boolean): Boolean;
var
Link: THH_AKLink;
ALink: string;
begin
CallHelp := False;
Result := True;
//argh, WinHelp commands
case Command of
HELP_COMMAND:
begin
ZeroMemory(#Link, SizeOf(Link));
Link.cbStruct := SizeOf(Link);
ALink := PChar(Data); // we are going to re-purpose the keyword as an A-link
Link.pszKeywords := PChar(AnsiString(ALink)); // seems we have to pass a PAnsiChar ..
Link.fIndexOnFail := True;
HtmlHelp(GetDesktopWindow, Application.HelpFile, HH_ALINK_LOOKUP,
DWORD_PTR(#Link));
end;
end;
end;
The HtmlHelpViewer unit contains methods named LookupALink which do the same. But I don't see how they could ever be called.
The above approach is a little bit hacky because it interprets keywords as A-Links. If you want context sensitive help, I can't see what else you can do.
Not sure how Xe2 viewer works (I'm on 2007) but I just use Eric Granges port of the Microsoft HTML help API, which unsurprisingly, is called HTMLhelpAPI.pas.
You can call an Alink using the function
ChmShowTopic(const filename,atopic:string):HWND;

How to implement some sort of Form Manager?

I'm in the middle of a project with a number of child forms. Many of the forms may be open at once. I'd like to know if there's already something I can use to manage and keep track of these forms, much like the windows taskbar and/or task manager. If not, then what would be the best approach? I don't want to have to reinvent the wheel if this is already done.
Description
As mentioned above, this project has many forms which may be opened at once. I will also be implementing some visual list control (much like the taskbar or task manager) for user control of these forms (or in the user's case, the forms are called windows). The most ideal way to manage these would be to first capture each of these forms as they're created and keep record of them somewhere. Some forms need this behavior, and some forms do not. For example, modal forms will never need this handling.
I will be giving the user access to show, minimize, or close these forms, as well as some other future un-thought handling, like maybe a custom popup menu associated with one of these forms (but that's another subject). The point is, I need to build something to capture these forms and keep them in order.
This will also include some other user interaction with all the forms at once, as well as simple access to each one of them, similar to how Screen.Forms already works. For example, a command to minimize all forms (FormManager.MinimizeAll), to maximize the currently active form (FormManager.ActiveForm.Maximize), or with a particular form (FormManager[3].Maximize).
Possible Options
I understand there are a few far different approaches to accomplish similar results, and haven't started coding it yet because each of those approaches has a different starting point. The options are...
Wrap Screen.Forms and other associated functionality from the Screen (which wouldn't allow too much of my desired flexibility)
Every time I create a form, register it with this form manager (which is very flexible, but I have to make sure I always register each created form)
Build a master form to register its self with the form manager and inherit everything from it (which is also very flexible, but in different ways, and much more complex)
The second option is sounding the most promising so far. But again, I don't want to start building it if there is already a solution for this. I'm pretty confident that I'm not the first person to do this. I don't know how to search for such a thing, I get nothing related to what I want on Google.
The global variable Screen (in Forms unit) does some "tracking", ie
Screen.Forms list all currently open forms;
Screen.ActiveForm form which has input focus (see also FocusedForm);
Screen.OnActiveFormChange event;
You could add each form to a TObjectList. I wrote a component called FormStack, which allows you to add forms (even forms with the same name), retrieve, remove, etc. To get a Task Manager like behavior, I think you'd just need to iterate the list to obtain form names . Hopefully you can use something here to shed some light on your idea..
Here's the code for FormStack.
unit uFormstack;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Contnrs;
type
TFormstack = class(TComponent)
private
{ Private declarations }
FormList: TObjectList;
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Procedure Add(InstanceClass: TComponentClass; Var Reference);
Procedure RemoveLast;
Procedure RemoveAll;
Function FindForm(AComponentClass: TComponentClass): Boolean;
Function GetForm(AComponentClass: TComponentClass): TObject;
Function GetByIndex(AIndex: Integer): TObject;
Procedure RemoveByIndex(AIndex: Integer);
published
{ Published declarations }
end;
procedure Register;
implementation
//{$R *.res}
procedure Register;
begin
RegisterComponents('FormStack', [TFormstack]);
end;
{-----------------------------------------------------------------------------
TFormStack
-----------------------------------------------------------------------------}
Constructor TFormStack.Create(AOwner: TComponent);
Begin
Inherited Create(AOwner);
FormList := TObjectList.Create;
FormList.OwnsObjects := True;
End;
Destructor TFormStack.Destroy;
Begin
FormList.Free;
Inherited Destroy;
End;
Procedure TFormStack.Add(InstanceClass: TComponentClass; Var Reference);
Var
Instance: TComponent;
Begin
Instance := TComponent(InstanceClass.NewInstance);
TComponent(Reference) := Instance;
Instance.Create(Self); // Owner is FormList <<-- blows up if datamodule in D2010
FormList.Add(Instance);
Instance.Tag := FormList.Count-1;
End;
Procedure TFormStack.RemoveAll;
Var
I: Integer;
Begin
For I := FormList.Count -1 downto 0 do // last in first out
begin
Self.RemoveLast;
End;
End;
// This removes the last form on the stack
Procedure TFormStack.RemoveLast;
Begin
if FormList.Count > 0 then
FormList.Remove(FormList.Items[FormList.Count-1]);
End;
Function TFormStack.FindForm(AComponentClass: TComponentClass): Boolean;
Var
I: Integer;
Begin
Result := False;
For I := FormList.Count-1 downto 0 do
If Formlist.Items[I].ClassType = AComponentClass then
Result := True;
End;
Function TFormStack.GetForm(AComponentClass: TComponentClass): TObject;
Var
I: Integer;
begin
Result := Nil;
For I := FormList.Count-1 downto 0 do
If Formlist.Items[I].ClassType = AComponentClass then
Result := FormList.Items[I];
end;
Function TFormStack.GetByIndex(AIndex: Integer): TObject;
begin
Result := Nil;
If FormList.Count-1 >= AIndex then
Result := FormList.Items[AIndex];
end;
Procedure TFormStack.RemoveByIndex(AIndex: Integer);
begin
If FormList.Count-1 >= AIndex then
FormList.Remove(FormList.Items[AIndex]);
end;
end.
If I understand you correctly, you want to track this in code while the app is running?
Maybe you can do something with Screen.Forms?

Resources