Lighten colors programmatically with Delphi

Many people understand that computers store colors as RGB values and that a value like 770000 represents a dark shade of red.  However, RGB values are hard to manipulate in a meaningful way (like brightening a color).  That is where the HSL color space comes in handy.  In the HSL color space, colors are represented by there Hue, Saturation, and Luminance.  The image below shows the full range of Saturation (horizontal axis) and Luminance (vertical axis) when the Hue is fixed at an arbitrary blue value.Once you understand how saturation and luminance affect a hue, you can manipulate these values to produce colors that work well together.  For example, the background of the interior boxes in the simple counters shown below were created by adjusting the luminance of the outer box.

The following code was used to do brighten the main color.  The functions  ColorHLSToRGB and ColorRGBToHSL are defined in the unit GraphUtil.

 
function Brighten(AColor: TColor): TColor; 
var 
  H, S, L: Word; 
begin 
  ColorRGBToHLS(AColor, H, L, S); 
  Result := ColorHLSToRGB(H, 225, S); 
end; 

Warning: this code assumes AColor will have a low luminance value.

Display error messages with TBalloonHint

This post will explain how to display messages using the TBalloonHint component that was added in Delphi 2009.  This approach is much less intrusive than traditional modal dialog boxes that steal focus and require user interaction.  Balloon hints simply display a message then disappear after a short period of time. 

TBalloonHint is easy to use but there are a few subtleties that I will go over.  Controls, like TButton, have a Hint and a ShowHint property which can be used to popup text near the cursor when it is over a control;  TBalloonHint is a just a prettier and more flexible hint.  Hints are automatically displayed when the cursor is over a control so it is hard to find documentation that explains how to display a balloon hint programmatically.  That is what I will do here.

Create and Configure

TBalloonHint is found in the ‘Additional’ section of the tool panel so it can be added to a form at design time.  Since the balloon hint is not being linked to any controls, I create and configure it in the OnCreate method instead.  The HideAfter property allows you to specify, in ms, how long the balloon will be shown before it is automatically hidden.  The Delay property allows you to specify, in ms, how long the hint should wait before appearing; the default this value is 500.

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBalloonHint := TBalloonHint.Create(Self);
  FBalloonHint.HideAfter := 5000;
  FBalloonHint.Delay := 0;
end;

Show and Position

Before showing a balloon hint, the Title and Description properties can be used to specify its contents.  Once the contents are set, the ShowHint method can be used to display the hint.  Since the hint is not attached to a specific control, we need to pass some position information, using screen coordinates, to ShowHint.

The orientation of the balloon depends on its screen location.  If the balloon is displayed in the bottom-half of the screen it looks like the image at the beginning and if it is displayed in the top-half of the screen it will look like the image below.   Thus telling a balloon to pop-up at the TopLeft or BottomRight corner of a control does not work well because one of the balloon orientations will cause it to cover the  control .This problem can be solved by passing a rectangle to ShowHint instead of a point.  When a rectangle is passed to ShowHint it will make sure that the region inside the rectangle remains visible when the hint is shown.

procedure TForm1.Button1Click(Sender: TObject);
var
  R: TRect;
begin
  FBalloonHint.Description := 'You pressed ' + Button1.Caption;
  R := Button1.BoundsRect;
  R.TopLeft := ClientToScreen(R.TopLeft);
  R.BottomRight := ClientToScreen(R.BottomRight);
  FBalloonHint.ShowHint(R);
end;

When to Hide

Balloon hints are created in their own window so it is important to hide them when your application is moved, minimized, resized or covered by another application.  The image below shows what happens when you move the form without hiding the hint.You only have to process two Windows messages (WM_ACTIVATEAPP and WM_WINDOWPOSCHANGED) to cover all of these situations.  To process these messages, define the following message handling functions in the protected section of the form.

protected
  procedure WMWindowPosChanged(var AMessage:TMessage); message WM_WINDOWPOSCHANGED;
  procedure WMActivateApp(var AMessage: TMessage); message WM_ACTIVATEAPP;

When you implement the functions make sure to call inherited to run the form’s message handlers.  It is possible for these message to come before the TBalloonHint object has been created so do not forget to check if it has been assigned.

procedure TForm1.WMActivateApp(var AMessage: TMessage);
begin
  if Assigned(FBalloonHint) then FBalloonHint.HideHint;
  inherited;
end;
procedure TForm1.WMWindowPosChanged(var AMessage: TMessage);
begin
  if Assigned(FBalloonHint) then FBalloonHint.HideHint;
  inherited;
end;

Exceptions: to throw or not to throw…

Exceptions are a useful programming concept because they¹:

1. separate error handling code from regular logic
2. propagate errors up the stack automatically
3. provide a convenient way to group and handle different types of errors

