Wie bekommt man ein zusätzliches Label in die Titelleiste?

[Mathias Simmack]

Hallo Leute,

sorry. Ich hab´ jetzt einen Großteil des Forums nach einer Lösung durchgesucht, aber jetzt kann ich nicht mehr ... *schnauf*. Vielleicht habe ich´s ja auch übersehen.

Ich hatte vor Jahren mal einen Quellcode in TurboPASCAL-Windows, der im aktuellen Fenster die Uhrzeit in der Titelleiste dargestellt hat. Leider war der erstens nicht von mir (sonst wüsste ich ja, wie´s geht), und zweitens ist der mittlerweile verschollen/gelöscht usw.

Es geht auch nicht um die Sache mit der Uhrzeit, sondern nur um die Frage: Wie bekomme ich ein Label in die Titelleiste rein? Oder überhaupt irgendwelchen zusätzlichen Text. Auch so, dass er nicht über die vorhandenen Buttons drübergeht. Ich denke, ich muss tiefer eingreifen, weil ich mit dem normalen "FormPaint" nur innerhalb der Form rumzeichnen kann.

Und ich meine nicht die "Caption", sondern wirklich ein Label, das man vielleicht als Link "missbrauchen" kann. Lange Rede, kurzer Sinn: so wie das "Comment" in den Whistler-Fenstern, dass man ja auf diversen Screenshots sehen kann ... )

Herr Kosch?
Hagen?
Nico?
Wer auch immer ... *fleh*

Und wenn diese Frage schon irgendwo beantwortet wurde, dann vergebt mir und macht mich einfach darauf aufmerksam, wo ich die Lösung finde. "I´ moag nur net mehr such´n" ...

Viele Grüße.
Mathias.

[Alexander Hofmann]

Das hab ich mal aus einem alten Entwickler-Heft, 1997 oder 1998:

Auf dem Formular ein TLabel LabelFont erstellen mit dem Text, der oben rein soll:

<pre>
procedure WMNCPaint(var Msg: TMessage) ; message WM_NCPAINT;
procedure WMNCActivate(var MSG: TMessage); message WM_NCActivate;
.
.
.
procedure TForm1.WMNCPaint(var Msg: TMessage) ;
var
hWinDC : HDC;
y : integer;
aCanvas : TCanvas;
hOldBrush : hBrush;
rw,Abstand:integer;
begin
inherited;
hWinDC := Windows.GetWindowDC(Handle);
try
Y := GetSystemMetrics(SM_CYFRAME);
aCanvas := TCanvas.Create;
try
with aCanvas do
begin
Handle := hWinDC;
Font := LabelFont.Font;
SetBkMode(Handle,TRANSPARENT);
Abstand := 50;
hOldBrush := SelectObject(hWinDC,CreateSolidBrush(clWhite));
rw := TextWidth(LabelFont.Caption);
PatBlt(hWinDC, Abstand,y+2,rw+9,y+9,PatCopy);
DeleteObject(SelectObject(hWinDC,hOldBrush));
Font := LabelFont.Font;
TextOut(Abstand,5,LabelFont.Caption);
end;
finally
aCanvas.Free;
end;
finally
Windows.ReleaseDC(Handle,hWinDC);
end;

end;

procedure TForm1.WMNCActivate(var MSG: TMessage);
begin
inherited;
WMNCPaint(Msg);
end;
<\pre>
<br>
Ich hoffe das hilft<br>
Gruß,<br>
Ale

[Alexander Hofmann]

Sorry, meine Lösung geht leider über die vorhandenen Buttons drüber. Vielleicht hat ja jemand eine Idee wie es anders geht, _oder_ wie man ein Neuzeichnen der Systembuttons bewirkt.

Gruß
Ale

[Mathias Simmack]

Hi,
das mit den vorhandenen Buttons ist so wichtig nicht. *g* (Was für ein Deutsch, na ja ...) Mit der Zeit findet sich hier bestimmt eine Lösung. Ich bin froh, dass ich dank deiner Hilfe wenigstens den Anfang habe.<br><br>
Also, danke schön.<br><br>
Gruß.<br>
Mathias

[Mathias Simmack]

Hallo Leute,

also ich habe selbst mal ein bisschen herumgefummelt, dank der Hilfe von Alexander. Ich habe seine Funktion (s. oben) allerdings ein wenig umgeändert. Das benötigte Label kann wegfallen, der Text in der Titelzeile kommt aus einer Variablen:

<pre>
resourcestring
&nbsp;&nbsp;msgComments = 'Kommentare?'; // die Meldung in der Titelzeile
var
&nbsp;&nbsp;CommentRect = TRect; // quasi "missbraucht" zum Koordinatenspeichern

