DELPHI/Часто задаваемые вопросы и ответы на них/Компоненты



На главную

Подписка

Новости

Главная / DELPHI / Часто задаваемые вопросы и ответы на них / Компоненты / Отображение полных строк списка при перемещении мыши по списку

Отображение полных строк списка при перемещении мыши по списку

Автор: Serzs

Внимание! Вы изменили положение мыши. Для того, чтобы изменения вступили в силу, необходимо перезагрузить компьютер.

Текст формы примера:

object MainForm: TMainForm
Left = 7
Top = 121
Width = 200
Height = 157
Hint = '34534535'
Caption = 'Long hints'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.name = 'MS Sans Serif'
Font.Style = []
ShowHint = True
OnCreate = FormCreate
PixelsPerInch = 120
TextHeight = 16
object ListBox1: TListBox
Left = 12
Top = 12
Width = 165
Height = 97
Hint = '1|2'
ItemHeight = 16
Items.Strings = (
'1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ'
'A1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ'
'1234567890'
'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
'ABCD')
ParentShowHint = False
ShowHint = True
TabOrder = 0
OnMouseMove = ListBox1MouseMove
end
end

Текст модуля:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMainForm = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
  private
    { Private declarations }
    FHintRow : Integer; // Номер строки в списке, на которую указывает мышь
  public
    { Public declarations }
    // Обработчик подсказок
    procedure OnShowHint(var HintStr: string; var CanShow: Boolean;
    var HintInfo: THintInfo);
end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FHintRow := -1;
  Application.OnShowHint := OnShowHint; // Установка обработчика
end;

procedure TMainForm.OnShowHint(var HintStr: string; var CanShow: Boolean;
var HintInfo: THintInfo);
var
  Pos: TPoint;
begin
  with HintInfo do
    // Проверка на нужный объект
    if HintControl is TListBox then
      with HintControl as TListBox do
      begin
        Pos.X := 0;
        Pos.Y := ListBox1.Tag;
        HintPos := ListBox1.ClientToScreen(Pos);
        HintStr := ListBox1.Hint;
      end;
end;

procedure TMainForm.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
  MousePos : TPoint;
  ItemPos : TRect;
  RowWidth,
  ItemNum : Integer;
  FHint : string;
begin
  MousePos.X := X;
  MousePos.Y := Y;
  // Определение номера строки в списке
  ItemNum := ListBox1.ItemAtPos(MousePos, True);

  // Проверка на перемещение мыши на другую строку
  if (ItemNum <> FHintRow) then
  begin
    FHintRow := ItemNum;
    // Проверка на наличие элементов в списке
    if ItemNum <> -1 then
    begin
      ItemPos := ListBox1.ItemRect(ItemNum);

      Application.CancelHint; // Снять текущую подсказку
      ListBox1.Tag := ItemPos.Top; // Запоминаем позицию строки по вертикали

      FHint := ListBox1.Items[ItemNum];

      // Проверка на ширину строки
      RowWidth := ListBox1.Canvas.TextWidth( FHint );
      if (RowWidth > ListBox1.ClientWidth) then
        FHint := FHint + '|'
      else
        FHint := '';

      ListBox1.Hint := FHint;
    end
    else
    begin
      ListBox1.Hint := '';
      Application.CancelHint;
      ListBox1.Tag := -1;
    end;
  end
end;

end.

Текст проекта:

program PrjHint;

uses
  Forms,
  Main in 'Main.pas' {MainForm};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);

  Application.ShowHint := True;
  Application.HintPause := 100;
  Application.HintHidePause := 999999;

  Application.Run;
end.

Источник получения информации: http://www.delphiworld.narod.ru