Форум: "Базы";
Текущий архив: 2008.01.27;
Скачать: [xml.tar.bz2];

Вниз

координаты ячейки в DBGrid с учетом прокрутки   Найти похожие ветки 

← →
makaronX   (2007-09-17 14:36) [0]

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

procedure TForm1.AppMess(var Msg: TMsg; var Handled: Boolean);

var
 a: TGridCoord;
 st: string;
 X, Y: integer;
begin
  if Msg.message=WM_MOUSEMOVE then
 begin
   if Msg.hwnd=DBGrid1.Handle then
   begin
    x:=LoWord(Msg.lParam);
    y:=HiWord(Msg.lParam);
    a:=DBGrid1.MouseCoord(X,Y);
  if (a.x>0) and (a.y>0) then
     begin
       DataSource1.DataSet.first;
       DataSource1.DataSet.MoveBy(a.y-1);
       st := DataSource1.DataSet.FieldValues["NOMER_TERMINALA"];
       adoquery2.close;
       adoquery2.sql.Clear;
       adoquery2.SQL.Add("select max(datestop) from terminalsession where terminalid = "+ st + " and success=1");
       adoquery2.ExecSQL;
       adoquery2.open;
       DBGrid1.Hint:="Последняя удачная инкассация: "+adoquery2.FieldList.Fields[0].AsString;
       application.ActivateHint(mouse.CursorPos);
    end;
   end;
  end;

Простите за сумбурное объяснение.

---

← →
Johnmen ©   (2007-09-17 15:16) [1]

Т.е. ты потестировал код http://www.delphisources.ru/pages/faq/base/hint_for_dbgrid.html и предлагаешь обсудить его якобы неработоспособность? :)
PS

>При попытке навести курсор на записи, которые находятся ниже

Их же не видно...:)

---

← →
makaronX   (2007-09-17 15:42) [2]

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


> Их же не видно...:)

при прокрутке скроллером они становятся видны

так вот, как мне учесть тот факт, что DBGrid уже прокручен на энное количество строчек в момент наведения мыши на определенную запись?

---

← →
Johnmen ©   (2007-09-17 16:13) [3]

Понятно.
Похоже данный пример действительно кривоват, ибо не учитывает, на сколько записей грид прокручен, сколько записей "сверху за кадром".
Поэтому отсчет надо делать односительный (а не абсолютный, как выше; и не дергать указатель в НД!). Т.е. надо опираться на внутренний буфер грида. Отсюда имеем код (из правильного фака :)):
type
TForm1 = class(TForm)
  DBGrid1: TDBGrid;
  ADOQuery1: TADOQuery;
  DataSource1: TDataSource;
  procedure DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
  procedure FormCreate(Sender: TObject);
  procedure FormDestroy(Sender: TObject);
private
  { Private declarations }
public
  { Public declarations }
  FHintWindow: THintWindow;
  procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

type
TXGrid = class(TCustomDBGrid);

procedure TForm1.CMMouseLeave(var Message: TMessage);
begin
if Message.LParam = Integer(DBGrid1) then
  FHintWindow.ReleaseHandle;
inherited;
end;

procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Grid: TDBGrid;
Cell: TGridCoord;
CellRect: TRect;
HintCol: TColumn;
OldActive: Integer;
Value: string;
Pt: TPoint;
begin
Grid := Sender as TDBGrid;
Cell := Grid.MouseCoord(X, Y);
if (Cell.X < 1) or (Cell.Y < 0) then Exit;
try
  HintCol := Grid.Columns[Cell.X - 1];
  Value := "";
  OldActive := TXGrid(Grid).DataLink.ActiveRecord;
  try
    TXGrid(Grid).DataLink.ActiveRecord := Cell.Y - 1;
    Value := HintCol.Field.DisplayText;
    CellRect := TXGrid(Grid).CellRect(Cell.X, Cell.Y);
    GetCursorPos(Pt);
    CellRect := FHintWindow.CalcHintRect(Grid.Width, Value, nil);
    OffsetRect(CellRect, Pt.X, Pt.Y);
    FHintWindow.ActivateHint(CellRect, Value) ;
  finally
    TXGrid(Grid).DataLink.ActiveRecord := OldActive;
  end;
except
  FHintWindow.ReleaseHandle;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FHintWindow := THintWindow.Create(Self);
FHintWindow.Color := clInfoBk;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FHintWindow.Free;
end;


---

← →
makaronX   (2007-09-17 18:13) [4]

спасибо большое, все работает так как хотелось :-)

---

Страницы: 1 вся ветка

Форум: "Базы";
Текущий архив: 2008.01.27;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.007 c