procedure TForm1.WMNCPaint(var Msg: TMessage);
var
&nbsp;&nbsp;hWinDC : HDC;
&nbsp;&nbsp;y, Abstand : integer;
&nbsp;&nbsp;aCanvas : TCanvas;
begin
&nbsp;&nbsp;inherited;
&nbsp;&nbsp;hWinDC := Windows.GetWindowDC(Handle);
&nbsp;&nbsp;try
&nbsp;&nbsp;&nbsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;// die Höhe der Titelleiste minus 2 = Breite der Buttons (Min, Max)
&nbsp;&nbsp;&nbsp;&nbsp;// ist das immer so, sonst steckt hier eine Fehlerquelle
&nbsp;&nbsp;&nbsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;y := GetSystemMetrics(SM_CYCAPTION) - 2;
&nbsp;&nbsp;&nbsp;&nbsp;aCanvas := TCanvas.Create;
&nbsp;&nbsp;&nbsp;&nbsp;try
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;with aCanvas do
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;be gin
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;Handle := hWinDC;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;Font.Color := clCaptionText;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;Font.Style := Font.Style + [fsUnderline];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;// Abstand von rechts
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;Abstand := Form1.Width - 15 - TextWidth(msgComments);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;// zusätzliche Buttons (Min, Max, Close) beachten
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;if(biSystemMenu in Form1.BorderIcons) then
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;begin
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dec(Abstand,y);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if(biMinimize in Form1.BorderIcons) or (biMaximize in Form1.BorderIcons) then dec(Abstand, (y * 2) + 2);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if(biHelp in Form1.BorderIcons) then dec(Abstand, succ(y));
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;end;

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;SetBkMode(Handle,TRANSPARENT);

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;// nur anzeigen, wenn´s noch reinpasst
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;if(Abstand + TextWidth(msgComments) < Form1.Width) then
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;begin
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;TextOut(Abstand, 5,msgComments);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;// Werte sichern
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CommentRect.Left := Abstand;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CommentRect.Righ t := TextWidth(msgComments);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CommentRect.Top := 1;
&nbsp;&nbsp;&nbsp

[Mathias Simmack]

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CommentRect.Bott om := GetSystemMetrics(SM_CYCAPTION);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;end
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;else
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;begin
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CommentRect.Left := 0;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CommentRect.Righ t := 0;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;end;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;en d;
&nbsp;&nbsp;&nbsp;&nbsp;finally
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;aCanvas.fre e;
&nbsp;&nbsp;&nbsp;&nbsp;end;
&nbsp;&nbsp;finally
&nbsp;&nbsp;&nbsp;&nbsp;Windows.ReleaseDC(Handle,h WinDC);
&nbsp;&nbsp;end;
end;
</pre>

Umständlich, ich weiß. Das "TRect" sollte man so wahrscheinlich nicht missbrauchen. ;o)
Wie auch immer, interessanterweise klappt es. Der Text wird in der Titelzeile angezeigt, und abhängig von den vorhandenen Buttons (Minimieren usw.) wird er ausgerichtet. Was die Button-Breite angeht habe ich getrickst, zugegeben. Gibt´s ´nen besseren Weg? Dann her damit.

Bitte!

[Mathias Simmack]

So, und weil´s wie ein Link aussieht, noch das passende Verhalten. Sprich: Mauscursor ändern. Nötig ist dazu logischerweise ein Cursor, der wie ´ne Hand aussieht und im Programm via "LoadCursor" geladen werden muss. Mein Konstantenwert dazu heißt "crHandshake", den ich auch nachfolgend im Code benutzt habe:

<pre>
procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
&nbsp;&nbsp;inherited;

&nbsp;&nbsp;if(M.Result = htCaption) then
&nbsp;&nbsp;&nbsp;&nbsp;begin
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if(CommentRect .Left <> 0) and (CommentRect.Right <> 0) then
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;be gin
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;// damit´s klappt, Windows überlisten
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;M.Result = htClient;

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;// Koordinaten kontrollieren
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;//
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;if(M.xPos > CommentRect.Left + Form1.Left) and
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;(M.xPos < CommentRect.Left + CommentRect.Right + Form1.Left) and
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;(M.yPos > CommentRect.Top + Form1.Top) and
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;&nbsp;&nbsp;(M.yPos < CommentRect.Top + CommentRect.Bottom + Form1.Top) then Form1.Cursor := crHandShake
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n bsp;&nbsp;else Form1.Cursor := crDefault;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;en d;
&nbsp;&nbsp;&nbsp;&nbsp;end;
end;

