rxdbctrl.pas

rx library V2.7.7a component use in delphi7 to delphi 2006

      if (FixedCols > 0) and (MasterCol.Index < FixedCols) then begin
        J := MasterCol.Depth;
      end
      else begin
        I := LeftCol;
        if Col.Depth > ARow then J := ARow
        else J := Col.Depth;
      end;
    end;
    Result := CellRect(I, J);
    InBiDiMode := UseRightToLeftAlignment and (Canvas.CanvasOrientation = coLeftToRight);
    for I := Col.Index to Columns.Count - 1 do begin
      if ColumnAtDepth(Columns[I], ARow) <> MasterCol then Break;
      if not InBiDiMode then begin
        J := CellRect(DataToRawColumn(I), ARow).Right;
        if J = 0 then Break;
        Result.Right := Max(Result.Right, J);
      end
      else begin
        J := CellRect(DataToRawColumn(I), ARow).Left;
        if J >= ClientWidth then Break;
        Result.Left := J;
      end;
    end;
    J := Col.Depth;
    if (J <= ARow) and (J < FixedRows - 1) then begin
      CalcFixedInfo(DrawInfo);
      Result.Bottom := DrawInfo.Vert.FixedBoundary -
        DrawInfo.Vert.EffectiveLineWidth;
    end;
  end;

  procedure DrawExpandBtn(var TitleRect, TextRect: TRect; InBiDiMode: Boolean;
    Expanded: Boolean); { copied from Inprise's DbGrids.pas }
  const
    ScrollArrows: array [Boolean, Boolean] of Integer =
      ((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
  var
    ButtonRect: TRect;
    I: Integer;
  begin
    I := GetSystemMetrics(SM_CXHSCROLL);
    if ((TextRect.Right - TextRect.Left) > I) then begin
      Dec(TextRect.Right, I);
      ButtonRect := TitleRect;
      ButtonRect.Left := TextRect.Right;
      I := SaveDC(Canvas.Handle);
      try
        Canvas.FillRect(ButtonRect);
        InflateRect(ButtonRect, -1, -1);
        with ButtonRect do
          IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
        InflateRect(ButtonRect, 1, 1);
        { DrawFrameControl doesn't draw properly when orienatation has changed.
          It draws as ExtTextOut does. }
        if InBiDiMode then { stretch the arrows box }
          Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
        DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
          ScrollArrows[InBiDiMode, Expanded] or DFCS_FLAT);
      finally
        RestoreDC(Canvas.Handle, I);
      end;
      TitleRect.Right := ButtonRect.Left;
    end;
  end;
{$ENDIF RX_D4}

var
  FrameOffs: Byte;
  BackColor: TColor;
  SortMarker: TSortMarker;
  Indicator, ALeft: Integer;
  Down: Boolean;
  Bmp: TBitmap;
  SavePen: TColor;
  OldActive: Longint;
  MultiSelected: Boolean;
  FixRect: TRect;
  TitleRect, TextRect: TRect;
  AField: TField;
{$IFDEF RX_D4}
  MasterCol: TColumn;
  InBiDiMode: Boolean;
{$ENDIF}
  DrawColumn: TColumn;
const
  EdgeFlag: array[Boolean] of UINT = (BDR_RAISEDINNER, BDR_SUNKENINNER);
begin
  if (gdFixed in AState) then Canvas.Brush.Color := FixedColor;
  inherited DrawCell(ACol, ARow, ARect, AState);
{$IFDEF RX_D4}
  InBiDiMode := Canvas.CanvasOrientation = coRightToLeft;
{$ENDIF}
  if (dgIndicator in Options) and (ACol = 0) and (ARow - TitleOffset >= 0)
    and MultiSelect and (DataLink <> nil) and DataLink.Active and
    (Datalink.DataSet.State = dsBrowse) then
  begin { draw multiselect indicators if needed }
    FixRect := ARect;
    if ([dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines]) then
    begin
      InflateRect(FixRect, -1, -1);
      FrameOffs := 1;
    end
    else FrameOffs := 2;
    OldActive := DataLink.ActiveRecord;
    try
      Datalink.ActiveRecord := ARow - TitleOffset;
      MultiSelected := ActiveRowSelected;
    finally
      Datalink.ActiveRecord := OldActive;
    end;
    if MultiSelected then begin
      if (ARow - TitleOffset <> Datalink.ActiveRecord) then Indicator := 0
      else Indicator := 1;  { multiselected and current row }
      FMsIndicators.BkColor := FixedColor;
      ALeft := FixRect.Right - FMsIndicators.Width - FrameOffs;
{$IFDEF RX_D4}
      if InBiDiMode then Inc(ALeft);
{$ENDIF}
      FMsIndicators.Draw(Self.Canvas, ALeft, (FixRect.Top +
        FixRect.Bottom - FMsIndicators.Height) shr 1, Indicator);
    end;
  end
  else if not (csLoading in ComponentState) and
    (FTitleButtons {$IFDEF RX_D4} or (FixedCols > 0) {$ENDIF}) and
    (gdFixed in AState) and (dgTitles in Options) and (ARow < TitleOffset) then
  begin
    SavePen := Canvas.Pen.Color;
    try
      Canvas.Pen.Color := clWindowFrame;
      if (dgIndicator in Options) then Dec(ACol, IndicatorOffset);
      AField := nil;
      SortMarker := smNone;
      if (Datalink <> nil) and Datalink.Active and (ACol >= 0) and
        (ACol < Columns.Count) then
      begin
        DrawColumn := Columns[ACol];
        AField := DrawColumn.Field;
      end
      else DrawColumn := nil;
{$IFDEF RX_D4}
      if Assigned(DrawColumn) and not DrawColumn.Showing then Exit;
      TitleRect := CalcTitleRect(DrawColumn, ARow, MasterCol);
      if TitleRect.Right < ARect.Right then
        TitleRect.Right := ARect.Right;
      if MasterCol = nil then
        Exit
      else if MasterCol <> DrawColumn then
        AField := MasterCol.Field;
      DrawColumn := MasterCol;
      if ((dgColLines in Options) or FTitleButtons) and (ACol = FixedCols - 1) then
      begin
        if (ACol < Columns.Count - 1) and not (Columns[ACol + 1].Showing) then
        begin
          Canvas.MoveTo(TitleRect.Right, TitleRect.Top);
          Canvas.LineTo(TitleRect.Right, TitleRect.Bottom);
        end;
      end;
      if ((dgRowLines in Options) or FTitleButtons) and not MasterCol.Showing then
      begin
        Canvas.MoveTo(TitleRect.Left, TitleRect.Bottom);
        Canvas.LineTo(TitleRect.Right, TitleRect.Bottom);
      end;
{$ELSE}
      TitleRect := ARect;
{$ENDIF RX_D4}
      Down := FPressed and FTitleButtons and (FPressedCol = DrawColumn);
      if FTitleButtons or ([dgRowLines, dgColLines] * Options =
        [dgRowLines, dgColLines]) then
      begin
        DrawEdge(Canvas.Handle, TitleRect, EdgeFlag[Down], BF_BOTTOMRIGHT);
        DrawEdge(Canvas.Handle, TitleRect, EdgeFlag[Down], BF_TOPLEFT);
        InflateRect(TitleRect, -1, -1);
      end;
      Canvas.Font := TitleFont;
      Canvas.Brush.Color := FixedColor;
      if (DrawColumn <> nil) then begin
        Canvas.Font := DrawColumn.Title.Font;
        Canvas.Brush.Color := DrawColumn.Title.Color;
      end;
      if FTitleButtons and (AField <> nil) and Assigned(FOnGetBtnParams) then
      begin
        BackColor := Canvas.Brush.Color;
        FOnGetBtnParams(Self, AField, Canvas.Font, BackColor, SortMarker, Down);
        Canvas.Brush.Color := BackColor;
      end;
      if Down then begin
        Inc(TitleRect.Left); Inc(TitleRect.Top);
      end;
      ARect := TitleRect;
      if (DataLink = nil) or not DataLink.Active then
        Canvas.FillRect(TitleRect)
      else if (DrawColumn <> nil) then begin
        case SortMarker of
          smDown: Bmp := GetGridBitmap(gpMarkDown);
          smUp: Bmp := GetGridBitmap(gpMarkUp);
          else Bmp := nil;
        end;
        if Bmp <> nil then Indicator := Bmp.Width + 6
        else Indicator := 1;
        TextRect := TitleRect;
{$IFDEF RX_D4}
        if DrawColumn.Expandable then
          DrawExpandBtn(TitleRect, TextRect, InBiDiMode, DrawColumn.Expanded);
{$ENDIF}
        with DrawColumn.Title do
          DrawCellText(Self, ACol, ARow, MinimizeText(Caption, Canvas,
            WidthOf(TextRect) - Indicator), TextRect, Alignment, vaCenter
            {$IFDEF RX_D4}, IsRightToLeft {$ENDIF});
        if Bmp <> nil then begin
          ALeft := TitleRect.Right - Bmp.Width - 3;
          if Down then Inc(ALeft);
{$IFDEF RX_D4}
          if IsRightToLeft then ALeft := TitleRect.Left + 3;
{$ENDIF}
          if (ALeft > TitleRect.Left) and (ALeft + Bmp.Width < TitleRect.Right) then
            DrawBitmapTransparent(Canvas, ALeft, (TitleRect.Bottom +
              TitleRect.Top - Bmp.Height) div 2, Bmp, clFuchsia);
        end;
      end
      else DrawCellText(Self, ACol, ARow, '', ARect, taLeftJustify, vaCenter);
    finally
      Canvas.Pen.Color := SavePen;
    end;
  end
  else begin
{$IFDEF RX_D4}
    Canvas.Font := Self.Font;
    if (DataLink <> nil) and DataLink.Active and (ACol >= 0) and
      (ACol < Columns.Count) then
    begin
      DrawColumn := Columns[ACol];
      if DrawColumn <> nil then Canvas.Font := DrawColumn.Font;
    end;
{$ENDIF}
  end;
end;

procedure TRxDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
var
  I: Integer;
  NewBackgrnd: TColor;
  Highlight: Boolean;
  Bmp: TBitmap;
  Field: TField;
begin
  Field := Column.Field;
  NewBackgrnd := Canvas.Brush.Color;
  Highlight := (gdSelected in State) and ((dgAlwaysShowSelection in Options) or
    Focused);
  GetCellProps(Field, Canvas.Font, NewBackgrnd, Highlight or ActiveRowSelected);
  Canvas.Brush.Color := NewBackgrnd;
  if FDefaultDrawing then begin
    I := GetImageIndex(Field);
    if I >= 0 then begin
      Bmp := GetGridBitmap(TGridPicture(I));
      Canvas.FillRect(Rect);
      DrawBitmapTransparent(Canvas, (Rect.Left + Rect.Right - Bmp.Width) div 2,
        (Rect.Top + Rect.Bottom - Bmp.Height) div 2, Bmp, clOlive);
    end else
    DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
  if Columns.State = csDefault then
    inherited DrawDataCell(Rect, Field, State);
  inherited DrawColumnCell(Rect, DataCol, Column, State);
  if FDefaultDrawing and Highlight and not (csDesigning in ComponentState)
    and not (dgRowSelect in Options)
    and (ValidParentForm(Self).ActiveControl = Self) then
    Canvas.DrawFocusRect(Rect);
end;

procedure TRxDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
end;

procedure TRxDBGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
var
  Coord: TGridCoord;
begin
  Coord := MouseCoord(X, Y);
  ACol := Coord.X;
  ARow := Coord.Y;
end;

procedure TRxDBGrid.SaveColumnsLayout(IniFile: TObject;
  const Section: string);
var
  I: Integer;
  S: string;
begin
  if Section <> '' then S := Section
  else S := GetDefaultSection(Self);
  IniEraseSection(IniFile, S);
  with Columns do begin
    for I := 0 to Count - 1 do begin
      IniWriteString(IniFile, S, Format('%s.%s', [Name, Items[I].FieldName]),
        Format('%d,%d', [Items[I].Index, Items[I].Width]));
    end;
  end;
end;

procedure TRxDBGrid.RestoreColumnsLayout(IniFile: TObject;
  const Section: string);
type
  TColumnInfo = record
    Column: TColumn;
    EndIndex: Integer;
  end;
  PColumnArray = ^TColumnArray;
  TColumnArray = array[0..0] of TColumnInfo;
const
  Delims = [' ',','];
var
  I, J: Integer;
  SectionName, S: string;
  ColumnArray: PColumnArray;
begin
  if Section <> '' then SectionName := Section
  else SectionName := GetDefaultSection(Self);
  with Columns do begin
    ColumnArray := AllocMemo(Count * SizeOf(TColumnInfo));
    try
      for I := 0 to Count - 1 do begin
        S := IniReadString(IniFile, SectionName,
          Format('%s.%s', [Name, Items[I].FieldName]), '');
        ColumnArray^[I].Column := Items[I];
        ColumnArray^[I].EndIndex := Items[I].Index;
        if S <> '' then begin
          ColumnArray^[I].EndIndex := StrToIntDef(ExtractWord(1, S, Delims),
            ColumnArray^[I].EndIndex);
          Items[I].Width := StrToIntDef(ExtractWord(2, S, Delims),
            Items[I].Width);
        end;
      end;
      for I := 0 to Count - 1 do begin
        for J := 0 to Count - 1 do begin
          if ColumnArray^[J].EndIndex = I then begin
            ColumnArray^[J].Column.Index := ColumnArray^[J].EndIndex;
            Break;
          end;
        end;
      end;
    finally
      FreeMemo(Pointer(ColumnArray));
    end;
  end;
end;

procedure TRxDBGrid.SaveLayoutReg(IniFile: TRegIniFile);
begin
  InternalSaveLayout(IniFile, '');
end;

procedure TRxDBGrid.RestoreLayoutReg(IniFile: TRegIniFile);
begin
  InternalRestoreLayout(IniFile, '');
end;

procedure TRxDBGrid.InternalSaveLayout(IniFile: TObject;
  const Section: string);
begin
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    if StoreColumns then SaveColumnsLayout(IniFile, Section) else
    InternalSaveFields(DataSource.DataSet, IniFile, Section);
end;

procedure TRxDBGrid.InternalRestoreLayout(IniFile: TObject;
  const Section: string);
begin
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then begin
    HandleNeeded;
    BeginLayout;
    try
      if StoreColumns then RestoreColumnsLayout(IniFile, Section) else
      InternalRestoreFields(DataSource.DataSet, IniFile, Section, False);
    finally
      EndLayout;
    end;
  end;
end;

procedure TRxDBGrid.SaveLayout(IniFile: TIniFile);
begin
  InternalSaveLayout(IniFile, '');
end;

procedure TRxDBGrid.RestoreLayout(IniFile: TIniFile);
begin
  InternalRestoreLayout(IniFile, '');
end;

procedure TRxDBGrid.IniSave(Sender: TObject);
var
  Section: string;
begin
  if (Name <> '') and (FIniLink.IniObject <> nil) then begin
    if StoreColumns then
      Section := FIniLink.RootSection + GetDefaultSection(Self) else
    if (FIniLink.RootSection <> '') and (DataSource <> nil) and
      (DataSource.DataSet <> nil) then
      Section := FIniLink.RootSection + DataSetSectionName(DataSource.DataSet)
    else Section := '';
    InternalSaveLayout(FIniLink.IniObject, Section);
  end;
end;

procedure TRxDBGrid.IniLoad(Sender: TObject);
var
  Section: string;
begin
  if (Name <> '') and (FIniLink.IniObject <> nil) then begin