Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kolekce/d3456/ALEXSOFT.ZIP/DBXGRID.PAS

Pascal/Delphi Source File | 2001-09-29 | 20.2 KB | 592 lines

(*////////////////////////////////////////////////////////////////////////////
//   Part of AlexSoft VCL/DLL Library.                                      //
//   All rights reserved. (c) Copyright 1998.                               //
//   Created by: Alex Rabichooc                                             //
//**************************************************************************//
//  Users of this unit must accept this disclaimer of warranty:             //
//    "This unit is supplied as is. The author disclaims all warranties,    //
//    expressed or implied, including, without limitation, the warranties   //
//    of merchantability and of fitness for any purpose.                    //
//    The author assumes no liability for damages, direct or                //
//    consequential, which may result from the use of this unit."           //
//                                                                          //
//  This Unit is donated to the public as public domain.                    //
//                                                                          //
//  This Unit can be freely used and distributed in commercial and          //
//  private environments provided this notice is not modified in any way.   //
//                                                                          //
//  If you do find this Unit handy and you feel guilty for using such a     //
//  great product without paying someone - sorry :-)                        //
//                                                                          //
//  Please forward any comments or suggestions to Alex Rabichooc at:        //
//                                                                          //
//  [e-mail] or [e-mail]                         //
/////////////////////////////////////////////////////////////////////////////*)

{---------------------------------------------------------------------------
  TRaDBGrid - Extended TDBGrid component
     properties
       VisibleColCount: Integer;
         - Use VisibleColCount to determine the number of scrollable columns
           fully visible in the grid. VisibleColCount does not include the fixed
           columns counted by the FixedCols property.
           It does not include any partially visible columns on the right edge
           of the grid.
         - Set VisibleColCount to adjust TRaDBGrid Component to it's actual
           Width;
       VisibleRowCount: Integer;
         - Use VisibleRowCount to determine the number of scrollable rows
           fully visible in the grid. VisibleRowCount does not include the
           fixed rows counted by the FixedRows property. It does not include
           any partially visible rows on the bottom of the grid.
         - Set VisibleRowCount to adjust TRaDBGrid Component to it's actual
           Height;
----------------------------------------------------------------------------}
unit dbXgrid;

interface

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

type

  TRaDBGrid = class(TDBgrid)
  private
    FCanEditShow: boolean;
    FMinRowCount: Integer;
    FOnReplaceField: TFieldNotifyEvent;
    FRedMinus: boolean;
    procedure CMChildKey(var Message: TCMChildKey); message CM_CHILDKEY;
    procedure CNReplaceField(var Message: TMessage); Message CN_REPLACEFIELD;
    procedure CNCloseDBForm(var Message: TMessage); Message CN_CLOSEDBFORM;
    function GetActualHeight: Integer;
    function GetActualWidth: Integer;
    function GetColWidth(Index: integer): Integer;
    function GetRowHeight(Index: integer): Integer;
    function GetVisColCount: Integer;
    function GetVisRowCount: Integer;
    procedure SetVisColCount(Value: Integer);
    procedure SetVisRowCount(Value: Integer);
    procedure SetOnReplaceField(const Value: TFieldNotifyEvent);
    procedure SetRedMinus(const Value: boolean);
  protected
    function CanEditAcceptKey(Key: Char): Boolean; override;
    function CanEditShow: Boolean; override;
    procedure DoExit; override;
    procedure EditButtonClick; override;
    function  GetEditLimit: Integer; override;
    procedure ColWidthsChanged; override;
    procedure SetColumnAttributes; override;
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
  public
    constructor Create(AOwner:TComponent); override;
    function FirstColumn: Integer;
    procedure SetToActualWidth;
    property ActualHeight: Integer read GetActualHeight;
    property ActualWidth: Integer read GetActualWidth;
    property ColWidth[Index: Integer]: Integer read GetColWidth;
    property RowHeight[Index: Integer]: Integer read GetRowHeight;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property MinRowCount: Integer read FMinRowCount write FMinRowCount;
    property TabStops;
  published
    property VisibleColCount: Integer read GetVisColCount
                                      write SetVisColCount stored False;
    property VisibleRowCount: Integer read GetVisRowCount
                                      write SetVisRowCount stored False;
    property OnReplaceField: TFieldNotifyEvent read FOnReplaceField write SetOnReplaceField;
    property RedMinus: boolean read FRedMinus write SetRedMinus;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
  end;

implementation
uses StdCtrls, dbTools, dbConsts, dbCtrls, dbTables, dbPanel, dbBoxGrd, dbClient;

{TRaDBGrid}
constructor TRaDBGrid.Create(AOwner: TComponent);
begin
   Inherited Create(AOwner);
   Options := Options + [dgAlwaysShowEditor];
   FRedMinus := True;
end;

function TRaDBGrid.CanEditAcceptKey(Key: Char): Boolean;
var AField: TField;
begin
  Result := Inherited CanEditAcceptKey(Key);
  with Columns[SelectedIndex] do
  if (Datasource <> nil) and (DataSource.DataSet <> nil) and
     DataSource.DataSet.Active and Assigned(Field) and
     (Field.FieldKind = fkData) and (Field.LookUpDataSet <> nil) then
  begin
     AField := Field.LookUpDataSet.FindField(Field.LookUpResultField);
     if AField <> nil then
         Result := AField.IsValidChar(Key);
  end;
end;

function TRaDBGrid.CanEditShow: Boolean;
var Master: TDataSource;
begin
   FCanEditShow := Inherited CanEditShow;
   if FCanEditShow then
   begin
      if (DataSource <> nil) and
         (DataSource.DataSet <> nil) then
      begin
         Master := GetMasterSource(DataSource.DataSet);
         if (Master <> nil) and
            (Master.DataSet <> nil) and
            (Master.DataSet.IsEmpty or
                    (Master.DataSet.State in [dsEdit, dsInsert])) then
         begin
            FCanEditShow := False;
            {$IFNDEF VER110}
               if (((DataSource.DataSet is TNestedTable) and
                    ((DataSource.DataSet as TNestedTable).DataSetField <> nil) and
                    ((DataSource.DataSet as TNestedTable).DataSetField.DataSet = Master.DataSet)) or
                   ((DataSource.DataSet is TClientDataSet) and
                    ((DataSource.DataSet as TClientDataSet).DataSetField <> nil) and
                    ((DataSource.DataSet as TClientDataSet).DataSetField.DataSet = Master.DataSet))) and
                  not (Master.Dataset.IsEmpty or (Master.DataSet.State = dsInsert)) then
                      FCanEditShow := True;
            {$ENDIF}
         end;
       end;
       if not FCanEditShow and (Parent is TRaDBPanel) then
        with (Parent as TRaDBPanel) do
        begin
           if Box.CanFocus and (ActiveControl = Self) then
              Box.DoKey(bgkFirstTab);
           if (InplaceEditor <> nil) and InplaceEditor.Visible then
              InplaceEditor.Hide;
        end;
   end;
   Result := FCanEditShow;
end;

procedure TRaDBGrid.ColWidthsChanged;
begin
   Inherited ColWidthsChanged;
   InvalidateEditor;
end;

procedure TRaDBGrid.SetColumnAttributes;
var i, j, AWidth: Integer;
    DefaultColumns: Boolean;
begin
   Inherited SetColumnAttributes;
   if (DataSource=nil) or
      (DataSource.DataSet=nil) or
      not DataSource.DataSet.Active then
     exit;
   DefaultColumns := not StoreColumns;
   for i := 0 to Columns.Count-1 do
   begin
      with Columns[i] do
      if Field <> nil then
      begin
         SetFieldAttributes(Field);

         if DefaultColumns and not ReadOnly then
         begin
            if IsLookUpField(Field) then
            begin
               for j := 0 to Columns.Count-1 do
               begin
                  if (Columns[i].Field <> Columns[j].Field) then
                  with Columns[j].Field do
                  if UpperCase(Columns[i].Field.KeyFields) = UpperCase(FieldName) then
                       break;
                  if j = Columns.Count-1 then
                     ButtonStyle := cbsEllipsis;
               end;
               if ButtonStyle <> cbsEllipsis then
                  TabStops[i+ColCount - Columns.Count] := False;
            end
             else
              case Field.DataType of
                ftMemo, ftFmtMemo, ftGraphic, ftTypedBinary, ftDate, ftDateTime:
                      ButtonStyle := cbsEllipsis;
               else
                if Field.DataSet <> nil then
                for j := 0 to Field.DataSet.FieldCount-1 do
                with Field.DataSet.Fields[j] do
                  if (UpperCase(KeyFields) =
                                    UpperCase(Columns[i].Field.FieldName)) then
                  begin
                     ButtonStyle := cbsEllipsis;
                     break;
                  end;
              end;
              if ButtonStyle = cbsEllipsis then
              begin
                AWidth := GetDefaultWidth(Columns[i].Font,
                                    Columns[i].Field.DisplayWidth)+
                                          GetSystemMetrics(SM_CXVSCROLL);
                if AWidth > ColWidths[i+ColCount-Columns.Count] then
                  ColWidths[i+ColCount-Columns.Count] := AWidth;
              end;
         end;
      end;
   end;
   SetBounds(Left, Top, Width, Height);
end;

function TRaDBGrid.GetVisColCount: Integer;
begin
   Result := Inherited VisibleColCount;
end;

function TRaDBGrid.GetColWidth(Index: integer): Integer;
var ColWidth: Integer;
begin
   ColWidth := ColWidths[Index];
   if dgColLines in Options then
     Inc(ColWidth, GridLineWidth);
   Result := ColWidth;
end;

function TRaDBGrid.GetRowHeight(Index: integer): Integer;
var RowHeight: Integer;
begin
   RowHeight := 0;
   case Index of
     0: begin
          if dgTitles in Options then
            if dgRowLines in Options then
                RowHeight := RowHeights[0] + GridLineWidth
              else
                RowHeight := RowHeights[0];
        end;
     else
        begin
           if dgRowLines in Options then
                RowHeight := RowHeights[1] + GridLineWidth
              else
                RowHeight := RowHeights[1];
        end;
   end;
   Result := RowHeight;
end;

function TRaDBGrid.GetVisRowCount: Integer;
var AHeight: Integer;
begin
   AHeight := Height - RowHeight[0];
   if ScrollBars in [ssHorizontal, ssBoth] then
     Dec(AHeight, 4+GetSystemMetrics(SM_CYHSCROLL));
   Result := AHeight div RowHeight[1];
end;

procedure TRaDBGrid.CMChildKey(var Message: TCMChildKey);
var ShiftState: TShiftState;

type
  TSelection = record
    StartPos, EndPos: Integer;
  end;

  function Selection: TSelection;
  begin
    if InplaceEditor <> nil then
      SendMessage(InplaceEditor.Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos))
     else
     begin
        Result.StartPos := 0;
        Result.EndPos := 0;
     end;
  end;

  function GetTextLen: Integer;
  begin
    if InplaceEditor <> nil then
       Result := InplaceEditor.GetTextLen
      else
       Result := 0;
   end;

  function RightSide: Boolean;
  begin
    with Selection do
      Result := ((StartPos = 0) or (EndPos = StartPos)) and
        (EndPos = GetTextLen);
   end;

  function LeftSide: Boolean;
  begin
    with Selection do
      Result := (StartPos = 0) and ((EndPos = 0) or (EndPos = GetTextLen));
  end;

