plumothy

The TTestDataProvider class looks like it will be very useful for me later. But, for now I have created a Helper for DUnitX.Assert which overrides WillRaise and takes the Exception as a string - here are the changes: : : type TDunitXAssertHelper = class helper for DUnitX.Assert class procedure WillRaise(AMethod: TTestLocalMethod; const ExceptionClass: string); overload; end; : : uses DUnitX.ResStrs; : : procedure TMyTestObject.RaiseExceptionForNegativeInput(const AValue: integer; const ExceptionClass : string); begin var TestMethod: TTestLocalMethod := procedure begin CUT.SimpleFunctionRequiringPositiveInput(AValue); end; Assert.WillRaise(TestMethod, exceptionClass); end; : : { TDunitXAssertHelper } class procedure TDunitXAssertHelper.WillRaise(AMethod: TTestLocalMethod; const ExceptionClass: string); begin DoAssert; try AMethod; except on E: Exception do begin Assert.AreEqual(ExceptionClass, E.ClassName ); exit; end; end; Fail(SNoException, ReturnAddress); end;

@Vincent Parrett Will do - thank you.

@Stefan Glienke OK, thank you, that explains my results. I looked at the comments for WillRaise: Of course, I should have looked further than that!

I am new to unit testing and trying to understand how WillRaise works in DUnitX. In the simple example below, there is only 1 function being tested: it is given an integer it expects the given integer to be positive so raises EMySimpleException if it is zero or less otherwise, it just returns the given integer. The first two TestCases check the return value. One of them passes and one of them fails (which is correct). The next 2 TestCases use WillRaise to check if the correct exception is raised for a negative input. I expect one test to pass and one to fail - but they both pass and I don't understand why. I am assuming that I do not yet fully understand how to use WillRaise. Perhaps someone can point out my stupid error? The code being tested: unit MySimpleLogic; interface uses System.SysUtils; type EMySimpleException = class(Exception) public constructor Create(const Msg: string); overload; end; TMySimpleObject = class public function SimpleFunctionRequiringPositiveInput(const AValue: integer): integer; end; implementation { MySimpleObject } function TMySimpleObject.SimpleFunctionRequiringPositiveInput(const AValue: integer): integer; begin if (AValue <= 0) then raise EMySimpleException.Create('Negative input not allowed'); result := Avalue; end; { EMySimpleException } constructor EMySimpleException.Create(const Msg: string); begin inherited Create(Msg); end; end. The unit testing code: unit TestsForMySimpleLogic; interface uses System.SysUtils, DUnitX.TestFramework, MySimpleLogic; type [TestFixture] TMyTestObject = class private CUT: TMySimpleObject; public [Setup] procedure Setup; [TearDown] procedure TearDown; [Test] [TestCase('TestPositiveInput01','1,1')] [TestCase('TestPositiveInput02','1,2')] procedure TestPositiveInput(const AValue: integer; const Expected: integer); [Test] [TestCase('NegativeValueShouldRaiseEMySimpleException', '-1,EMySimpleException')] [TestCase('NegativeValueShouldRaiseESomeOtherException', '-2,ESomeOtherException')] procedure RaiseExceptionForNegativeInput(const AValue: integer; const exceptionClass : ExceptClass); end; implementation procedure TMyTestObject.TestPositiveInput(const AValue: integer; const Expected: integer); begin var Actual := CUT.SimpleFunctionRequiringPositiveInput(AValue); Assert.AreEqual(Expected, Actual); end; procedure TMyTestObject.RaiseExceptionForNegativeInput(const AValue: integer; const exceptionClass : ExceptClass); begin var TestMethod: TTestLocalMethod := procedure begin CUT.SimpleFunctionRequiringPositiveInput(AValue); end; Assert.WillRaise(TestMethod, exceptionClass, 'Incorrect Exception raised'); end; procedure TMyTestObject.Setup; begin CUT := TMySimpleObject.Create; end; procedure TMyTestObject.TearDown; begin CUT.Free; end; initialization TDUnitX.RegisterTestFixture(TMyTestObject); end.

