[소스] 풍선도움말을 마음대로..

안녕하세요..
델을 사랑하는 사람입니다.

쓸만한 힌트컴포넌트가 있어서 소개를 드립니다.
원래 어떤분이 만드셨던것인데 ( EllipticHint : 힌트가 타원형으로 나옴 )
약간의 수정을 가해서 올려봅니다.

기능 :
힌트의 색, 폰트등의 변경이 가능..
가령 검정바탕에 흰색의 글자가 나오는데 굴림체에 20포인트로 할수가 있죠..

기본적으로 힌트의 모양은 타원형, 하지만 OnDrawHint라는 이벤트에서 마음대로
조작이 가능...

OnDrawHint외에 OnHint(마우스커서가 컨트롤 위에 위치할때 나오는 메시지)와
OnShowHint(힌트 뜨려고 할때 나오는 메시지)의 이벤트를 가지고 있습니다...
브러쉬, 폰트, 펜을 프로퍼티에서 바로 조작할 수 있습니다.
물론 힌트가 떠있는 시간도 조절할 수 있죠..(HintPauseTime)
이정도면 힌트에 대한 거의 모든 조작을 할 수 있을겁니다.

아래에 간단한 예제와 컴포넌트 소스를 함께 올립니다.
소스를 보시고 공부해 보시는 것도 좋겠지요..

그럼... 좋은 코딩하세요..


procedure TForm1.FormCreate(Sender: TObject);
begin
CCHint1.Font.Name := '굴림';
CCHint1.Font.Size := 40;
CCHint1.FontColor := clTeal;
CCHint1.HintColor := clLime;
end;

procedure TForm1.CCHint1DrawHint(Sender: TObject; Canvas: TCanvas;
var R: TRect);
var PT : Array [0..10] of TPoint;
begin

PT[0] := Point( 0, 0 );
PT[1] := Point( R.Right, 0 );
PT[2] := Point( R.Right-10, R.Bottom div 2 );
PT[3] := Point( R.Right, R.Bottom-1 );
PT[4] := Point( R.Left, R.Bottom-1 );
PT[5] := Point( R.Left+10, R.Bottom div 2 );
PT[6] := Point( 0, 0 );

Canvas.Polygon( Slice( PT, 7 ) );
{}
// Canvas.CopyRect( R, Image1.Canvas, R );
end;




unit CCHint;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs;

Const
Sqrt2 = 1.4142135624;

type
TDrawHint =
procedure (Sender : TObject; Canvas : TCanvas; var R : TRect) of object;
TOnHint =
procedure (Sender : TObject; Hint : string) of object;

TCCHint = class(TComponent)
private
{ Private declarations }
FHintPauseTime : Integer;
FFontColor : TColor;
FHintColor : TColor;
FPen : TPen;
FBrush : TBrush;
fFont : TFont;

fDrawHint : TDrawHint;
fOnShowHint : TShowHintEvent;
fOnHint : TOnHint;

procedure SetHintPauseTime(Value:Integer);
Procedure SetPen(Value : TPen);
Procedure SetBrush(Value : TBrush);
procedure fSetFont(Font : TFont);

procedure DoOnShowHint(var HintStr: string; var CanShow:
Boolean; var HintInfo: THintInfo);
procedure DoOnHint(Sender: TObject);

protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner:TComponent); Override;
destructor Destroy; Override;
published
{ Published declarations }
property HintPauseTime : Integer read FHintPauseTime
write SetHintPauseTime default 600;
property Pen : TPen Read FPen Write SetPen;
property Brush : TBrush Read FBrush Write SetBrush;
property FontColor : TColor Read FFontColor
Write FFontColor Default clBlack;
property HintColor : TColor Read FHintColor
Write FHintColor Default clYellow;
property Font : TFont read fFont write fSetFont;

property OnDrawHint : TDrawHint read fDrawHint write fDrawHint;
property OnHint : TOnHint read fOnHint write fOnHint;
property OnShowHint : TShowHintEvent read fOnShowHint write fOnShowHint;

end;

TNxHintWindow = class(THintWindow)
private
{ Private declarations }
FNxHint : TCCHint;
function FindNxHint : TCCHint;
protected
{ Protected declarations }
procedure Paint; Override;
procedure CreateParams(var Params: TCreateParams); Override;
public
{ Public declarations }
procedure ActivateHint(Rect: TRect; const AHint: string); Override;
published
{ Published declarations }
end;

procedure Register;

implementation

var
MemBmp : TBitmap;

procedure Register;
begin
RegisterComponents('C쟁이네', [TCCHint]);
end;

Constructor TCCHint.Create(AOwner:TComponent);
begin
inherited Create(AOwner);

FPen := TPen.Create;
FBrush := TBrush.Create;
fFont := TFont.Create;
FBrush.Color := clYellow;
FFontColor := clBlack;
FHintColor := clYellow;

