
{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{                                                       }
{       Copyright (c) 1995 Borland International        }
{                                                       }
{*******************************************************}

unit DBGrids;

interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Controls, Forms,
  Graphics, Menus, StdCtrls, DB, DBTables, Grids, DBCtrls;

type
  TCustomDBGrid = class;

  TGridDataLink = class(TDataLink)
  private
    FGrid: TCustomDBGrid;
    FFieldCount: Integer;
    FFieldMapSize: Integer;
    FModified: Boolean;
    FInUpdateData: Boolean;
    FFieldMap: Pointer;
    function GetDefaultFields: Boolean;
    function GetFields(I: Integer): TField;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure DataSetScrolled(Distance: Integer); override;
    procedure EditingChanged; override;
    procedure LayoutChanged; override;
    procedure RecordChanged(Field: TField); override;
    procedure UpdateData; override;
  public
    constructor Create(AGrid: TCustomDBGrid);
    destructor Destroy; override;
    function AddMapping(const FieldName: string): Boolean;
    procedure ClearMapping;
    procedure Modified;
    procedure Reset;
    property DefaultFields: Boolean read GetDefaultFields;
    property FieldCount: Integer read FFieldCount;
    property Fields[I: Integer]: TField read GetFields;
  end;

  TDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
    dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,
    dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit);
  TDBGridOptions = set of TDBGridOption;
  TDrawDataCellEvent = procedure (Sender: TObject; const Rect: TRect; Field: TField;
    State: TGridDrawState) of object;

  TCustomDBGrid = class(TCustomGrid)
  private
    FIndicators: TImageList;
    FTitleFont: TFont;
    FTitleColor: TColor;
    FReadOnly: Boolean;
    FConnected: Boolean;
    FUserChange: Boolean;
    FDataChanged: Boolean;
    FEditRequest: Boolean;
    FUpdatingColWidths: Boolean;
    FOptions: TDBGridOptions;
    FTitleOffset, FIndicatorOffset: Byte;
    FUpdateLock: Byte;
    FInColExit: Boolean;
    FDefaultDrawing: Boolean;
    FSelfChangingTitleFont: Boolean;
    FSelRow: Integer;
    FDataLink: TGridDataLink;
    FOnColEnter: TNotifyEvent;
    FOnColExit: TNotifyEvent;
    FOnDrawDataCell: TDrawDataCellEvent;
    FEditText: string;
    function AcquireFocus: Boolean;
    procedure DataChanged;
    procedure EditingChanged;
    function Edit: Boolean;
    function GetDataSource: TDataSource;
    function GetFieldCount: Integer;
    function GetFields(Index: Integer): TField;
    function GetSelectedField: TField;
    function GetSelectedIndex: Integer;
    procedure MoveCol(ACol: Integer);
    procedure RecordChanged(Field: TField);
    procedure SetDataSource(Value: TDataSource);
    procedure SetOptions(Value: TDBGridOptions);
    procedure SetSelectedField(Value: TField);
    procedure SetSelectedIndex(Value: Integer);
    procedure SetTitleFont(Value: TFont);
    procedure TitleFontChanged(Sender: TObject);
    procedure UpdateData;
    procedure UpdateActive;
    procedure UpdateScrollBar;
    procedure UpdateRowCount;
    procedure CMExit(var Message: TMessage); message CM_EXIT;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  protected
    FUpdateFields: Boolean;
    FAcquireFocus: Boolean;
    procedure LayoutChanged; virtual;
    function CanEditAcceptKey(Key: Char): Boolean; override;
    function CanEditModify: Boolean; override;
    function GetEditLimit: Integer; override;
    procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
    procedure ColEnter; dynamic;
    procedure ColExit; dynamic;
    procedure Scroll(Distance: Integer); virtual;
    procedure ColWidthsChanged; override;
    function HighlightCell(DataCol, DataRow: Integer; const Value: string;
      AState: TGridDrawState): Boolean; virtual;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    function GetEditMask(ACol, ARow: Longint): string; override;
    function GetEditText(ACol, ARow: Longint): string; override;
    procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
    function GetColField(ACol: Integer): TField;
    function GetFieldValue(ACol: Integer): string;
    procedure DefineFieldMap; virtual;
    procedure DrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState); dynamic;
    procedure SetColumnAttributes; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure LinkActive(Value: Boolean); virtual;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure TimedScroll(Direction: TGridScrollDirection); override;
    procedure CreateWnd; override;
    property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DataLink: TGridDataLink read FDataLink;
    property Options: TDBGridOptions read FOptions write SetOptions
      default [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines,
      dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
    property ParentColor default False;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property TitleColor: TColor read FTitleColor write FTitleColor default clBtnFace;
    property TitleFont: TFont read FTitleFont write SetTitleFont;
    property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
    property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
    property OnDrawDataCell: TDrawDataCellEvent read FOnDrawDataCell write FOnDrawDataCell;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DefaultDrawDataCell(const Rect: TRect; Field: TField; State: TGridDrawState);
    property EditorMode;
    property FieldCount: Integer read GetFieldCount;
    property Fields[Index: Integer]: TField read GetFields;
    property SelectedField: TField read GetSelectedField write SetSelectedField;
    property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
  end;

  TDBGrid = class(TCustomDBGrid)
  public
    property Canvas;
  published
    property Align;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DataSource;
    property DefaultDrawing;
    property DragCursor;
    property DragMode;
    property Enabled;
    property FixedColor;
    property Font;
    property Options;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property TitleFont;
    property Visible;
    property OnColEnter;
    property OnColExit;
    property OnDrawDataCell;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  end;

implementation

uses DBConsts, Consts, Dialogs;

{$R DBGRIDS.RES}

const
  bmArrow = 'DBGARROW';
  bmEdit = 'DBEDIT';
  bmInsert = 'DBINSERT';

  MaxMapSize = 65520 div SizeOf(Integer);

var
  ClickSpeed: Integer;

{ Error reporting }

procedure RaiseGridError(const S: string);
begin
  raise EInvalidGridOperation.Create(S);
end;

procedure GridError(S: Word);
begin
  RaiseGridError(LoadStr(S));
end;

procedure GridErrorFmt(S: Word; const Args: array of const);
begin
  RaiseGridError(FmtLoadStr(S, Args));
end;

{ TGridDataLink }

type
  TIntArray = array[0..MaxMapSize] of Integer;
  PIntArray = ^TIntArray;

constructor TGridDataLink.Create(AGrid: TCustomDBGrid);
begin
  inherited Create;
  FGrid := AGrid;
end;

destructor TGridDataLink.Destroy;
begin
  ClearMapping;
  inherited Destroy;
end;

function TGridDataLink.GetDefaultFields: Boolean;
begin
  Result := True;
  if DataSet <> nil then Result := DataSet.DefaultFields;
end;

function TGridDataLink.GetFields(I: Integer): TField;
begin
  if I < FFieldCount then
    Result := DataSet.Fields[PIntArray(FFieldMap)^[I]];
end;

function TGridDataLink.AddMapping(const FieldName: string): Boolean;
var
  Field: TField;
  NewSize: Integer;
  NewMap: Pointer;
begin
  if FFieldCount >= MaxMapSize then GridError(STooManyColumns);
  Field := DataSet.FieldByName(FieldName);
  Result := Field <> nil;
  if Result then
  begin
    if FFieldMapSize = 0 then
    begin
      FFieldMapSize := 8;
      GetMem(FFieldMap, FFieldMapSize * SizeOf(Integer));
    end
    else if FFieldCount = FFieldMapSize then
    begin
      NewSize := FFieldMapSize;
      Inc(NewSize, NewSize);
      if (NewSize > MaxMapSize) or (NewSize < FFieldCount) then
        NewSize := MaxMapSize;
      GetMem(NewMap, NewSize * SizeOf(Integer));
      Move(FFieldMap^, NewMap^, SizeOf(Integer) * FFieldCount);
      FreeMem(FFieldMap, SizeOf(Integer) * FFieldCount);
      FFieldMapSize := NewSize;
      FFieldMap := NewMap;
    end;
    PIntArray(FFieldMap)^[FFieldCount] := Field.Index;
    Inc(FFieldCount);
  end;
end;

procedure TGridDataLink.ActiveChanged;
begin
  FGrid.LinkActive(Active);
end;

procedure TGridDataLink.ClearMapping;
begin
  if FFieldMap <> nil then
  begin
    FreeMem(FFieldMap, FFieldMapSize * SizeOf(Integer));
    FFieldMapSize := 0;
    FFieldCount := 0;
  end;
end;

procedure TGridDataLink.Modified;
begin
  FModified := True;
end;

procedure TGridDataLink.DataSetChanged;
begin
  FGrid.DataChanged;
  FModified := False;
end;

procedure TGridDataLink.DataSetScrolled(Distance: Integer);
begin
  FGrid.Scroll(Distance);
end;

procedure TGridDataLink.LayoutChanged;
begin
  FGrid.LayoutChanged;
end;

procedure TGridDataLink.EditingChanged;
begin
  FGrid.EditingChanged;
end;

procedure TGridDataLink.RecordChanged(Field: TField);
begin
  if (Field = nil) or not FInUpdateData then
  begin
    FGrid.RecordChanged(Field);
    FModified := False;
  end;
end;

procedure TGridDataLink.UpdateData;
begin
  FInUpdateData := True;
  try
    if FModified then FGrid.UpdateData;
    FModified := False;
  finally
    FInUpdateData := False;
  end;
end;

procedure TGridDataLink.Reset;
begin
  if FModified then RecordChanged(nil) else Dataset.Cancel;
end;

{ TCustomDBGrid }

var
  DrawBitmap: TBitmap;
  UserCount: Integer;

procedure UsesBitmap;
begin
  if UserCount = 0 then
  begin
    DrawBitmap := TBitmap.Create;
    DrawBitmap.Monochrome := True;
  end;
  Inc(UserCount);
end;

procedure ReleaseBitmap;
begin
  Dec(UserCount);
  if UserCount = 0 then DrawBitmap.Free;
end;

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

procedure WriteText(ACanvas: TCanvas; const ARect: TRect; DX, DY: Integer;
  const Text: string; Format: Word);
var
  S: array[0..255] of Char;
  B, R: TRect;
begin
  if Format = DT_LEFT then
    ExtTextOut(ACanvas.Handle, ARect.Left + DX, ARect.Top + DY, ETO_OPAQUE or
      ETO_CLIPPED, @ARect, StrPCopy(S, Text), Length(Text), nil)
  else if Format = DT_RIGHT then
    with ACanvas do
      ExtTextOut(Handle, ARect.Right - TextWidth(Text) - 3, ARect.Top + DY,
        ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text), Length(Text), nil)
  else
  begin
    with DrawBitmap, ARect do
    begin
      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
      Font := ACanvas.Font;
      Font.Color := clBlack;
      FillRect(B);
      DrawText(Handle, StrPCopy(S, Text), Length(Text), R, Format);
    end;
    with DrawBitmap, ARect do ACanvas.CopyRect(ARect, Canvas, B);
  end;