begin
  ShiftState := GetShiftState;
  with Message do
  begin
     case CharCode of
         VK_F1:
               if ShiftState = [ssCtrl] then
                  if (Columns[SelectedIndex].ButtonStyle = cbsEllipsis)
                     {$IFNDEF VER110}
                       or ((SelectedField<>nil) and (SelectedField.DataType = ftDataSet))
                     {$ENDIF} then
                     EditButtonClick;
         VK_RETURN:
               if ShiftState = [] then
               begin
                  if InplaceEditor <> nil then
                    SendMessage(InplaceEditor.Handle, WM_KEYDOWN, CharCode,
                                                      TMessage(Message).LParam);
                  CharCode := VK_TAB;
                  Result := 1;
               end;
         VK_F8: if ShiftState = [] then
                begin
                  Include(ShiftState, ssCtrl);
                  CharCode := VK_DELETE;
                  Result := 1;
                end;
         VK_PRIOR:
                if ShiftState = [ssCtrl] then
                begin
                  CharCode := VK_HOME;
                  Result := 1;
                end;
         VK_NEXT:
                if ShiftState = [ssCtrl] then
                begin
                  CharCode := VK_END;
                  Result := 1;
                end;
         VK_RIGHT:
                if (ShiftState = []) and RightSide then
                begin
                  if InplaceEditor <> nil then
                     SendMessage(InplaceEditor.Handle, WM_KEYDOWN, VK_RETURN,
                                                  TMessage(Message).LParam);
                  CharCode := VK_TAB;
                  Result := 1;
                end;
         VK_LEFT:
                if (ShiftState = []) and LeftSide then
                begin
                  if InplaceEditor <> nil then
                     SendMessage(InplaceEditor.Handle, WM_KEYDOWN, VK_RETURN,
                                                  TMessage(Message).LParam);
                  Include(ShiftState, ssShift);
                  CharCode := VK_TAB;
                  Result := 1;
                end;
     end;
     if Result = 1 then
     begin
        KeyDown(CharCode, ShiftState);
        exit;
     end;
  end;
  inherited;
