ShowWarning Function

by Erick Engelke
September 21, 2024

When you perform validation, you may want to display a short-lived warning balloon above the offending field.

In my sample, clicking the button shows the balloon above it with a message for a definable time in seconds. It also flashes between orange and red for a short interval to alert the user, then stays the orange colour so it can be read. Clicking or waiting a few seconds clears the balloon.

sample

EWB includes BalloonLabels, which we will use for this operation. But there is some setup to create the BalloonLabel, whereas we want something simpler.

Our solution here is to reduce it to one line of code for you.

procedure TFormWarning.Button1Click(Sender: TObject);
begin
   ShowWarning( button1, 'This is a ' +#10+#13 + 'multiline' + #10+#13 + 'warning!', 10 );
end;

If you wish to use this function, you have two options. Users of my Nice library can conveniently just add the nicebase file to your uses section and call the ShowWarning function. Other developers can feel free to add the code shown below which implements the function and class.

How It Works

We define a new TBalloonWarning class built on the TBalloonLabel class. It has an auto-hide feature, but we don’t use it, because it only hides and doesn’t free the resource.

We add a TTimer to this new class, the timer is used to flash the red/orange colour and eventually frees the resources when it’s done being displayed.

We add an OnClick handler which frees the resources earlier for the user.

unit balloonwarning;
interface

uses WebCore, WebUI, WebForms, WebCtrls, WebBtns, WebLabels, WebComps;

type
   TBalloonWarning = class (TBalloonLabel )
   private
      Timer : TTimer;
      flashtime : DateTime;
      erasetime : DateTime;
      procedure BalloonTimer(Sender: TObject);
      procedure BalloonLabelClick(Sender: TObject);
   end;

implementation

procedure TBalloonWarning.BalloonLabelClick(Sender: TObject);
begin
  async self.free;
end;

procedure TBalloonWarning.BalloonTimer(Sender: TObject);
var
  c : TColor;
begin
  c := background.Fill.Color;

  if flashtime > now then begin

     if c = clElevateLightOrange then c := clElevateRed
     else c := clElevateLightOrange;
  end else c := clElevateLightOrange;

  background.Fill.Color := c;

  if erasetime < now then
    async self.free;
end;


procedure ShowWarning( control : TControl ; msg : string ; seconds : integer ; flashseconds : integer = 3 );
var
   bal : TBalloonWarning;

begin
   bal := TBalloonWarning.Create( control.parent );
   bal.parent := control.parent;

   bal.erasetime := now + seconds * 1000;

   bal.caption := msg;
   bal.top := control.Top - bal.height - 5;
   if  bal.top < 0 then bal.top := 1;
   bal.left := control.Left;

   // user can close it
   bal.onClick := bal.BalloonLabelClick;

   bal.flashtime := now + flashseconds * 1000;
   bal.Timer := TTimer.Create( bal );
   bal.Timer.Interval := 300;
   bal.timer.OnTimer := bal.BalloonTimer;
   bal.Timer.enabled := True;

end;