end;

constructor TCustomDBGrid.Create(AOwner: TComponent);
var
  Bmp: TBitmap;
begin
  inherited Create(AOwner);
  inherited DefaultDrawing := False;
  FAcquireFocus := True;
  Bmp := TBitmap.Create;
  try
    Bmp.Handle := LoadBitmap(HInstance, bmArrow);
    FIndicators := TImageList.Create(Bmp.Width, Bmp.Height);
    FIndicators.AddMasked(Bmp, clWhite);
    Bmp.Handle := LoadBitmap(HInstance, bmEdit);
    FIndicators.AddMasked(Bmp, clWhite);
    Bmp.Handle := LoadBitmap(HInstance, bmInsert);
    FIndicators.AddMasked(Bmp, clWhite);
  finally
    Bmp.Free;
  end;
  FTitleOffset := 1;
  FIndicatorOffset := 1;
  FUpdateFields := True;
  FOptions := [dgEditing, dgTitles, dgIndicator, dgColumnResize,
    dgColLines, dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
  UsesBitmap;
  ScrollBars := ssHorizontal;
  inherited Options := [goFixedHorzLine, goFixedVertLine, goHorzLine,
    goVertLine, goColSizing, goColMoving, goTabs, goEditing];
  inherited RowCount := 2;
  inherited ColCount := 2;
  FDataLink := TGridDataLink.Create(Self);
  Color := clWindow;
  ParentColor := False;
  FTitleFont := TFont.Create;
  FTitleFont.OnChange := TitleFontChanged;
  FTitleColor := clBtnFace;
  FSaveCellExtents := False;
  FUserChange := True;
  FDefaultDrawing := True;
  HideEditor;
end;

destructor TCustomDBGrid.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  FIndicators.Free;
  inherited Destroy;
  ReleaseBitmap;
end;

procedure TCustomDBGrid.DefineFieldMap;
var
  I: Integer;
begin
  with FDatalink.Dataset do
    for I := 0 to FieldCount - 1 do
      with Fields[I] do if Visible then FDatalink.AddMapping(Fieldname);
end;

procedure TCustomDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
  if Assigned(FOnDrawDataCell) then FOnDrawDataCell(Self, Rect, Field, State);
end;

procedure TCustomDBGrid.SetColumnAttributes;
var
  I: Integer;
  CWidth: Integer;
begin
  for I := 0 to FieldCount - 1 do
    with Fields[I] do
    begin
      Canvas.Font := Font;
      CWidth := DisplayWidth * Canvas.TextWidth('0') + 4;
      if dgTitles in Options then
      begin
        Canvas.Font := TitleFont;
        if CWidth < Canvas.TextWidth(DisplayLabel) + 4 then
          CWidth := Canvas.TextWidth(DisplayLabel) + 4;
      end;
      ColWidths[I + FIndicatorOffset] := CWidth;
      TabStops[I + FIndicatorOffset] := not ReadOnly and not Calculated;
    end;
end;

procedure TCustomDBGrid.LayoutChanged;
var
  J: Integer;
begin
  if csLoading in ComponentState then Exit;
  if not HandleAllocated then Exit;
  if FUpdateLock <> 0 then Exit;
  Inc(FUpdateLock);
  try
    FUpdatingColWidths := True;
    try
      J := 0;
      FTitleOffset := 0;
      if dgTitles in Options then FTitleOffset := 1;
      Canvas.Font := Font;
      DefaultRowHeight := Canvas.TextHeight('W') + 2;
      if dgRowLines in Options then
        DefaultRowHeight := DefaultRowHeight + 1;
      if dgTitles in Options then
      begin
        Canvas.Font := FTitleFont;
        RowHeights[0] := Canvas.TextHeight('W') + 4;
      end;
      FIndicatorOffset := 0;
      if dgIndicator in Options then FIndicatorOffset := 1;
      FDatalink.ClearMapping;
      if FDatalink.Active then DefineFieldMap;
      J := FieldCount;
      if J = 0 then J := 1;
      inherited ColCount := J + FIndicatorOffset;
      inherited FixedCols := FIndicatorOffset;
      if dgIndicator in Options then ColWidths[0] := 11;
      UpdateRowCount;
      SetColumnAttributes;
    finally
      FUpdatingColWidths := False;
    end;
    UpdateActive;
    Invalidate;
  finally
    Dec(FUpdateLock);
  end;
end;

procedure TCustomDBGrid.LinkActive(Value: Boolean);
var
  I: Integer;
begin
  if not Value then HideEditor;
  LayoutChanged;
  UpdateScrollBar;
  if Value and (dgAlwaysShowEditor in Options) then ShowEditor;
end;

procedure TCustomDBGrid.CreateWnd;
begin
  inherited CreateWnd;
  LayoutChanged;
  UpdateScrollBar;
end;

function TCustomDBGrid.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

function TCustomDBGrid.CanEditAcceptKey(Key: Char): Boolean;
begin
  Result := FDatalink.Active and (FieldCount > 0) and
    Fields[SelectedIndex].IsValidChar(Key);
end;

function TCustomDBGrid.GetEditLimit: Integer;
begin
  Result := 0;
  if (FieldCount > 0) and (SelectedField is TStringField) then
    Result := TStringField(SelectedField).Size;
end;

function TCustomDBGrid.CanEditModify: Boolean;
begin
  Result := False;
  if not ReadOnly and FDatalink.Active and not FDatalink.Readonly and
    (FieldCount > 0) and Fields[SelectedIndex].CanModify then
  begin
    FDatalink.Edit;
    Result := FDatalink.Editing;
    if Result then FDatalink.Modified;
  end;
end;

function TCustomDBGrid.GetEditMask(ACol, ARow: Longint): string;
begin
  Result := '';
  if FDatalink.Active and (ACol - FIndicatorOffset < FieldCount) then
    Result := Fields[ACol - FIndicatorOffset].EditMask;
end;

function TCustomDBGrid.GetEditText(ACol, ARow: Longint): string;
begin
  Result := '';
  if FDatalink.Active and (ACol - FIndicatorOffset < FieldCount) then
    Result := Fields[ACol - FIndicatorOffset].Text;
  FEditText := Result;
end;

procedure TCustomDBGrid.SetEditText(ACol, ARow: Longint; const Value: string);
begin
  FEditText := Value;
end;

function TCustomDBGrid.GetFieldCount: Integer;
begin
  Result := FDatalink.FieldCount;
end;

function TCustomDBGrid.GetFields(Index: Integer): TField;
begin
  Result := FDatalink.Fields[Index];
end;

procedure TCustomDBGrid.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  LinkActive(FDataLink.Active);
end;

function TCustomDBGrid.GetSelectedField: TField;
begin
  Result := nil;
  if SelectedIndex < FieldCount then Result := Fields[SelectedIndex];
end;

function TCustomDBGrid.GetSelectedIndex: Integer;
begin
  Result := Col - FIndicatorOffset;
end;

procedure TCustomDBGrid.SetSelectedField(Value: TField);
var
  I: Integer;
begin
  for I := 0 to FieldCount - 1 do
    if Fields[I] = Value then SelectedIndex := I;
end;

procedure TCustomDBGrid.SetSelectedIndex(Value: Integer);
begin
  MoveCol(Value);
end;

procedure TCustomDBGrid.DataChanged;
begin
  if not HandleAllocated then Exit;
  UpdateRowCount;
  UpdateScrollBar;
  UpdateActive;
  InvalidateEditor;
  ValidateRect(Handle, nil);
  Invalidate;
end;

procedure TCustomDBGrid.EditingChanged;
begin
  if dgIndicator in Options then InvalidateCell(0, FSelRow);
end;

procedure TCustomDBGrid.RecordChanged(Field: TField);
var
  R: TRect;
  InvBegin, InvEnd: Integer;
begin
  if not HandleAllocated then Exit;
  InvBegin := 0;
  if Field = nil then InvEnd := ColCount - 1 else
  begin
    for InvBegin := 0 to FieldCount - 1 do
      if Fields[InvBegin] = Field then Break;
    InvEnd := InvBegin;
  end;
  R := BoxRect(InvBegin + FIndicatorOffset, Row, InvEnd + FIndicatorOffset,
    Row);
  InvalidateRect(Handle, @R, False);
  if ((Field = nil) or (SelectedField = Field)) and
    (Fields[SelectedIndex].Text <> FEditText) then
  begin
    InvalidateEditor;
    if InplaceEditor <> nil then InplaceEditor.Deselect;
  end;
end;

function TCustomDBGrid.Edit: Boolean;
begin
  Result := False;
  if not ReadOnly then
  begin
    FDataChanged := False;
    FEditRequest := True;
    try
      FDataLink.Edit;
    finally
      FEditRequest := False;
    end;
    Result := FDataChanged;
  end;
end;

procedure TCustomDBGrid.Scroll(Distance: Integer);
var
  OldRect, NewRect: TRect;
  RowHeight: Integer;
begin
  OldRect := BoxRect(0, Row, ColCount - 1, Row);
  UpdateScrollBar;
  UpdateActive;
  NewRect := BoxRect(0, Row, ColCount - 1, Row);
  ValidateRect(Handle, @OldRect);
  InvalidateRect(Handle, @OldRect, False);
  InvalidateRect(Handle, @NewRect, False);
  if Distance <> 0 then
  begin
    HideEditor;
    try
      if Abs(Distance) > VisibleRowCount then
      begin
        Invalidate;
        Exit;
      end
      else
      begin
        RowHeight := DefaultRowHeight;
        if dgRowLines in Options then Inc(RowHeight);
        NewRect := BoxRect(FIndicatorOffset, FTitleOffset, ColCount - 1, 1000);
        ScrollWindow(Handle, 0, -RowHeight * Distance, @NewRect, @NewRect);
        if dgIndicator in Options then
        begin
          OldRect := BoxRect(0, FSelRow, ColCount - 1, FSelRow);
          InvalidateRect(Handle, @OldRect, False);
          NewRect := BoxRect(0, Row, ColCount - 1, Row);
          InvalidateRect(Handle, @NewRect, False);
        end;
      end;
    finally
      if dgAlwaysShowEditor in Options then ShowEditor;
    end;
  end;
  Update;
end;

procedure TCustomDBGrid.TitleFontChanged(Sender: TObject);
begin
  if (not FSelfChangingTitleFont) and not (csLoading in ComponentState) then
    ParentFont := False;
  if dgTitles in Options then LayoutChanged;
end;

procedure TCustomDBGrid.UpdateData;
begin
  if FieldCount > 0 then with Fields[SelectedIndex] do Text := FEditText;
end;

procedure TCustomDBGrid.UpdateActive;
var
  I: Integer;
  NewRow: Integer;
begin
  if FDatalink.Active then
  begin
    NewRow := FDatalink.ActiveRecord + FTitleOffset;
    if Row <> NewRow then
    begin
      if not (dgAlwaysShowEditor in Options) then HideEditor;
      Row := NewRow;
    end;
    if (FieldCount > 0) and (Fields[SelectedIndex].Text <> FEditText) then
      InvalidateEditor;
  end;
end;

function TCustomDBGrid.GetColField(ACol: Integer): TField;
begin
  Result := nil;
  if (ACol >= 0) and FDatalink.Active and (ACol < FDataLink.FieldCount) then
    Result := FDatalink.Fields[ACol];
end;

function TCustomDBGrid.GetFieldValue(ACol: Integer): string;
var
  Field: TField;
begin
  Result := '';
  Field := GetColField(ACol);
  if Field <> nil then Result := Field.DisplayText;
end;

procedure TCustomDBGrid.UpdateScrollBar;
var
  Pos: Integer;
begin
  if FDatalink.Active and HandleAllocated then
    with FDatalink.DataSet do
    begin
      Pos := 2;
      SetScrollRange(Self.Handle, SB_VERT, 0, 4, False);
      if BOF then Pos := 0
      else if EOF then Pos := 4
      else Pos := 2;
      if GetScrollPos(Self.Handle, SB_VERT) <> Pos then
        SetScrollPos(Self.Handle, SB_VERT, Pos, True);
    end;
end;

procedure TCustomDBGrid.UpdateRowCount;
begin
  if RowCount <= FTitleOffset then RowCount := FTitleOffset + 1;
  FixedRows := FTitleOffset;
  with FDataLink do
    if not Active or (RecordCount = 0) then
      RowCount := 1 + FTitleOffset
    else
    begin
      RowCount := 1000;
      FDataLink.BufferCount := VisibleRowCount;
      RowCount := RecordCount + FTitleOffset;
      UpdateActive;
    end;
end;

function TCustomDBGrid.AcquireFocus: Boolean;
begin
  Result := True;
  if FAcquireFocus and CanFocus and not (csDesigning in ComponentState) then
  begin
    SetFocus;
    Result := Focused or (InplaceEditor <> nil) and InplaceEditor.Focused;
  end;
end;

procedure TCustomDBGrid.CMParentFontChanged(var Message: TMessage);
begin
  inherited;
  if ParentFont then
  begin
    FSelfChangingTitleFont := True;
    try
      TitleFont := Font;
    finally
      FSelfChangingTitleFont := False;
    end;
    LayoutChanged;
  end;
end;

procedure TCustomDBGrid.CMExit(var Message: TMessage);
begin
  try
    if FDatalink.Active then
      with FDatalink.Dataset do
        if (dgCancelOnExit in Options) and (State = dsInsert) and
          not Modified and not FDatalink.FModified then
          Cancel else
          FDataLink.UpdateData;
  except
    SetFocus;
    raise;
  end;
  inherited;
end;

procedure TCustomDBGrid.CMFontChanged(var Message: TMessage);
begin
  inherited;
  LayoutChanged;
end;

procedure TCustomDBGrid.CMDesignHitTest(var Msg: TCMDesignHitTest);
begin
  inherited;
  if Msg.Result = 0 then
    with MouseCoord(Msg.Pos.X, Msg.Pos.Y) do
      if (X >= FIndicatorOffset) and (Y < FTitleOffset) then Msg.Result := 1;
  if (Msg.Result = 1) and ((FDataLink = nil) or FDataLink.DefaultFields or
    not FDataLink.Active) then
    Msg.Result := 0;
end;

procedure TCustomDBGrid.WMSetCursor(var Msg: TWMSetCursor);
begin
  if (csDesigning in ComponentState) and ((FDataLink = nil) or
    FDataLink.DefaultFields or not FDataLink.Active) then
    WinProcs.SetCursor(LoadCursor(0, IDC_ARROW))
  else inherited;
end;

procedure TCustomDBGrid.WMSize(var Message: TWMSize);
begin
  inherited;
  if FUpdateLock = 0 then UpdateRowCount;
end;

procedure TCustomDBGrid.WMVScroll(var Message: TWMVScroll);
begin
  if not AcquireFocus then Exit;
  if FDatalink.Active then
    with Message, FDataLink.DataSet, FDatalink do
      case ScrollCode of
        SB_LINEUP: MoveBy(-ActiveRecord - 1);
        SB_LINEDOWN: MoveBy(RecordCount - ActiveRecord);
        SB_PAGEUP: MoveBy(-VisibleRowCount);
        SB_PAGEDOWN: MoveBy(VisibleRowCount);
        SB_THUMBPOSITION:
          begin
            case Pos of
              0: First;
              1: MoveBy(-VisibleRowCount);
              2: Exit;
              3: MoveBy(VisibleRowCount);
              4: Last;
            end;
          end;
        SB_BOTTOM: Last;
        SB_TOP: First;
      end;
end;

function TCustomDBGrid.HighlightCell(DataCol, DataRow: Integer;
  const Value: string; AState: TGridDrawState): Boolean;
begin
  Result := (gdSelected in AState) and ((dgAlwaysShowSelection in Options) or
    Focused);
end;

procedure TCustomDBGrid.DefaultDrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
const
  Formats: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT,
    DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX);