end;

procedure TRaDBGrid.CNReplaceField(var Message: TMessage);
var AField: TField;
    Form: TCustomForm;
begin
   if CanFocus and FCanEditShow then
   begin
      AField := pointer(Message.LParam);
      if Assigned(FOnReplaceField) then
        FOnReplaceField(AField)
       else
        ReplaceField(AField);
      SelectedField := AField;
      SetFocus;
   end;
   Form := GetParentForm(Self);
   if (Form <> nil) and (Form.CanFocus) then
      Form.SetFocus;
end;

procedure TRaDBGrid.CNCloseDBForm(var Message: TMessage);
begin
   if (DataSource <> nil) and
      (DataSource.DataSet <> nil) and
      DataSource.DataSet.Active then
     if Message.WParam = mrCancel then
        DataSource.DataSet.Cancel
       else
        DataSource.DataSet.CheckBrowseMode;
end;

procedure TRaDBGrid.DoExit;
begin
   if (DataSource <> nil) and
      (DataSource.DataSet <> nil) and
      (DataSource.DataSet.Modified) then
     DataSource.DataSet.Post;
   Inherited DoExit;
end;

procedure TRaDBGrid.EditButtonClick;
begin
   if Assigned(OnEditButtonClick) then
      Inherited EditButtonClick
     else
      DoEditButtonClick(SelectedField, InplaceEditor);
