Добавление к TDBGrid события OnClick

TGroothuisGrid = class(TDBGrid) {!}
published
property OnClick; end;

Это все! OnClick уже объявлен в TControl как защищенное свойство. Все, что вы должны сделать, это опубликовать это свойство в компоненте-наследнике, зарегистрировать его (смотри гл. 8 Руководства по созданию компонентов, Component Writer's Guide) и использовать взамен TDBGrid. [001455]

Две таблицы в одном TDBGrid

Если у вас D2, вы можете воспользоваться свойством Lookup. Для этого выберите в контекстном меню объекта table редактор полей (fields editor). Затем для добавления нового поля нажмите <Ctrl>+N. Просто раскройте combobox и выберите lookup-поле. TDBGrid автоматически создаст выпадающий список, в котором пользователь сможет выбрать нужный элемент. [001378]

Хочу шапку в TDBGrid. Как сделать?

Nomadic советует:

Уже реализовано в виде вот этого компонента - © Andre

unit bdbgrid;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, Math;

type
TOnDrawTitleEvent = procedure(ACol : integer; ARect : TRect; var TitleText : string) of object;

TBitDBGrid = class(TDBGrid)
private
FBitmapBrowse : TBitmap;
FBitmapEdit : TBitmap;
FBitmapInsert : TBitmap;
FBitmapFill : TBitmap;
FRealTitleFont : TFont;
FOnDrawTitle : TOnDrawTitleEvent;
FResizeFlag : boolean;
{ Private declarations }
procedure SetRealTitleFont(Value : TFont);
procedure UpdateTitlesHeight;
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
{ Protected declarations }
public
constructor Create(AOwner : TComponent);override;
destructor Destroy; override;
{ Public declarations }
published
property OnDrawTitle : TOnDrawTitleEvent read FOnDrawTitle write FOnDrawTitle;
property RealTitleFont : TFont read FRealTitleFont write SetRealTitleFont;
{ Published declarations }
end;

procedure Register;

implementation

var
DrawBitmap : TBitmap;

function Max(X, Y: Integer): Integer;
begin
Result := Y;
if X > Y then Result := X;
end;

procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer; const Text: string; Alignment: TAlignment);
// © Borland function :)
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
var
B, R: TRect;
I, Left: Integer;
begin
with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
begin { brush origin tics in painting / scrolling. }
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap.Canvas do
begin
DrawBitmap.Canvas.CopyRect(B, ACanvas, ARect);
Font := ACanvas.Font;
Font.Color := ACanvas.Font.Color;
Brush := ACanvas.Brush;
SetBkMode(Handle, TRANSPARENT);
DrawText(Handle, PChar(Text), Length(Text), R,
AlignFlags[Alignment]);
end;
ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
end;

constructor TBitDBGrid.Create(AOwner : TComponent);
begin
inherited Create(Aowner);
FRealTitleFont := TFont.Create;
FResizeFlag := false;
end;

destructor TBitDBGrid.Destroy;
begin
FRealTitleFont.Free;
inherited Destroy;
end;

procedure TBitDBGrid.UpdateTitlesHeight;
var
Loop : integer;
MaxTextHeight : integer;
RRect : TRect;
begin
MaxTextHeight := 0;
for loop := 0 to Columns.Count - 1 do
begin
RRect := CellRect(0, 0);
RRect.Right := Columns[Loop].Width;
RRect.Left := 0;
Canvas.Font := RealTitleFont;
MaxTextHeight := Max(MaxTextHeight, DrawText(Canvas.Handle,
PChar(Columns[Loop].Title.Caption),
Length(Columns[Loop].Title.Caption), RRect,
DT_CALCRECT + DT_WORDBREAK)
);
end;
if TitleFont.Height <> - MaxTextHeight then
TitleFont.Height := - MaxTextHeight;
end;

procedure TBitDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if MouseCoord(X, Y).Y = 0 then
FResizeFlag := true;
inherited MouseDown(Button, Shift, X, Y);
end;

procedure TBitDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if FResizeFlag then begin
FResizeFlag := false;
UpdateTitlesHeight;
end;
end;

procedure TBitDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
Indicator : TBitmap;
TitleText : string;
Al : TAlignment;
begin
if not ((gdFixed in AState) and ((ARow = 0) and (dgTitles in Options) and (ACol <> 0))) then
inherited DrawCell(ACol, ARow, ARect, AState)
else
begin
if DefaultDrawing then
begin DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMLEFT);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPRIGHT);
InflateRect(ARect, -1, -1);
Canvas.Brush.Color := FixedColor;
Canvas.FillRect(ARect);
end;
TitleText := Columns[ACol - 1].Title.Caption;
if Assigned(OnDrawTitle) then OnDrawTitle(ACol, ARect, TitleText);
if DefaultDrawing and (TitleText <> '') then
begin
Canvas.Brush.Style := bsClear;
Canvas.Font := RealTitleFont;
if ACol > 0 then Al := Columns[ACol - 1].Title.Alignment
else Al := Columns[0].Title.DefaultAlignment;
WriteText(Canvas, ARect, 2, 2, TitleText, Al);
end;
end;
end;

procedure TBitDBGrid.SetRealTitleFont(Value : TFont);
begin
FRealTitleFont.Assign(Value);
Repaint;
end;

procedure Register;
begin
RegisterComponents('Andre VCL', [TBitDBGrid]);
end;

initialization
DrawBitmap := TBitmap.Create;

finalization
DrawBitmap.Free;

end.

[001288]

Использование Enter как Tab в TDBGrid

Приведу код, позволяющий использовать нажатие клавиши Enter как клавиши Tab пока управление находится в табличной сетке.

Данный код включает обработку клавиши Enter для всего приложения, включая поля и пр.. Код для работы с компонентом DBGrid заключен в блок ELSE. Приведенный код не имитирует поведение клавиши Tab, связанное с переходом на следующую запись когда курсор достигает последней колонки табличной сетки, в нашем случае он перемещается на первую колонку.

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
{ Это обработчик события OnKeyPress для ФОРМЫ! }
{ Вы должны также установить свойство формы KeyPreview в True }
begin
if Key = #13 then { если это клавиша Enter } if not (ActiveControl is TDBGrid) then begin { если не на TDBGrid } Key := #0; { гасим клавишу Enter } Perform(WM_NEXTDLGCTL, 0, 0); { перемещаемя на следующий элемент управления } end else if (ActiveControl is TDBGrid) then { если это TDBGrid } with TDBGrid(ActiveControl) do if selectedindex < (fieldcount -1) then { увеличиваем поле } selectedindex := selectedindex +1 else selectedindex := 0; end;

[000536]

Использование опции MultiSelect в DBGRID

Есть пример в Delphi Technical Information... Его можно посмотреть по адресу

http://loki.borland.com/winbin/bds.exe?getdoc+2976+Delphi

{*
Данный пример позволяет производить множественный выбор записей в табличной сетке и отображать второе поле набора данных.
Метод 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;

[000064]

Изменение месторасположение колонок в TDBGrid

Var
i : Integer ; fName : string ; ............ { Определение изменения месторасположения колонок }
............
with DBGrid1.DataSource.DataSet as TTable do for i := 0 to IndexDefs.Count - 1 do begin fName := DBGrid1.Fields[0].FieldName ; if Copy( IndexDefs[i].Fields, 1, Length( fName ) ) = fName then IndexName := IndexDefs[i].Name end ;

[001341]

Изменение размеров DBGrid

У меня есть форма. На ней расположены поле редактирования, компонент SQL Query, DBGrid и кнопка. Я заполняю поле редактирования и при нажатии на кнопку DBGrid отражает результат запроса. Как я могу изменить размер табличной сетки и ее колонок в зависимости от новых значений полей? Поля, возвращаемые запросом, не заполняют всей ширины сетки, а все мои попытки сделать это из кода терпят крах...

Вы можете изменить размер колонки во время выполнения программы, изменяя свойство DisplayWidth соответствующего поля компонента DBGrid...

MyTableMyField.DisplayWidth := Length(MyTableMyField.value);

Если Вам действительно необходимо вычислить ширину всего DBGrid, используйте следующий код:

function NewTextWidth(fntFont : TFont; const sString : OpenString) :

integer; var
fntSave : TFont; begin
result := 0; fntSave := Application.MainForm.Font; Application.MainForm.Font := fntFont; try result := Application.MainForm.Canvas.TextWidth(sString); finally Application.MainForm.Font := fntSave; end; end;

{ вычисляем ширину табличной сетки, которую необходимо отобразить без                 }
{ горизонтальной полосы прокрутки и без дополнительного пространства между последней }
{ колонкой и вертикальной полосой прокрутки. Свойство Datasource у компонента DBGrid, }
{ как и свойство Dataset у Datasource должны быть назначены заранее,                  }
{ но таблица не должна быть открытой. Примечание: полученная ширина включает ширину   }
{ вертикальной полосы прокрутки, полученной на основе базового режима                 }
{ отображения. Вычисленная ширина полностью занимает рабочую область компонента.      }

function iCalcGridWidth
( dbg : TDBGrid { корректируемый компонент } ) : integer; { "точная" ширина }
const
cMEASURE_CHAR   = '0'; iEXTRA_COL_PIX = 4; iINDICATOR_WIDE = 11;
var
i, iColumns, iColWidth, iTitleWidth, iCharWidth : integer; begin
iColumns := 0; result := GetSystemMetrics(SM_CXVSCROLL); iCharWidth := NewTextWidth(dbg.Font, cMEASURE_CHAR); with dbg.dataSource.dataSet do for i := 0 to FieldCount - 1 do with Fields[i] do if visible then begin iColWidth := iCharWidth * DisplayWidth; if dgTitles in dbg.Options then begin iTitleWidth := NewTextWidth(dbg.TitleFont, DisplayLabel); if iColWidth < iTitleWidth then iColWidth := iTitleWidth; end; inc(iColumns, 1); inc(result, iColWidth + iEXTRA_COL_PIX); end; if dgIndicator in dbg.Options then begin inc(iColumns, 1); inc(result, iINDICATOR_WIDE); end; if dgColLines in dbg.Options then inc(result, iColumns) else inc(result, 1); end;

Я должен использовать функцию NewTextWidth, а не Canvas.TextWith компонента DBGrid, так как Canvas еще не инициализирован во время вызова iCalcGridWidth.

[000071]

Эксперт создания таблиц

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

Да, это известная проблема. [000334]

Как определить изменение фокуса строки в TDBGrid?

Используйте событие OnDataChange объекта Datasource, соединенного с DBGrid. Если параметр State в обработчике событие равен dsBrowse, значит вы перешли в новую строку (или только что открыли таблицу).

Почему сетка не поддерживает такое событие? Поскольку сетка может быть не единственным элементом управления, оторбажающим данные из текущей строки и может быть не единственным элементом, позволяющим осуществлять перемещение от строки к строке. С помощью Datasource обработка события осуществляется централизованно.

Я не уверен в том, что проблему можно решить, обрабатывая событие одинарного щелчка, для отслеживания события изменения строк я рекомендую использовать событие TDatasource.OnDataChange, а для колонок - TDBGrid.OnColEnter/Exit.

Лично я пользуюсь следующей рабочей технологией: Для того, чтобы обнаружить изменения текущей строки, воспользуйтесь событием TDataSource OnDataChange. OnDataChange возникает при прокрутке или щелчке на другой строке. Обработчик события может выглядеть приблизительно так:

procedure Form1.DSrc1DataChange(Sender: TObject; Field: TField);

где Field является колонкой, где произошло изменение.

Поля TTable могут использоваться для сравнения текущих выбранных строк полей (ключ) с вашими требованиями. С той же целью может быть использовано и свойство TDBGrid Fields. Для примера:

if tbl1.Fields[0].AsString = 'BlaBlaBla' then ...

или

if dbGrid1.Fields[I].IsNull then ...

Для отслеживания изменения колонки, используйте события TDBGrid OnColExit & OnColEnter. Для определения выбранной к настоящему времени колонки воспользуйтесь свойствами TDBGrid SelectedField и SelectedIndex.

Когда выбирается другая колонка другой строки, вы получаете события OnColExit, OnColEnter и OnDataChange.

Можно пойти и "кривым" путем, взявшись за обработку события TDBGrid OnDrawDataCell, которое возникает когда ячейка выбирается, или когда сетка скроллируется. Обработчик события может выглядеть примерно так:

procedure Form1.dbGrid1DrawDataCell(Sender: TObject; Rect: TRect; Field: TField; State: TGridDrawState);

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

Если у вас нет проблем в создании "101 изменения" стандартных компонентов - что является проблемой для меня 8-), то попробуйте это. Это легко.