FHintPauseTime := 600;

if not (csReading in ComponentState) then
begin
Application.OnShowHint := DoOnShowHint;
Application.OnHint := DoOnHint;

Application.HintPause := FHintPauseTime;
HintWindowClass := TNxHintWindow;
Application.ShowHint := not Application.ShowHint;
Application.ShowHint := not Application.ShowHint;
end;
end;

destructor TCCHint.Destroy;
begin
FPen.Free;
FBrush.Free;
fFont.Free;
inherited Destroy;
end;


Procedure TCCHint.fSetFont(Font : TFont);
begin
fFont := Font;
end;

Procedure TCCHint.SetHintPauseTime(Value : Integer);
Begin
If (Value <> FHintPauseTime) Then Begin
FHintPauseTime := Value;
Application.HintPause := Value;
End;
End;

Procedure TCCHint.SetPen(Value : TPen);
Begin
FPen.Assign(Value);
End;

Procedure TCCHint.SetBrush(Value : TBrush);
Begin
FBrush.Assign(Value);
End;

Function TNxHintWindow.FindNxHint : TCCHint;
var
I : Integer;
begin
Result := nil;
For I := 0 To Application.MainForm.ComponentCount-1 Do
If Application.MainForm.Components[I] Is TCCHint Then Begin
Result := TCCHint(Application.MainForm.Components[I]);
Exit;
End;
End;

procedure TNxHintWindow.CreateParams(var Params : TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style-WS_BORDER;
end;

procedure TNxHintWindow.Paint;
var
R : TRect;
OfstX,OfstY : Integer;
begin
R := ClientRect;
With MemBMP.Canvas Do Begin
Pen.Assign(FNxHint.FPen);
Brush.Assign(FNxHint.FBrush);
Font.Assign(FNxHint.FFont);

Brush.Color := FNxHint.FHintColor;
Font.Color := FNxHint.FFontColor;

OfstX := (R.Right-R.Left-TextWidth(Caption)) Div 2;
OfstY := (R.Bottom-R.Top-TextHeight(Caption)) Div 2;

if Assigned (FNxHint.fDrawHint) then
FNxHint.fDrawHint(self, MemBMP.Canvas, R)
else
begin
Ellipse(R.Left,R.Top,R.Right,R.Bottom);
{
RoundRect( R.Left,R.Top,R.Right,R.Bottom,
(R.Bottom - R.Right) div 3, (R.Bottom - R.Right) div 3);
}
end;

Brush.Style := bsClear;
TextOut(R.Left+OfstX,R.Top+OfstY,Caption);
End;
Canvas.CopyMode:=cmSrcCopy;
Canvas.CopyRect(ClientRect,MemBmp.Canvas,ClientRect);
MemBmp.Free;
end;

procedure TNxHintWindow.ActivateHint(Rect: TRect; const AHint: string);
var
ScreenDC : HDC;
Pnt : TPoint;
OfstX,OfstY : Integer;
begin
MemBmp := TBitmap.Create;

Caption := AHint;
FNxHint := FindNxHint;

MemBmp.Canvas.Font := FNxHint.FFont ;
Rect.Right := Rect.Left + MemBmp.Canvas.TextWidth(AHint);
Rect.Bottom := Rect.Top + MemBmp.Canvas.TextHeight(AHint);

OfstX := Round((Rect.Right-Rect.Left-4)*(Sqrt2-1)*0.5);
OfstY := Round((Rect.Bottom-Rect.Top-4)*(Sqrt2-1)*0.5);
With Rect Do Begin
Top := Top-OfstY;
Left := Left-OfstX;
Right := Right+OfstX;
Bottom := Bottom+OfstY;
End;
BoundsRect := Rect;
MemBmp.Width := Width;
MemBmp.Height := Height;
ScreenDC := CreateDC('DISPLAY',nil,nil,nil);
Pnt.X := 0;
Pnt.Y := 0;
Pnt := ClientToScreen(Pnt);
BitBlt(MemBmp.Canvas.Handle,0,0,Width,Height,ScreenDC,Pnt.X,Pnt.Y,SRCCOPY);
SetWindowPos(Handle,HWND_TOPMOST,Pnt.X,Pnt.Y,0,0,
SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);
BitBlt(Canvas.Handle,0,0,Width,Height,MemBmp.Canvas.Handle,0,0,SRCCOPY);
DeleteDC(ScreenDC);
end;

procedure TCCHint.DoOnShowHint(var HintStr: string; var CanShow: Boolean;
var HintInfo: THintInfo);
begin
if Assigned(fOnShowHint) then fOnShowHint(HintStr, CanShow, HintInfo);
end;

procedure TCCHint.DoOnHint(Sender: TObject);
begin
if Assigned(fOnHint) then fOnHint(Sender, Application.Hint);
end;

end.

출처 : 델마당