//
// und ein Patch, damit´s wieder zurückgesetzt wird, wenn man in die Form geht
//
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
&nbsp;&nbsp;Form1.Cursor := crDefault;
end;
</pre>

So, die Procedure "WMNCHitTest" muss natürlich noch im Deklarationsbereich eingetragen werden:

<pre>
private
&nbsp;&nbsp;procedure WMNCHitTest(var M: TWMNCHitTest); message WM_NCHITTEST;

...
</pre>

Fazit:
Es fehlt noch der finale Klick, denn bisher ist der Text in der Titelzeile nur Staffage. Mich würde aber mehr interessieren, ob irgendwelche "Bomben" in dem Code stecken. Ich gebe zu, ich bin nicht so bewandert in diesen Windows-Botschaften usw. Meine Lösung entstand auf dem üblichen Weg: Idee eintippen, Testen, Fluchen, und von vorn ...
)

Lasst mal bitte was von euch hören.
Auch, ob man´s vielleicht noch einfacher hinbekommt.

Gruß.
Mathias

[Gesine Kuhlmann]

Hi,

Entschuldige, aber darf ich fragen wo der tiefere Sinn liegt, den vom BS-Hersteller definierten ( und damit wenigstens zum kleinen Teil standarisierten ) Weg zu verbiegen um eine weitere Funktionalität einzubinden, die dort soundso keiner findet/sucht ???

Gruß
Gesin

[Mathias Simmack]

Och, menno, Gesine ) Ich wollte doch auch nur so einen schicken Link ("Kommentare?") in meinen Programmen haben, wie er im neuen WinXP auch drin steckt. Zumindest in den Betas 1 und 2.

Ich hab´s ja auch hingekriegt, aber es reagiert halt (noch) nicht so auf Mausklicks, wie ich das wünschen würde. Deshalb dachte ich, die richtigen Profis hier können sich der Sache mal annehmen und mir sagen, wo die Fehler liegen.

So, jetzt etwas spaßiger werden: Ich bin nur Anfänger, aber das liegt daran, dass man in der 5. Reihe nicht allzu viel mitbekommt. )

Gruß.
Mathias

[Gesine Kuhlmann]

Hi,

war doch nich' böse gemeint ;-)

Gruß
Gesin

[Mathias Simmack]

Ich hab´s auch nicht böse aufgefasst. *kicher* Wollte nur flirten ... Und das in ´nem Entwickler-Forum. *kopfschüttel*

Wo ist das Single-Forum?

[Nico Bendlin]

Was DIr jetzt noch fehlt, ist die Behandlung von <b>WM_NCLBUTTONDOWN</b> und/oder <b>WM_NCLBUTTONUP</b>.<p>

Gruß Nico<p>

PS: Der Rest sieht schon gut aus, aber, WIE sieht Dein Programm unter XP mit aktiviertem Luna aus

[Mathias Simmack]

Hab´ ich noch nicht probiert, ehrlich gesagt. Wahrscheinlich bescheuert, weil da ja schon so ein Link drin ist. )

Das mit dem "WM_NCLBUTTONUP" beispielsweise funktioniert irgendwie nicht richtig. Keine Ahnung, was ich falsch gemacht habe - der Link reagiert merkwürdigerweise nur auf Doppelklicks. ???

Oder muss ich tatsächlich beides abfragen? Also "ButtonDown" (meinetwegen ein Flag setzen), und dann "ButtonUp"?

Hm. Mal bei Gelegenheit probieren

[Hagen Reddmann]

Hi

Vieleicht solltes Du wm_NCHitTest anders umsetzen. wm_NCHitTest soll in Message.Result solch Konstanten wie htClient, htBorder etc. zurückgeben. Definiere nun eine eigene Konstante die sich nicht mit den Standard-Windows Konstanten überschneidet, z.B. htLink. In der wm_SetCursor Message kann nun direkt Message.HitTest = htLink abgefragt werden, das gleiche gilt für wm_NCxButton_xxx, auch dort gibts ein HitTest Member in TMessage.

Dein Problem reduziert sich also auf wm_NCHitTest --> Link-Screenbereich ermitteln, schauen ob xPos/yPos darin ist und Result := htLink setzen. In wm_SetCursor if HitTest = htLink then SetCursor(crLink) und in wm_NCLButtonUp das gleiche.

Nun fehlt nur noch wm_NCActivate und wm_NCPaint um den Link darzustellen.

Gruß Hage

[Hagen Reddmann]

Hi

