unit ExtProc;
  { пример, как в DBGrid работает раскраска строк/ячеек,
    перезагрузка строк (в случае изменения значений DataSet в другом месте)
    без смещения этих строк  }
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables, ComCtrls, ShellAPI,
  DBCtrls, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    QueryMain: TQuery;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    DataSource1: TDataSource;
    DBNavigator1: TDBNavigator;
    BtnEdit: TBitBtn;
    BtnAdd: TBitBtn;
    BtnDel: TBitBtn;
    BtnHelp: TBitBtn;
    procedure FormShow(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure MnHelpClick(Sender: TObject);
    procedure BtnEditClick(Sender: TObject);
    procedure BtnAddClick(Sender: TObject);
    procedure BtnDelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  public
    procedure UpdateDBGrid1(ID,NRow:integer; Stat:byte);
  end;

  function ActiveRow(DBGrid:TDBGrid):integer;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses EditForm;

type
  TXDBGrid = class(TDBGrid);  // чтобы глубже залезть в DBGrid

var WorkPath: string;

procedure TForm1.FormShow(Sender: TObject);
var s:string;
begin
    // можно внутри программы использовать свой формат даты
  DateSeparator:= '.';
  ShortDateFormat:= 'dd/mm/yyyy';
    // если готовить Panels, то здесь - в FormActivate это делать уже нельзя -
    // могут быть повторные вызовы Activate
  StatusBar1.Panels.Add;
  StatusBar1.Panels.Add;
  StatusBar1.Panels[0].Width:= 100;
  Application.OnMessage:= AppMessage; // чтобы задействовать колесико мышки
  WorkPath:= ExtractFilePath(Application.ExeName);
  s:= WorkPath + 'Primer.db';
  if not FileExists(s) then begin
    with TTable.Create(nil) do begin
      TableName:= s;
      with FieldDefs do begin
        Clear;
        Add('ID', ftAutoInc,0);
        Add('NAME', ftString,50);
        Add('SALDO', ftCurrency, 0); // сальдо
      end;
      CreateTable;
      Free
    end; { with TTable }
  end;
  QueryMain.Close;
  QueryMain.SQL.Clear;
  QueryMain.SQL.Add('SELECT * FROM "' + s + '" ORDER BY NAME');
  QueryMain.Open;
  StatusBar1.Panels[0].Text:= ' Primer.db';
  StatusBar1.Panels[1].Text:=
    ' Всего записей - ' + IntToStr(QueryMain.RecordCount);
  Form2.Table1.TableName:= s;
end;

    { ---- Раскраска строки (с отрицательным сальдо) ---- }

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  s: string; k: integer; ColumnSaldo, NeedDraw: boolean;
begin
    // раскраска ячеек с отрицательным сальдо
  if not QueryMain.Active then exit;  // на в.с.
  with DBGrid1.Canvas do begin
    NeedDraw:= false;  // пока раскрашивать не надо
    ColumnSaldo:= Column.Field.FieldName = 'SALDO';
    if ColumnSaldo then
      NeedDraw:= Column.Field.AsCurrency < 0;
    if not NeedDraw and not(gdSelected in State) then
      exit;  // - ничего раскрашивать не надо
    if gdSelected in State then begin
       // выделенную строку раскрашиваем сами, но можно и пропустить -
       // тогда - выйти, если NeedDraw = false
      Brush.Color := clBlue; // цвет ячейки
      FillRect(Rect); // - если ячейку закрашивать
    end;
    if NeedDraw then begin
      Font.Color:= $0050C8;  // red
      Font.Style := Font.Style + [fsBold];
    end;
        // цвет есть, теперь - текст
    s:= Column.Field.DisplayText;
        // положение
    case Column.Alignment of
       taLeftJustify: k:= Rect.Left + 2;
      taRightJustify: k:= Rect.Right - TextWidth(s) - 3;
                else  // taCenter
           k:= Rect.Left + (Rect.Right - Rect.Left) shr 1
           - (TextWidth(s) shr 1);
    end;
    TextRect(Rect, k, Rect.Top + 2, s);
  end;
end;

  { ----- № строки в DBGrid с текущей записью (нач. с 0) ------ }
     // если есть строка Title, то реальная строка в DBGrid на 1 больше
function ActiveRow(DBGrid:TDBGrid):integer;
begin
  Result:= TXDBGrid(DBGrid).DataLink.ActiveRecord
end;

            { ----  Обновление DBGrid1  ---- }

procedure TForm1.UpdateDBGrid1(ID,NRow:integer; Stat:byte);
  // Stat = 0 - Add, 1 - Edit, 2 - Delete;
  // ID - куда курсор ставить (in DataSet); при Delete значение ID не важно
var
  k0,r0, R, RCount: integer; FindRec:boolean;
  // поскольку рассм. R <> NRow, то dgTitles не влияет
begin
  DBGrid1.DataSource.DataSet.DisableControls;
  RCount:= TXDBGrid(DBGrid1).VisibleRowCount; // ! кол-во рабочих строк в DBGrid
  QueryMain.Next;                        { выясняем ближ. номер на случай }
  if QueryMain.Eof then QueryMain.Prior; { исчезновения записи из SELECT }
  k0:= QueryMain.Fields[0].AsInteger;    // ключ ID
   // перезагрузка данных
  QueryMain.Close; QueryMain.Open;
  if QueryMain.RecordCount > 0 then begin
    if Stat = 2 then FindRec:= false
    else FindRec:= QueryMain.Locate('ID', ID, []);
    if not FindRec then
      FindRec:= QueryMain.Locate('ID', k0, []);
    if FindRec then
      if Stat > 0 then begin
        R:= ActiveRow(DBGrid1); // обычно это середина списка
        if R <> NRow then begin
          if NRow < R then dec(NRow, RCount - 1); // верхняя половина списка
          r0:= QueryMain.MoveBy(-NRow);  // туда
          QueryMain.MoveBy(-r0);      // обратно
        end;
      end;
  end;
  DBGrid1.DataSource.DataSet.EnableControls;
  StatusBar1.Panels[1].Text:=
      ' Всего записей - ' + IntToStr(QueryMain.RecordCount);
end; { UpdateDBGrid1 }

{ -- Задействовать полностью колесико мышки (MouseWheel) -- }

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  i: SmallInt;
begin
  if Msg.message = WM_MOUSEWHEEL then
  begin
     Msg.message:= WM_KEYDOWN;
     Msg.lParam:= 0;
     i:= HiWord(Msg.wParam);
     if i > 0 then
       Msg.wParam:= VK_UP
     else
       Msg.wParam:= VK_DOWN;
     Handled:= False;
  end;
{ в теле программы:
  Application.OnMessage:= AppMessage; }
end;

      { ---- Изменить запись ---- }

procedure TForm1.BtnEditClick(Sender: TObject);
begin
  if QueryMain.RecordCount = 0 then
    Form2.Tag:= 0  // переведем на ввод новой записи
  else Form2.Tag:= 1; // признак редактирования - для Form2
  Form2.ShowModal;
end;

      { ---- Добавить новую запись ---- }

procedure TForm1.BtnAddClick(Sender: TObject);
begin
  Form2.Tag:= 0;
  Form2.ShowModal;
end;

      { ---- Удаление записи ---- }

procedure TForm1.BtnDelClick(Sender: TObject);
var NRow:integer;
begin
  if QueryMain.RecordCount = 0 then exit;
  if Application.MessageBox('Удалить выделенную запись?', PChar(Caption),
     MB_ICONQUESTION + MB_YESNO) = mrNO then exit;
  NRow:= ActiveRow(DBGrid1);
  with TQuery.Create(nil) do begin
    SQL.Clear;
    SQL.Add('DELETE FROM "' + WorkPath + 'Primer.db"');
    SQL.Add('WHERE ID=' + QueryMain.Fields[0].AsString);
    ExecSQL;
    Free;
  end;
  UpdateDBGrid1(0,NRow,2);
end;

      { ---- Вызов справочника-инструкции ---- }

procedure TForm1.MnHelpClick(Sender: TObject);
var h:hWnd; HelpF:string;
begin
  HelpF:= ExtractFilePath(ParamStr(0)) + 'Manual.hlp';
  if not FileExists(HelpF) then begin
    Application.MessageBox('Нет соответствующего help-файла',
     ' Ошибка открытия файла', MB_ICONSTOP);
    exit
  end;
  h:=0;
  ShellExecute(h, 'open', PChar(HelpF), nil, nil, SW_SHOW)
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  QueryMain.Close;
end;

end.