Чтобы иметь доступ к индексу строки или колонки выбранной ячейки, вы должны унаследовать ваш класс от TCustomGrid и опубликать свойства времени выполнения Row и Col (текущие строка и колонка сетки, не таблицы!!):

type TSampleDBGrid = class(TCustomGrid) public property Col; property Row; end;

в соответствующей процедуре или обработчике события осуществите приведение типа:

var G: TSampleDBGrid; begin G := TSampleDBGrid(myDBGrid1); if G.Row = I then ... if G.Col = J then ...

Дело в том, что TDBGrid является потомком TCustomGrid, который имеет несколько свойств, содержащих координаты сетки, но это не опубликовано в TDBGrid.

...из чего я могу заключить, что вы должны это сделать программным путем. Подразумеваем, что сетка уже существует, и у вас есть доступ к основной таблице TTable:

grid.colcount := dbGrid.fieldcount; table.first; row := 0; while not table.eof do begin grid.rowcount := row + 1; for i := 0 to grid.colcount-1 do grid.cells[i,row] := dbGrid.fields[i].asString; table.next; inc (row); end;

Могут быть ошибки, но это должно помочь.

Посмотрите на следующий код, он может вам помочь. Он берет у элемента управления свойсто 'Name' и помещает его в свойство 'Caption' метки.

unit Unit1;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm) Label1: TLabel; Edit1: TEdit; Edit2: TEdit; Button1: TButton; procedure Button1Click(Sender: TObject); procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Edit2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } public { Public declarations } end;
var
Form1: TForm1;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
close; end;

procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); begin
Label1.Caption := TEdit(Sender).Name; end;

procedure TForm1.Edit2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); begin
Label1.Caption := TEdit(Sender).Name; end;

end.

[001528]

Как отучить TDBGrid от автодобавления новой записи?

Добавьте в обработчик события вашего TTable "BeforeInsert" следующую строку:

procedure TForm1.Tbable1BeforeInsert(DataSet: TDataset);
begin
Abort; <<---эту строчку end;

Осуществляем перехват нажатия клавиши и проверку на конец файла (end-of-file):

procedure TForm8.DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); begin
if (Key = VK_DOWN) then begin TTable1.DisableControls ; TTable1Next ; if TTable1.EOF then Key := 0 else TTable1.Prior ; TTable1.EnableControls ; end ; end;

[001364]

Как сделать так, чтобы в DBGrid напротив некоторых строк можно было бы галочку поставить?

Nomadic советует:

Hу примерно тaк (лишнее мaло-мaло порезaл, больно много его, но идея виднa :) нa сервере - тaблицa Advertis.DB, первичный ключ ID - autoincrement. Ha локaльном диске - тaблицa Founds.DB, с полем Advertis: integer, по которому есть индекс, и tblFounds.IndexFieldNames = 'Advertis'.

Ha гриде:

=== cut ===

procedure TMainForm.dbgWorkDblClick(Sender: TObject);
begin
TriggerRowSelection;
end;

procedure TMainForm.TriggerRowSelection;
begin
if dmFile.AdvertisCount <> 0then
begin
with dmFile do if not tblFounds.FindKey([tblAdvertisID.Value]) then
begin
tblFounds.AppendRecord( [tblAdvertisID.Value] );

end
else
begin
tblFounds.Delete;
end;
dbgWork.Refresh;
end;
end;

procedure TMainForm.dbgWorkDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
if DataCol = 0 then with dmFile, dbgWork.Canvas do
begin
FillRect(Rect); {clear the cell}
if tblFounds.FindKey( [tblAdvertisID.Value] ) then
begin
TextOut(Rect.Left, Rect.Top, '?');
end
else
begin
TextOut(Rect.Left, Rect.Top, 'o');
end;
end;
end;

=== cut ===

Окaзывaется, я переопределял рисовaние гридa, a не вычислял поле. Hе помню точно, но кaжется, чтобы не перечитывaть тaблицу нa кaждый дaблклик, a толькоперерисовaть грид.

А колонкa для гaлки в гриде определялaсь тaк:

=== cut ===

with dmFile, dbgWork.Columns do
begin
BeginUpdate;
Clear;

{check mark}
nc := Add;
nc.Width := 14;
nc.Font.Name := 'Wingdings';
nc.Font.Size := 11;
nc.Alignment := taRightJustify;
nc.Title.Caption := 'y';
nc.Title.Font.Name := 'Wingdings';
nc.Title.Font.Size := 10;
nc.Title.Alignment := taCenter;

[skip определения остaльных колонок]

EndUpdate;
end;

=== cut ===

Вроде всё.

Hу, кaк нaпечaтaть/обрaботaть только помеченное, сaм рaзберёшься. У меня тaм нaкручено чего-то с фильтрaми, думaю, можно проще.

Что кaсaется других способов - можно вместо временной тaблицы попользовaть список, мaссив или in-memory table. [001320]

Как в TDBGrid pазpешить только опеpации UPDATE записей и запpетить INSERT/DELETE?

Nomadic советует:

А я делаю так.
На DataSource, к которому прицеплен Grid, вешаю обработчик на событие OnStateChange.
Ниже текст типичного обратчика -

if DBGrid1.DataSource.DataSet.State in [dsEdit, dsInsert] then
DBGrid1.Options := DBGrid1.Options + goRowSelect
else
DBGrid1.Options := DBGrid1.Options - goRowSelect;

Дело в том, что если у Grid'а стоит опция goRowSelect, то из Grid'а невозможно добавить запись. Ну а когда програмно вызываешь редактирование или вставку, то курсор принимает обычный вид и все Ok.

Лучше использовать конструкцию "State in dsEditModes" [001334]

Как зафиксировать один или несколько столбцов в 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;
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;

[001098]

Как заставить DBGrid сортировать данные по щелчку на заголовке столбца?

Nomadic советует:

Кyсочек кода, чтобы повесить на clickable столбец RxGrid, показывающий RxQuery с опpеделенным макpосом %Order. Работать не бyдет (без модyлей), но в качестве идеи может быть полезен.

unit vgRXutil;

interface

uses
SysUtils, Classes, DB, DBTables, rxLookup, RxQuery;

{ TrxDBLookup }
procedure RefreshRXLookup(Lookup: TrxLookupControl);
procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);

function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;

{ TRxQuery }

{ Applicatable to SQL's without SELECT * syntax }

{ Inserts FieldName into first position in '%Order' macro and refreshes query }
procedure HandleOrderMacro(Query: TRxQuery; Field: TField);

{ Sets '%Order' macro, if defined, and refreshes query }
procedure InsertOrderBy(Query: TRxQuery; NewOrder: String);

{ Converts list of order fields if defined and refreshes query }
procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);

implementation
uses
vgUtils, vgDBUtl, vgBDEUtl;

{ TrxDBLookup refresh }

type
TRXLookupControlHack = class(TrxLookupControl)
property DataSource;
property LookupSource;
property Value;
property EmptyValue;
end;

procedure RefreshRXLookup(Lookup: TrxLookupControl);
var
SaveField: String;
begin
with TRXLookupControlHack(Lookup) do
begin
SaveField := DataField;
DataField := '';
DataField := SaveField;
end;
end;

procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);
var
SaveField: String;
begin
with TRXLookupControlHack(Lookup) do
begin
SaveField := LookupDisplay;
LookupDisplay := '';
LookupDisplay := SaveField;
end;
end;

function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;
begin
with TRXLookupControlHack(Lookup) do
try
if Value <> EmptyValue then
Result := StrToInt(Value) else
Result := 0;
except
Result := 0;
end;
end;

procedure InsertOrderBy(Query: TRxQuery; NewOrder: String);
var
Param: TParam;
OldActive: Boolean;
OldOrder: String;
Bmk: TPKBookMark;
begin
Param := FindParam(Query.Macros, 'Order');
if not Assigned(Param) then Exit;

OldOrder := Param.AsString;

if OldOrder <> NewOrder then
begin
OldActive := Query.Active;
if OldActive then Bmk := GetPKBookmark(Query, '');
try
Query.Close;
Param.AsString := NewOrder;
try
Query.Prepare;
except
Param.AsString := OldOrder;
end;
Query.Active := OldActive;
if OldActive then SetToPKBookMark(Query, Bmk);
finally
if OldActive then FreePKBookmark(Bmk);
end;
end;
end;

procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);
var
NewOrderFields: TStrings;

procedure AddOrderField(S: String);
begin
if NewOrderFields.IndexOf(S) < 0 then
NewOrderFields.Add(S);
end;

var
I, J: Integer;
Field: TField;
FieldDef: TFieldDef;
S: String;
begin
NewOrderFields := TStringList.Create;
with Query do
try
for I := 0 to OrderFields.Count - 1 do
begin
S := OrderFields[I];
Field := FindField(S);
if Assigned(Field) and (Field.FieldNo > 0) then
AddOrderField(IntToStr(Field.FieldNo))
else
try
J := StrToInt(S);
if J < FieldDefs.Count then
AddOrderField(IntToStr(J));
except
end;
end;
OrderFields.Assign(NewOrderFields);
finally
NewOrderFields.Free;
end;
end;

procedure HandleOrderMacro(Query: TRxQuery; Field: TField);
var
Param: TParam;
Tmp, OldOrder, NewOrder: String;
I: Integer;
C: Char;
TmpField: TField;
OrderFields: TStrings;
begin
Param := FindParam(Query.Macros, 'Order');
if not Assigned(Param) or Field.Calculated or Field.Lookup then Exit;
OldOrder := Param.AsString;
I := 0;
Tmp := '';
OrderFields := TStringList.Create;
try
OrderFields.Ad(Field.FieldName);
while I < Length(OldOrder) do
begin
Inc(I);
C := OldOrder[I];
if C in FieldNameChars then
Tmp := Tmp + C;

