ShowMessage when open Form (Designer Time) - delphi

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.

Related

Why does the DOF remove lines?

I'm trying to write a plugin for Delphi 5 that will store the paths to our testing exes in the DOF so that there is a direct association between the project and the tests for that project. When I go to add my own module to the DOF file, something like
[DUint Plugin]
IntegrationTestExe=Somepath
UnitTestExeList=Some;Path;
Anytime I go to add this either manually or through code, when I save the project, the lines I add are removed. I chalked this up to maybe the IDE just doesn't allow custom modules in the DOF.
However, we use a third party plugin called EurekaLog. EurekaLog injects its own vars into the DOF and when you save, those vars are not removed. I copied much of the code over so I could test if the EurekaLog code would work properly (through some magic) but their code just wrote their module to the DOF and did nothing else special.
Does anyone know how this is accomplished in EurekaLog? Do I need to register my module somewhere so that the IDE knows not to remove it?
Update After a bit of experimenting, it seems that saving settings to the DOF is actually noticeably more reliable than saving them to the DSK file.
Add another TEdit to the form and create LoadDOFSettings and SaveDOFSettings
analogous to the existing LoadSettings and SaveSettings and call them on receipt
of the DesktopLoad and DesktoSave notifications. The SaveDOFSettings doesn't need to be called via the Timer1 event because the renaming doesn't seem to happen to the DOF.
Original answer
I suggest that before reading this answer, you do a File | Close All in the IDE,
create a new package, add the unit below into it and install it in the IDE.
The purpose of the package is two-fold, firstly to show how to save custom settings in the DSK file and secondly to give you an idea of what event information about project
files you can get from the IDE via the services in the ToolsAPI unit..
Once you've installed the package, keep an eye on its form, which shows you file notifications in the upper memo as you open, work on and close a project. There are
several things to notice:
When you open a project, the last notification you receive is about its DSK file having been opened.
Not every file type is the subject of a notification. In particular, you don't receive any notifications specifically about the DOF file, so if you want to write to it and later read from it, you have to make assumptions about when it's safe (or not) to do so, and this is possibly why you have run into the problem you are asking about.
When you do a Close All on the project, the last file change you get notified about is the DSK being written. The catch is that it's initially written to a file of the same name but with the extension .$$$. Very soon afterwards, but asaics you can't tell exactly when, this .$$$ file is renamed to .DSK.
The form created by the code below has an edit box, edMyValue' which can be used to set a value in a section of the DSK file calledMySettingsand which is reloaded the next time the project is opened. The writing of theMySettings` section of the DSK file is triggered aby a TTimer with a 2-second delay to give the IDE time to write and rename the DSK file as I've described. This obviously provides the opportunity for a race condition.
You might like to refer to
http://www.gexperts.org/open-tools-api-faq/#dsk
(GExperts is the IDE add-in tool that's been around since very early days of Delphi)
The section of the article is talking about the current project's .DSK file. Like the DOF, this is in INI file format, with sections like
[Closed Files]
[Modules]
[EditWindow0]
[View0]
As you'll see it says
check for the ofnProjectDesktopLoad and ofnProjectDesktopSave NotifyCode values. When you see one of those, you can save/load values from the file indicated by the FileName parameter using a class such as TIniFile.
Perhaps it's a bit trickier than the article suggests, because of the renaming business.
Have fun!
unit IDEEventsu;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ToolsAPI, Grids, IniFiles;
type
TFileEventsForm = class(TForm)
Panel1: TPanel;
Memo1: TMemo;
edMyValue: TEdit;
btnClear: TButton;
Timer1: TTimer;
Memo2: TMemo;
procedure btnClearClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
function GetCurrentProject: IOTAProject;
public
// The following are using interfaces accessible via the ToolsAPI
Services: IOTAServices;
ProjectGroup : IOTAProjectGroup;
Project: IOTAProject;
Options : IOTAProjectOptions;
ModServices: IOTAModuleServices;
Module: IOTAModule;
NotifierIndex: Integer; // This is used to disconnect our notifier from the IDE
IsSetUp : Boolean;
SetUpCount : Integer;
DskFileName : String;
procedure SetUp;
procedure SaveSettings;
procedure LoadSettings;
end;
var
FileEventsForm: TFileEventsForm;
procedure Register;
[...]
uses
typinfo;
type
TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier)
// This is the class we use to receive file notication events from the IDE via the
// interfaces in ToolsAPI.Pas
//
// It needs to implement the IOTANotifier and IOTAIDENotifier interfaces and,
// once registered with the IDE, the IDE calls its methods as a kind of call-back
// mechanism so that it gets notified of file events
//
// Note that this file also provides a form for displaying the received event
// notifications and that the IOTANotifier and IOTAIDENotifier interfaces could
// just as easily be implemented by the form itself
protected
procedure AfterCompile(Succeeded: Boolean);
procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
procedure FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
end;
procedure Register;
// This is necessary to register the package in the IDE
var
Notifier : TIdeNotifier;
begin
FileEventsForm:= TFileEventsForm.Create(Nil);
FileEventsForm.Services := BorlandIDEServices as IOTAServices;
Notifier := TIdeNotifier.Create;
Notifier.Form := FileEventsForm;
FileEventsForm.NotifierIndex := FileEventsForm.Services.AddNotifier(TIdeNotifier.Create);
end;
procedure CloseDown;
begin
FileEventsForm.Services.RemoveNotifier(FileEventsForm.NotifierIndex);
FileEventsForm.Close;
FileEventsForm.Free;
end;
function NotifyCodeString(NotifyCode : TOTAFileNotification) : String;
begin
Result := Copy(GetEnumName(TypeInfo(TOTAFileNotification), Ord(NotifyCode)), 4, MaxInt);
end;
procedure TIdeNotifier.AfterCompile(Succeeded: Boolean);
begin
end;
procedure TIdeNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
begin
end;
procedure TIdeNotifier.FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
begin
if True {NotifyCode in [ofnProjectDesktopLoad, ofnActiveProjectChanged]} then begin
FileEventsForm.Show;
FileEventsForm.Memo1.Lines.Add(Format('%s file: %s', [NotifyCodeString(NotifyCode), FileName]));
case NotifyCode of
ofnProjectDesktopLoad,
ofnDefaultDesktopLoad : begin
FileEventsForm.DskFileName := FileName;
FileEventsForm.LoadSettings;
end;
ofnProjectDesktopSave,
ofnDefaultDesktopSave : begin
if True{CompareText(ExtractFileExt(FileName), '.DSK') = 0} then begin
FileEventsForm.Caption := FileName;
FileEventsForm.Timer1.Enabled := True; // causes DSK file to be updated after Timer1.Interval (=2000ms)
end;
end;
end; { case }
end;
end;
procedure TFileEventsForm.btnClearClick(Sender: TObject);
begin
Memo1.Lines.Clear;
end;
function TFileEventsForm.GetCurrentProject: IOTAProject;
var
i: Integer;
begin
Result := nil;
ModServices := BorlandIDEServices as IOTAModuleServices;
for i := 0 to ModServices.ModuleCount - 1 do
begin
Module := ModServices.Modules[i];
if Supports(Module, IOTAProjectGroup, ProjectGroup) then begin
Result := ProjectGroup.ActiveProject;
Options := Result.ProjectOptions;
Exit;
end
else if Supports(Module, IOTAProject, Project) then
begin // In the case of unbound packages, return the 1st
if Result = nil then begin
Result := Project;
Options := Result.ProjectOptions;
end;
end;
end;
end;
procedure TFileEventsForm.SetUp;
begin
Project := GetCurrentProject;
Inc(SetUpCount);
Caption := 'Setup done ' + IntToStr(SetUpCount);
IsSetUp := True;
end;
procedure TFileEventsForm.LoadSettings;
var
Ini : TMemIniFile;
S : String;
begin
Ini := TMemIniFile.Create(DSKFileName);
try
S := Ini.ReadString('MySettings', 'Name', 'no value');
edMyValue.Text := S;
finally
Ini.Free;
end;
end;
procedure TFileEventsForm.SaveSettings;
var
Ini : TMemIniFile;
S : String;
begin
S := DSKFileName;
Caption := 'Saving: ' + S;
Ini := TMemIniFile.Create(S);
try
Ini.WriteString('MySettings', 'Name', edMyValue.Text);
Ini.UpdateFile;
Ini.ReadSections(Memo2.Lines);
Memo2.Lines.Add('This file : ' + DSKFileName);
edMyValue.Text := '?';
finally
Ini.Free;
end;
end;
procedure TFileEventsForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
SaveSettings;
end;
initialization
finalization
CloseDown;
end.