I have been thinking about exceptions a lot lately and I would have to agree with the commonly help opinion that exceptions are a useful programming concept.  However, for all the good they provide, I do think that there is one major disadvantage and that it does not get much attention.

it is hard to use exceptions and exception handling correctly

By this I mean it is hard to know when an exception is the right way to communicate an error condition.  I have read several blogs recently and it seems that most people subscribe to one of the following philosophies:

1. exceptions should be used whenever a function cannot perform its job
2. exceptions should only be used for unpredictable events

To help clarify the difference between the two trains of thought, lets consider a function that converts an ascii string to an integer.  These two groups disagree on what should happed when the function is passed the string ‘abc’.  People in group 1 want an exception while people in group 2 do not.  However, both groups would agree that an exception should be thrown if the function is passed a null pointer or something along those lines.

Both camps have some good arguments explaining why their approach is better [here are a few 1, 2, 3, 4].  Since I do most of my coding in Delphi, I decided to look to the choices made by its designers for guidance.  Here’s what I found²:

//throws an exception if S cannot be converted to an integer
function StrToInt(S: String): integer;
// returns false if S cannot be converted to an integer
function TryStrToInt(S: String; out Value: Integer): boolean;
//returns Default if S cannot be converted to an integer
function StrToIntDef(S: String; Default: Integer): integer;

Hmmm… why didn’t they pick a side?  I believe that the designers realized that there is no best approach because both approaches can be useful depending on the situation.  So, if you are writing a really generic function, like one that converts a string to an integer, it is probably best to provide both options but if your writing a really specific function, like one that reads an applications settings, just do what is best for the code that will be calling your functions.

1. http://java.sun.com/docs/books/tutorial/essential/exceptions/advantages.html
2. dig a little deeper and you will discovered that these functions are just wrappers for the Val function which does not use exceptions

Save time debugging. Use the EAX register.

Once and a while I run into code like this.

if SomeObject.SomeCounter() > 0 then
    // do something
else
    // do something else

Under normal circumstances the exact value of SomeCounter does not matter but when your are trying to track down a nasty bug, the exact value could be really useful.  If your lucky, you can just mouse over SomeCounter or add a watch, and the debugger will tell you the value.  However, there are many cases where this does not work so you have to stop debugging and change the code to look something like this.

N := SomeObject.SomeCounter();
if N > 0 then
  // do something
else
  // do something else

Here is a trick that saves me a lot of time.  The return value of a function is stored in the EAX register. So to get value of SomeCounter, you can just at the watch Integer(EAX) and look at it immediately after the function returns.  What if the return type is a string or some sort of complex object?  The EAX register will hold a pointer to the object which can be casted and examined (i.e. PString(EAX)^ or TMyObject(EAX)).  So far the only type I haven’t figured out are floating point values.  Please post a comment if you know how to do this.

Introduction to Pascal Script

I recently started using Pascal Script and the only useful documentation I could find were these (one, two) tutorials. These two tutorials utilize the TPSScript component and Unit Import tool which, in my opinion, make Pascal Script cumbersome to use.   Because of this, I decided to write this article which should help you use Pascal Script effectively.

I will use this example to teach you how to:

1. Write Pascal Scripts
2. Compile and Execute Pascal Scripts
3. Add additional classes, functions, and types to Pascal Scripts

Write Pascal Scripts

Here is the script that comes the example.  The script defines the function PrettyPrint and makes use of the custom function print and the custom class TAccumulator.  By custom, I mean, the compiler and runtime had to be extend before print and TAccumulator could be used.

function PrettyPrint(Value: Integer): String;
begin
   Result := 'The value is ' + IntToStr(Value);
end;

var
   Accumulator: TAccumulator;
   I: Integer;
begin
   print('Script started...');
   Accumulator := TAccumulator.Create;
   try
      for I := 3 to 6 do
      begin
         print(PrettyPrint(Accumulator.GetTotal));
         Accumulator.Add(I);
      end;
   finally
      Accumulator.free;
   end;
   print('Script complete.');
end.

Here are some tips that will help you write Pascal Scripts.

1. Every script must have a main code block; ‘begin … end.’ note the period after end. When the script is run, it starts at the first line in the main code block. Any code that cannot be reached by from the main code block will not be executed. The main code block starts on line 9 in the example.
2. Functions, constants, and variables that will be used in the script must be defined before the main code block.  Any variable defined outside of a function is global and can be used by any of the functions that it precedes.  The use of global variables is considered bad practice so I like to define them immediately before the main code block.  The variable definitions start on line 6 in the example and can only be used by the main code block.
3. Functions are supported but procedures are not. This is not a big deal but it can get annoying because the compiler will return a warning if the result of a function is not set.
4. Scripts can introduce memory leaks.  Any objects created during the scripts execution should also be destroyed.

