Ana içeriğe atla

HintInfo

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

Bu blogdaki popüler yayınlar

The O.C.

Arkadaşların evde Cnbc-e olmadığından, eve yolum düştüğü vakitlerde dizinin yayın saatine uymadığından uzun zamandır bu diziyi izleyemedim. En son Ryan kız arkadaşından ayrılmıştı. Daha doğrusu piskopat bi çocuğun oyunlarından dolayı kız Ryanı terk etmişti. Konu hakkında bilgisi olan var mı?