Highlight component while user is dragging

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

How to handle EAccessViolation when closing a Form

I'm having EAccessViolation when I close the form of my application and I don't know how to deal with this, I have two units, here is the main unit relevant code:
unit MainUnit;
uses
.., myComponent1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
MyComponent1.doSomeWork(p1, p2, ..., pn);
end;
procedure TForm1.OnMyComponen1tEvent(sender: TObject; p: Integer);
begin
memo1.Lines.Add(message);
end;
end.
This unit uses another unit is a component class, in which i send a signal to memo1 to show the message, of course using the component event, it's something like:
unit myComponent;
type
TMyComponentEvent = procedure(sender: TObject; p: integer) of object;
type
TMyComponent = class(TComponent)
// Properties and events declaration
procedure TPThread.Execute;
begin
try
// Create and run some worker threads
// Wait for them to finish the job
// This is the last thing to do:
if Assigned(FOnMyComponentEvent) then
begin
FOnMyComponentEvent(Self, p);
end;
finally
//free ressources
end;
end;
procedure TMyComponent.DoSomeWork;
begin
TPThread.Create(p1, p2 ...);
end;
end.
When I close the form before the program finishes its job ( The threads are still working), i get that exception but sometimes, there is no exception raised. Well, when the exception is raised it indicates the line: memo1.Lines.Add(message);.
I don't know how to solve it, so how can I prevent the exception from happening?
Sounds like you are not setting the MyEvent event to nil when destroying the Form, eg
procedure TForm1.FormCreate(sender: TObject);
begin
OtherUnit.MyEvent := MyEvent;
end;
procedure TForm1.FormDestroy(sender: TObject);
begin
OtherUnit.MyEvent := nil;
end;

