Метод DisableControls используется в случае,когда необходимо запретить обновление DBGridпри изменении набора данных. Последняя позициянабора данных сохраняется как TBookmark.
Метод IndexOf вызывается при необходимостипроверить существование закладки.Решение использовать метод IndexOf, а неRefresh, должно приниматься исходя изспецифики приложения.*}
procedure TForm1.SelectClick(Sender: TObject);
var
x: word;
TempBookmark: TBookMark;
begin
DBGrid1.Datasource.Dataset.DisableControls;
with DBgrid1.SelectedRows do if Count > 0 then begin
TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark;
for x:= 0 to Count - 1 do begin
if IndexOf(Items[x]) > -1 then begin
DBGrid1.Datasource.Dataset.Bookmark:= Items[x];
showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);
end;
end;
end;
DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);
DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);
DBGrid1.Datasource.Dataset.EnableControls;
end;
{*Данный пример позволит вам установить закладку изатем найти ее в списке выбранных записей компонента DBGrid.*}
//Устанавливаем закдадку
procedure TForm1.GetBookMarkClick(Sender: TObject);
begin
Bookmark1:= DBGrid1.Datasource.Dataset.GetBookmark;
end;
//Освобождаем закладку
procedure TForm1.FreeBookmarkClick(Sender: TObject);
begin
if assigned(Bookmark1) then begin
DBGrid1.Datasource.Dataset.FreeBookmark(Bookmark1);
Bookmark1:= nil;
end;
end;
//Испольуем метод Find для установления позиции
//записи-закладки в списке выбранных записей компонента DBGrid
procedure TForm1.FindClick(Sender: TObject);
begin
if assigned(Bookmark1) then begin
if DBGrid1.SelectedRows.Find(TBookMarkStr(Bookmark1),z) then showmessage(inttostr(z));
end;
end;
end.
Вертикальная полоса прокрутки Dbgrid
Delphi 1
Это небольшое исправление к исходному коду VCL, позволяющее поддерживать перемещение по таблице с помощью изменения позиции движка вертикальной полосы прокрутки.
(Примечание: это работает только с таблицами Paradox и BDE. Для использования этого кода с другими таблицами/движками вам необходимо заменить DBIGetSeqNo на функцию, надежно возвращающую текущую позицию записи вне зависимости от того, использует ли таблица индекс или нет.)
В DBGRID.PAS измените две следующих процедуры:
procedure TCustomDBGrid.UpdateScrollBar;
var
Pos: Integer;
mPos, mMax: longint;
begin
if FDatalink.Active and HandleAllocated then
with FDatalink.DataSet do begin
UpdateCursorPos;
if (DBIGetSeqNo(Handle,mPos) = DBIERR_NONE) then begin
mMax := RecordCount;
while mMax > 1000 do begin
mMax := mMax div 10;
mPos := mPos div 10;
end;
SetScrollRange(Self.Handle, SB_VERT, 1, mMax, False);
end else begin
if BOF then mPos := 0
else if EOF then mPos := 4
else mPos := 2;
SetScrollRange(Self.Handle, SB_VERT, 0, 4, False);
end; (**)
if GetScrollPos(Self.Handle, SB_VERT) <> mPos then
SetScrollPos(Self.Handle, SB_VERT, mPos, True);
end;
end;
procedure TCustomDBGrid.WMVScroll(var Message: TWMVScroll);
var
mMin, mMax: integer;
RecCount, RecNo, NewRecNo: longint;
begin
if not AcquireFocus then Exit;
if FDatalink.Active then
with Message, FDataLink.DataSet, FDatalink do
case ScrollCode of
SB_LINEUP: MoveBy(-ActiveRecord - 1);
SB_LINEDOWN: MoveBy(RecordCount - ActiveRecord);
SB_PAGEUP: MoveBy(-VisibleRowCount);
SB_PAGEDOWN: MoveBy(VisibleRowCount);
SB_THUMBPOSITION:
if (DBIGetSeqNo(Handle,RecNo) = DBIERR_NONE) then begin
GetScrollRange(self.Handle, SB_VERT, mMin, mMax);
NewRecNo := Pos*(FDataLink.DataSet.RecordCount div mMax);
MoveBy(NewRecNo-RecNo);
end else case Pos of
0: First;
1: MoveBy(-VisibleRowCount);
2: Exit;
3: MoveBy(VisibleRowCount);
4: Last;
end;
SB_BOTTOM: Last;
SB_TOP: First;
end;
end;
Имейте в виду, что из-за небольшой ошибки в VCL (MoveBy использует integer-параметр вместо longint), могут быть проблемы с большими таблицами (RecordCount>MaxInt). Объяснение этому факту я нашел в журнале Delphi Magazine. Для больших таблиц вы должны заменить вызовы MoveBy на DBISetToSeqNo или DBIGetRelativeRecord. Не забудьте после данного вызова вызвать Resnyc([]) или Refresh!
P.S. Пока вы ковыряетесь в DBGRIDS.PAS: найдите и замените TitleColor на FixedColor в TCustomDBGrid.Create и в TCustomDBGrid.DrawCell. Значение свойства FixedColor влияет на показ заголовков колонок, и они будут выводится как и ожидалось.
– Reinhard Kalinke
TDBGrid Lookup-поле в D2
Delphi 2
1. Как создать lookup-поле в TDBGrid для Delphi 2.0
2. Разместите на форме 2 компонента TTable, 1 компонент TDataSource и 1 – TDBGrid.
• Подключите Table1 – к DataSource1 – к DBGrid1
• DataSource1.DataSet = Table1
• DBGrid1.DataSource = DataSource1
3. Установка Table1
• Table1.Database = DBDemos
• Table1.TableName = Customer
• Table1.Active = True
4. Установка Table2
• Table2.Database = DBDemos
• Table2.TableName = Orders
• Table2.Active = True
5. Добавьте все поля для Table1, используя Fields Editor (редактор полей):
• Дважды щелкните на Table1
• Нажмите правую кнопку мыши в редакторе полей
• Выберите пункт Add New Fields. Добавьте их все.
6. Добавьте новое поле для Table1.
• Нажмите правую кнопку мыши в редакторе полей и выберите пункт «New Field».
7. Определите следующие параметры для вновь добавленного поля:
• Name: Bob
• Type: String
• Size: 30
• Select Lookup
• Key Fields: CustNo – Поле в Table1 для хранения значения
• DataSet: Table2 – Здесь устанавливается табличный lookup
• LookUpKeys: CustNo – Данный ключ копируется в KeyField
• Result Field: OrderNo – Значение для показа пользователю в выпадающем списке
8. Запустите приложение
Как зафиксировать один или несколько столбцов в TDBGrid с возможностью навигации по этим столбцам?
Nomadic советует:
Это маленькая вставка в Ваш наследник от TCustomDBGrid, которая решает данную задачу.
// DBGRIDEX.PAS
// ----------------------------------------------------------------------------
destructor TDbGridEx.Destroy;
begin
_HideColumnsValues.Free;_HideColumns.Free;
inherited Destroy;
end;
// ----------------------------------------------------------------------------
constructor TDbGridEx.Create(Component : TComponent);
begin
inherited Create(Component);
FFreezeCols := ?;
_HideColumnsValues := TList.Create;
_HideColumns := TList.Create;
end;
// ----------------------------------------------------------------------------
procedure TDbGridEx.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (Key = VK_LEFT) then ColBeforeEnter(-1);
if (Key = VK_RIGHT) then ColBeforeEnter(1);
inherited;
end;
// ----------------------------------------------------------------------------
procedure TDbGridEx.SetFreezeColor(AColor : TColor);
begin
InvalidateRow(0);
end;
// ----------------------------------------------------------------------------
procedure TDbGridEx.SetFreezeCols(AFreezeCols : Integer);
begin
FFreezeCols := AFreezeCols;
InvalidateRow(0);
end;
// ----------------------------------------------------------------------------
procedure TDbGridEx.ColEnter;
begin
ColBeforeEnter(0);
if Assigned(OnColEnter) then OnColEnter(Self);
end;
// ----------------------------------------------------------------------------
procedure TDbGridEx.ColBeforeEnter(ADelta : Integer);
var nIndex : Integer;
function ReadWidth : Integer;
var i : Integer;