<pre>

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FLinkFont: TFont;
FLinkText: String;
FLinkWidth: Integer;
FLinkSpace: Integer;
FLinkActive: Boolean;
protected
procedure PaintLink;
procedure WMNCHitTest(var Msg: TWMNCHitTest); message wm_NCHitTest;
procedure WMNCActivate(var Msg: TWMNCActivate); message wm_NCActivate;
procedure WMNCLButtonUp(var Msg: TWMNCLButtonUp); message wm_NCLButtonUp;
procedure WMNCPaint(var Msg: TMessage); message wm_NCPaint;
procedure WMSetCursor(var Msg: TWMSetCursor); message wm_SetCursor;
end;<br>

implementation<br>

uses ShellAPI;<br>

const
htLink = 50;<br>

procedure CreateCaptionFont(Font: TFont);
var
NCM: TNonClientMetrics;
begin
NCM.cbSize := SizeOf(NCM);
if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0) then
Font.Handle := CreateFontIndirect(NCM.lfCaptionFont);
end;<br>

procedure TForm1.FormCreate(Sender: TObject);
begin
FLinkText := 'www.dinosGmbH.de';
FLinkSpace := 8;
FLinkActive := False;
FLinkFont := TFont.Create;
CreateCaptionFont(FLinkFont);
Canvas.Font.Assign(FLinkFont);
FLinkWidth := Canvas.TextWidth(FLinkText);
end;<br>

procedure TForm1.FormDestroy(Sender: TObject);
begin
FLinkFont.Free;
FLinkFont := nil;
end;<br>

procedure TForm1.PaintLink;
var
C: TCanvas;
R: TRect;
I: Integer;
begin
GetWindowRect(Handle, R);
OffsetRect(R, -R.Left, -R.Top);
Inc(R.Top, GetSystemMetrics(sm_CYFrame));
R.Bottom := R.Top + GetSystemMetrics(sm_CYCaption) - 2;
Dec(R.Right, GetSystemMetrics(sm_CXFrame) + FLinkSpace);
Dec(R.Right, GetSystemMetrics(sm_CXSMIcon) * 3);
R.Left := R.Right - FLinkWidth;
C := TCanvas.Create;
try
C.Handle := GetWindowDC(Handle);
if C.Handle <> 0 then
begin
C.Font := FLinkFont;
I := C.TextWidth(Caption) + GetSystemMetrics(sm_CXFrame) + GetSystemMetrics(sm_CXSMIcon) + 8;
if I > R.Left then R.Left := I;
SetBkMode(C.Handle, Transparent);
DrawText(C.Handle, PChar(FLinkText), Length(FLinkText), R,
dt_Center or dt_SingleLine or dt_VCenter or $8000);
end;
finally
ReleaseDC(Handle, C.Handle);
C.Free;
end;
end;<br>

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
var
X: Integer;
begin
inherited;
if Msg.Result = htCaption then
begin
X := Left + Width - GetSystemMetrics(sm_CXFrame) - GetSystemMetrics(sm_CXSMIcon) * 3 - FLinkSpace;
if (Msg.XPos >= X - FLinkWidth) and (Msg.XPos <= X) then
Msg.Result := htLink;
end;
end;<br>

procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
begin
inherited;
if Msg.Active then FLinkFont.Color := clCaptionText
else FLinkFont.Color := clInactiveCaptionText;
PaintLink;
end;<br>

procedure TForm1.WMNCLButtonUp(var Msg: TWMNCLButtonUp);
begin
if Msg.HitTest = htLink then
ShellExecute(Handle, 'OPEN', PChar(FLinkText), nil, nil, sw_ShowNormal);
else inherited;
end;<br>

procedure TForm1.WMNCPaint(var Msg: TMessage);
begin
inherited;
PaintLink;
end;<br>

procedure TForm1.WMSetCursor(var Msg: TWMSetCursor);<br>

procedure SetLinkActive(Value: Boolean);
var
R: hRgn;
begin
if FLinkActive <> Value then
begin
FLinkActive := Value;
with FLinkFont do
if FLinkActive then Style := Style + [fsUnderLine]
else Style := Style - [fsUnderLine];
R := CreateRectRgn(Left + Width - FLinkWidth - 100, Top, Left + Width,
Top + GetSystemMetrics(sm_CYCaption) + GetSystemMetrics(sm_CYFrame));
try
SendMessage(Handle, wm_NCPaint, R, 0);
finally
DeleteObject(R);
end;
end;
end;<br>

begin
SetLinkActive(Msg.HitTest = htLink);
if Msg.HitTest = htLink then SetCursor(Screen.Cursors[crHandPoint])
else inherited;
end;<br>
&#10