[Shoni]

Доброго времени суток!

Помогите, пожалуйста, решить проблемку: нужно содержимое ячеек вывести в Hint... Реализовано, НО: экран постоянно мерцает + нельзя перейти к нижним записям, не убирающимся на экран, особенно при использовании колесика мыши (как бы выталкивает наверх, в область, ограниченную экраном)

Код:

  private
 procedure AppMess(var Msg: TMsg; var Handled: Boolean);

    { Private declarations }
  public

Код:

procedure TfmChild1.AppMess(var Msg: TMsg; var Handled: Boolean);
var
  X, Y: integer;
  gpt: TGridCoord;
  s: string;
  w, len: integer;
begin
  if Msg.message=WM_MOUSEMOVE then
  begin
    if Msg.hwnd=DBGrid1.Handle then
    begin
      x:=LoWord(Msg.lParam);
      y:=HiWord(Msg.lParam);
      gpt:=DBGrid1.MouseCoord(x,y);
      if (gpt.x>0) and (gpt.y>0) then
      begin
        DataSource2.DataSet.First;
        DataSource2.DataSet.MoveBy(gpt.y-1);
        s:=FmMain.ADOQuery1.Fields[gpt.x-1].asString;
        w:=DBGrid1.Columns[gpt.x-1].Width;
        len:=DBGrid1.Canvas.TextWidth(s);
        if len > w then
          DBGrid1.Hint:=s
        else
          DBGrid1.Hint:='';
      end;
    end;
  end;
end;

Код:

procedure TfmChild1.FormCreate(Sender: TObject);
begin
  DBGrid1.ShowHint := True;
  Application.OnMessage := AppMess;
end;

[Shoni]

Нашла ещё такой вариант:

Код:

type
   TMouseGrid = class(TCustomDrawGrid);
   THackDBGrid = Class(TDBGrid);

По движению мыши:
var s: string;
    DLink : TDataLink;
    nCol,nRow:Integer;
    OldPosRecord: Integer;// vecchia posizione del cursore
  Procedure NoHint;
  begin  // nel caso di nessun hint .. lo nascondo
    DBGrid1.Hint:='';
    Application.HideHint;
  end;
begin
  nCol := -1;
  nRow := -1;
  s:= '';
  if DBGrid1.DataSource.DataSet.Active then  // solo se il dataset и aperto
  begin
    TMouseGrid(Sender).MouseToCell(X, Y, nCol, nRow);  //Mi ritorna riga colonna del mouse
    if (nCol>0) and (nRow>0) then
    begin
      DLink:=THackDBGrid(DBGrid1).DataLink;  //mi becco il datalink
      if Assigned(DLink) then  // и sicuramente assegnato .. ma .. 
      begin
        OldPosRecord := DLink.ActiveRecord;  // salvo il cursore del record
        DLink.ActiveRecord := nRow - 1;  //-1 conto che ci sia l'intestazione
        if assigned(DBGrid1.DataSource.DataSet.Fields[nCol - 1]) then
          s := DBGrid1.DataSource.DataSet.Fields[nCol - 1].AsString; // prendo il valore
        DBGrid1.Hint := s;   // assegno il valore all'hint della grid
        Application.ActivateHint(DBGrid1.ClientToScreen( Point(X,Y) ));  //mostro l'hint nella posizione del cursore
        DLink.ActiveRecord := OldPosRecord; // ripristino posizione
      end
      else
        NoHint;
    end
    else
      NoHint;
  end
  else
   NoHint;

Админ: Пользуемся тегами для оформления кода!

Правда, почему-то не работает

[Shoni]

Код:

type
TXGrid=class(DBGrids.TDBGrid);

Код:

var Coord: TGridCoord;
CurRec: Integer;
lh1, lh2: Integer;
begin
with TXGrid(DBGrid1) do
begin
Coord:=MouseCoord(x,y);
with Coord do
if (Y<1) or (X<1) or (X>Columns.Count) then Exit;
CurRec:=DataLink.ActiveRecord;
DataLink.ActiveRecord:=Coord.Y-1;
//
// Опредиляем длину данных в поле
lh1:=Canvas.TextWidth(Columns[Coord.X-1].Field.AsString);
Label3.Caption:=IntToStr(lh1);
//
// Определяем длину поля
lh2:=Columns[Coord.X-1].Width;
Label4.Caption:=IntToStr(lh2);
//
// Если длина поля меньше длины его текста - выводим подсказку
if lh2 <= lh1 then
begin
ShowHint:=True;
Hint:=Columns[Coord.X-1].Field.AsString;
Application.ActivateHint(ClientToScreen(Point(X, Y)));
Edit1.Text:=Columns[Coord.X-1].Field.AsString;
end
else
begin
Edit1.Text:='';
ShowHint:=False;
Hint:=''; 
end;
//
DataLink.ActiveRecord:=CurRec;
end;
end; 

тоже отказывается работать

[Viajero]

в DBGridEh уже встроено (библиотека компонентов EhLib).

[Страдалецъ]

Вот такой еще вариант:

Код:

procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
Var
  CellXY: TGridCoord;
  RecNo: Integer;
begin
 CellXY := DBGrid1.MouseCoord(X, Y);
 DBGrid1.DataSource.DataSet.DisableControls;
 RecNo := DBGrid1.DataSource.DataSet.RecNo;
 DBGrid1.DataSource.DataSet.MoveBy(CellXY.Y - DBGrid1.DataSource.DataSet.RecNo);
 if CellXY.X > 0
 then begin
      DBGrid1.Hint := DBGrid1.Columns[CellXY.X - 1].Field.DisplayText;
      Application.ActivateHint(DBGrid1.ClientToScreen(Point(X,Y)));
      end;
 DBGrid1.DataSource.DataSet.RecNo := RecNo;
 DBGrid1.DataSource.DataSet.EnableControls;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 DBGrid1.DoubleBuffered := True;
end;

[Shoni]

2 Страдалецъ :

За код - огромное спасибо! Правда, проблемы он не решил - экран по-прежнему мерцает и работать можно только с верхней частью таблицы, отображающейся на экране...

Пошла следующим путем:

Код:

procedure TfmChild1.DBGrid1CellClick(Column: TColumn);
begin
 if Column.FieldName='Info' then
 Hint:=DBGrid1.DataSource.DataSet.FieldByName('info').AsString;
 if Column.FieldName='Prim' then
 Hint:=DBGrid1.DataSource.DataSet.FieldByName('prim').AsString;

end;

Работает четко, НО при условии, что в DBGride в Options dgRowSelect стоит False. В противном случае, индекс колонки всегда будет 0, заголовок=заголовку 0-й колонки и подсказки, естественно, не будут выводиться... А dgRowSelect должно стоять в true... Не подскажете, как решить проблемку?