end;

function TRaDBGrid.GetActualHeight: Integer;
var AHeight: Integer;
    ARowCount: Integer;
begin
   ARowCount := (Height-RowHeight[0]) div RowHeight[1];
   if ARowCount < MinRowCount then
        ARowCount := MinRowCount;
   AHeight := RowHeight[0]+RowHeight[1]*ARowCount;
   if (ScrollBars in [ssHorizontal, ssBoth]) and (Width <> ActualWidth) then
     Inc(AHeight, 4+GetSystemMetrics(SM_CYHSCROLL));
   Result := AHeight;
end;

function TRaDBGrid.GetActualWidth: Integer;
var i: Integer;
    AWidth: Integer;
begin
   AWidth := GetSystemMetrics(SM_CYVSCROLL)+4;
   for i := 0 to ColCount-1 do
      AWidth := AWidth + ColWidth[i];
   Result := AWidth;
end;

function TRaDBGrid.FirstColumn: Integer;
var i: Integer;
begin
    Result := -1;
    for i := 0 to Columns.Count-1 do
      if TabStops[i+ColCount - Columns.Count] then
      begin
         Result := i;
         break;
      end;
end;

procedure TRaDBGrid.SetToActualWidth;
begin
   Width := ActualWidth;
end;

procedure TRaDBGrid.SetVisColCount(Value: Integer);
var i: Integer;
    AWidth: Integer;