if (not (C in FieldNameChars) or (I = Length(OldOrder))) and (Tmp <> '') then
begin
TmpField := Field.DataSet.FindField(Tmp);
if OrderFields.IndexOf(Tmp) < 0 then
OrderFields.Add(Tmp);
Tmp := '';
end;
end;

UpdateOrderFields(Query, OrderFields);
NewOrder := OrderFields[0];
for I := 1 to OrderFields.Count - 1 do
NewOrder := NewOrder + ', ' + OrderFields[1];
finally
OrderFields.Free;
end;
InsertOrderBy(Query, NewOrder);
end;

end.

[001242]

КОМПОНЕНТ #1 - TDBLOOKUPCOMBO

Вам нужна форма с компонентом DBGrid на ней. Создайте новый проект и поместите на основную форму DBGrid.

Далее поместите на форму TTable, установите псевдоним (Alias) в DBDEMOS, TableName в GRIDDATA.DB и присвойте свойству Active значение True. Поместите DataSource и сошлитесь в свойстве DataSet на Table1. Вернитесь к DBGrid и укажите в свойстве DataSource компонент DataSource1. Данные из GRIDDATA.DB должные появиться в табличной сетке...

Первый элемент, который мы собираемся поместить в DBGrid - TDBLookupCombo, т.к. нам нужна вторая таблица для поиска. Поместите второй TTable на форму. Установите псевдоним (Alias) в DBDEMOS, TableName в CUSTOMER.DB и присвойте свойству Active значение True. Поместите второй DataSource и сошлитесь в свойстве DataSet на Table2.

Теперь нужно поместить компонент TDBLookupCombo из палитры Data Controls на любое место формы - это не имеет никакого значения, т.к. он обычно будет невидим или будет нами имплантирован в табличную сетку. Установите свойства компонента LookuoCombo следующим образом:

DataSource DataSource1 DataField CustNo LookupSource DataSource2 LookupField CustNo LookupDisplay CustNo {Вы можете изменить это на Company позже, но сейчас пусть это будет CustNo)

Пока мы только настроили компоненты. Теперь давайте создадим некоторый код.

Первое, что Вам необходимо - сделать так, чтобы DBLookupCombo, который Вы поместили на форму, во время запуска приложения оставался невидимым. Для этого выберите Form1 в инспекторе объектов, перейдите на закладку Events (события) и дважды щелкните на событии onCreate. Delphi немедленно сгенерит и отобразит скелет кода будущего обработчика события onCreate:

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

Присвойте свойству Visible значение False в LookupCombo следующим образом:

procedure TForm1.FormCreate(Sender: TObject);
begin
DBLookupCombo1.Visible := False; end;

Наверняка многим стало интересно, почему я не воспользовался инспектором объектов для изменения свойств компонента. Действительно, можно было бы и так. Лично я таким способом инициализирую компоненты, чьи свойства могут изменяться во время работы приложения. Я изменил статическое свойство, которое не отображается во время проектирования (если воспользоваться инспектором объктов). Я думаю это делает код легче для понимания.

Теперь нам необходимо "прикрутить" компонент к нашей табличной сетке. Наша задача - автоматически отобразить DBLookupCombo в ячейке во время получения ею фокуса (или перемещении курсора). Для этого необходимо написать код для обработчиков двух событий: OnDrawDataCell и OnColExit. Первым делом обработаем событие OnDrawDataCell. Дважды щелкните на строчке OnDrawDataCell в инспекторе объектов и введите следующий код:

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState); begin
if (gdFocused in State) then begin if (Field.FieldName = DBLookupCombo1.DataField) then begin DBLookupCombo1.Left := Rect.Left + DBGrid1.Left; DBLookupCombo1.Top := Rect.Top + DBGrid1.top; DBLookupCombo1.Width := Rect.Right - Rect.Left; { DBLookupCombo1.Height := Rect.Bottom - Rect.Top; } DBLookupCombo1.Visible := True; end; end; end;

Причины чрезмерного использования конструкций begin/end скоро станут понятны. В коде "говорится", что если параметр State имеет значение gdFocused, то данная ячейка имеет фокус (в любой момент времени только одна ячейка в табличной сетке может иметь фокус). Далее: если это выделенная ячейка и ячейка имеет тоже имя поля как и поле данных DBLookupCombo, DBLookupCombo необходимо поместить над этой ячейкой и сделать его видимым. Обратите внимание на определение позиции DBLookupCombo: она определяется относительно формы, а не ячейки. Так, например, положение левой стороны LookupCombo должно учитывать положение сетки (DBGrid1.Left) плюс положение соответствующей ячейки относительно сетки (Rect.Left).

Также обратите внимание на то, что определение высоты LookupCombo в коде закомментарено. Причина в том, что LookupCombo имеет минимальную высоту. Вы просто не сможете сделать ее меньше. Минимальная высота LookupCombo больше высоты ячейки. Если Вы раскомментарили строку, касающуюся высоты LookupCombo, Ваш код изменит размер компонента и Delphi немедленно его перерисует. Это вызовет неприятное моргание компонента. Бороться с этим невозможно. Позвольте, чтобы LookupCombo был немного больше, чем ячейка. Это выглядит немного странным, но это работает.

Теперь ради шутки запустите программу. Заработала? Сразу после запуска переместите курсор на одну из ячеек табличной сетки. Вы ожидали чего-то большего? Да! Мы только в середине пути. Теперь нам нужно спрятать LookupCombo при покидании курсором колонки. Напишем обработчик события onColExit. Это должно выглядеть примерно так:

procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
If DBGrid1.SelectedField.FieldName = DBLookupCombo1.DataField then DBLookupCombo1.Visible := false; end;

Код использует свойство TDBGrids SelectedField для ассоциации имени поля ячейки (FieldName) с нашим LookupCombo. Код "говорит": "Если ячейка была в колонке с DBLookupCombo (имя поля ячейки совпадает с именем поля DBLookupCombo), его необходимо сделать невидимым".

Теперь снова запустите приложение. Чувствуете эффект?

Теперь вроде бы все правильно, но мы забыли об одной вещи. Попробуйте ввести новое значение в одно из LookupCombo. Проблема в том, что нажатие клавиши обрабатывает DBGrid, а не LookupCombo. Чтобы исправить это, нам нужно написать для табличной сетки обработчик события onKeyPress. Это должно выглядеть примерно так:

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if (key <> chr(9)) then begin if (DBGrid1.SelectedField.FieldName = DBLookupCombo1.DataField) then begin
DBLookupCombo1.SetFocus; SendMessage(DBLookupCombo1.Handle, WM_Char, word(Key), 0); end; end; end;

В данном коде "говорится": если нажатая клавиша не является клавишей Tab (Chr(9)) и текущее поле в табличной сетке LookupCombo, тогда установите фокус на LookupCombo и передайте сообщение с кодом нажатой клавиши LookupCombo. Здесь я воспользовался WIN API функцией. Вам не нужно знать как это работает, достаточно того, что это просто работает.

Небольшое пояснение я все же дам. Для того, чтобы функция Window SendMessage послала сообщение "куда надо", ей в качестве параметра необходим дескриптор ("адрес") нужного компонента. Используйте свойство компонента Handle. Затем нужно сообщить компоненту что мы от него хотим. В нашем случае это Windows-сообщение WM_CHAR, извещающее LookupCombo о том, что ему посылается символ. Наконец, мы передаем ему сам символ нажатой клавиши - word(Key). Word(key) - приведение к типу word параметра Key события нажатия клавиши. Все достаточно просто, правда? Все, что Вам действительно необходимо сделать - заменить имя DBLookupCombo1 нашего вымышленного компонента на имя реального компонента, который будет участвовать в "модернизации" табличной сетки. Более подробную информацию о функции SendMessage Вы можете почерпнуть из электронной справки, поставляемой вместе с Delphi.

Запустите снова Ваше приложение и попробуйте что-нибудь ввести. Это работает! Экспериментируя, Вы увидите что с помощью клавиши Tab Вы можете перейти из режима редактирования в режим перемещения курсора и наоборот.

Теперь перейдите к инспектору объектов и измнените у компонента DBLookupCombo свойство LookupDIsplay на Company. Снова запустите. Это то, что Вы ожидали?

КОМПОНЕНТ #2 - TDBCOMBO

Здесь я не собираюсь обсуждать технологию имплантации DBCombo, так как она практически не отличается от той, что была показана выше. Все написанное в пункте #1 имеет силу и здесь. Вот пошагово разработанный код для вашего компонента.

procedure TForm1.FormCreate(Sender: TObject);
begin
DBLookupCombo1.Visible := False; DBComboBox1.Visible := False; end;

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState); begin
if (gdFocused in State) then begin if (Field.FieldName = DBLookupCombo1.DataField) then
begin DBLookupCombo1.Left := Rect.Left + DBGrid1.Left; DBLookupCombo1.Top := Rect.Top + DBGrid1.top; DBLookupCombo1.Width := Rect.Right - Rect.Left; DBLookupCombo1.Visible := True; end else if (Field.FieldName = DBComboBox1.DataField) then begin DBComboBox1.Left := Rect.Left + DBGrid1.Left; DBComboBox1.Top := Rect.Top + DBGrid1.top; DBComboBox1.Width := Rect.Right - Rect.Left; DBComboBox1.Visible := True; end end; end;

procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
If DBGrid1.SelectedField.FieldName = DBLookupCombo1.DataField then DBLookupCombo1.Visible := false else If DBGrid1.SelectedField.FieldName = DBComboBox1.DataField then DBComboBox1.Visible := false; end;

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if (key <> chr(9)) then begin if (DBGrid1.SelectedField.FieldName = DBLookupCombo1.DataField) then begin DBLookupCombo1.SetFocus; SendMessage(DBLookupCombo1.Handle, WM_Char, word(Key), 0); end else if (DBGrid1.SelectedField.FieldName = DBComboBox1.DataField) then
begin DBComboBox1.SetFocus; SendMessage(DBComboBox1.Handle, WM_Char, word(Key), 0); end; end; end;

КОМПОНЕНТ #3 - TDBCHECKBOX

Технология работы с компонентом DBCheckBox более интересна. В этом случае нам необходимо дать понять пользователю о наличие компонента DBCheckBox в ячейках без фокуса. Вы можете вставлять статическое изображение компонента или динамически изменять изображение в зависимости от логического состояния элемента управления. Я выбрал второе. Я создал два BMP-файла - включенный (TRUE.BMP) и выключенный (FALSE.BMP) DBCheckBox. Поместите два компонента TImage на форму, присвойте им имена ImageTrue и ImageFalse и назначьте соответствующие BMP-файлы в свойстве Picture. Да, чуть не забыл: Вам также необходимо поместить на форму два компонента DBCheckbox. Установите набор данных обоих компонентов в DataSource1 и присвойстве свойству Color значение clWindow. Для начала создадим для формы обработчик события onCreate:

