Balloon.pas

{
    Balloon - using Balloon-shaped windows in your Delphi programs
    Copyright (C) 2003 JWB Software

    Web:   http://people.zeelandnet.nl/famboek/delphi/
    Email: jwbsoftware@zeelandnet.nl
}

Unit Balloon;

Interface

Uses
  Forms, Classes, Controls, StdCtrls, ExtCtrls, Windows, Graphics,
  Messages, SysUtils;

Type
  TBalloonType     = (blnInfo, blnError, blnWarning);
  TBalloonHoriz    = (blnLeft, blnMiddle, blnRight);
  TBalloonVert     = (blnTop, blnCenter, blnBottom);
  TBalloonPosition = (blnArrowTopLeft, blnArrowTopRight, blnArrowBottomLeft, blnArrowBottomRight);

Type
	TBalloonControl = Class(TComponent)
	private
		FTitle: String;
    FText: TStringList;
		FDuration, FPixelCoordinateX, FPixelCoordinateY: Integer;
		FHorizontal: TBalloonHoriz;
		FVertical: TBalloonVert;
		FPosition: TBalloonPosition;
		FControl: TWinControl;
		FBalloonType: TBalloonType;

    procedure SetText(Value: TStringList);
	public
		procedure ShowControlBalloon;
		procedure ShowPixelBalloon;
	published
		property Text: TStringList read FText write SetText;
		property Title: String read FTitle write FTitle;
		property Duration: Integer read FDuration write FDuration;
		property Horizontal: TBalloonHoriz read FHorizontal write FHorizontal;
		property Vertical: TBalloonVert read FVertical write FVertical;
		property Position: TBalloonPosition read FPosition write FPosition;
		property Control: TWinControl read FControl write FControl;
		property PixelCoordinateX: Integer read FPixelCoordinateX write FPixelCoordinateX;
		property PixelCoordinateY: Integer read FPixelCoordinateY write FPixelCoordinateY;
		property BalloonType: TBalloonType read FBalloonType write FBalloonType;

    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
	End;

Type
  TBalloon = Class(TCustomForm)
  private
    lblTitle: TLabel;
    lblText: TLabel;
    pnlAlign: TPanel;
    iconBitmap: TImage;
    tmrExit: TTimer;
    Procedure FormPaint(Sender: TObject);
  protected
    Procedure CreateParams(Var Params: TCreateParams); override;
    Procedure OnMouseClick(Sender: TObject);
    Procedure OnExitTimer(Sender: TObject);
    Procedure OnChange(Sender: TObject);
    Procedure WndProc(Var Message: TMessage); override;
  public
    Constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
    Procedure ShowBalloon(blnLeft, blnTop: Integer; blnTitle, blnText: String; blnType: TBalloonType; blnDuration: Integer; blnPosition: TBalloonPosition);
    Procedure ShowControlBalloon(blnControl: TWinControl; blnHoriz: TBalloonHoriz; blnVert: TBalloonVert; blnTitle, blnText: String; blnType: TBalloonType; blnDuration: Integer);
  End;

Procedure Register;

Implementation

{$R Balloon.res}

Procedure Register;
Begin
  RegisterComponents('Custom', [TBalloonControl]);
End;

Constructor TBalloonControl.Create(AOwner: TComponent);
Begin
	Inherited;

	FText := TStringList.Create;
End;

Destructor TBalloonControl.Destroy;
Begin
	FText.Free;

	Inherited;
End;

procedure TBalloonControl.SetText(Value: TStringList);
begin
  FText.Assign(Value);
end;

Procedure TBalloonControl.ShowControlBalloon();
Var
	Balloon: TBalloon;
Begin
	Balloon := TBalloon.CreateNew(Owner);
	Balloon.ShowControlBalloon(FControl, FHorizontal, FVertical, FTitle, Trim(FText.Text), FBalloonType, FDuration);
End;

Procedure TBalloonControl.ShowPixelBalloon();
Var
	Balloon: TBalloon;
Begin
	Balloon := TBalloon.CreateNew(nil);
	Balloon.ShowBalloon(FPixelCoordinateX, FPixelCoordinateY, FTitle, Trim(FText.Text), FBalloonType, FDuration, FPosition);
End;

Procedure TBalloon.CreateParams(Var Params: TCreateParams);
Begin
  Inherited CreateParams(Params);

  Params.Style     := (Params.Style and not WS_CAPTION) or WS_POPUP;
  Params.ExStyle   := Params.ExStyle or WS_EX_TOOLWINDOW or WS_EX_NOACTIVATE or WS_EX_TOPMOST;
  Params.WndParent := GetDesktopWindow;
End;

Procedure TBalloon.OnMouseClick(Sender: TObject);
Begin
  Release;
End;

Procedure TBalloon.OnExitTimer(Sender: TObject);
Begin
  Release;
