unit teMyHint;
//==============================================================================
// Klasse: TMyHint
// Author: Jan Karger
// Datum: 26.01.2004
// Feedback: [email]punkerat76@gmx.net[/email]
// Benutzung: Jeder kann diesen Code benutzen, weitergeben oder auch verändern,
// verbessern und dann weitergeben und mir, wenn Verbesserungen
// erfolgt sind, vielleicht ein kleines Feedback geben.
//==============================================================================
// Einbinden in ein Projekt: in FormCreate
//
// HintWindowClass := TMyHint;
// Application. ShowHint := False;
// Application. ShowHint := True;
//
// Formatierung des Hints:
//
// Hint:=
// 'Ein Test' + ';' +
// 'Ein Test<@=80@>Noch ein Test<@=120@>Noch ein Test' + ';' +
// 'Ein Test<@=80@>Noch ein Test<@=120@>blubb' + ';' +
// 'Ein Test<@=80@>Noch ein Test' + ';' +
// '1235678';
//
// <@=80@> Spaltenbreite
// ';' Trenner für den Zeilenumbruch
//==============================================================================
interface
uses
Windows, Classes, Graphics, Controls, Forms;
type
TMyHint =
class(THintWindow)
private
procedure MyCalcHintRect (
var ARect: TRect; AHint:
string);
public
constructor Create (AOwner: TComponent);
override;
function CalcHintRect (MaxWidth: Integer;
const AHint:
string; AData: Pointer): TRect;
override;
protected
procedure Paint;
override;
published
property Caption;
end;
var
gMyHintColor : TColor;
gMyHintFont :
string;
gMyHintFontStyle : TFontStyles;
gMyHintFontSize : integer;
gZeilenUmbruch : Char;
implementation
uses
SysUtils, Math;
constructor TMyHint. Create (AOwner: TComponent);
begin
inherited Create(AOwner);
{* eigenes Aussehen des Hints: Color, Schriftart, Schriftgrösse }
Color := gMyHintColor;
if gMyHintFont <> '
'
then begin
Canvas. Font.
Name := gMyHintFont;
Canvas. Font. Style := gMyHintFontStyle;
Canvas. Font. Size := gMyHintFontSize;
end
else begin
Canvas. Font := Screen. HintFont;
end;
Canvas. Brush. Style := bsClear;
end;
{** Berechnet das Hint-Rechteck und den Clientbereich für den Text }
procedure TMyHint. MyCalcHintRect (
var ARect: TRect; AHint:
string);
var
iIndex : integer;
iColPos : integer;
iPos1, iPos2 : integer;
iColWidth : integer;
iMax : integer;
s :
string;
sTemp :
string;
iTop : integer;
iLeft : integer;
iRight : integer;
MyHintList : TStringList;
iMyPos : integer;
bIsFertig : boolean;
begin
MyHintList := TStringList. Create;
try
{* den Hint zerpflücken, durch den angegebenen Zeilentrenner }
iMyPos:= Pos (gZeilenUmbruch, AHint);
if iMyPos > 0
then begin
bIsFertig:= FALSE;
repeat
MyHintList. Add (Copy (AHint, 1, iMyPos-1));
Delete (AHint, 1, iMyPos);
iMyPos:= Pos (gZeilenUmbruch, AHint);
if iMyPos = 0
then begin
MyHintList. Add (AHint);
bIsFertig:= TRUE;
end;
until bIsFertig;
end
else
MyHintList. Add (AHint);
if MyHintList. Count = 0
then EXIT;
Inc (ARect.Left, 2);
Inc (ARect.Top, 2);
iTop:= 0;
iMax:= 0;
for iIndex:= 0
to MyHintList. Count - 1
do
begin
s:= MyHintList [iIndex];
ARect. Bottom:= iTop + Canvas. Textheight (s) + 4;
iLeft:= 0;
iColPos:= Pos ('
<@=', s);
if iColPos > 0
then
begin
while iColPos > 0
do
begin
iPos1:= iColPos + 3;
iPos2:= Pos ('
@>', s);
if iPos2 = 0
then EXIT;
iColWidth:= StrToIntDef (Copy (s, iPos1, iPos2-iPos1), 0);
if iColWidth = 0
then EXIT;
sTemp:= Copy (s, 1, iColPos-1);
Delete (s, 1, iPos2+1);
iRight:= iLeft+iColWidth;
iMax:= Max (iMax, iRight);
ARect. Right:= iMax;
Canvas. TextRect (ARect, iLeft+2, iTop+2, sTemp);
iLeft:= iRight;
iColPos:= Pos ('
<@=', s);
if iColPos = 0
then begin
iMax:= Max (iMax, iLeft + Canvas. TextWidth (s) + 8);
ARect. Right:= iMax;
Canvas. TextRect (ARect, iLeft+2, iTop+2, s);
end;
end;
end
else begin
iMax:= Max (iMax, iLeft + Canvas. TextWidth (s) + 8);
ARect. Right:= iMax;
Canvas. TextRect (ARect, iLeft+2, iTop+2, s);
end;
s:= MyHintList [iIndex];
iTop:= iTop + Canvas. Textheight(s) + 2;
end;
finally
MyHintList. Free;
end;
end;
procedure TMyHint. Paint;
var
R : TRect;
begin
{* hier muss nochmal explizit die Farbe des Hints angegeben werden }
Color := gMyHintColor;
{* Text in Hint-ClientRechteck zeichnen }
R := ClientRect;
MyCalcHintRect (R, Caption);
end;
function TMyHint. CalcHintRect (MaxWidth: Integer;
const AHint:
string; AData: Pointer): TRect;
begin
{* Hint-Rechteck errechnen }
Result := Rect (0, 0, 0, 0);
MyCalcHintRect (Result, AHint);
end;
initialization
gMyHintColor := clInfoBk;
gMyHintFont :=
{'Arial'}'
';
// wenn leer, dann Standardfont
gMyHintFontStyle := [fsBold];
gMyHintFontSize := 9;
gZeilenUmbruch := '
;';
finalization
end.