var
  Alignment: TAlignment;
  Value: string;
begin
  Alignment := taLeftJustify;
  Value := '';
  if Field <> nil then
  begin
    Alignment := Field.Alignment;
    Value := Field.DisplayText;
  end;
  WriteText(Canvas, Rect, 2, 2, Value, Formats[Alignment]);
end;

procedure TCustomDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  OldActive: Integer;
  Indicator: Integer;
  Highlight: Boolean;
  Value: string;

  procedure Display(const S: string; Alignment: TAlignment);
  const
    Formats: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT,
      DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX);
  begin
    WriteText(Canvas, ARect, 2, 2, S, Formats[Alignment]);
  end;

begin
  if gdFixed in AState then
    Canvas.Font := TitleFont else
    Canvas.Font := Font;
  with Canvas do
  begin
    if gdFixed in AState then
      Brush.Color := TitleColor else
      Brush.Color := Color;
    Dec(ARow, FTitleOffset);
    Dec(ACol, FIndicatorOffset);
    if ARow < 0 then
      if (ACol >= 0) and (ACol < FieldCount) then
        Display(Fields[ACol].DisplayLabel, taLeftJustify) else
        Display('', taLeftJustify)
    else if (FDataLink = nil) or not FDataLink.Active then
      FillRect(ARect)
    else if ACol < 0 then
    begin
      FillRect(ARect);
      if ARow = FDataLink.ActiveRecord then
      begin
        Indicator := 0;
        if FDataLink.DataSet <> nil then
          case FDataLink.DataSet.State of
            dsEdit: Indicator := 1;
            dsInsert: Indicator := 2;
          end;
        FIndicators.Draw(Canvas, ARect.Right - FIndicators.Width - 2,
          (ARect.Top + ARect.Bottom - FIndicators.Height) div 2, Indicator);
        FSelRow := ARow + FTitleOffset;
      end;
    end
    else
    begin
      Value := '';
      OldActive := FDataLink.ActiveRecord;
      try
        FDataLink.ActiveRecord := ARow;
        Value := GetFieldValue(ACol);
        Highlight := HighlightCell(ACol, ARow, Value, AState);
        if Highlight then
        begin
          Brush.Color := clHighlight;
          Font.Color := clHighlightText;
        end;
        if FDefaultDrawing then
          DefaultDrawDataCell(ARect, GetColField(ACol), AState);
        DrawDataCell(ARect, GetColField(ACol), AState);
      finally
        FDataLink.ActiveRecord := OldActive;
      end;
      if FDefaultDrawing and Highlight and not (csDesigning in ComponentState) and
        not (dgRowSelect in Options) and (ValidParentForm(Self).ActiveControl = Self) then
        WinProcs.DrawFocusRect(Handle, ARect);
    end;
    if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
      [dgRowLines, dgColLines]) then
      with ARect do
      begin
        Pen.Color := clBtnHighlight;
        PolyLine([Point(Left, Bottom - 1), Point(Left, Top), Point(Right, Top)]);
      end;
  end;
