Friday, September 21, 2007

A ještě jednou bublinková nápověda

A znovu tu máme téma bublinkové nápovědy. Tentokrát si vytvoříme přímo vlastní bublinkovou nápovědu (Hint), a to prostřednictvím komponenty Panel. Umístěte ji tedy na formulář. O její vlastnosti se nemusíte starat, budou měněny přímo programově. Dále bude potřeba jeden Timer, abychom náš Hint zobrazili na požadovaný časový interval. Poté si ještě na formulář umístěte jedno tlačítko, na kterém budeme funkčnost příkladu demonstrovat.
A nyní již samotný kód:
.
.
.
private
{ Private declarations }
procedure ShowAHint(x: integer; y: integer; Caption: string; Duration: LongInt);
.
.
.

procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled := false;
Panel1.Visible := false;
Panel1.BevelInner := bvNone;
Panel1.BevelOuter := bvNone;
Panel1.BorderStyle := bsSingle;
end;

procedure TForm1.ShowAHint(x : integer; y : integer; Caption : string; Duration : LongInt);
var
dc : hdc;
OldFont : hFont;
pt : TSize;
p : pChar;
begin
if Timer1.Enabled <> false then Timer1.Enabled := false;
Timer1.Enabled := false;
if Panel1.Visible <> false then Panel1.Visible := false;
if Caption = '' then exit;
Panel1.Caption := caption;
GetMem(p, Length(Panel1.Caption) + 1);
StrPCopy(p, Panel1.Caption);
dc := GetDc(Panel1.Handle);
OldFont := SelectObject(dc, Panel1.Font.Handle);
GetTextExtentPoint32(dc, p, Length(Panel1.Caption), pt);
SelectObject(dc, OldFont);
ReleaseDc(Panel1.Handle, Dc);
FreeMem(p, Length(Panel1.Caption) + 1);
Panel1.Left := x;
Panel1.Top := y;
Panel1.Width := pt.cx + 6;
Panel1.Height := pt.cy + 2;
Panel1.Color:= clLime;
Panel1.Font.Color := clBlue;
Panel1.Visible := true;
Timer1.Interval := Duration;
Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Panel1.Visible <> false then
Panel1.Visible := false;
Timer1.Enabled := false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Application.ProcessMessages;
ShowAHint(Button1.Left, Button1.Top + Button1.Height + 6, Button1.Hint, 2000);
end;

Labels: