Arsip: Bikin Balooon tooltip


by Starboard in Articles more 16 years ago 1733
Bikin Baloon Tooltip Di Delphi, ini adalah source componentnya. soalnya aku ndak punya tempat buat upload component packgake nya, ya gini aja saya rasa udah cukup. kamu tinggal bikin aja component entar paste kan sourec ini. class nya pake class(TComponent), benernya ini tips yang aku ambil dari torry.net cuman biar gampang jadi aku buat komponent, tinggal pasang jadi dech.
contoh penggunaan:
  TooltipBaloon1.ShowBalloonTip(edit1,1,'Login','Masukan User Login Anda disini',clWhite,clBlue);
TooltipBaloon1.ShowBalloonTip(edit2,'Password','Masukan Password Anda disini',clWhite,clBlue);

source komponen:
unit TooltipBaloon;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, CommCtrl;
type
TTooltipBaloon = class(TComponent)
private
FxAuthor: ShortString;
FxVersion: ShortString;
procedure SetxAuthor(const Value: ShortString);
procedure SetxVersion(const Value: ShortString);
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner : TComponent);override;
destructor Destroy();override;
procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: pchar; Text: PWideChar;
BackCL, TextCL: TColor);
published
{ Published declarations }
property xAuthor    : ShortString read FxAuthor write SetxAuthor;
property xVersion   : ShortString read FxVersion write SetxVersion;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Kiyat', [TTooltipBaloon]);
end;
{ TTooltipBaloon }
constructor TTooltipBaloon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FxAuthor   := 'Kiyat Yuni Saptoko';
FxVersion  := 'April 2004';
end;
destructor TTooltipBaloon.Destroy;
begin
inherited Destroy();
end;
procedure TTooltipBaloon.SetxAuthor(const Value: ShortString);
begin
FxAuthor := Value;
if FxAuthor <> 'Kiyat Yuni Saptoko' then FxAuthor := 'Kiyat Yuni Saptoko';
end;
procedure TTooltipBaloon.SetxVersion(const Value: ShortString);
begin
FxVersion := Value;
if FxVersion <>' April 2004' then FxVersion := 'April 2004';
end;
procedure TTooltipBaloon.ShowBalloonTip(Control: TWinControl;
Icon: integer; Title: pchar; Text: PWideChar; BackCL, TextCL: TColor);
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;
type
TOOLINFO = packed record
cbSize: Integer;
uFlags: Integer;
hwnd: THandle;
uId: Integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: Integer;
end;
var
hWndTip: THandle;
ti: TOOLINFO;
hWnd: THandle;
begin
hWnd    := Control.Handle;
hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
0, 0, 0, 0, hWnd, 0, HInstance, nil);
if hWndTip <> 0 then
begin
SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
ti.cbSize := SizeOf(ti);
ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
ti.hwnd := hWnd;
ti.lpszText := Text;
Windows.GetClientRect(hWnd, ti.rect);
SendMessage(hWndTip, TTM_SETTIPBKCOLOR, BackCL, 0);
SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, TextCL, 0);
SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
end;
end;
end.
Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com