end;

procedure TCustomDBGrid.MoveCol(ACol: Integer);
var
  OldCol: Integer;
begin
  FDatalink.UpdateData;
  if ACol >= FieldCount then ACol := FieldCount - 1;
  if ACol < 0 then ACol := 0;
  OldCol := Col - FIndicatorOffset;
  if ACol <> OldCol then
  begin
    if not FInColExit then
    begin
      FInColExit := True;
      try
        ColExit;
      finally
        FInColExit := False;
      end;
      if Col - FIndicatorOffset <> OldCol then Exit;
    end;
    if not (dgAlwaysShowEditor in Options) then HideEditor;
    Col := ACol + FIndicatorOffset;
    ColEnter;
  end;
end;

procedure TCustomDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
var
  KeyDownEvent: TKeyEvent;

  procedure NextRow;
  begin
    with FDatalink.Dataset do
    begin
      if (State = dsInsert) and not Modified and not FDatalink.FModified then
        if EOF then Exit else Cancel
      else Next;
      if EOF and CanModify and (dgEditing in Options) then
        Append;
    end;
  end;

  procedure PriorRow;
  begin
    with FDatalink.Dataset do
      if (State = dsInsert) and not Modified and EOF and
        not FDatalink.FModified then
        Cancel else
        Prior;
  end;

  procedure Tab(GoForward: Boolean);
  var
    ACol, Original: Integer;
  begin
    ACol := SelectedIndex;
    Original := ACol;
    while True do
    begin
      if GoForward then
        Inc(ACol) else
        Dec(ACol);
      if ACol >= FieldCount then
      begin
        NextRow;
        ACol := 0;
      end
      else if ACol < 0 then
      begin
        PriorRow;
        ACol := FieldCount - 1;
      end;
      if ACol = Original then Exit;
      if TabStops[ACol + FIndicatorOffset] then
      begin
        MoveCol(ACol);
        Exit;
      end;
    end;
  end;

  function DeletePrompt: Boolean;
  begin
    Result := not (dgConfirmDelete in Options) or
      (MessageDlg(LoadStr(SDeleteRecordQuestion), mtConfirmation, mbOKCancel,
        0) <> idCancel);
  end;