procedure TForm1.FormCreate(Sender: TObject);
begin
DBLookupCombo1.Visible := False; DBCheckBox1.Visible := False; DBComboBox1.Visible := False; ImageTrue.Visible := False; ImageFalse.Visible := False; end;

Теперь нам нужен обработчик события onDrawDataCell чтобы делать что-то с ячейками, не имеющими фокуса. Здесь подойдет следующий код:

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState); begin
if (gdFocused in State) then begin if (Field.FieldName = DBLookupCombo1.DataField) then begin ...СМОТРИ ВЫШЕ end else if (Field.FieldName = DBCheckBox1.DataField) then begin DBCheckBox1.Left := Rect.Left + DBGrid1.Left + 1; DBCheckBox1.Top := Rect.Top + DBGrid1.top + 1; DBCheckBox1.Width := Rect.Right - Rect.Left{ - 1}; DBCheckBox1.Height := Rect.Bottom - Rect.Top{ - 1};
DBCheckBox1.Visible := True; end else if (Field.FieldName = DBComboBox1.DataField) then begin ...СМОТРИ ВЫШЕ end end else {в этом месте помещаем статическое изображение компонента} begin if (Field.FieldName = DBCheckBox1.DataField) then begin if TableGridDataCheckBox.AsBoolean then DBGrid1.Canvas.Draw(Rect.Left,Rect.Top,ImageTrue.Picture.Bitmap) else DBGrid1.Canvas.Draw(Rect.Left,Rect.Top,ImageFalse.Picture.Bitmap) end end;

Самое интересное место - последний участок кода. Он выполняется в случае, когда состояние не равно gdFocused и сам CheckBox находится в колонке. В нем осуществляется проверка данных поля: если они равны True, то выводится рисунок TRUE.BMP, в противном случае - FALSE.BMP. Предварительно я создал два изображения, представляющие собой "слепок" двух логических состояния компонента, теперь будет очень трудно обнаружить отсутствие компонента в ячейках с фокусом и без оного. Теперь напишем обработчик события onColExit:

procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
If DBGrid1.SelectedField.FieldName = DBLookupCombo1.DataField then DBLookupCombo1.Visible := false else If DBGrid1.SelectedField.FieldName = DBCheckBox1.DataField then DBCheckBox1.Visible := false else If DBGrid1.SelectedField.FieldName = DBComboBox1.DataField then DBComboBox1.Visible := false; end;

Организуйте обработку события onKeyPress как показано ниже:

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if (key <> chr(9)) then begin if (DBGrid1.SelectedField.FieldName = DBLookupCombo1.DataField) then begin DBLookupCombo1.SetFocus; SendMessage(DBLookupCombo1.Handle, WM_Char, word(Key), 0); end else if (DBGrid1.SelectedField.FieldName = DBCheckBox1.DataField) then
begin DBCheckBox1.SetFocus; SendMessage(DBCheckBox1.Handle, WM_Char, word(Key), 0); end else if (DBGrid1.SelectedField.FieldName = DBComboBox1.DataField) then
begin DBComboBox1.SetFocus; SendMessage(DBComboBox1.Handle, WM_Char, word(Key), 0); end; end; end;

Наконец, последняя хитрость. Для удобства пользователя заголовку компонента нужно присвоить текущее логическое значение. С самого начала у меня была идея поручить это обработчику события onChange, но проблема в том, что событие может возникнуть неединожды. Итак, я должен снова воспользоваться функцией Windows API и послать компоненту соответствующее значение: "SendMessage(DBCheckBox1.Handle, BM_GetCheck, 0, 0)", которая возвращает 0 в случае если компонент невключен и любое другое число в противном случае.

procedure TForm1.DBCheckBox1Click(Sender: TObject);
begin
if SendMessage(DBCheckBox1.Handle, BM_GetCheck, 0, 0) = 0 then DBCheckBox1.Caption := ' ' + 'Ложь' else DBCheckBox1.Caption := ' ' + 'Истина' end;

Это все. Надеюсь, Вы узнали для себя что-то новое. Я пробовал данную технологию с диалоговыми окнами. Делается достаточно просто и великолепно работает. Радует простота реализации. Вам даже не нужно знать как это работает, единственное, что Вам придется - заменить в тексте кода имена вымышленных компонентов на те, которые Вы реально хотите отображать в табличной сетке.

Копирование информации из DBGrid-а в Clipboard

Читатель советует:

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

С уважением, Беличенко Б.

unit UnGridToClb;

interface

Uses
Windows, SysUtils, Classes, Dialogs, Grids, DBGrids, Db, DBTables, ClipBrd;

procedure CopyGRDToClb(dbg :TDBGrid);
//Копирует DBGrid в буфер обмена, //после чего данные отлично переносятся //как в простой текстовый редактор, так и в Excell
implementation
procedure CopyGRDToClb(dbg :TDBGrid);
var
bm : TBookMark; pch,pch1: PChar; s,s2 : string; i,j : integer;
begin

s := ''; for j := 0 to dbg.Columns.Count-1 do s := s + dbg.Columns.Items[j].Title.Caption +#9 ; s := s + #13+#10; if not dbg.DataSource.DataSet.active then begin ShowMessage('Нет выборки!!!'); Exit; end; try dbg.Visible := False; //Делаем грид невидимым, чтобы не тратилось время //на его перерисовку при прокрутке DataSet - просто и //эффективно bm := dbg.DataSource.DataSet.GetBookmark; // для того чтобы не // потерять текущую запись dbg.DataSource.DataSet.First; while not dbg.DataSource.DataSet.EOF do begin s2 := ''; for j := 0 to dbg.Columns.Count-1 do begin s2 := s2 + dbg.Columns.Items[j].Field.AsString +#9; end; s := s + s2 + #13+#10; dbg.DataSource.DataSet.Next; end; //Переключаем клавиатуру "в русский режим", //иначе - проблемы с кодировкой GetMem(pch,100); GetMem(pch1,100); GetKeyboardLayoutName(pch); StrCopy(pch1,pch); while pch <> '00000419' do begin ActivateKeyboardLayout(HKL_NEXT,0); GetKeyboardLayoutName(pch); if strComp(pch, pch1) = 0 then //Круг замкнулся - нет такого языка '00000419' StrCopy(pch,'00000419'); end;
clipboard.AsText := s; //Данные - в буфер!!!
//Возвращаем режим клавиатуры while strComp(pch, pch1)<>0 do begin ActivateKeyboardLayout(HKL_NEXT,0); GetKeyboardLayoutName(pch); end;
FreeMem(pch); FreeMem(pch1);
dbg.DataSource.DataSet.GotoBookmark( bm ); //ShowMessage('Данные успешно скопированы в буфер обмена.'); finally dbg.Visible := True; end; end;

end.

Замечания:

Я привожу только сомнительную часть. Мои комментарии отмечены {AK:}

//как в простой текстовый редактор, так и в Excell
{AK: Excel - с одной L на конце}
...

dbg.Visible := False; // Делаем грид невидимым, чтобы не тратилось время
// на его перерисовку при прокрутке DataSet - просто и // эффективно {AK: Вот изврат, который сразу бросается в глаза. Для это предназначены методы EnableControls/DisableControls датасета!}
bm := dbg.DataSource.DataSet.GetBookmark; // для того чтобы не
// потерять текущую запись { АК: насколько я помню, сами борланоиды не рекомендовали пользоваться Get/SetBookmark и использовать вместо них свойство BookMark }

Удачи!
Алексей Коган

Примечание (В.О.): вот так советы превращаются в споры и дискуссии, а то и в форумы между читателями :-) [000887]

Многострочный DBGrid

...я тоже на днях пытался сделать себе такую сеточку. Вначале я думал что можно будет ушибиться, делая такую штуку, но это оказалось совсем простым. Ничего сложного. В TDBGrid необходимо изменять высоту строки и переносить текст, если для его показа нужно более одной строки. Я не стал корежить исходники VCL, а написал своего наследника TDBGrid.

Я добавил дополнительное свойство LinesPerRow. Установка значений данного свойства соответственно изменяет высоту строки, в зависимости от текущего шрифта. Текст в ячейках будет переноситься, если значение LinesPerRow больше чем единица. Все это произведение искусств оказалось чрезвычайно полезным и удивительно простым, так что я публикую его здесь в надежде, что оно пригодится кому-нибудь еще. Код простой, но для его понимания необходимо изучение исходного кода VCL.

Я протестировал данный код и он отлично работал. Небольшая доводка все-же нужна (обработка blob-полей, обработка ошибок и пр.), но это не сложно.

unit Dbmygrid;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, DB, DBTables, StdCtrls, ExtCtrls, Grids, DBGrids;
type
TMultiLineDBGrid = class(TDBGrid) private FLinesPerRow: Integer; procedure DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState); procedure LayoutChanged; override; procedure SetLinesPerRow(ALinesPerRow: Integer); public property LinesPerRow: Integer read FLinesPerRow write SetLinesPerRow default 1; constructor Create(AOwner: TComponent); override; end;

implementation

constructor TMultiLineDBGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner); FLinesPerRow := 1; OnDrawDataCell := DrawDataCell; end;

procedure TMultiLineDBGrid.LayOutChanged;
begin
inherited LayOutChanged; DefaultRowHeight := DefaultRowHeight * LinesPerRow; end;

procedure TMultiLineDBGrid.DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);
var
Format: Word; C: array[0..255] of Char; begin
if LinesPerRow = 1 then Format := DT_SINGLELINE or DT_LEFT else Format := DT_LEFT or DT_WORDBREAK;
Canvas.FillRect(Rect);
StrPCopy(C, Field.AsString); WinProcs.DrawText(Canvas.Handle, C, StrLen(C), Rect, Format); end;

procedure TMultiLineDBGrid.SetLinesPerRow(ALinesPerRow: Integer);
begin
if ALinesPerRow <> FLinesPerRow then begin FLinesPerRow := ALinesPerRow; LayoutChanged; end; end;

end.

Chris Hall [000668]

Модуль Db_QBF.PAS, позволяющий в Delphi осуществить форму запроса для компонентов DbGrid

Предлагаю Вашему вниманию модуль Delphi для модального диалога, поддерживающий форму запроса (Query By Form - QBF) для компонентов DbGrid с возможностью получения данных от Table-компонентов (не используя Query-компонентов).

Встроенные характеристики обмена данными в Delphi делают эту задачу намного труднее, чем, например, в таких ресурсоемких инструментальных средствах, как Oracle Forms (Оракловые формы). Данный модуль не такой мощный как встроенные QBF-возможности Оракловых форм, но он заполняет значительную брешь в функциональности Delphi.

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

unit Db_QBF; { Форма запроса базы данных }

{ Все права защищены. Автор Rick Rutt.
Данный модуль может без какой-либо оплаты быть использован в программе, скопирован или распространен любым человеком и для любой цели, если все копии данного модуля сохраняют это авторское уведомление. Автор предоставляет разрешение каждому для создания производного кода, если каждая производная работа содержит авторское уведомление и строку "Части данной работы основываются на Db_QBF.PAS, созданным Rick Rutt." }