End;

Procedure TBalloon.OnChange(Sender: TObject);
Begin
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
End;

Procedure TBalloon.WndProc(Var Message: TMessage);
Begin
  If (Message.Msg = WM_SIZE) and (Message.WParam = SIZE_MINIMIZED) Then
    Show;

  Inherited;
End;

Constructor TBalloon.CreateNew(AOwner: TComponent; Dummy: Integer = 0);
Begin
  Inherited;

  OnActivate   := OnChange;
  OnDeactivate := OnChange;
  OnShow       := OnChange;
  BorderStyle  := bsNone;
  FormStyle    := fsStayOnTop;
  OnPaint      := FormPaint;
  Color        := clInfoBk;
  Font.Name    := 'Tahoma';

  pnlAlign   := TPanel.Create(Self);
  lblTitle   := TLabel.Create(Self);
  lblText    := TLabel.Create(Self);
  iconBitmap := TImage.Create(Self);
  tmrExit    := TTimer.Create(Self);

  OnClick          := OnMouseClick;
  iconBitmap.OnClick := OnMouseClick;
  pnlAlign.OnClick := OnMouseClick;
  lblTitle.OnClick := OnMouseClick;
  lblText.OnClick  := OnMouseClick;

  lblTitle.Parent      := Self;
  lblTitle.ParentColor := True;
  lblTitle.ParentFont  := True;
  lblTitle.AutoSize    := True;
  lblTitle.Font.Style  := [fsBold];
  lblTitle.Left        := 34;
  lblTitle.Top         := 12;

  lblText.Parent      := Self;
  lblText.ParentColor := True;
  lblText.ParentFont  := True;
  lblText.AutoSize    := True;
  lblText.Left        := 10;

  iconBitmap.Parent      := Self;
  iconBitmap.Transparent := True;
  iconBitmap.Left        := 10;
  iconBitmap.Top         := 10;

  tmrExit.Enabled  := False;
  tmrExit.Interval := 0;
  tmrExit.OnTimer  := OnExitTimer;
End;

Procedure TBalloon.FormPaint(Sender: TObject);
Var
  TempRegion: HRGN;
Begin
  With Canvas.Brush Do
   Begin
    Color := clBlack;
    Style := bsSolid;
   End;

  TempRegion := CreateRectRgn(0,0,1,1);
  GetWindowRgn(Handle, TempRegion);
  FrameRgn(Canvas.Handle, TempRegion, Canvas.Brush.handle, 1, 1);
  DeleteObject(TempRegion);
End;

Procedure TBalloon.ShowControlBalloon(blnControl: TWinControl; blnHoriz: TBalloonHoriz; blnVert: TBalloonVert; blnTitle, blnText: String; blnType: TBalloonType; blnDuration: Integer);
Var
  Rect: TRect;
  blnPosLeft, blnPosTop: Integer;
  blnPosition: TBalloonPosition;
Begin
  GetWindowRect(blnControl.Handle, Rect);

  blnPosTop  := 0;
  blnPosLeft := 0;

  If blnVert = blnTop Then
    blnPosTop := Rect.Top;

  If blnVert = blnCenter Then
    blnPosTop := Rect.Top + Round((Rect.Bottom - Rect.Top) / 2);

  If blnVert = blnBottom Then
    blnPosTop := Rect.Bottom;

  If blnHoriz = blnLeft Then
    blnPosLeft := Rect.Left;

  If blnHoriz = blnMiddle Then
    blnPosLeft := Rect.Left + Round((Rect.Right - Rect.Left) / 2);

  If blnHoriz = blnRight Then
    blnPosLeft := Rect.Right;

  blnPosition := blnArrowBottomRight;

  If ((blnHoriz = blnRight) and (blnVert = blnBottom)) or ((blnHoriz = blnMiddle) and (blnVert = blnBottom)) Then
    blnPosition := blnArrowBottomRight;

  If (blnHoriz = blnLeft) and (blnVert = blnBottom) or ((blnHoriz = blnLeft) and (blnVert = blnCenter)) Then
    blnPosition := blnArrowBottomLeft;

  If (blnHoriz = blnLeft) and (blnVert = blnTop) or ((blnHoriz = blnMiddle) and (blnVert = blnTop)) Then
    blnPosition := blnArrowTopLeft;

  If (blnHoriz = blnRight) and (blnVert = blnTop) or ((blnHoriz = blnRight) and (blnVert = blnCenter)) Then
    blnPosition := blnArrowTopRight;

  ShowBalloon(blnPosLeft, blnPosTop, blnTitle, blnText, blnType, blnDuration, blnPosition);
End;