Compile and Execute Pascal Scripts

The makers of Pascal Script, decide that scripts would be compiled into bytecode before being run.  This means that scripts must be syntactically correct before they can be run (some scripting languages are interpreted line by line during execution).  It also means that bytecode can be reused so a script that is run several times only needs to be compiled once.

Pascal Scripts can be compiled with the class TPSPascalCompiler which is found in the unit uPSCompiler.  On line 12 in the following code, both the Compile and GetOutput methods of TPSPascalCompiler are called.  Both methods return true on success, so if Result is true after line 12 is executed, that means Script was compiled successfully and the resulting bytecode was stored in Bytecode.  The compiler produces both error and warning messages, so lines 13-17 are used to copy any messages into the string Messages.

function TForm1.CompileScript(Script: AnsiString; out Bytecode, Messages: AnsiString): Boolean;
var
    Compiler: TPSPascalCompiler;
    I: Integer;
begin
    Bytecode := '';
    Messages := '';

    Compiler := TPSPascalCompiler.Create;
    Compiler.OnUses := ExtendCompiler;
    try
        Result := Compiler.Compile(Script) and Compiler.GetOutput(Bytecode);
        for I := 0 to Compiler.MsgCount - 1 do
          if Length(Messages) = 0 then
            Messages := Compiler.Msg[I].MessageToString
          else
            Messages := Messages + #13#10 + Compiler.Msg[I].MessageToString;
    finally
        Compiler.Free;
    end;
end;

Once you have the bytecode for your script, you can use TPSExec, found in unit uPSRuntime, to execute it.  Line 10 of the following code attempts to submit Bytecode to the runtime, execute it, and then verify that it executed successfully.  LoadData prepares the runtime to execute Bytecode and returns true if it is ready to run.  RunScript is only called if LoadData returns true and it will return false if the script encounters some sort of runtime error (like divide by 0).  If either method returns false, Runtime.LastEx will contain an error code.  When an error occurs, the function PSErrorToString is used to convert the error code to a string.

function TForm1.RunCompiledScript(Bytecode: AnsiString; out RuntimeErrors: AnsiString): Boolean;
var
  Runtime: TPSExec;
  ClassImporter: TPSRuntimeClassImporter;
begin
  Runtime := TPSExec.Create;
  ClassImporter := TPSRuntimeClassImporter.CreateAndRegister(Runtime, false);
  try
    ExtendRuntime(Runtime, ClassImporter);
    Result := Runtime.LoadData(Bytecode)
          and Runtime.RunScript
          and (Runtime.ExceptionCode = erNoError);
    if not Result then
      RuntimeErrors :=  PSErrorToString(Runtime.LastEx, '');
  finally
    ClassImporter.Free;
    Runtime.Free;
  end;
end;

Extend the scripting language with your own objects, functions, and types

I mentioned earlier that the compiler and runtime have to be extend before print and TAccumulator can be used.  When you extend the compiler, you are telling it that additional classes, functions, and types will be available at runtime.  On the other hand, when you extend the runtime, you provide it with the actual code that will be executed when the additional classes and functions are used by a script.

To extend the compiler, you must assign a function to the OnUses event handler of the compiler object.  I assigned the function ExtendCompiler, shown below, on line 10 of the CompileScript function shown above.  The OnUses event handler is called by the compiler during compilation and will cause compilation to fails if it returns false.  I’m not sure why it is designed this way but trying to extend the compiler from outside the OnUses event handler will result in an exception.

function ExtendCompiler(Compiler: TPSPascalCompiler; const Name: AnsiString): Boolean;
var
    CustomClass: TPSCompileTimeClass;
begin
  try
    Compiler.AddDelphiFunction('procedure print(const AText: AnsiString);');

    SIRegisterTObject(Compiler); // Add compile-time definition for TObject
    CustomClass := Compiler.AddClass(Compiler.FindClass('TObject'), TAccumulator);
    Customclass.RegisterMethod('procedure Add(AValue: Integer)');
    CustomClass.RegisterMethod('function GetTotal: Integer');
    Result := True;
  except
    Result := False; // will halt compilation
  end;
end;

Line 6 of ExtendCompiler passes the definition of the print procedure to the compiler.  If you need to define a type you can use the method AddTypeS which takes the name of the new type and the definition of the new type as strings [i.e. AddTypeS(‘TDynStringArray’, ‘Array of String’)].  When you add functions and types, the compiler will perform compile type checks to make sure they are used correctly (i.e. correct number of arguments passed to a function).

Registering classes is a bit more difficult than registering functions and types.  First you need to register the class which will return an instance of TPSCompileTimeClass.  The instance of TPSCompileTimeClass is then used to register the individual methods.  Line 9, tell the compiler that TAccumulator exists and that it extends the class TObject (FindClass returns an instance of TPSCompileTimeClass for classes that have already been registered).  It is important that the compiler knows TAccumulator extends TObject because the script uses the Free method which is inherited from TObject.