begin
  KeyDownEvent := OnKeyDown;
  if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  if not FDatalink.Active or not CanGridAcceptKey(Key, Shift) then Exit;
  with FDatalink.DataSet do
    if ssCtrl in Shift then
      case Key of
        VK_UP, VK_PRIOR: MoveBy(-FDatalink.ActiveRecord);
        VK_DOWN, VK_NEXT: MoveBy(FDatalink.BufferCount - FDatalink.ActiveRecord - 1);
        VK_LEFT: MoveCol(0);
        VK_RIGHT: MoveCol(FieldCount - 1);
        VK_HOME: First;
        VK_END: Last;
        VK_DELETE: if not ReadOnly and CanModify and DeletePrompt then Delete;
      end
    else
      case Key of
        VK_UP: PriorRow;
        VK_DOWN: NextRow;
        VK_LEFT:
          if dgRowSelect in Options then
            PriorRow else
            MoveCol(SelectedIndex - 1);
        VK_RIGHT:
          if dgRowSelect in Options then
            NextRow else
            MoveCol(SelectedIndex + 1);
        VK_HOME:
          if (FieldCount = 1) or (dgRowSelect in Options) then
            First else
            MoveCol(0);
        VK_END:
          if (FieldCount = 1) or (dgRowSelect in Options) then
            Last else
            MoveCol(FieldCount - 1);
        VK_NEXT: MoveBy(VisibleRowCount);
        VK_PRIOR: MoveBy(-VisibleRowCount);
        VK_INSERT: if not ReadOnly then Insert;
        VK_TAB: if not (ssAlt in Shift) then Tab(not (ssShift in Shift));
        VK_ESCAPE:
          begin
            FDatalink.Reset;
            if not (dgAlwaysShowEditor in Options) then HideEditor;
          end;
        VK_F2: EditorMode := True;
      end;