Show custom control hint when disabled

I've written a custom control (TCustomControl) which shows the standard built-in hint on hovering. However, when the control is disabled, the hint does not show. But, the TSpeedButton does show a hint when it's disabled, so there must be a way I can do the same in my control.
What do I need to do to show hints when my control is disabled?
The standard hint mechanism is based on mouse messages. Controls derived from TWinControl (which includes TCustomControl) do not receive mouse messages when disabled, and the hint system internally ignores disabled windowed controls. TSpeedButton is derived from TGraphicControl instead of TWinControl, so it is not subject to those restrictions.
You need to enable the window handle in order to get a WM_MOUSEMOVE which starts showing the hint. This has some implications.
First, to enable the window handle (WinAPI), you need to delete the WS_DISABLED style from the window style, or use EnableWindow. This modification does not synchronize the VCL's Enabled property (unlike the other way around: setting the Enabled property dóes call EnableWindow), which is why this works.
But enabling the window handle lets all mouse messages through, so you have to block them and activate the hint manually on WM_MOUSEMOVE:
type
TMyControl = class(TCustomControl)
private
FDisabledHint: Boolean;
procedure CheckEnabled;
procedure SetDisabledHint(Value: Boolean);
procedure CMEnabledchanged(var Message: TMessage);
message CM_ENABLEDCHANGED;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetParent(AParent: TWinControl); override;
procedure WndProc(var Message: TMessage); override;
published
property DisabledHint: Boolean read FDisabledHint write SetDisabledHint;
end;
{ TMyControl }
procedure TMyControl.CheckEnabled;
begin
if DisabledHint and HasParent and (not Enabled) and
not (csDesigning in ComponentState) then
EnableWindow(Handle, True);
end;
procedure TMyControl.CMEnabledchanged(var Message: TMessage);
begin
inherited;
CheckEnabled;
end;
procedure TMyControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if DisabledHint and not Enabled then
Params.Style := Params.Style and (not WS_DISABLED);
end;
procedure TMyControl.SetDisabledHint(Value: Boolean);
begin
if FDisabledHint <> Value then
begin
FDisabledHint := Value;
CheckEnabled;
end;
end;
procedure TMyControl.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
CheckEnabled;
end;
procedure TMyControl.WndProc(var Message: TMessage);
begin
if not Enabled and DisabledHint and (Message.Msg = WM_MOUSEMOVE) then
Application.HintMouseMessage(Self, Message);
if Enabled or (Message.Msg < WM_MOUSEFIRST) or
(Message.Msg > WM_MOUSELAST) then
inherited WndProc(Message);
end;
I checked the working of the TabStop property, and this solution does not interfere with it. But beware of issues which I have not thought of yet.
(Besides, why a disabled TControl shows a hint is because it receives a CM_MOUSEENTER from WndProc of its parent, despite of that same parent blocking all other mouse input via IsControlMouseMsg to prevent the mouse events from firing.)
Actually you control's Winproc doesn't even get called when you control is disabled. Thy this small demo in order for understainding the message loop a bit better.
Place a TPanel on a form, and add a Double clickEvent To the form. Then try this code:
unit Unit39;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TPanel = class(ExtCtrls.TPanel)
protected
procedure WndProc(var Message: TMessage); override;
end;
TForm39 = class(TForm)
Panel1: TPanel;
procedure FormDblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form39: TForm39;
implementation
{$R *.dfm}
{ TPanel }
procedure TPanel.WndProc(var Message: TMessage);
begin
inherited;
Application.MainForm.Caption := FloatToStr(now);
end;
procedure TForm39.FormDblClick(Sender: TObject);
begin
Panel1.Enabled := not Panel1.Enabled;
end;
end.
YES! Correct: Ugly hack and violation of ALL designpatterns but with this small example you can see how the message loop works, and it is a very simple way to test some thing.
PS: I placed this as an answer because you can not format you text in comment :D

Delphi: How to create an extra design-time menu for a custom component?

I've recently recompiled TDBGrid component, to implement several custom functions, altho i've noticed that the feature of extra design-time context menu item "Columns editor" is gone now.
I've failed to find any code which creates this menu in original Vcl.DBGrids unit and had a really bad luck looking for a solution online on how to do this.
This also applies to double-clicking. It used to call Columns Editor, now it just creates OnCellClick event.
In your design time package for the component, implement a component editor:
type
TMyComponentEditor = class(TComponentEditor)
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
procedure TMyComponentEditor.ExecuteVerb(Index: Integer);
begin
case Index of
0:
Beep;
end;
end;
function TMyComponentEditor.GetVerb(Index: Integer): string;
begin
Result := 'Beep';
end;
function TMyComponentEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
You need to register this component editor also. Call RegisterComponentEditor in your Register procedure to do so:
RegisterComponentEditor(TMyComponent, TMyComponentEditor);

Resources