
{                                                                              }
{ IB_StatementGrid                                                             }
{                                                                              }

{***************************************************************}
{                                                               }
{          IB Objects Components and Resources Library          }
{                                                               }
{          Copyright (C) 1996-2007 Jason Wharton                }
{          and Computer Programming Solutions, Mesa, AZ         }
{                                                               }
{  This source code unit is released under the terms of the     }
{  CPS Trustware License.                                       }
{  It may be distributed or deployed as source code or in       }
{  compiled form only in compliance with the terms and          }
{  conditions of the CPS Trustware License which may be         )
{  examined at http://www.ibobjects.com/ibo_trustware.html      )
{                                                               }
{***************************************************************}

{******************************************************************************}
{  CONTRIBUTED MODIFICATIONS                                                   }
{  Additions or modifications listed below using format:                       }
{                                                                              }
{  Joe Citizen <joe@joecitizen.com>                                            }
{  mm/dd/yyyy                                                                  }
{     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                 }
{     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                 }
{     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                 }
{            Copyright (C) 2001 Joe Citizen                                    }
{                                                                              }
{------------------------------------------------------------------------------}
{  Place your credits and information in the top of the section                }
{  below with any other descriptions or explanations desired.                  }
{------------------------------------------------------------------------------}
{                                                                              }
{                                                                              }
{******************************************************************************}

{$INCLUDE IB_Directives.inc}

{: This unit contains the TIB_StatementGrid component.}
unit
  IB_StatementGrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids,

  IB_Header,
  IB_Constants,
  IB_Components,
  
  IB_StatementSource;

type
{: This component serves as a row viewer and modifier.
<br><br>
It also can display extended attributes of a row's columns.}
TIB_StatementGrid = class( TStringGrid )
private
  FIB_StatementSource: TIB_StatementSource;
  FIB_RowType: TIB_RowType;
  FFieldTypeInfo: boolean;
  FFieldInfo: boolean;
  FDomainInfo: boolean;
  FTitleInfo: boolean;
  FRowOffset: integer;
  FPosting: boolean;
  FrameFlags1, FrameFlags2: DWORD;
  FCtl3DShallow: boolean;
  procedure SetStatement( AValue: TIB_Statement ); virtual;
  function GetStatement: TIB_Statement; virtual;
  procedure SetIB_RowType( AValue: TIB_RowType ); virtual;
  procedure SetFieldTypeInfo( AValue: boolean ); virtual;
  procedure SetFieldInfo( AValue: boolean ); virtual;
  procedure SetDomainInfo( AValue: boolean ); virtual;
  procedure SetTitleInfo( AValue: boolean ); virtual;
  property RowOffset: integer read FRowOffset;
  procedure SetCtl3DShallow( AValue: boolean );
  function GetNameText( ACol: TIB_Column ): string;
  function GetTypeText( ACol: TIB_Column ): string;
  function GetInfoText( ACol: TIB_Column ): string;
protected
  procedure ChangeScale( M, D: integer ); override;
  procedure DrawCell( ACol, ARow: Longint;
                      ARect: TRect;
                      AState: TGridDrawState ); override;
  procedure Loaded; override;
  procedure Paint; override;
  procedure IB_StatementUpdate( Sender: TIB_StatementLink;
                                Statement: TIB_Statement );
  procedure IB_FieldChanged( Sender: TIB_StatementLink;
                             Statement: TIB_Statement;
                             Field: TIB_Column );
  procedure IB_ParamChanged( Sender: TIB_StatementLink;
                             Statement: TIB_Statement;
                             Param: TIB_Column );
  procedure IB_FieldUpdate( Sender: TIB_StatementLink;
                            Statement: TIB_Statement;
                            Field: TIB_Column );
  procedure IB_ParamUpdate( Sender: TIB_StatementLink;
                            Statement: TIB_Statement;
                            Param: TIB_Column );
public
  constructor Create( AOwner: TComponent ); override;
  procedure UpdateGrid;
  procedure UpdateTitle;
  procedure UpdateColWidths;
  procedure CloseGrid;
  procedure SetupGrid;
  procedure PostChanges;
  
published

{: This controls the depth of the 3D appearance of the fixed cells.}
  property Ctl3DShallow: boolean read FCtl3DShallow
                                 write SetCtl3DShallow
                                 default false;
{: If true then Field type attributes are included in an additional column
in the grid.}
  property FieldTypeInfo: boolean read FFieldTypeInfo
                                  write SetFieldTypeInfo
                                  default true;
{: If true then Field attributes are included in an additional column
in the grid.}
  property FieldInfo: boolean read FFieldInfo
                              write SetFieldInfo
                              default false;
{: If true this will include the name of the domain along with the Field type.
FieldTypeInfo must also be true for this property to have any effect.}
  property DomainInfo: boolean read FDomainInfo
                               write SetDomainInfo
                               default false;

{: If true this will include column headers. }
  property TitleInfo: boolean read FTitleInfo write SetTitleInfo default false;
{: The statement for which this grid is to display or modify row data.}
  property Statement: TIB_Statement read GetStatement
                                    write SetStatement;
{: Each statement has two rows. One for Param and one for Field.
<br><br>
This property determines which row the grid will display or modify.}
  property IB_RowType: TIB_RowType read FIB_RowType write SetIB_RowType;
{$IFNDEF HELPSCAN}
  property DefaultRowHeight;
{$ENDIF}
  end;

implementation

uses
  IB_Utils;
  
constructor TIB_StatementGrid.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );
  FIB_StatementSource := TIB_StatementSource.Create( Self );
  with FIB_StatementSource as TIB_StatementSource do
  begin
    AfterAssignment := IB_StatementUpdate;
    AfterExecute := IB_StatementUpdate;
    OnPreparedChanged := IB_StatementUpdate;
    OnParamsDataChange := IB_ParamChanged;
    OnParamsUpdateData := IB_ParamUpdate;
    OnFieldsDataChange := IB_FieldChanged;
    OnFieldsUpdateData := IB_FieldUpdate;
  end;
  DefaultRowHeight := 17;
  FFieldTypeInfo := true;
  CloseGrid;
end;

procedure TIB_StatementGrid.Loaded;
begin
  inherited Loaded;
  UpdateGrid;
end;

{------------------------------------------------------------------------------}

procedure TIB_StatementGrid.SetIB_RowType( AValue: TIB_RowType );
begin
  if FIB_RowType <> AValue then
  begin
    FIB_RowType := AValue;
    UpdateGrid;
  end;
end;

procedure TIB_StatementGrid.SetStatement( AValue: TIB_Statement);
begin
  if FIB_StatementSource <> nil then
    if FIB_StatementSource.Statement <> AValue then
    begin
      FIB_StatementSource.Statement := AValue;
      UpdateGrid;
    end;
end;

function TIB_StatementGrid.GetStatement: TIB_Statement;
begin
  Result := FIB_StatementSource.Statement;
end;

procedure TIB_StatementGrid.SetFieldTypeInfo( AValue: boolean );
begin
  if FieldTypeInfo <> AValue then
  begin
    FFieldTypeInfo := AValue;
    UpdateGrid;
  end;
end;

procedure TIB_StatementGrid.SetFieldInfo( AValue: boolean );
begin
  if FieldInfo <> AValue then
  begin
    FFieldInfo := AValue;
    UpdateGrid;
  end;
end;

procedure TIB_StatementGrid.SetDomainInfo( AValue: boolean );
begin
  if DomainInfo <> AValue then
  begin
    FDomainInfo := AValue;
    UpdateGrid;
  end;
end;

procedure TIB_StatementGrid.SetTitleInfo( AValue: boolean );
begin
  if TitleInfo <> AValue then
  begin
    FTitleInfo := AValue;
    if TitleInfo then
      Inc( FRowOffset )
    else
      Dec( FRowOffset );
    UpdateGrid;
  end;
end;

{------------------------------------------------------------------------------}

procedure TIB_StatementGrid.IB_StatementUpdate( Sender: TIB_StatementLink;
                                                Statement: TIB_Statement);
begin
  UpdateGrid;
end;

procedure TIB_StatementGrid.IB_FieldChanged( Sender: TIB_StatementLink;
                                             Statement: TIB_Statement;
                                             Field: TIB_Column );
begin
  if IB_RowType = rtField then
    UpdateGrid; // Lazy inefficient code!
end;

procedure TIB_StatementGrid.IB_ParamChanged( Sender: TIB_StatementLink;
                                             Statement: TIB_Statement;
                                             Param: TIB_Column );
begin
  if IB_RowType = rtParam then
    UpdateGrid; // Lazy inefficient code!
end;

procedure TIB_StatementGrid.IB_FieldUpdate( Sender: TIB_StatementLink;
                                            Statement: TIB_Statement;
                                            Field: TIB_Column );
begin
  if IB_RowType = rtField then
    PostChanges;
end;

procedure TIB_StatementGrid.IB_ParamUpdate( Sender: TIB_StatementLink;
                                            Statement: TIB_Statement;
                                            Param: TIB_Column );
begin
  if IB_RowType = rtParam then
    PostChanges;
end;

{------------------------------------------------------------------------------}

procedure TIB_StatementGrid.SetupGrid;
var
  NewColCount: integer;
begin
  NewColCount := 2;
  if FieldTypeInfo then
    Inc( NewColCount );
  if FieldInfo then
    Inc( NewColCount );
  if ColCount <> NewColCount then
    ColCount := NewColCount;
  if FixedCols <> NewColCount - 1 then
    FixedCols := NewColCount - 1;
  UpdateColWidths;
end;

procedure TIB_StatementGrid.UpdateColWidths;
var
  ii: integer;
  tmpRow: TIB_Row;
  procedure GetCellWidth(   var CurWidth: integer;
                          const ATxt: string );
  var
    tWidth: integer;
  begin
    tWidth := Self.Canvas.TextWidth( ATxt );
    Inc( tWidth, 8 );
    if tWidth > CurWidth then
      CurWidth := tWidth;
  end;
var
  tCol: integer;
  ss: string;
  tWidth: integer;
  NameWidth: integer;
  TypeWidth: integer;
  InfoWidth: integer;
  DataWidth: integer;
begin
  NameWidth := 80;
  TypeWidth := 60;
  InfoWidth := 50;
  DataWidth := DefaultColWidth;
  if DataWidth < 80 then
    DataWidth := 80;
  if TitleInfo then
  begin
    if IB_RowType = rtparam then
      ss := C_SG_Parameter
    else
      ss := C_SG_Field;
    if TitleInfo then
    begin
      GetCellWidth( NameWidth, ss + ' ' + C_SG_Name );
      GetCellWidth( TypeWidth, ss + ' ' + C_SG_Type );
      GetCellWidth( InfoWidth, ss + ' ' + C_SG_Info );
      GetCellWidth( DataWidth, ss + ' ' + C_SG_Value );
    end;
  end;
  if Assigned( Statement ) and Statement.Prepared then
  begin
    if IB_RowType = rtParam then
      tmpRow := Statement.Params
    else
      tmpRow := Statement.Fields;
    for ii := 0 to tmpRow.ColumnCount - 1 do
    begin
      GetCellWidth( NameWidth, GetNametext( tmpRow.Columns[ii] ));
      GetCellWidth( TypeWidth, GetTypeText( tmpRow.Columns[ii] ));
      GetCellWidth( InfoWidth, GetInfoText( tmpRow.Columns[ii] ));
      if not (( tmpRow.Columns[ii].IsBlob ) or
              ( tmpRow.Columns[ii].IsArray )) then
        GetCellWidth( DataWidth, tmpRow.Columns[ii].DisplayText );
    end;
  end;
  tCol := 0;
  if ColWidths[ tCol ] <> NameWidth then
    ColWidths[ tCol ] := NameWidth;
  tWidth := NameWidth;
  Inc( tCol );
  if FieldTypeInfo then
  begin
    if ColWidths[ tCol ] <> TypeWidth then
      ColWidths[ tCol ] := TypeWidth;
    Inc( tCol );
    Inc( tWidth, TypeWidth );
  end;
  if FieldInfo then
  begin
    if ColWidths[ tCol ] <> InfoWidth then
      ColWidths[ tCol ] := InfoWidth;
    Inc( tCol );
    Inc( tWidth, InfoWidth );
  end;
  if DataWidth > Width - tWidth then
    DataWidth := Width - tWidth;
  if ColWidths[ tCol ] <> DataWidth then
    ColWidths[ tCol ] := DataWidth;
end;

procedure TIB_StatementGrid.CloseGrid;
var
  ii: integer;
begin
  Options := Options - [goEditing,goAlwaysShowEditor];
  SetupGrid;
  for ii := RowOffset to RowCount - 1 + RowOffset do
  begin
    Cells[ 0, ii ] := '';
    Cells[ 1, ii ] := '';
    Cells[ 2, ii ] := '';
    if FieldInfo then
      Cells[ 3, ii ] := '';
  end;
  FixedRows := 0;
  RowCount  := RowOffset + 1;
  FixedRows := RowOffset;
end;

procedure TIB_StatementGrid.UpdateTitle;
var
  ss: string;
  tCol: integer;
begin
  SetupGrid;
  if IB_RowType = rtparam then
    ss := C_SG_Parameter
  else
    ss := C_SG_Field;
  if TitleInfo then
  begin
    Cells[ 0, 0 ] := ss + ' ' + C_SG_Name;
    tCol := 1;
    if FieldTypeInfo then
    begin
      Cells[ tCol, 0 ] := ss + ' ' + C_SG_Type;
      Inc( tCol );
    end;
    if FieldInfo then
    begin
      Cells[ tCol, 0 ] := ss + ' ' + C_SG_Info;
      Inc( tCol );
    end;
    Cells[ tCol, 0 ] := ss + ' ' + C_SG_Value;
  end;
end;

function TIB_StatementGrid.GetNameText( ACol: TIB_Column ): string;
var
  RName: string;
begin
  Result := ACol.FieldName;
  if ( ACol.SQLName <>     '' ) and
     ( ACol.SQLName <> Result ) then
    Result := ACol.SQLName + '[' + Result + ']';
  if ( ACol.Row.RelationCount > 1 ) or
     ( ACol.Row.RowType = rtParam ) then
  begin
    RName := ACol.RelAliasName;
    if ( ACol.RelName <>    '' ) and
       ( ACol.RelName <> RName ) then
      RName := ACol.RelName + '[' + RName + ']';
    if RName <> '' then
      Result := RName + '.' + Result;
  end;
end;

function TIB_StatementGrid.GetTypeText( ACol: TIB_Column ): string;
begin
  Result := '(' + Copy( ACol.ClassName, 11, 256 ) + ')';
  if ( DomainInfo ) and
     ( ACol.DomainName <> '' ) and
     ( Copy( ACol.DomainName, 1, 4 ) <> 'RDB$' ) then
    Result := Result + ' [' + ACol.DomainName + ']';
  Result := Result + ' ' + ACol.SQLTypeSource[false];
end;

function TIB_StatementGrid.GetInfoText( ACol: TIB_Column ): string;
begin
  Result := '';
  if ACol.IsPrimary then
    Result := Result + 'PK ';
  if ACol.IsForeign then
    Result := Result + 'FK ';
  if ACol.IsAlternate then
    Result := Result + 'AK ';
  if not ACol.IsPrimary and
     not ACol.IsForeign and
     not ACol.IsAlternate and
         ACol.IsIndexField then
    Result := Result + 'IN ';
  if ACol.IsNullable then
    Result := Result + 'NULL ';
  if ACol.IsDefaulted then
    Result := Result + 'DF ';
  if ACol.Computed then
    Result := Result + 'COMP ';
end;

procedure TIB_StatementGrid.UpdateGrid;
var
  ii: integer;
  tmpRow: TIB_Row;
  tmpCol: TIB_Column;
  tCol: integer;
begin
  if FPosting then Exit;
  if not ( csLoading in ComponentState ) and
     not ( csDestroying in ComponentState ) then
  begin
    if FIB_StatementSource.Prepared then
    begin
      SetupGrid;
      with Statement do
      begin
        if IB_RowType = rtParam then
          tmpRow := Params
        else
          tmpRow := Fields;
        if ( tmpRow.RowState <> rsNone ) and
           ( tmpRow.ColumnCount > 0 ) then
          Options := Options + [goEditing,goAlwaysShowEditor]
        else
          Options := Options - [goEditing,goAlwaysShowEditor];
        if tmpRow.ColumnCount > 0 then
        begin
          RowCount := tmpRow.ColumnCount + RowOffset;
          FixedRows := RowOffset;
          for ii := RowOffset to tmpRow.ColumnCount - 1 + RowOffset do
          begin
            tmpCol := tmpRow[ ii - RowOffset ];
            with tmpCol do
            begin
              Cells[ 0, ii ] := GetNameText( tmpCol );
              tCol := 1;
              if FieldTypeInfo then
              begin
                Cells[ tCol, ii ] := GetTypeText( tmpCol );
                Inc( tCol );
              end;
              if FieldInfo then
              begin
                Cells[ tCol, ii ] := GetInfoText( tmpCol );
                Inc( tCol );
              end;
              if tmpRow.RowState = rsNone then
                Cells[ tCol, ii ] := ''
              else if tmpCol.IsBlob or tmpCol.IsArray then
                Cells[ tCol, ii ] := tmpCol.DisplayText
              else
                Cells[ tCol, ii ] := tmpCol.AsString;
            end;
          end;
        end
        else
          CloseGrid;
      end;
    end
    else
      CloseGrid;
  end;
  UpdateTitle;
  Invalidate;
  InvalidateEditor;
end;

procedure TIB_StatementGrid.PostChanges;
var
  ii: integer;
  tmpFld: TIB_Column;
begin
  if Assigned( Statement ) and ( IB_RowType = rtParam ) then
  begin
    if FIB_StatementSource.Prepared and not FPosting then
    begin
      FPosting := true;
      FIB_StatementSource.OnParamsDataChange := nil;
      try
        if Assigned( Statement ) then
        begin
          with Statement do
          begin
            for ii := RowOffset to ParamCount - 1 + RowOffset do
            begin
              tmpFld := Params[ ii - RowOffset ];
              if (( tmpFld.AsString <> Cells[ FixedCols, ii ] ) or
                  ( Row = ii )) and
                 ( Pos( IBO_ORDLINK, tmpFld.FieldName ) <> 1 ) and
                 ( Pos( IBO_QBE_PARAMETER, tmpFld.FieldName ) <> 1 ) then
                tmpFld.AsString := Cells[ FixedCols, ii ];
            end;
          end;
        end;
      finally
        FPosting := false;
        FIB_StatementSource.OnParamsDataChange := IB_ParamChanged;
      end;
    end;
  end;
end;

procedure TIB_StatementGrid.ChangeScale( M, D: integer );
begin
  if M <> D then
    DefaultRowHeight := MulDiv( DefaultRowHeight, M, D );
  inherited ChangeScale( M, D );
end;

procedure TIB_StatementGrid.DrawCell( ACol, ARow: Longint;
                                      ARect: TRect;
                                      AState: TGridDrawState );
var
  tmpRect: TRect;
begin
  if csLoading in ComponentState then
  begin
    Canvas.Brush.Color := Color;
    Canvas.FillRect( ARect );
  end
  else
  if gdFixed in AState then
  begin
    Canvas.Brush.Color := FixedColor;
    Canvas.FillRect( ARect );
    Canvas.TextRect( ARect, ARect.Left + 2, ARect.Top + 2, Cells[ACol, ARow] );
    tmpRect := ARect;
    if Ctl3D and
       ((FrameFlags1 or FrameFlags2) <> 0) then
    begin
      tmpRect := ARect;
      if (FrameFlags1 and BF_RIGHT) = 0 then
      begin
        Inc( tmpRect.Right, GridLineWidth );
      end
      else
      if (FrameFlags1 and BF_BOTTOM) = 0 then
      begin
        Inc( tmpRect.Bottom, GridLineWidth );
      end;
      if Ctl3D and Ctl3DShallow then
      begin
        DrawShallowEdge( Canvas, tmpRect, Options );
      end
      else
      begin
        DrawEdge( Canvas.Handle, tmpRect, BDR_RAISEDINNER, FrameFlags1 );
        DrawEdge( Canvas.Handle, tmpRect, BDR_RAISEDINNER, FrameFlags2 );
      end;
    end;
  end
  else
  begin
    Canvas.Brush.Color := Color;
    Canvas.FillRect( ARect );
    Canvas.TextRect( ARect, ARect.Left + 2, ARect.Top + 2, Cells[ACol, ARow] );
  end;
end;

procedure TIB_StatementGrid.Paint;
begin
  FrameFlags1 := 0;
  FrameFlags2 := 0;
  if goFixedVertLine in Options then
  begin
    FrameFlags1 := BF_RIGHT;
    FrameFlags2 := BF_LEFT;
  end;
  if goFixedHorzLine in Options then
  begin
    FrameFlags1 := FrameFlags1 or BF_BOTTOM;
    FrameFlags2 := FrameFlags2 or BF_TOP;
  end;
  inherited Paint;
end;

procedure TIB_StatementGrid.SetCtl3DShallow( AValue: boolean );
begin
  if Ctl3DShallow <> AValue then
  begin
    FCtl3DShallow := AValue;
    if AValue then
    begin
      Ctl3D := true;
      DefaultDrawing := false;
    end;
    Invalidate;
  end;
end;

end.
