{
Copyright: Copyright © 2002-2004 gate(n)etwork GmbH. Alle Rechte vorbehalten.
Author: Daniel Wischnewski
State: Public Domain, only for Delphi-PRAXiS Group
Remarks: this Copyright must be included
Version: Delphi 2-7
Description: Creates a custom hint window
* THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS
* OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
* LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
* BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
* OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
* EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
}
unit uCustomHint;
interface
uses
Classes, Windows, Forms, Graphics, Controls, Types;
type
TGraphicHintWindow =
class(THintWindow)
private
FActivating: Boolean;
public
procedure ActivateHint(Rect: TRect;
const AHint:
string);
override;
protected
procedure Paint;
override;
public
constructor Create(AOwner: TComponent);
override;
property Caption;
end;
var
CurrentHintImage:
String;
const
BMP_SPACE = 30;
implementation
{ TGraphicHintWindow }
procedure TGraphicHintWindow.ActivateHint(Rect: TRect;
const AHint:
string);
begin
FActivating := True;
try
Caption := AHint;
Inc(Rect.Bottom, 16);
Rect.Right := Rect.Right + BMP_SPACE;
UpdateBoundsRect(Rect);
// calc screen position
if Rect.Top + Height > Screen.ActiveForm.Monitor.WorkareaRect.Bottom
then
Rect.Top := Screen.ActiveForm.Monitor.WorkareaRect.Bottom - Height;
if Rect.Left + Width > Screen.ActiveForm.Monitor.WorkareaRect.Right
then
Rect.Left := Screen.ActiveForm.Monitor.WorkareaRect.Right - Width;
if Rect.Left < Screen.ActiveForm.Monitor.WorkareaRect.Left
then
Rect.Left := Screen.ActiveForm.Monitor.WorkareaRect.Left;
if Rect.Bottom < Screen.ActiveForm.Monitor.WorkareaRect.Top
then
Rect.Bottom := Screen.ActiveForm.Monitor.WorkareaRect.Top;
// set new position
SetWindowPos(
Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
SWP_SHOWWINDOW
or SWP_NOACTIVATE);
// redraw
Invalidate;
finally
FActivating := False;
end;
end;
constructor TGraphicHintWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
with Canvas.Font
do
Color := clBlack;
end;
procedure TGraphicHintWindow.Paint;
var
R: TRect;
Bmp: TBitmap;
begin
R := ClientRect;
Inc(R.Left, 2);
Inc(R.Top, 2);
// draw left corner
Bmp := TBitmap.Create;
try
try
with Canvas
do
begin
Brush.Style := bsSolid;
Brush.Color := clSkyBlue;
Pen.Color := clGray;
Rectangle(0, 0, BMP_SPACE, R.Bottom + 1);
Bmp.LoadfromFile(CurrentHintImage);
Draw(4, Succ((R.Bottom - Bmp.Height)
div 2), Bmp);
end;
except
end;
finally
Bmp.Free;
end;
Color := clWhite;
// draw text
Canvas.Brush.Style := bsClear;
Canvas.TextOut(Succ(BMP_SPACE), (R.Bottom
div 2) - (Canvas.Textheight(Caption)
div 2), Caption);
end;
initialization
CurrentHintImage := '
';
end.