{ Данный модуль обеспечивает простую, но эффективную форму запроса
для доступа приложений к базам данных, используя Borland Delphi. Данный модуль также располагает сервисом Sort By Form (форма сортировки).
Форма запроса отображает модальное диалоговое окно с компонентом StringGrid, содержащим искомые поля, полученные при вызове DbGrid. Пользователь может ввести точную величину поиска для любого количества полей и использовать функцию drag and drop (перетащи и брось) для изменения порядка сортировки полей. (Только тех полей, которые содержат искомые величины, влияющие на сортировку.) Когда пользователь щелкает в диалоговом окне на кнопку OK, данный модуль модифицирует значение свойства IndexFieldNames компонента DbGrid, применяет диапазон поиска (точные величины), и обновляет данные. В случае, если пользователь не указывает ни одной из величин поиска, данный модуль очищает значение свойства IndexFieldNames компонента DbGrid, очищает диапазон поиска и обновляет данные.
Сервис Sort By Form работает аналогично, за исключением того, что не принимает в расчет величину поиска, введенную пользователем. Пользователь пользуется функцией drag and drop (перетащи и брось) для установления порядка сортировки и затем нажимает на кнопку OK. Данный модуль модифицирует значение свойства IndexFieldNames компонента DbGrid, очищает диапазон поиска и обновляет данные. }

{ Создайте соответствуюшую форму диалога, используя меню "File/New.../Dialogs"
и выбрав пункт "Standard Dialog Box". Разместите на форме компонент StringGrid (Вы найдете его в палитре компонентов на странице "Additional"). Установите следующие размеры StringGrid: высота 161 и ширина 305. И, наконец, замените исходный код новой формы (PAS-файл) данным модулем. }

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
StdCtrls, ExtCtrls, Grids, DBGrids;
{ Следующие две процедуры обеспечивают механизм доступа
сервисов данного модуля.
Кнопка (или пункт меню) вызывают процедуру, передавая ей в качестве аргумента DbGrid. (Не забудьте добавить строку "uses Db_QBF;" в секцию реализации модуля вызова форм.)
Ограничение: компонент DbGrid должен ссылаться на DataSource, который, в свою очередь, ссылается на DataSet, работающий с таблицой. Данный модуль не поддерживает запрос напрямую к DataSet ввиду отсутствия свойства IndexFieldNames. }

procedure QueryByForm(grid: TDbGrid);

procedure SortByForm(grid: TDbGrid);

{ Следующая секция управляется средой Delphi. }

type
TdlgQBF = class(TForm) OKBtn: TBitBtn; CancelBtn: TBitBtn; HelpBtn: TBitBtn; gridQBF: TStringGrid; procedure OKBtnClick(Sender: TObject); procedure CancelBtnClick(Sender: TObject); private { Private declarations } public { Public declarations } end;
var
dlgQBF: TdlgQBF;
implementation

{ Следующая секция пишется программистом
с помощью среды Delphi. }
uses Dialogs, Db, DbTables;

{$R *.DFM}

const
qbfRowHeight = 16; qbfColWidth = 150;
qbfFieldLabel = '<<Поле>>'; qbfValueLabel = '<<Значение>>';
qbfQueryCaption = 'Запрос для таблицы '; qbfSortCaption = 'Порядок сортировки для таблицы ';
var
{ Объявим некоторые элементы управления, участвующие в QBF-диалоге при нажатии кнопки OK. } CallingGrid: TDbGrid; CallingMode: (modeQuery, modeSort);
procedure SetupAndShowForm; { Инициализация формы, обеспечивающей визуализацию работы двух объявленных выше процедур }
var
i, j, n: integer; tbl: TTable; f: TField; begin
n := CallingGrid.FieldCount; if n <= 0 then begin { Вместо вывода сообщений могут генерится исключительные ситуации } MessageDlg( 'При обращении к DbGrid, модуль Db_QBF не обнаружил полей', mtWarning, [mbOK], 0); end else if CallingGrid.DataSource = NIL then begin MessageDlg( 'При обращении к DbGrid, модуль Db_QBF не обнаружил ссылки на DataSource', mtWarning, [mbOK], 0); end else if CallingGrid.DataSource.DataSet = NIL then begin MessageDlg( 'При обращении к DbGrid, модуль Db_QBF обнаружил подключенный DataSource без ссылки на DataSet', mtWarning, [mbOK], 0); end else if not (CallingGrid.DataSource.DataSet is TTable) then begin MessageDlg( 'При обращении к DbGrid, модуль Db_QBF обнаружил подключенный DataSource с сылкой на DataSet, не являющийся таблицей.', mtWarning, [mbOK], 0); end else with dlgQBF.gridQBF do begin { Данные свойства могут быть изменены и в режиме проектирования } DefaultRowHeight := qbfRowHeight; Scrollbars := ssVertical; ColCount := 2; { Для режима сортировки необходимы две пустые колонки }
{ Данные свойства должны быть установлены во время выполнения программы } RowCount := Succ(n); Cells[0,0] := qbfFieldLabel; Options := Options + [goRowMoving];
tbl := TTable(CallingGrid.DataSource.DataSet);
if CallingMode = modeQuery then begin dlgQBF.Caption := qbfQueryCaption + tbl.TableName; Cells[1,0] := qbfValueLabel; Options := Options + [goEditing]; { Позволяем пользователю ввести значение } DefaultColWidth := qbfColWidth; end else begin dlgQBF.Caption := qbfSortCaption + tbl.TableName; Cells[1,0] := ''; { Ввод "пустышки" для первой, нефункциональной колонки } Options := Options - [goEditing]; { Убираем возможность редактирования } DefaultColWidth := (2 * qbfColWidth); { Этим трюком мы помещаем две пустых секции над одной колонкой } end;
j := 0; { Фактическое число полей, показываемое пользователю } for i := 1 to n do begin f := CallingGrid.Fields[Pred(i)]; if f.DataType in [ftBlob,ftBytes,ftGraphic,ftMemo,ftUnknown,ftVarBytes] then RowCount := Pred(RowCount) { Игнорируем неиндексируемые поля } else begin Inc(j); Cells[0,j] := f.FieldName; Cells[1,j] := ''; { Сбрасываем искомую величину } end; end;
dlgQBF.HelpBtn.Visible := False; { Помощь, понятно, отсутствует... } dlgQBF.ShowModal; end; { with dlgQBF.gridQBF } end;

procedure QueryByForm(Grid: TDbGrid);
begin
CallingGrid := Grid; { Сохраняем для использования при нажатии на кнопку OK } CallingMode := modeQuery; SetupAndShowForm; end;

procedure SortByForm(Grid: TDbGrid);
begin
CallingGrid := Grid; { Сохраняем для использования при нажатии на кнопку ОК } CallingMode := modeSort; SetupAndShowForm; end;

procedure TdlgQBF.CancelBtnClick(Sender: TObject);
begin
{ Просто прячем диалог, не делая никаких изменений в вызывающем Grid'е. } dlgQBF.Hide; end;

procedure TdlgQBF.OKBtnClick(Sender: TObject);
var
flds, sep, val: string; i, n, nfld: integer; begin
flds := ''; { Список полей, разделенных ';'. } sep := ''; { Разделитель ';' ставится после добавления первого поля. } nfld := 0; { Количество полей в списке. }
with dlgQBF.gridQBF do begin n := Pred(RowCount); if n > 0 then for i := 1 to n do begin val := Cells[1,i]; { Значение поиска, введенное пользователем (если имеется) } if (CallingMode = modeSort) or (val <> '') then begin flds := flds + sep + Cells[0,i]; sep := ';'; nfld := Succ(nfld); end; end;
with CallingGrid.DataSource.DataSet as TTable do begin IndexFieldNames := flds; if (CallingMode = modeSort) or (flds = '') then begin CancelRange; end else begin SetRangeStart; for i := 1 to n do begin val := Cells[1,i]; if val <> '' then begin FieldByName(Cells[0,i]).AsString := val; end; end;
SetRangeEnd; { Устанавливаем конец диапазона так, чтобы он соответствовал его началу } for i := 1 to n do begin val := Cells[1,i]; if val <> '' then begin FieldByName(Cells[0,i]).AsString := val; end; end; ApplyRange; end;
Refresh; end; { with CallingGrid.DataSource.DataSet } end; { with dlgQBF.gridQBF }
dlgQBF.Hide; end;

end.

[000069]

Несколько таблиц в одном TDBGrid

Насколько я знаю, единственное легкое решение заключается в использовании вычисляемых полей.

Для того, чтобы поместить данные из нескольких таблиц в один DBGrid, нужно воспользоваться объектом TQuery. На заметку: используйте TQuery в режиме только для чтения, если вы не можете обеспечить гарантию выполнения некоторых из его руководящих принципов, один из которых - данные могут быть получены только от одной таблицы. [001302]

Обновление TDBGrid после редактирования отдельной записи на отдельной форме

А вы постите запись, прежде чем закрыть форму? При закрытии, форма самостоятельно данных не постит. Вы должны постить изменения или с помощью компонента dbnavigator, или c помощью кода, который при закрытии формы постит данные в основную таблицу.

На странице 95 Database Application Developers Guide (руководство разработчиков приложений баз данных), поставляемое с Delphi, приведен демонстрационный проект с двумя формами, демонстрирующий хорошую технику при использовании ttable на мастер-форме в качестве набора данных для детали.

Одним из решений вашей проблемы может служить связывание компонента DataSource на Form2 с набором данных DataSet на Form1. Это может быть достигнуто путем добавления следующей строки в обработчик события OnActivate для Form2:

MyDataSource.DataSet := Form1.MyTable;

Данный метод имеет 3 преимущества: сделанные вами изменения немедленно отображаются, поскольку вы используете одну и ту же логическую таблицу;

если вам нужно определить установки для ваших полей таблицы, например, DisplayFormat или EditMask, вам нужно сделать это только один раз в таблице на Form1, вам не нужно это делать на каждой форме, которая использует таблицу;

это сохраняет ресурсы и повышает производительность, поскольку ваше приложение при работе с таблицей использует только одну сессию. Тем не менее, в проектном времени вам нужно иметь TTable на вашей Form2 для того, чтобы вы могли выбрать поля для БД-контролов, после чего вы можете удалить TTable. [001335]

Обновление вычисляемых полей в DBGrid

Разместите строчку типа нижеприведенной в конце кода обработчика события OnCalcFields:

{предположим, что вы используете DBGrid1}
if DBGrid1.Showing then DBGrid1.Invalidate ;

OAmiry/Borland [000571]

OnClick и DBGrid

Многие программисты хотели бы использовать OnClick у TDBGrid. Но TDBGrid не имеет такого события. В данном документе рассказывается о том, как обеспечить поддержку события OnClick для TDBGrid. Рассказанная здесь технология может пригодиться при добавлении других свойств к различным объектам. Если вы знаете, что сделать это мог предок, то можно заставить сделать это и наследника. Ключевым моментом здесь можно считать добавление csClickEvents к свойству-набору элемента управления ControlStyle. Это позволит элементу управления, приведенному к типу THack, получать и правильно обрабатывать системные сообщение о щелчке мышью. Назначение OnClick какого-либо элемента управления OnClick DBGrid1 позволяет воспользоваться событием OnClick для элемента управления, которое его не поддерживает.

Это "неофициальный" путь. Существует несколько причин того, почему dbgrid не поддерживает этого события. Используйте этот код на свой страх и риск.

unit Udbgclk;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids, DBTables, DB;
type
thack = class(tcontrol);
TForm1 = class(TForm) DBGrid1: TDBGrid; Button1: TButton; DataSource1: TDataSource; Table1: TTable; procedure Button1Click(Sender: TObject); procedure FormClick(Sender: TObject);
private { Private declarations } public
{ Public declarations } end;
var
Form1: TForm1;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
THack(dbgrid1).controlstyle := THack(dbgrid1).controlstyle + [csClickEvents]; THack(dbgrid1).OnClick := Form1.OnClick; end;

procedure TForm1.FormClick(Sender: TObject);
begin
messagebeep(0); application.processmessages; end;

end.

[001273]

Перехват события компонента DBGrid MouseDown

...вот совпадение. Я потолько что отвечал на другой вопрос, где меня также спрашивали как перехватить событие DBGrid MouseDown:

Вам необходимо создать класс-наследник TDBGrid и перекрыть процедуру MouseDown. Вот код, который реально работает у меня:

TMyDBGrid = class(TDBGrid) procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; end;
procedure TMyDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); begin
inherited MouseDown(Button, Shift, X, Y);
{ Здесь делайте что хотите, можете погудеть в системный рожок } MessageBeep(mb_Ok); end;

