Hi all.
I am trying to modify a component. Have managed to do some change, but the last
one is a public event OnMouseUp and I am having trouble with it.
It needs to propagate from the TBalloon to the TBalloonControl and this is where
I am having the problem that I dont understand how to do it.
Example is below with the added code in //*******************
Certainly the new code needs to be in Tballoon and to propagate through to
TBalloonControl. Also I added the HideBalloon with the global variable, but
there is probably a better way of doing that.
Thanks,
Alistair:
{
Balloon - using Balloon-shaped windows in your Delphi programs
Copyright (C) 2003 JWB Software
Web: http://people.zeelandnet.nl/famboek/delphi/
Email: [EMAIL PROTECTED]
}
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
//***************************
FOnMouseUp: TNotifyEvent;
//***************************
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;
//*************************
procedure HideBalloon;
//*************************
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;
//*****************************************
property OnMouseUp: TNotifyEvent read FOnMouseUp write FOnMouseUp;
//*****************************************
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;
var CurrentBalloon: Tballoon;
const WS_EX_NOACTIVATE = $08000000;
procedure Register;
implementation
{$R Balloon.res}
procedure Register;
begin
RegisterComponents('Utils', [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();
begin
CurrentBalloon := TBalloon.CreateNew(Owner);
CurrentBalloon.ShowControlBalloon(FControl, FHorizontal, FVertical, FTitle,
Trim(FText.Text), FBalloonType, FDuration);
end;
procedure TBalloonControl.ShowPixelBalloon();
begin
CurrentBalloon := TBalloon.CreateNew(nil);
CurrentBalloon.ShowBalloon(FPixelCoordinateX, FPixelCoordinateY, FTitle,
Trim(FText.Text), FBalloonType, FDuration, FPosition);
end;
procedure TBalloonControl.HideBalloon;
begin
if CurrentBalloon <> nil then
begin
CurrentBalloon.Release;
CurrentBalloon := nil;
end;
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;
CurrentBalloon := nil;
end;
procedure TBalloon.OnExitTimer(Sender: TObject);
begin
Release;
CurrentBalloon := nil;
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.
_______________________________________________
Delphi mailing list
[EMAIL PROTECTED]
http://ns3.123.co.nz/mailman/listinfo/delphi