Procedure TBalloon.ShowBalloon(blnLeft, blnTop: Integer; blnTitle, blnText: String; blnType: TBalloonType; blnDuration: Integer; blnPosition: TBalloonPosition);
Var
  ArrowHeight, ArrowWidth: Integer;
  FormRegion, ArrowRegion: HRGN;
  Arrow: Array [0..2] Of TPoint;
  ResName: String;
Begin
  ArrowHeight := 20;
  ArrowWidth  := 20;

  lblTitle.Caption := blnTitle;

  If blnPosition = blnArrowBottomRight Then
    lblTitle.Top := lblTitle.Top + ArrowHeight;

  If blnPosition = blnArrowBottomLeft Then
    lblTitle.Top := lblTitle.Top + ArrowHeight;

  lblText.Top     := lblTitle.Top + lblTitle.Height + 8;
  lblText.Caption := blnText;

  If blnPosition = blnArrowBottomRight Then
    iconBitmap.Top := iconBitmap.Top + ArrowHeight;

  If blnPosition = blnArrowBottomLeft Then
    iconBitmap.Top := iconBitmap.Top + ArrowHeight;

  Case blnType Of
    blnError:
      ResName := 'ERROR';
    blnInfo:
      ResName := 'INFO';
    blnWarning:
      ResName := 'WARNING';
    Else
      ResName := 'INFO';
   End;
  iconBitmap.Picture.Bitmap.LoadFromResourceName(HInstance, ResName);

  If blnPosition = blnArrowBottomRight Then
    ClientHeight := lblText.Top + lblText.Height + 10;
  If blnPosition = blnArrowBottomLeft Then
    ClientHeight := lblText.Top + lblText.Height + 10;
  If blnPosition = blnArrowTopLeft Then
    ClientHeight := lblText.Top + lblText.Height + 10 + ArrowHeight;
  If blnPosition = blnArrowTopRight Then
    ClientHeight := lblText.Top + lblText.Height + 10 + ArrowHeight;

  If (lblTitle.Left + lblTitle.Width) > (lblText.Left + lblText.Width) Then
    Width := lblTitle.Left + lblTitle.Width + 10
  Else
    Width := lblText.Left + lblText.Width + 10;

  If blnPosition = blnArrowTopLeft Then
   Begin
    Left := blnLeft - (Width - 20);
    Top  := blnTop - (Height);
   End;

  If blnPosition = blnArrowTopRight Then
   Begin
    Left := blnLeft - 20;
    Top  := blnTop - (Height);
   End;

  If blnPosition = blnArrowBottomRight Then
   Begin
    Left := blnLeft - 20;
    Top  := blnTop - 2;
   End;

  If blnPosition = blnArrowBottomLeft Then
   Begin
    Left := blnLeft - (Width - 20);
    Top  := blnTop - 2;
   End;

  FormRegion := 0;

  If blnPosition = blnArrowTopLeft Then
   Begin
    FormRegion := CreateRoundRectRgn(0, 0, Width, Height - (ArrowHeight - 2), 7, 7);

    Arrow[0] := Point(Width - ArrowWidth - 20, Height - ArrowHeight);
    Arrow[1] := Point(Width - 20, Height);
    Arrow[2] := Point(Width - 20, Height - ArrowHeight);
   End;

  If blnPosition = blnArrowTopRight Then
   Begin
    FormRegion := CreateRoundRectRgn(0, 0, Width, Height - (ArrowHeight - 2), 7, 7);

    Arrow[0] := Point(20, Height - ArrowHeight);
    Arrow[1] := Point(20, Height);
    Arrow[2] := Point(20 + ArrowWidth, Height - ArrowHeight);
   End;

  If blnPosition = blnArrowBottomRight Then
   Begin
    FormRegion := CreateRoundRectRgn(0, ArrowHeight + 2, Width, Height, 7, 7);

    Arrow[0] := Point(20, 2);
    Arrow[1] := Point(20, ArrowHeight + 2);
    Arrow[2] := Point(20 + ArrowWidth, ArrowHeight + 2);
   End;

  If blnPosition = blnArrowBottomLeft Then
   Begin
    FormRegion := CreateRoundRectRgn(0, ArrowHeight + 2, Width, Height, 7, 7);

    Arrow[0] := Point(Width - 20, 2);
    Arrow[1] := Point(Width - 20, ArrowHeight + 2);
    Arrow[2] := Point(Width - 20 - ArrowWidth, ArrowHeight + 2);
   End;

  ArrowRegion := CreatePolygonRgn(Arrow, 3, WINDING);

  CombineRgn(FormRegion, FormRegion, ArrowRegion, RGN_OR);
  DeleteObject(ArrowRegion);
  SetWindowRgn(Handle, FormRegion, True);

  Visible := False;
  ShowWindow(Handle, SW_SHOWNOACTIVATE);
  Visible := True;

  tmrExit.Interval := blnDuration * 1000;
  tmrExit.Enabled  := True;
End;

End.