--------- покоцано --------------

unit MyDBGrid;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids;
type
TMyDBGrid = class(TDBGrid) private { Private declarations } protected { Protected declarations } procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public { Public declarations } published { Published declarations } property OnMouseDown; end;
procedure Register;

implementation

procedure TMyDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); var
FOnMouseDown: TMouseEvent; begin
inherited MouseDown(Button, Shift, X, Y); FOnMouseDown := OnMouseDown; if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y); end;

[000411]

Перемещение из DbGrid

Кто-нибудь пробовал перемещать что-либо из DbGrid методом перетащи и брось (drag and drop)? Вы сами можете создать потомка TDBGrid (или TDBCustomGrid) и добавить необходимую функциональность для достижения цели.

Скопируйте код из данного "Совета", сохраните его с именем DBGrid.pas и установите компонент в палитру. У Вас появится новый компонент EDBGrid с двумя новыми событиями: OnMouseDown и OnMouseUp. Я не считаю эту информацию конфиденциальной: это ошибка разработчиков Delphi! На самом деле эти два события должны быть частью компонента DBGrid.

unit Dbgrid;

interface

uses
DBGrids, Controls, Classes;
type
TEDBGrid = class(TDBGrid) private FOnMouseDown: TMouseEvent; FOnMouseUp: TMouseEvent; protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
published Property OnMouseDown : TMouseEvent read FOnMouseDown write FOnMouseDown ;
Property OnMouseUp : TMouseEvent read FOnMouseUp write FOnMouseUp ; end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Data Controls',[TEDBGrid]); end;

procedure TEDBGrid.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 TEDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
if Assigned(FOnMouseUp) then FOnMouseUp(Self,Button,Shift,X,Y); inherited MouseUp(Button,Shift,X,Y); end;

end.

[000072]

Пересортица в коде полей TDBGrid во время вополнения программы

используйте <имя поля>.index := <желаемый номер поля> [001339]

Показ изображений в DBGrid

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

Код компонента:

{
// DBPICGRD.PAS (C)
//              ВСЕ ПРАВА ЗАЩИЩЕНЫ.
//
//    ОПИСАНИЕ:
//      Компонент DBGrid, способный отображать графику в ячейках.
}

unit DBPicGrd;

interface

uses
DBGrids, DB, DBTables, Grids, WinTypes, Classes, Graphics;
type
TDBPicGrid = class(TDBGrid) protected procedure DrawDataCell(const Rect: TRect; Field: TField; State: TGridDrawState); override; public constructor Create(AOwner : TComponent); override; published property DefaultDrawing default False; end;
procedure Register;

implementation

constructor TDBPicGrid.Create(AOwner : TComponent);
begin
inherited Create(AOwner); DefaultDrawing := False; end;

procedure TDBPicGrid.DrawDataCell(const Rect: TRect; Field: TField;
State: TGridDrawState);
var
bmp : TBitmap; begin
with Canvas do begin FillRect(Rect); if Field is TGraphicField then try bmp := TBitmap.Create; bmp.Assign(Field); Draw(Rect.Left, Rect.Top, bmp); finally bmp.Free; end else TextOut(Rect.Left, Rect.Top, Field.Text); end; end;

procedure Register;
begin
RegisterComponents('Custom', [TDBPicGrid]); end;

end.

[000068]

Показ Memo-поля в Dbgrid

...я все же лелею надежду, что когда-нибудь увижу TMemoField.DataSize, имеющим значение, отличное от нуля. Может быть значение DataSize является размером части Memo, которая сохранилась в .db-файле? Вместо этого я теперь пользуюсь объектом TBlobStream, который вполне хорошо справляется с этой работой. Все это у меня происходит примерно так:

Var
pBuffer : PChar ; Blob : TBlobStream ; begin
{FDataField - это TMemoField} Blob := TBlobStream.Create( FDataField, bmRead ) ; try if Blob.Size > 0 then try GetMem( pBuffer, Blob.Size ) ; Blob.Read( pBuffer^, Blob.Size ) ; { что-то тут делаем }
FreeMem( pBuffer, Blob.Size ) ; except ShowMessage( 'Нехватка памяти' ); end ; finally Blob.Free end ;

[001505]

Получение данных DBGrid прежде

Вы можете "видеть" что набирается в TDBGrid, "смотря" на контрол сетки TInPlaceEdit. Вы должны убедиться только в том, что к моменту использования TInPlaceEdit, контрол уже создан. Следующая функция покажет данные, редактируемые в колонках сетки:

procedure TForm1.DBGrid1KeyUp(Sender: TObject;
var Key: Word; Shift: TShiftState); var B: byte;
begin for B := 0 to DBGrid1.ControlCount - 1 do if DBGrid1.Controls[B] is TInPlaceEdit then begin with DBGrid1.Controls[B] as TInPlaceEdit do begin Label1.Caption := 'Текст = ' + Text; end; end; end;

[001285]

Получение текста ячейки TDBGrid под курсором мыши

type TDBGridHack = class(TCustomDBGrid);
...................
function GrabDbGridCellText(AGrid : TDBGrid; X, Y : Integer) : string;
var Pt : TGridCoord; CurrentRec : Integer; HasTitles, HasIndicator : boolean;
begin
HasTitles := dgTitles in AGrid.Options; HasIndicator := dgIndicator in AGrid.Options; Pt := AGrid.MouseCoord(X, Y); if AGrid.DataSource.DataSet.Active and (Pt.Y >= 0) and not ((Pt.Y = 0) and HasTitles) and not ((Pt.X = 0) and HasIndicator) then begin CurrentRec := TDbGridHack(AGrid).DataLink.ActiveRecord; if HasTitles then Pt.Y := Pt.Y - 1; if HasIndicator then Pt.X := Pt.X - 1; TDbGridHack(AGrid).DataLink.ActiveRecord := Pt.Y; try Result := AGrid.Columns[Pt.X].Field.AsString; finally TDbGridHack(AGrid).DataLink.ActiveRecord := CurrentRec; end; end else Result := ''; end;

Пример вызова:

procedure TForm1.RxDBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
Label1.Caption:=GrabDbGridCellText(RxDBGrid1,x,y); end;

Проверено только на Delphi 5. [001947]

Помещение компонентов в DBGrid

В: Как мне поместить компоненты в TDBGrid?
О: Я знаю как это сделать, и это нечто!

Как поместить компоненты в DBGrid

Данный совет и сопутствующий код показывает как просто поместить любой компонент в ячейку сетки данных. Компонент в данном контексте может означать любой видимый элемент управления - от простого combobox до сложного диалогового окна. Методы, описанные ниже, применимы практически к любому визуальному компоненту. Если Вы можете поместить его на форму, то, вероятно, сможете поместить и в ячейку DBGrid.

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

Позиция DBGrid

В режиме разработки дважды щелкните на компоненте TQuery, и выберите все поля, которые вы хотите использовать в DBGrid. Затем в обработчике события DBGrid doubleclick смотрите значение DBGrid.SelectedIndex. Если оно < 0, выбранных пунктов нет. Также, текущая запись TQuery будет указывать на ту же самую строку, которая выбранна в DBGrid. Таким образом, вы можете использовать что-то типа requiredvalue := Query1Field1.AsString; и т.д., естественно, компоненты TQuery и DBGrid должны быть подключены друг к другу. [001250]

Позиция ячейки в TDBGrid

В TCustomGrid определен метод CellRect, который, к сожалению, защищен. Это означает, что даный метод доступен только для TCustomGrid и его наследников. Но все-таки существует немного мудреное решение вызова данного метода:

type
TMyDBGrid = class(TDBGrid) public function CellRect(ACol, ARow: Longint): TRect; end;
function TMyDBGrid.CellRect(ACol, ARow: Longint): TRect;
begin
Result := inherited CellRect(ACol, ARow); end;

Вы можете сделать приведение типа вашего DBGrid к TMyDBGrid (это возможно, поскольку CellRect статический метод) и вызвать CellRect:

Rectangle := TMyDBGrid(SomeDBGrid).CellRect(SomeColumn, SomeRow);

procedure TfmLoadIn.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); const
Disp = 2; //Правильно выравниваем компонент begin
inherited; if (gdFocused in State) then begin if (Column.FieldName = 'TYPEDescription') then begin dlTYPEDescription.Left := Rect.Left + DBGrid1.Left + Disp; dlTYPEDescription.Top := Rect.Top + DBGrid1.top + Disp; dlTYPEDescription.Width := Rect.Right - Rect.Left; dlTYPEDescription.Height := Rect.Bottom - Rect.Top; dlTYPEDescription.Visible := True; end; end; end;

[001464]

Предохранение от автодобавления записи

Мне необходимо как-то предотвратить автоматическое добавление записей в таблицу. Может быть предусмотреть какую-то хитрость для создания новой записи в табличной сетке?

Попробуй это (я правда оставил некоторый мусор после испытаний кодов клавиш). Для DBGridkeydown используй:

begin
s := 'ASCII код клавиши ' + IntToStr(Ord(key)) +
' десятичное'; {showmessage(s);}
s :=IntToStr(Ord(key));
end;

И затем в TTable сделайте следующее:

begin
if
s<&gt'45' then
raise Eabort.create('');
s:='';
end;

Естественно, "s" должна быть объявлена глобально.

Bill Curtis
Borland International [000378]

Drag and Drop между двумя Dbgrid

Данный пример компонента и демонстрационный проект показывают простой путь осуществления операции "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); procedure MyDBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer); private { Private declarations } public { Public declarations } end;
var
Form1: TForm1;
implementation

