var nIndex : Integer;
function ReadWidth : Integer;
var i : Integer;
begin
i := _HideColumns.IndexOf(Columns[nIndex]);
if i = -1 then result := 120
else result := Integer(_HideColumnsValues[i]);
end;
procedure SaveWidth;
var i : Integer;
begin
i := _HideColumns.IndexOf(Columns[nIndex]);
if i <> - 1 then begin
_HideColumnsValues[i] := Pointer(Columns[nIndex].Width);
end else begin
_HideColumns.Add(Columns[nIndex]);
_HideColumnsValues.Add(Pointer(Columns[nIndex].Width));
end;
end;
begin
for nIndex := 0 to Columns.Count - 1 do begin
if (Columns[nIndex].Width = 0) then begin
if (nIndex + 1 <= FreezeCols) or (nIndex >= SelectedIndex + ADelta) then
Columns[nIndex].Width := ReadWidth;
end else begin
SaveWidth;
if (nIndex + 1 > FreezeCols) and (nIndex < SelectedIndex + ADelta) and
(nIndex + 1 < Columns.Count) and (FreezeCols > 0) then
Columns[nIndex].Width := 0;
end;
end;
end;
Dbgrid с цветными ячейками IV
Nomadic советует:
Hапример, так:
DefaultDrawing:=False;
….
procedure TfrmCard.GridDrawColumnCell(Sender: TObject; constRect: TRect; DataCol: Integer; Column: TColumn;State: TGridDrawState);
var
Index : Integer;
Marked, Selected: Boolean;
begin
Marked := False;
if (dgMultiSelect in Grid.Options) and THackDBGrid(Grid).Datalink.Active then
Marked:=Grid.SelectedRows.Find(THackDBGrid(Grid).Datalink.Datasource.Dataset.Bookmark, Index);
Selected := THackDBGrid(Grid).Datalink.Active and (Grid.Row-1 = THackDBGrid(Grid).Datalink.ActiveRecord);
if Marked then begin
Grid.Canvas.Brush.Color:=$DFEFDF;
Grid.Canvas.Font.Color :=clBlack;
end;
if Selected then begin
Grid.Canvas.Brush.Color:=$FFFBF0;
Grid.Canvas.Font.Color :=clBlack;
if Marked then Grid.Canvas.Brush.Color:=$EFE3DF; { $8F8A30 }
end;
Grid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
где
THackDBGrid = class(TDBGrid)
property DataLink;
property UpdateLock;
end;
Обратите внимание на обьявление класса THackDBGrid. Таким образом можно получить доступ к приватным полям, свойствам и методам класса, что, к сожалению, приходится делать, если авторы исходного класса оказались не предусмотрительны.
Dbgrid с цветными ячейками V
Delphi 1
Попробуйте следующий код в обработчике события TDBGrid OnDrawDataCell:
Procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);
begin
If gdFocused in State then with (Sender as TDBGrid).Canvas do begin
Brush.Color := clRed;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, Field.AsString);
end;
end;
Установите рисование по умолчинию (Default drawing) в True. Только после этого можно нарисовать выделенную ячейку. Если вы установили DefaultDrawing в False, вы должны сами рисовать все ячейки, используя свойство Canvas.
Что я получаю от наличия ConstraintBroker (брокера ограничений)?
Nomadic отвечает:
ConstraintBroker позволяет Вам включать проверки на ограничения в данные.
Это означает, что когда Вы запрашиваете данные, Вы получаете вместе с ними и правила, которым они дорлжны удовлетворять. Эти правила автоматически без дополнительного кода входят в силу.
Поскольку это происходит без единой строчки кода, то Вам не требуется переписывать или обновлять приложение каждый раз при изменении правил.
Фактически это простое решение задачи обновления клиентского приложения без выхода из него.
Каждое приложение, использующее ConstraintBroker, автоматически получает это качество…
Улучшенный Dbgrid
Delphi 1
{
Код улучшенного TDBGrid, имеющего свойства Col, Row и Canvas и метод CellRect. Это чрезвычайно полезно в случае, если вы, к примеру, хотите получить выпадающий список на месте редактируемой пользователем ячейки.
}
unit VUBComps;
interface
uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, Grids, DBGrids, DB, Menus;
type TDBGridVUB = class(TDBGrid)
private
{ Private declarations }
protected
{ Protected declarations }
public
property Canvas;
function CellRect(ACol, ARow: Longint): TRect;
property Col;
property Row;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('VUBudget', [TDBGridVUB]);
end;
function TDBGridVUB.CellRect(ACol, ARow: Longint): TRect;
begin
Result := inherited CellRect(ACol, ARow);
end;
end.
Пример Drag and Drop между двумя Dbgrid
Delphi 3
Данный пример компонента и демонстрационный проект показывают простой путь осуществления операции "drag and drop" (перетащи и брось) между двумя полями различных табличных сеток.
Запустите Delphi 3 (с незначительными изменениями данный код может работать и в Delphi 1-2).
Активизируйте File|New|Unit. Скопируйте приведенный ниже модуль MyDBGrid во вновь созданный модуль. Сделайте File|Save As. Сохраните модуль как MyDBGrid.pas.
Выберите пункт меню Component|Install Component. Переключитесь на страницу Info New Package. Поместите MyDBGrid.pas в поле редактирования "Unit file name" (имя файла модуля). Назовите модуль MyPackage.dpk. Ответьте Yes на вопрос Delphi 3 о необходимости сборки и установки пакета. Нажмите OK на сообщение Delphi 3 о необходимости включения VCL30.DPL. После этого пакет будет собран и установлен. Теперь компонент TMyDBGrid будет отображен в Палитре Компонентов в группе "Samples". Закройте редактор пакетов и сохраните пакет.
Выберите пункт меню File|New Application. Щелкните правой кнопкой мыши на форме (Form1) и выберите View As Text. Скопируйте приведенный ниже исходный код формы GridU1 в Form1. Щелкните правой кнопкой мыши на форме и выберите View As Form. Убедитесь в активности ваших таблиц. Скопируйте расположенный ниже модуль GridU1 в ваш модуль Unit1.
Выберите пункт меню File|Save Project As. Сохраните модуль как GridU1.pas. Сохраните проект как GridProj.dpr.
Теперь запустите проект и наслаждайтесь функцией Drag and Drop между двумя табличными сетками.
Модуль MyDBGrid
unit MyDBGrid;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids;
type TMyDBGrid = class(TDBGrid)
private
{ Private declarations }
FOnMouseDown: TMouseEvent;
protected
{ Protected declarations }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
published
{ Published declarations }
property Row;
property OnMouseDown read FOnMouseDown write FOnMouseDown;
end;
procedure Register;
implementation
procedure TMyDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
inherited MouseDown(Button, Shift, X, Y);
end;
procedure Register;
begin
RegisterComponents('Samples', [TMyDBGrid]);
end;
end.
Модуль GridU1
unit GridU1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, MyDBGrid, StdCtrls;
type TForm1 = class(TForm)
MyDBGrid1: TMyDBGrid;
Table1: TTable;
DataSource1: TDataSource;
Table2: TTable;
DataSource2: TDataSource;
MyDBGrid2: TMyDBGrid;
procedure MyDBGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MyDBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
