28 Mart 2005

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

Yorum Gönder