{$R *.DFM}

var
SGC : TGridCoord;
procedure TForm1.MyDBGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var
DG : TMyDBGrid; begin
DG := Sender as TMyDBGrid; SGC := DG.MouseCoord(X,Y); if (SGC.X > 0) and (SGC.Y > 0) then (Sender as TMyDBGrid).BeginDrag(False); end;

procedure TForm1.MyDBGrid1DragOver(Sender, Source: TObject;
X, Y: Integer; State: TDragState; var Accept: Boolean); var
GC : TGridCoord; begin
GC := (Sender as TMyDBGrid).MouseCoord(X,Y); Accept := Source is TMyDBGrid and (GC.X > 0) and (GC.Y > 0); end;

procedure TForm1.MyDBGrid1DragDrop(Sender, Source: TObject;
X, Y: Integer); var
DG : TMyDBGrid; GC : TGridCoord; CurRow : Integer; begin
DG := Sender as TMyDBGrid; GC := DG.MouseCoord(X,Y); with DG.DataSource.DataSet do begin with (Source as TMyDBGrid).DataSource.DataSet do Caption := 'Вы перетащили "'+Fields[SGC.X-1].AsString+'"'; DisableControls; CurRow := DG.Row; MoveBy(GC.Y-CurRow); Caption := Caption+' в "'+Fields[GC.X-1].AsString+'"'; MoveBy(CurRow-GC.Y); EnableControls; end; end;

end.

Форма GridU1

object Form1: TForm1
Left = 200 Top = 108 Width = 544 Height = 437 Caption = 'Form1' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] PixelsPerInch = 96 TextHeight = 13 object MyDBGrid1: TMyDBGrid Left = 8 Top = 8 Width = 521 Height = 193 DataSource = DataSource1 Row = 1 TabOrder = 0 TitleFont.Charset = DEFAULT_CHARSET TitleFont.Color = clWindowText TitleFont.Height = -11 TitleFont.Name = 'MS Sans Serif' TitleFont.Style = [] OnDragDrop = MyDBGrid1DragDrop OnDragOver = MyDBGrid1DragOver OnMouseDown = MyDBGrid1MouseDown end object MyDBGrid2: TMyDBGrid Left = 7 Top = 208 Width = 521 Height = 193 DataSource = DataSource2 Row = 1 TabOrder = 1 TitleFont.Charset = DEFAULT_CHARSET TitleFont.Color = clWindowText TitleFont.Height = -11 TitleFont.Name = 'MS Sans Serif' TitleFont.Style = [] OnDragDrop = MyDBGrid1DragDrop OnDragOver = MyDBGrid1DragOver OnMouseDown = MyDBGrid1MouseDown end object Table1: TTable Active = True DatabaseName = 'DBDEMOS' TableName = 'ORDERS' Left = 104 Top = 48 end object DataSource1: TDataSource DataSet = Table1 Left = 136 Top = 48 end object Table2: TTable Active = True DatabaseName = 'DBDEMOS' TableName = 'CUSTOMER' Left = 104 Top = 240 end object DataSource2: TDataSource DataSet = Table2 Left = 136 Top = 240 end end

[001213]

Проблема # 1 - Необходимость двойного нажатия клавиши Tab.

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

Для начала в форме, содержащей табличную сетку, опишем логическую переменную WasInFloater следующим образом:

type
TForm1 = class(TForm) ... ... private { Private declarations } WasInFloater : Boolean; ... ... end;

Затем для компонента LookupCombo напишем обработчик события onEnter, где присвоим переменной WasInFloater значение True. Это позволит нам понять где в данный момент находится фокус.

procedure TForm1.DBLookupCombo1Enter(Sender: TObject);
begin
WasInFloater := True; end;

И, наконец, создаем хитрый обработчик события onKeyUp, позволяющий исправить досадный недостаток.

procedure TForm1.DBGrid1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState); begin
if (Key in [VK_TAB]) and WasInFloater then begin SendMessage(DBGrid1.Handle, WM_KeyDown, Key, 0); WasInFloater := False; end; end;

Данный код реагирует на нажатие клавиши и позволяет в случае, когда фокус передался из имплантированного элемента управления табличной сетеке, вторично эмулировать нажатие клавиши Tab (передается код нажатой клавиши, т.е. Tab). Это работает как для отдельной клавиши Tab, так и для комбинации Shift-Tab.

Проблема #2 - Новая запись исчезает, когда компонент получает фокус.

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

По-моему, Borland неправильно поступил, назначив такое значение по умолчанию, флаг должен иметь значение False. Я все время сталкиваюсь с данной проблемой, да и не только я, судя по новостным конференциям. Данная опция действует в случае потери компонентом фокуса и отменяет последние результаты редактирования. Во всяком случае во всех моих проектах я первым делом сбрасываю данный флаг.

[000065]

Работа с несколькими записями

DBGrid не отображает графические поля. Тем не менее вы можете решить эту задачу программным путем. Один из методов заключается в следующем: на форме располагаются несколько компонентов TTable со ссылкой на одну и ту же таблицу, и несколько компонентов DBImage, связанные с компонентами TTable. Основная идея заключается в синхронизации позиции курсора, управляемым пользователем. Для этого мы применим компонент DBNavigator, который заботится о перемещении в первую таблицу и запишем код для обработчика события навигатора OnClick для позиционирования указателя записи для других объектов. Для воссоздания примера выполните следующее:

Расположите на форме три компонента TTable с именами Table1, Table2, и Table3 соответственно Расположите на форме три компонента DataSources и свяжите их с Table1..Table3 Расположите на форме три компонента DBImage и свяжите их с DataSource1..DataSource3, все они будут иметь одно и тоже значение свойства DataField. Расположите на форме компонент DBNavigator и свяжите его с DataSource1. Создайте процедуру как показано ниже:

procedure InitPosition ;
begin
{ Начальная позиция } Form1.Table2.Active := TRUE ; Form1.Table3.Active := TRUE ; if Form1.Table1.RecordCount > 1 then Form1.Table2.MoveBy(1) ; if Form1.Table2.RecordCount > 2 then Form1.Table3.MoveBy(2) ; end ;

В обработчике события Form.OnShow вызовите InitPosition. В обработчике события OnClick компонента DBNavigator создайте следующий код:

procedure TForm1.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
begin
case button of nbNext : begin if not Table2.Eof then Table2.Next ; if Table2.Eof then Table2.Active := FALSE ; if not Table3.Eof then Table3.Next ; if Table3.Eof then Table3.Active := FALSE ; end ; nbPrior : begin if not Table2.Bof then Table2.Prior ; if not Table3.Bof then Table3.Prior ; end ; nbFirst : InitPosition ; nbLast : begin Table2.Active := FALSE; Table3.Active := FALSE; end ; end ; end;

Данный метод отображает на форме три графических поля. Пожалуйста имейте в виду, что вышеуказанный код НЕ завершен и требует доработки. Кроме того, я уверен, что существуют другие, не худшие решения.

OAmiry/Borland [000371]

Решение проблемы передачи фокуса TDBGrid

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

Относится ко всем версиям Delphi

Очевидно, DBGrid имеет некоторые проблемы с управлением фокусом, если он находится на дочерней MDI-форме. Эта проблема решена в приведенном ниже наследнике TDBGrid, в котором обрабатываются мышиные сообщения и выясняется когда фокус должен быть передан сетке. Наследник создан в виде компонента, который легко устанавливается в Палитру Компонентов. Примечание: код адаптирован для всех версий Delphi. Проблемы могут быть в Delphi 2 и 3, если вы забудете заменить устаревшие в этих версиях модули "winprocs" и "wintypes" на "windows."

unit FixedDBGrid;

interface

uses
Winprocs,wintypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids;
type
TFixedDBGrid = class(TDBGrid) private { Private declarations } protected { Protected declarations } public { Public declarations } procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; published { Published declarations } end;
procedure Register;

implementation

procedure TFixedDBGrid.WMRButtonDown(var Message: TWMRButtonDown);
begin
winprocs.SetFocus(handle); {помните, что winprocs относится только к Delphi 1!} inherited; end;
procedure TFixedDBGrid.WMLButtonDown(var Message: TWMLButtonDown);
begin
winprocs.SetFocus(handle); {помните, что winprocs относится только к Delphi 1!} inherited; end;
procedure Register;
begin
RegisterComponents('Samples', [TFixedDBGrid]); end;

end.

[001342]

Ревизия

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

Рисование текста в DBGrid I

Следующий метод может быть использован в качестве обработчика события TDBGrid.OnDrawDataCell. Он демонстрирует способ рисования текста в колонке цветом, отличным от цвета текста в остальной части табличной сетки.

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);
{ ПРИМЕЧАНИЕ: Свойство DefaultDrawing компонента Grid должно быть установлено в False }
begin
{ если имя поля - "NAME" } if Field.FieldName = 'NAME' then { изменяем цвет шрифта на красный } (Sender as TDBGrid).Canvas.Font.Color := clRed; { выводим текст в табличной сетке } (Sender as TDBGrid).Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2,Field.AsString); end;

[000591]

Рисование текста в DBGrid II

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

Вам необходимо обработать событие OnDrawDataCell, например так:

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState); begin if Field.FieldName = 'SERIAL' then if (Field as TStringField).Value = 'НЕИЗВЕСТНО' then with (Sender as TDBGrid).Canvas do begin Brush.Color := clRed; Font.Style := [fsItalic]; Font.Color := clAqua; FillRect(Rect); TextOut(Rect.Left, Rect.Top, Field.AsString); end; end;

....BTW, выключите DefaultDrawing.

Eryk [000673]

Симуляция нажатия кнопки при наличии DBGrid

В случае нажатия клавиши Enter, клавиша по умолчанию не срабатывает, если у вас на форме расположен компонент DBGrid, но вы можете создать обработчик события DBGrid OnKeypUp, уведомляющий кнопку по умолчанию о ее "нажатии" при реальном нажатии клавиши Enter. Пример:

{Код DBGrid OnKeyUp. Default-кнопка - BitBtn1.}
if Key = VK_RETURN then
begin PostMessage(BitBtn1.Handle, WM_LBUTTONDOWN, Word(0), LongInt(0)) ; PostMessage(BitBtn1.Handle, WM_LBUTTONUP, Word(0), LongInt(0)) ; end ;

OAmiry/Borland [000608]

Сохранение и восстановление конфигурации DBGRID

Данный совет рассказывает о возможности сохранения и восстановления порядка колонок после изменения его пользователем (воспользовавшись, например, функцией drag and grop - перетащи и брось).

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

Код содержит интуитивно понятные комментарии и строки на шведском языке, нецелесообразные для перевода.

procedure TMainForm.NewIni(const NomeIni: string);
var F: System.Text;
i: Byte; begin
System.Assign(F, NomeIni); System.ReWrite(F); System.WriteLn(F, '[Campi_Ordine]'); for i:=1 to Table1.FieldCount do System.WriteLn(F, 'Campo',i,'=',Table1.Fields[i-1].FieldName); System.WriteLn(F, ''); System.WriteLn(F, '[Campi_Size]'); for i:=1 to Table1.FieldCount do System.WriteLn(F, 'Campo',i,'=',Table1.Fields[i-1].DisplayWidth); System.Close(F); end;

