Народ, как изменить вид hint a?

← →
Igor_thief © (2002-07-19 13:19) [0]

Сделать его другой формы?

← →
blackman (2002-07-19 15:37) [1]

"Borland Delphi 4, Руководство разработчика", К. Пачеко и С.
Тейксер
unit CoolHint
interface
uses Windows, Classes, Controls, Forms, Messages, Graphics
type
TddgHintWindow = class(THintWindow)
private
FRegion: THandle
procedure FreeCurrentRegion
public
destructor Destroy override
procedure ActivateHint(Rect: TRect const AHint: string)
override
procedure Paint override
procedure CreateParams(var Params: TCreateParams) override
end
implementation
destructor TddgHintWindow.Destroy
begin
FreeCurrentRegion
inherited Destroy
end
procedure TddgHintWindow.CreateParams(var Params: TCreateParams)
{ We need to remove the border created on the Windows API-level }
{ when the window is created. }
begin
inherited CreateParams(Params)
Params.Style := Params.Style and not ws_Border // remove border
end
procedure TddgHintWindow.FreeCurrentRegion
{ Regions, like other API objects, should be freed when you are }
{ through using them. Note, however, that you cannot delete a }
{ region which is currently set in a window, so this method sets }
{ the window region to 0 before deleting the region object. }
begin
if FRegion <>0 then begin // if Region is alive...
SetWindowRgn(Handle, 0, True) // set win region to 0
DeleteObject(FRegion) // kill the region
FRegion := 0 // zero out field
end
end
procedure TddgHintWindow.ActivateHint(Rect: TRect const AHint:
string)
{ Called when the hint is activated by putting the mouse pointer }
{ above a control. }
begin
with Rect do
Right := Right + Canvas.TextWidth("WWWW") // add some slop
BoundsRect := Rect
FreeCurrentRegion
with BoundsRect do
{ Create a round rectangular region to display the hint window }
FRegion := CreateRoundRectRgn(0, 0, Width, Height, Width, Height)
if FRegion <>0 then
SetWindowRgn(Handle, FRegion, True) // set win region
inherited ActivateHint(Rect, AHint) // call inherited
end
procedure TddgHintWindow.Paint
{ This method gets called by the WM_PAINT handler. It is }
{ responsible for painting the hint window. }
var
R: TRect
begin
R := ClientRect // get bounding rectangle
Inc(R.Left, 1) // move left side slightly
Canvas.Font.Color := clInfoText // set to proper color
{ paint string in the center of the round rect }
DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R,
DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_VCENTER)
end
var
OldHintClass: THintWindowClass
function SetNewHintClass(AClass: THintWindowClass): THintWindowClass
var
DoShowHint: Boolean
begin
Result := HintWindowClass // return value is old hint
window
DoShowHint := Application.ShowHint
if DoShowHint then
Application.ShowHint := False // destroy old hint window
HintWindowClass := AClass // assign new hint window
if DoShowHint then
Application.ShowHint := True // create new hint window
end
initialization
OldHintClass := SetNewHintClass(TddgHintWindow)
finalization
SetNewHintClass(OldHintClass)
end.

Народ, как изменить вид hint a? Найти похожие ветки