Programın arabiriminde yer alan bazı bileşenlerin içerdikleri metin ekrana sığmayabiliyor. Kaydırma çubukları da gerekli esnekliği sağlıyamıyor. Böyle bir durumda hintleri kullanarak kullanıcıya metnin tamamını göstermek güzel bir davranış olabilir. Bu örneğimizde kullanıcı fareyle listbox üzerinde ki metinlerin üzerine geldiği zaman (metin listboxa sığmamışsa) metnin tam halini hint olarak kullanıcıya gösteriyor.
Kodun orjinal hali hinti direkt olarak kendi üzerinde gösteriyordu. Hintin fareye göre konumlanması daha çok hoşuma gittiği için kod üzerinde bir kaç ufak değişiklik yaptım.
...
...
...
type
TForm1 = class(TForm)
ListBox1: TListBox;
...
...
public
procedure ShowHint(var HintStr: String;
var CanShow: Boolean; var HintInfo: THintInfo);
{ Public declarations }
end;
...
...
...
procedure TForm1.ShowHint(var HintStr: String;
var CanShow: Boolean; var HintInfo: THintInfo);
var
MyItemIndex: Integer;
MyString: String;
MySize: TSize;
MyPos: TPoint;
begin
with HintInfo do
begin
if HintControl = ListBox1 then
begin
CanShow := False;
MyItemIndex := ListBox1.ItemAtPos(
Point(CursorPos.X,
CursorPos.Y),
True);
if MyItemIndex <> -1 then
begin
MyString := ListBox1.Items[MyItemIndex];
GetTextExtentPoint32(ListBox1.Canvas.Handle,
PChar(MyString),
Length(MyString),
MySize);
MyPos:= ListBox1.ScreenToClient(mouse.CursorPos);
MyPos.Y := MyPos.Y - 20;
if MySize.cx > ListBox1.ClientWidth then
begin
HintPos := ListBox1.ClientToScreen(MyPos);
HintMaxWidth := MySize.cx + 1;
CursorRect := Rect(MyPos.x, MyPos.y, MyPos.x +
MySize.cx, MyPos.y + MySize.cy);
HintStr := MyString;
CanShow := True;
end;
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnShowHint :=ShowHint;
end;
kaynak
Yorumlar