Title: Transparent hint window component
Question: Want to have a unique hint window? How bout transparent?
Answer:
This component requires unit udcUtil, in post Create Transparent Bitmap by me.
Just drop this component to your form and set enabled to true.
unit udcHintEx;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, udcUtil;
type
TdcInternalHintEx = class(THintWindow)
private
FTransBitmap: TTransparentBitmap;
FActivating: Boolean;
protected
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
public
procedure ActivateHint(Rect: TRect; const AHint: string); override;
function CalcHintRect(MaxWidth: Integer; const AHint: string;
AData: Pointer): TRect; override;
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
end;
TdcHintEx= class(TComponent)
private
FFont: TFont;
FTransparent: Boolean;
FTransparency: Integer;
FTranspColor: TColor;
FShadowColor: TColor;
FEnabled: Boolean;
FLeftMargin: Integer;
FRightMargin: Integer;
FBottomMargin: Integer;
FTopMargin: Integer;
procedure SetEnable(const Value: Boolean);
procedure SetTransparency(const Value: Integer);
procedure SetFont(const Value: TFont);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Transparent: boolean read FTransparent write FTransparent;
property Transparency: Integer read FTransparency write SetTransparency default 30;
property TranspColor: TColor read FTranspColor write FTranspColor default clInfoBk;
property ShadowColor: TColor read FShadowColor write FShadowColor default clWhite;
property Enabled: Boolean read FEnabled write SetEnable;
property Font: TFont read FFont write SetFont;
property LeftMargin: Integer read FLeftMargin write FLeftMargin default 5;
property TopMargin: Integer read FTopMargin write FTopMargin default 5;
property RightMargin: Integer read FRightMargin write FRightMargin default 5;
property BottomMargin: Integer read FBottomMargin write FBottomMargin default 5;
end;
procedure Register;
implementation
{ TdcInternalHintEx }
{$R *.RES}
var dcHintEx: TdcHintEx;
procedure TdcInternalHintEx.ActivateHint(Rect: TRect; const AHint: string);
type
PRGBArray = ^TRGBArray;
TRGBArray = array[0..1000000] of TRGBTriple;
begin
FActivating := True;
try
ShowWindow(Handle, SW_HIDE);
Caption := AHint;
Inc(Rect.Bottom, 2);
Inc(Rect.Right, 2);
UpdateBoundsRect(Rect);
if Rect.Top + Height Screen.DesktopHeight then
Rect.Top := Screen.DesktopHeight - Height;
if Rect.Left + Width Screen.DesktopWidth then
Rect.Left := Screen.DesktopWidth - Width;
if Rect.Left if Rect.Bottom
if dcHintEx.Transparent then
FTransBitmap.CreateBitmap(Rect, dcHintEx.TranspColor, dcHintEx.Transparency);
SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
SWP_SHOWWINDOW or SWP_NOACTIVATE);
Invalidate;
finally
FActivating := False;
end;
end;
function TdcInternalHintEx.CalcHintRect(MaxWidth: Integer; const AHint: string;
AData: Pointer): TRect;
begin
Result := Rect(0, 0, MaxWidth, 0);
Canvas.Font := dchintEx.Font;
DrawText(Canvas.Handle, PChar(AHint), -1, Result, DT_CALCRECT or DT_LEFT or
DT_WORDBREAK or DT_NOPREFIX or DrawTextBiDiModeFlagsReadingOnly);
Inc(Result.Right, dchintEx.RightMargin+dcHintEx.LeftMargin);
Inc(Result.Bottom, dcHintEx.BottomMargin+dcHintEx.TopMargin);
end;
constructor TdcInternalHintEx.Create(AOwner: TComponent);
begin
inherited;
FTransBitmap := TTransparentBitmap.Create;
end;
procedure TdcInternalHintEx.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style - WS_BORDER;
end;
destructor TdcInternalHintEx.Destroy;
begin
FTransBitmap.Free;
inherited;
end;
procedure TdcInternalHintEx.Paint;
var R: TRect;
begin
R := ClientRect;
Canvas.Font := dcHintEx.Font;
if dcHintEx.Transparent then
BitBlt(Canvas.Handle, 0, 0, FTransBitmap.TransBitmap.Width, FTransBitmap.TransBitmap.Height,
FTransBitmap.TransBitmap.Canvas.Handle, 0, 0, SRCCOPY);
Inc(R.Left, dcHintEx.LeftMargin-1);
Inc(R.Top, dcHintEx.TopMargin-1);
Dec(R.Right, dcHintEx.RightMargin+1);
Dec(R.Bottom, dcHintEx.BottomMargin+1);
Canvas.Font.Color := dcHintEx.ShadowColor;
DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
Inc(R.Left,2);
Inc(R.Top,2);
Inc(R.Right,2);
Inc(R.Bottom,2);
DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
Dec(R.Left);
Dec(R.Top);
Dec(R.Right);
Dec(R.Left);
Canvas.Font.Color := dcHintEx.Font.Color;
DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
end;
{ TdcHintEx }
constructor TdcHintEx.Create(AOwner: TComponent);
begin
if not (AOwner.InheritsFrom(TCustomForm)) then
raise Exception.Create('dcHintEx must be dropped on a form.');
inherited;
FLeftMargin:= 5;
FRightMargin:= 5;
FTopMargin:= 5;
FBottomMargin:= 5;
FTransparent := True;
FTransparency := 30;
FTranspColor := clInfoBk;
FShadowColor := clWhite;
FFont := TFont.Create;
FFont.Assign(TCustomForm(AOwner).Font);
end;
destructor TdcHintEx.Destroy;
begin
FFont.Free;
inherited;
end;
procedure TdcHintEx.SetEnable(const Value: Boolean);
begin
if FEnabled Value then begin
FEnabled := Value;
if not (csDesigning in ComponentState) then
if FEnabled then begin
dcHintEx := Self;
HintWindowClass := TdcInternalHintEx
end
else begin
dcHintEx := nil;
if HintWindowClass = TdcInternalHintEx then
HintWindowClass := THintWindow;
end;
end;
end;
procedure TdcHintEx.SetFont(const Value: TFont);
begin
FFont.Assign(Value);
end;
procedure TdcHintEx.SetTransparency(const Value: Integer);
begin
if (Value 100) then
raise Exception.Create('Invalid transparency percentage value.');
FTransparency := Value;
end;
procedure Register;
begin
RegisterComponents('dc Tools', [TdcHintEx]);
end;
end.