The function SSIRegisterTObject on line 8 registers the class TObject.  The function is defined in the unit uPSC_std which comes with Pascal Script.  There are several units, all starting with uPSC_, that contain functions similar to SSIRegisterTObject that will register common Delphi functions, classes, and types, with the compiler.  I recommend you locate these functions because they will save you a lot of time and code.

Extending the runtime involves assigning function pointers to all of the functions and methods that were added to the compiler.  If this is done incorrectly, i.e. a wrong calling convention is used or a function does not match the declarations given to the compiler, the script will generate errors when run.

procedure TForm1.ExtendRuntime(Runtime: TPSExec; ClassImporter: TPSRuntimeClassImporter);
var
  RuntimeClass: TPSRuntimeClass;
begin
  Runtime.RegisterDelphiMethod(Self, @TForm1.MyPrint, 'print', cdRegister);

  RIRegisterTObject(ClassImporter);
  RuntimeClass := ClassImporter.Add(TAccumulator);
  RuntimeClass.RegisterMethod(@TAccumulator.Add, 'Add');
  RuntimeClass.RegisterMethod(@TAccumulator.GetTotal, 'GetTotal');
end;

The call to RegisterDelphiMethod on line 5 tells the runtime to call the MyPrint method every time the print function is called from the script.  RegisterDelphiMethod was used because my MyPrint is a method and it belongs to a class.  If MyPrint were a function, you would use RegisterDelphiFunction instead which only takes three parameters [i.e. RegisterDelphiFunction(@MyPrint, ‘print’, cdRegister)].

To register classes and their methods with the runtime, an instance of TPSRuntimeClassImporter is needed.  In my example, an instance of  TPSRuntimeClassImporter created on line 7 of RunCompiledScript, passed to the ExtendRuntime function, and then manually freed when the script is finished executing.  I manually free TPSRuntimeClassImporter because the AutoFree option, the second parameter of the constructor, always generates an exception when I try to use it.  Once you have an instance of TPSRuntimeClassImporter, registering classes with the runtime works pretty much the same as registering classes with the compiler.  However, the functions for registering common Delphi functions and classes are stored in units starting with uPSR_.

That’s all I have for now.  Don’t forget to take a look at the example.  It is very short and should be quite helpful.

If you have any questions, suggestions, corrections, etc… please leave a comment.

Center a dialog box with Delphi

If you use Delphi, then you have likely used the functions ShowMessage, ShowMessagePos,  MessageDlgPos, etc…  These functions are nice because the allow you to display a quick message to the user with very little code (typically 1 line).  Unfortunately, the use of these functions usually leads to some variant of the question.

‘How can I center this dialog box in the application window?’

This seems like it should be easy to do but I have wasted a lot of time trying to find an elegant way to do this.  After some searching I discovered that all of the function listed above ultimately call the function CreateMessageDialog ¹.  This function returns a form that can be resized and/or repositioned as necessary before showing.  However, using this function also means more code which makes it inconvenient to use.  If you don’t mind the extra code, just use CreateMessageDialog in place of ShowMessage, ShowMessagePos,  MessageDlgPos, etc…

I created a simple wrapper for CreateMessageDialog that is very similar to MessageDlgPos but my version allows you control the location of the dialog box by passing a TPosition value.  This way you can just write something like

ShowMessageDialog(‘Hi.’, mtInformation, poMainFormCenter, [mbOk]);

Here is the code.  Please leave a comment if you know of a better approach.

function ShowMessageDialog(const Msg: string; DlgType: TMsgDlgType; DlgPos: TPosition;
  Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TModalResult; overload;
var
  Dialog: TForm;
begin
  Dialog := CreateMessageDialog(Msg, DlgType, Buttons, DefaultButton);
  try
    Dialog.Position := DlgPos;
    Dialog.ShowModal;
    Result := Dialog.ModalResult;
  finally
    Dialog.Free;
  end;
end;

function ShowMessageDialog(const Msg: string; DlgType: TMsgDlgType; DlgPos: TPosition;
  Buttons: TMsgDlgButtons): TModalResult; overload;
var
  DefaultButton: TMsgDlgBtn;
begin
  if mbOk in Buttons then DefaultButton := mbOk else
    if mbYes in Buttons then DefaultButton := mbYes else
      DefaultButton := mbRetry;

  Result := ShowMessageDialog(Msg, DlgType, DlgPos, Buttons, DefaultButton);
end;

1. As of Vista, these functions will try to use a Task Dialog instead of calling CreateMessageDialogs.  If you just need a regular ole dialog box, this code will work fine.