procedure TMainForm.SaveIni(const FN: String);
var Ini: TIniFile;
i: Integer; begin
NewIni(FN); Ini := TIniFile.Create(FN); with Ini do begin for i:=1 to Table1.FieldCount do begin S:= Table1.Fields[i-1].FieldName; WriteString('Campi_Ordine', 'Campo'+IntToStr(i), Table1.Fields[i-1].FieldName); WriteInteger('Campi_Size', 'Campo'+IntToStr(i), Table1.Fields[i-1].DisplayWidth); end; end; Ini.Free; end;

procedure TMainForm.LoadIni(const FN: String);
var Ini: TIniFile;
i: Integer; j: Longint; S: String;
function MyReadInteger(const Section, Ident: string): Longint; begin result := Ini.ReadInteger(Section, Ident, -1); if result=-1 then raise Exception.Create('Errore nel file di configurazione.'); end;
function MyReadString(const Section, Ident: string): String; begin result := Ini.ReadString(Section, Ident, ''); if result='' then raise Exception.Create('Errore nel file di configurazione.'); end;
begin
Ini := TIniFile.Create(FN); try with Ini do begin for i:=1 to Table1.FieldCount do begin S:= MyReadString('Campi_Ordine', 'Campo'+IntToStr(i)); j:= MyReadInteger('Campi_Size', 'Campo'+IntToStr(i)); Table1.FieldByName(S).Index := i-1; Table1.FieldByName(S).DisplayWidth := j; end; end; finally Ini.Free; end; end;

[000070]

Сортировка колонок в DBGrid

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

Главное препятствие в решении задачи - сам DBGrid. Проблема в отсутствии событий OnClick или OnMouseDown, позволяющие реагировать на элементарные манипуляции с заголовком. Правда, существует событие OnDoubleClick, но для данной цели оно не слишком изящно. Все что нам нужно - сделать заголовок, реагирующий на однократный щелчок мышью. Обратимся к компоненту THeaderControl.

THeaderControl - компонент, введенный в палитру еще в Delphi 2.0 и обеспечивающий необходимые нам функции. Главное достоинство - реакция компонента при щелчке на отдельных панелях, панели также обеспечивают визульное отображение подобно кнопке (могут вдавливаться и отжиматься). Нам необходимо "прикрутить" THeaderControl к DBGrid. Вот как это сделать:

Во-первых, создайте новое приложение. Положите THeaderControl на форму. Он автоматически выровняется по верхнему краю формы. Затем поместите на форму DBGrid и присвойте свойству Align значение alClient. Затем добавьте компоненты TTable и TDataSource. В компоненте TTable присвойте свойству DatabaseName значение DBDEMOS, а свойству TableName значение EVENTS.DB. В TDataSource укажите в свойстве DataSet на компонент Table1, а в TDBGrid в свойстве DataSource на DataSource1. Если свойство Active компонента TTable было неактивно, включите его (значение True). Теперь немного поколдуем!

Сделаем так, чтобы компонент THeaderControl выглядел похожим на заголовок компонента DBGrid. Произведем необходимые манипулиции в момент создания формы. Дважды щелкните на событии OnCreate формы и введите следующий код:

procedure TForm1.FormCreate(Sender: TObject);
var
TheCap : String; TheWidth,a : Integer; begin
DBGrid1.Options := DBGrid1.Options - [dgTitles]; HeaderControl1.Sections.Add; HeaderControl1.Sections.Items[0].Width := 12; Table1.Exclusive := True; Table1.Active := True; For a := 1 to DBGrid1.Columns.Count do begin with DBGrid1.Columns.Items[a-1] do begin TheCap := Title.Caption; TheWidth := Width; end; with HeaderControl1.Sections do begin Add; Items[a].Text := TheCap; Items[a].Width := TheWidth+1; Items[a].MinWidth := TheWidth+1; Items[a].MaxWidth := TheWidth+1; end; try Table1.AddIndex(TheCap,TheCap,[]); except HeaderControl1.Sections.Items[a].AllowClick := False; end; end; Table1.Active := False; Table1.Exclusive := False; Table1.Active := True; end;

После того как THeaderControl заменил стандартный заголовок DBGrid, в первую очередь мы сбрасываем (устанавливаем в False) флаг dgTitles в свойстве Options компонента DBGrid. Затем мы добавляем колонку в HeaderControl и устанавливаем ее ширину, равную 12. Это будет пустой колонкой, которая имеет ту же ширину, что и левая колонка статуса в DBGrid.

Затем нужно убедиться что таблица открыта для эксклюзивного доступа (никакие другие пользователи использовать ее не смогут). Причину я объясню немного позже.

Теперь добавляем секции в HeaderControl. Для каждой добавленной колонки мы создаем в заголовке тот же текст, что и в соответствующей колонке DBGrid. В цикле мы проходим по всем колонкам DBGrid и повторяем текст заголовка колонки и его высоту. Мы также устанавливаем для HeaderControl значения свойств MinWidth и MaxWidth, равными ширине соответствующей колонки в DBGrid. Это предохранит колонки от изменения их ширины. Для изменяющих размер колонок нужно дополнительное кодирование, и я решил не лишать Вас этого удовольствия.

Теперь самое интересное. Мы собираемся создать индекс для каждой колонки в DBGrid. Имя индекса будет таким же, как и название колонки. Данный код мы должны заключить в конструкцию try..finally, поскольку существуют некоторые поля, которые не могут быть проиндексированы (например, Blob- и Memo-поля). При попытке индексации этих полей генерится исключительная ситуация. Мы перехватываем это исключение и недопускаем возможности щелчка на данной колонке. Это означает, что колонки, содержащие неиндексированные поля, не будут реагировать на щелчок мышью. Создание этих индексов служит объяснением тому, почему таблица должна быть открыта в режиме эксклюзивного доступа. И в заключение мы закрываем таблицу, сбрасываем флаг эксклюзивности и снова делаем таблицу активной.

Последний шаг. При щелчке на HeaderControl нам необходимо включить правильный индекс таблицы. Создадим обработчик события OnSectionClick компонента HeaderControl как показано ниже:

procedure TForm1.HeaderControl1SectionClick(
HeaderControl: THeaderControl; Section: THeaderSection); begin
Table1.IndexName := Section.Text; end;

Это все! После щелчка на заголовке колонки значение свойства таблицы IndexName становится равным заголовку компонента HeaderControl.

Просто и красиво, да? Тем не менее есть масса мест, требующих улучшения. К примеру, вторичный щелчок должен возобновлять порядок сортировки. Или возможность изменения размера самих колонок. Попробуйте сами, это не сложно!

TDBGrid CutToClipboard

Внутри TDBGrid "зашит" защищенный (protected) элемент управления типа TInPlaceEdit, потомок TCustomMaskEdit. Данный элемент управляется комбинацией клавиш [Shift]+[Ins] и [Shift]+[Del]. Но для нас не существует способа оперировать элементом, поскольку он является защищенным членом.

Да, но вы можете сделать это обманным путем. Попробуйте так:

procedure TForm1.Paste1Click(Sender: TObject); begin SendMessage(GetFocus, WM_PASTE, 0, 0); end;
procedure TForm1.Copy1Click(Sender: TObject); begin SendMessage(GetFocus, WM_COPY, 0, 0); end;

Эти методы привязаны к вашим пунктам меню. Они посылают сообщение окну с текущим фокусом. Если это элемент управления TInPlaceEdit, то мы добились того, чего хотели.

Kurt Barthelmess [000740]

TDBGrid и вертикальная полоса прокрутки I

...существует несколько причин для такого поведения. Давайте быть последовательными. Delphi может иметь связь с различными базами данных, движками, и связываться с таблицами различных размеров. Можно представить себе движок, который должен передавать позицию в базе данных достаточно реалистичным способом, чтобы можно было понять при этом примерное количество записей. Тем не менее, поскольку методы доступа отличаются друг от друга весьма сильно, то такую информацию подчас получить очень трудно или долго. Таким образом, как мне сообщили, Borland не собирается реализовывать такое поведение.

Если у вас есть исходный код компонента, можно унаследоваться от него и создать свое поведение... [001613]

TDBGrid и вертикальная полоса прокрутки II

...что ж, и да, и нет. Проблема неверного позиционирования полосы прокрутки заключается в том, что не все форматы данных (фактически никто) имеют поддержку порядковых номеров записей. Другими словами, в таблице не существует уникального идентификатора, определяющего в каком месте таблицы должна быть расположена запись. Например, в таблицах dBase записи имеют recNo, основанный на порядке их ввода. Если вы построите индекс на основе этого поля, то увидите, что все числа не имеют ничего общего с нумерацией. С другой стороны, SQL-таблицы и запросы никогда не слышали о порядке записей, да и этого никогда не будет. Таблицы Paradox единственные, которые включают логический порядок сортировки номеров в каждом индексе, который они создают. По какой-то, сугубо внутренней причине, Borland выбрал такое поведение вертикальной полосы прокрутки, которое не зависит от того, используете вы таблицы Paradox, или нет. Вы можете обойти это, выключив интегрированные полоски прокрутки и используя вместо них компонент TScrollBar, тем самым позволяя задать его поведение таким, каким вы его хотите видеть. [001638]

Добавьте все поля для Table1,

Как создать lookup-поле в TDBGrid для Delphi 2.0 Разместите на форме 2 компонента TTable, 1 компонент TDataSource и 1 - TDBGrid. Подключите Table1 - к DataSource1 - к DBGrid1 DataSource1.DataSet = Table1 DBGrid1.DataSource = DataSource1 Установка Table1 Table1.Database = DBDemos Table1.TableName = Customer Table1.Active = True Установка Table2 Table2.Database = DBDemos Table2.TableName = Orders Table2.Active = True Добавьте все поля для Table1, используя Fields Editor (редактор полей): Дважды щелкните на Table1 Нажмите правую кнопку мыши в редакторе полей Выберите пункт Add New Fields. Добавьте их все. Добавьте новое поле для Table1. Нажмите правую кнопку мыши в редакторе полей и выберите пункт "New Field". Определите следующие параметры для вновь добавленного поля: Name: Bob Type: String Size: 30 Select Lookup Key Fields: CustNo - Поле в Table1 для хранения значения DataSet: Table2 - Здесь устанавливается табличный lookup LookUpKeys: CustNo - Данный ключ копируется в KeyField Result Field: OrderNo - Значение для показа пользователю в выпадающем списке Запустите приложение [001023]

TDBGrid - поддержка одинарного щелчка

Есть какой-либо способ отследить событие одинарного щелчка на компоненте TDBGrid?

Нет. Вы должны взять объект, поддерживающий данное событие (типа tStringGrid) и добавить поддержку данных (смотри главу 12 руководства по созданию компонентов), или взять tDBGrid и добавить событие OnMouseDown (смотри главу 4 руководства по созданию компонентов). [000331]