begin
   if Value >= ColCount then
      Value := ColCount-1;
   AWidth := 0;
   for i := 0 to Value do
      AWidth := AWidth + ColWidth[i];
   Width := AWidth+GetSystemMetrics(SM_CYVSCROLL)+4;
end;

procedure TRaDBGrid.SetVisRowCount(Value: Integer);
var AHeight: Integer;
begin
   AHeight := RowHeight[0]+RowHeight[1]*Value;
   if ScrollBars in [ssHorizontal, ssBoth] then
     Inc(AHeight, 4+GetSystemMetrics(SM_CYHSCROLL));
   Height := AHeight;
end;

function TRaDBGrid.GetEditLimit: Integer;
var AField: TField;
begin
  if Assigned(SelectedField) and (SelectedField.DataType = ftString) and
     (SelectedField.LookUpDataSet <> nil) then
  begin
     with SelectedField do
        AField := LookUpDataSet.FindField(LookUpResultField);
     if (AField <> nil) then
        Result := AField.Size
       else
        Result := SelectedField.DisplayWidth;
  end
   else
    Result := Inherited GetEditLimit;
end;

procedure TRaDBGrid.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var ButtonVisible: Boolean;
    MasterField: TField;
    ActWidth, i: Integer;
begin
   Inherited SetBounds(ALeft, ATop, AWidth, AHeight);
   if (Columns <> nil) then
   begin
      {for i := 0 to Columns.Count-1 do
        with Columns[i] do
        if Field <> nil then
            SetFieldAttributes(Field);}

      if Columns[Columns.Count-1].Field <> nil then
      with Columns[Columns.Count-1] do
      begin
         ButtonVisible := False;
         AWidth := GetDefaultWidth(Font, Field.DisplayWidth);
         case ButtonStyle of
            cbsEllipsis: ButtonVisible := True;
            cbsAuto:
              if Field.FieldKind = fkLookup then
              begin
                 MasterField := nil;
                 if (DataLink.DataSet <> nil) and (Field <> nil) then
                    MasterField := DataLink.DataSet.FindField(Field.KeyFields);
                 if Assigned(MasterField) and MasterField.CanModify and
                    not ((cvReadOnly in AssignedValues) and ReadOnly) then
                  if not Self.ReadOnly and DataLink.Active and
                     not Datalink.ReadOnly then
                      ButtonVisible := True;
              end
                else
                 if Assigned(Picklist) and
                   (PickList.Count > 0) and
                   not Readonly then
                      ButtonVisible := True;
         end;
         if ButtonVisible then
           AWidth := AWidth + GetSystemMetrics(SM_CXVSCROLL);
         ActWidth := GetSystemMetrics(SM_CYVSCROLL)+4+AWidth;
         for i := 0 to ColCount-2 do
            ActWidth := ActWidth + ColWidth[i];
         if (Self.Width-ActWidth > 0) and (Columns.Count <= ColCount) then
            ColWidths[ColCount-1] := AWidth + Self.Width-ActWidth
           else
            ColWidths[ColCount-1] := AWidth;
         //SetFieldAttributes(Field);
      end;
   end;
end;

procedure TRaDBGrid.SetOnReplaceField(const Value: TFieldNotifyEvent);
begin
  FOnReplaceField := Value;
end;

procedure TRaDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
begin
   if FRedMinus and (Column <> nil) and (Column.Field <> nil) and
      (Column.Field is TFloatField) and (Column.Field.AsFloat < 0) then
     Canvas.Font.Color := clRed;
   inherited;
end;

procedure TRaDBGrid.SetRedMinus(const Value: boolean);
begin
  FRedMinus := Value;
end;

end.