end;

procedure TCustomDBGrid.KeyPress(var Key: Char);
begin
  if not (dgAlwaysShowEditor in Options) and (Key = #13) then
    FDatalink.UpdateData;
  inherited KeyPress(Key);
end;

procedure TCustomDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Cell: TGridCoord;
begin
  if not AcquireFocus then Exit;
  if (ssDouble in Shift) and (Button = mbLeft) then
  begin
    DblClick;
    Exit;
  end;
  if Sizing(X, Y) then
    inherited MouseDown(Button, Shift, X, Y)
  else
  begin
    Cell := MouseCoord(X, Y);
    if ((csDesigning in ComponentState) or (dgColumnResize in Options)) and
      (Cell.Y < FTitleOffset) then inherited MouseDown(Button, Shift, X, Y)
    else
      if FDatalink.Active then
        with Cell do
        begin
          if (X = Col) and (Y = Row) then ShowEditor;
          if X >= FIndicatorOffset then MoveCol(X - FIndicatorOffset);
          if Y >= FTitleOffset then
            if Y - Row <> 0 then FDatalink.Dataset.MoveBy(Y - Row);
        end;
  end;
end;

procedure TCustomDBGrid.ColEnter;
begin
  if Assigned(FOnColEnter) then FOnColEnter(Self);
end;

procedure TCustomDBGrid.ColExit;
begin
  if Assigned(FOnColExit) then FOnColExit(Self);
end;

procedure TCustomDBGrid.ColumnMoved(FromIndex, ToIndex: Longint);
begin
  if FDatalink.Active and (FieldCount > 0) then
    Fields[FromIndex - FIndicatorOffset].Index := Fields[ToIndex - FIndicatorOffset].Index;
end;

procedure TCustomDBGrid.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
      (AComponent = DataSource)  then
    DataSource := nil;
end;

procedure TCustomDBGrid.TimedScroll(Direction: TGridScrollDirection);
begin
  if FDatalink.Active then
  begin
    with FDatalink do
    begin
      if sdUp in Direction then
      begin
        DataSet.MoveBy(-ActiveRecord - 1);
        Exclude(Direction, sdUp);
      end;
      if sdDown in Direction then
      begin
        DataSet.MoveBy(RecordCount - ActiveRecord);
        Exclude(Direction, sdDown);
      end;
    end;
    if Direction <> [] then inherited TimedScroll(Direction);
  end;
end;

procedure TCustomDBGrid.ColWidthsChanged;
var
  I: Integer;
  CWidth: Integer;
  ParentForm: TForm;
begin
  inherited ColWidthsChanged;
  if not FUpdatingColWidths and FUpdateFields and FDatalink.Active and
    HandleAllocated then
  begin
    Inc(FUpdateLock);
    try
      Canvas.Font := Font;
      CWidth := Canvas.TextWidth('0');
      for I := 0 to FieldCount - 1 do
        Fields[I].DisplayWidth := (ColWidths[I + FIndicatorOffset] +
          CWidth div 2 - 3) div CWidth;
      ParentForm := GetParentForm(Self);
      if (ParentForm <> nil) and (ParentForm.Designer <> nil) then
        ParentForm.Designer.Modified;
    finally
      Dec(FUpdateLock);
    end;
    LayoutChanged;
  end;
end;

procedure TCustomDBGrid.Loaded;
begin
  inherited Loaded;
  LayoutChanged;
end;

procedure TCustomDBGrid.SetOptions(Value: TDBGridOptions);
const
  LayoutOptions = [dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
    dgColLines, dgRowLines, dgRowSelect, dgAlwaysShowSelection];
var
  NewGridOptions: TGridOptions;
  ChangedOptions: TDBGridOptions;
begin
  if FOptions <> Value then
  begin
    NewGridOptions := [];
    if dgColLines in Value then
      NewGridOptions := NewGridOptions + [goFixedVertLine, goVertLine];
    if dgRowLines in Value then
      NewGridOptions := NewGridOptions + [goFixedHorzLine, goHorzLine];
    if dgColumnResize in Value then
      NewGridOptions := NewGridOptions + [goColSizing, goColMoving];
    if dgTabs in Value then Include(NewGridOptions, goTabs);
    if dgRowSelect in Value then Include(NewGridOptions, goRowSelect);
    if dgEditing in Value then Include(NewGridOptions, goEditing);
    if dgAlwaysShowEditor in Value then Include(NewGridOptions, goAlwaysShowEditor);
    inherited Options := NewGridOptions;
    ChangedOptions := (FOptions + Value) - (FOptions * Value);
    FOptions := Value;
    if ChangedOptions * LayoutOptions <> [] then LayoutChanged;
  end;
end;

procedure TCustomDBGrid.SetTitleFont(Value: TFont);
begin
  FTitleFont.Assign(Value);
  LayoutChanged;
end;

end.