Thank you to everyone who has responded in this listing - you inspired me to look in the right place to solve the issue. As is usually the case, it was my own fault! I had a Custom Manifest file specified in the Project Options. The problem with that was the manifest file was missing (which must have happened after I specified it). Delphi does not tell you this when you build (perhaps it should - I'll suggest it to Embarcadero). This explains why my forms were being painted fully opaque. After I corrected the manifest problem, MDI forms were not being painted correctly when maximized (large areas not painted at all). Again, my own fault! My MDI forms descend from a common ancestor (to ensure they all have a consistent appearance and behaviour). I discovered today that the ancestor form had AlphaBlend = True (and AlphaBlendValue = 255). I wouldn't have knowingly done that, so must have had a "senior moment" at some point (no-one else works on this project!). So with AlphaBlend = False, everything works the way I want it to. All that explains why I could not reproduce the issue in a new test project. Once again, thanks for your input guys.

Just tried it. Does not work (form remains opaque) unless I have a manifest. If I have a manifest then maximising MDI forms just produces a mess.

This looks interesting - I'll give it a go tomorrow.

My joy was short lived. With a manifest, my application does not maximize MDI windows properly. Large portions remain unpainted and menus are not merging correctly. Back to the drawing board!

Uwe Raabe - brilliant, thank you!!! If only the Delphi documentation had mentioned that

In my Delphi project, the availability of some features depends on the user's licence. So, a Basic licence will not allow access to Advanced features. However, I want Basic licence users to see what they are missing by placing a "No Entry" form over the restricted part of the application. I have a form with a No Entry sign and a couple of TLabels. The No Entry form has an AlphaBlendValue = 100 so that it is translucent - the user can see what's behind it and the two TLabels tell them what they are missing and what to do about it. This is working nicely except for one thing: the AlphaBlendValue is having no effect so the form displays completely opaque (the user cannot see what is underneath). I cannot upload my project because it is confidential and simply way too big. I have tried for many hours to reproduce this issue in various test projects but have been unable to do so - they all work perfectly!! So, I can only conclude that there is some aspect of my project that is causing the No Entry form to display 100% opaque. I have wasted many hours changing things (pure trial and error), but nothing helped. My only hope is that someone here has experienced the same (or similar) issue and managed to discover the cause. Or, perhaps I am going about this the wrong way and there is a better solution? Delphi 12.2 Enterprise Windows 11 Professional Here is the unit for the No Entry form: unit NoEntryForm; interface uses System.SysUtils, Vcl.Controls, Vcl.Forms, SVGIconImage, Vcl.ExtCtrls, System.Classes, Vcl.StdCtrls; type INoEntryForm = interface ['{085FB8DC-3E21-4A50-B4CC-006E9872BF62}'] procedure ShowMe; end; /// <summary> /// A "no entry" panel to be displayed when a user attempts to access a feature to which their application licence does not permit access. /// It is intended to encourage the user to upgrade by showing them a glimpse of what they are missing. /// </summary> TfrmNoEntry = class(TForm, INoEntryForm) imgNoEntry: TSVGIconImage; pnlTop: TPanel; lblNoEntry: TLabel; lblPleaseUpgrade: TLabel; procedure ShowMe; public { Public declarations } end; procedure ShowNoEntry(const strMessage: string; const ctlParent: TWinControl; const strCaption: string); implementation {$R *.dfm} /// <summary> /// Displays a "No Entry" form over the given control (ctlParent) /// </summary> /// <param name="strMessage">Message to the user (typically something about having to upgrade to access the inaccessible feature)</param> /// <param name="ctlParent">The TWinControl descendant on which the No Entry form should be displayed (eg a TPanel for example)</param> /// <param name="strCaption">The No Entry form's caption (typically "No Entry")</param> procedure ShowNoEntry(const strMessage: string; const ctlParent: TWinControl; const strCaption: string); begin for var i := 0 to ctlParent.ControlCount - 1 do begin if ctlParent.Controls[i] is TfrmNoEntry then exit; // ctlParent already has a TfrmNoEntry so we can stop here end; var frmNoEntry := TfrmNoEntry.Create(nil); var FormInterface: INoEntryForm := frmNoEntry; frmNoEntry.Parent := ctlParent; frmNoEntry.TransparentColor := false; frmNoEntry.AlphaBlend := True; frmNoEntry.AlphaBlendValue := 100; frmNoEntry.Align := alNone; frmNoEntry.BoundsRect := ctlParent.BoundsRect; frmNoEntry.Anchors := [akLeft,akTop,akRight,akBottom]; frmNoEntry.lblNoEntry.Caption := strCaption; frmNoEntry.lblPleaseUpgrade.Caption := strMessage; frmNoEntry.ShowMe; end; procedure TfrmNoEntry.ShowMe; begin Show; end; end. So, in my project if I need to display a No Entry form on top of Panel1 I just call ShowNoEntry; ShowNoEntry('Text explaining why access is denied', Panel1, 'No Entry!');

Anders, Thanks for clarifying. Yes you’re right, it’s a hack - but that is exactly what makes it interesting to me. (Although I think a single line of comments would be enough to explain it - “hack to get at sending Action in OnHint event”.) I really enjoy discovering how things work and what is “under the hood” (whether it’s how to build a Delphi application or how to build a house). I now have 3 possible answers to my original question and I will try them all (not just the hack) and then decide which to deploy in my project.

Anders, I don't understand. Please explain what you mean by that.

Remy - thank you. That looks interesting - I will try it.

Thanks Remy - I suspected as much. I wonder why they did it that way? Just about every other event I have ever used has a Sender parameter. I actually want to use OnHint for my Dataset Actions so I can customise the Hints depending on which dataset the Action is working on. Then the Hint can be more meaningful - eg "Delete order item" rather than a generic "Delete record". Your suggestion will work of course, but I might investigate creating my own descendant Dataset Action.

In the Object Inspector, if you double-click the OnHint event of a TAction then you get a procedure like this: procedure TForm1.Action1Hint(var HintStr: string; var CanShow: Boolean); There is no Sender parameter (like most other events have) so how can I tell which TAction made the call if several TActions share this event?