Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров

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);