⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 qlrptbld.pas

📁 详细的ERP设计资料
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  inherited;
end;

procedure TQLDBGridReportBuilder.BuildList(Grid: TDBGrid; AutoFit: Boolean;
  ColumnHeaderBand, DetailBand, SummaryBand: TQRCustomBand;
  FieldList: TList; SummaryFields: TStrings);
const
  HorzOffset = 2;
var
  I, TitleRowCount: Integer;
  AColumn: TColumn;
  AData: TQRDBText;
  ALabel: TQRLabel;
  AExpr: TQRExpr;
  AColumnShape, ADetailShape: TQRShape;
  AWidth: Integer;
  TotalWidth: Integer;
  HadDetail: Boolean;
  HadColHead: Boolean;
  VertLines, HorzLines: Boolean;
//  TM: TTextMetric;
  CurrentLefts: array of Integer;

  function GridLineWidth: Integer;
  begin
    Result := THackDBGrid(Grid).GridLineWidth;
  end;

  procedure AddColumn(AColumn: TColumn);

    function GetColumnCount: Integer;
    var
      I: Integer;
    begin
      Result := 0;
      if AColumn.ParentColumn <> nil then
        for I := 0 to Grid.Columns.Count - 1 do
          with Grid.Columns[I] do
            if ParentColumn = AColumn.ParentColumn then
              Inc(Result);
    end;

    function GetMasterCol(ACol: TColumn; ADepth: Integer): TColumn;
    begin
      Result := ACol;
      while (Result <> nil) and (Result.Depth > ADepth) do
        Result := Result.ParentColumn;
    end;

    function GetRowCount: Integer;
    var
      I: Integer;
      MasterCol: TColumn;
    begin
      Result := 0;
      MasterCol := GetMasterCol(AColumn, 0);
      with Grid do
        for I := 0 to Columns.Count - 1 do
          if (GetMasterCol(Columns[I], 0) = MasterCol) and (Columns[I].Depth + 1 > Result) then
            Result := Columns[I].Depth + 1;
    end;

    function GetColWidth: Integer;
    var
      I: Integer;
//      MasterCol: TColumn;
    begin
      Result := 0;
      with Grid do
        for I := 0 to Columns.Count - 1 do
          if GetMasterCol(Columns[I], AColumn.Depth) = AColumn then
            Result := Result + Columns[I].Width + GridLineWidth;
    end;

    function GetIsLastColumn: Boolean;
    var
      I: Integer;
    begin
      Result := True;
      for I := AColumn.Index + 1 to Grid.Columns.Count - 1 do
        if GetMasterCol(Grid.Columns[I], AColumn.Depth) <> AColumn then
        begin
          Result := False;
          Break;
        end;
    end;

    function GetIsChildLastCol: Boolean;
    var
      MasterCol: TColumn;
      I: Integer;
    begin
      Result := False;
      MasterCol := GetMasterCol(AColumn, AColumn.Depth - 1);
      if MasterCol <> nil then
      begin
        for I := AColumn.Index + 1 to Grid.Columns.Count - 1 do
          if GetMasterCol(Grid.Columns[I], AColumn.Depth - 1) = MasterCol then
            Exit;
        Result := True;
      end;
    end;

  var
    Temp: string;
    RowCount, RowHeight, ColWidth, I: Integer;
//    ARect: TRect;
    IsLastCol: Boolean;
  begin
{$IFDEF DEBUG}
    SendDebug('-------------------------------------------');
    SendDebug('AColumn.FieldName = ' + AColumn.FieldName);
    SendInteger('AColumn.Depth', AColumn.Depth);
{$ENDIF}
//    ARect := THackDBGrid(Grid).CalcTitleRect(AColumn, AColumn.Depth, MasterCol);
    if Length(CurrentLefts) <= AColumn.Depth then SetLength(CurrentLefts, Length(CurrentLefts) + 1);
//    ColWidth := ARect.Right - ARect.Left;
    ColWidth := GetColWidth;
    RowCount := GetRowCount;
    RowHeight := ColumnHeaderBand.Height div RowCount;
//    ColCount := GetColumnCount;
    IsLastCol := GetIsLastColumn;
    AData := nil;

    ALabel := TQRLabel(ColumnHeaderBand.AddPrintable(TQRLabel));
    ALabel.Top := RowHeight * AColumn.Depth + (RowHeight - ALabel.Height) div 2;
    ALabel.AutoSize := False;
    ALabel.Font.Assign(AColumn.Title.Font);
    ALabel.Alignment := AColumn.Title.Alignment;
    if AutoFit then
    begin
      if IsLastCol  then
        AWidth := ColumnHeaderBand.Width - CurrentLefts[AColumn.Depth]
      else
        AWidth := Trunc(ColWidth / TotalWidth * ColumnHeaderBand.Width);
      ALabel.Width := AWidth - HorzOffset;
//      ALabel.Transparent := True;
    end
    else begin
//      ALabel.AutoSize := True;
//      GetTextMetrics(Grid.Canvas.Handle, TM);
//      ALabel.Caption := MakeStr('X', (ColWidth + (TM.tmAveCharWidth div 2) - TM.tmOverhang - 3)
//          div TM.tmAveCharWidth);
//      ALabel.AutoSize := False;
      ALabel.Width := ColWidth - HorzOffset;
      AWidth := ColWidth + GridLineWidth;
//      AWidth := ALabel.Width + HorzOffset;
    end;
//    ALabel.AutoSize := False;
//    ALabel.Font.Style := ALabel.Font.Style + [fsBold];
    if ALabel.Alignment = taRightJustify then
      ALabel.Left := CurrentLefts[AColumn.Depth]
    else
      ALabel.Left := CurrentLefts[AColumn.Depth] + HorzOffset;
    ALabel.Caption := AColumn.Title.Caption;
//    ALabel.Frame.DrawBottom := True;
    if HorzLines and (AColumn.Depth < RowCount - 1) then
    begin
      with TQRShape(ColumnHeaderBand.AddPrintable(TQRShape)) do
      begin
        Shape := qrsHorLine;
        Top := RowHeight * (AColumn.Depth + 1) - 1;
        Left := CurrentLefts[AColumn.Depth];
        if IsLastCol then Width := ColumnHeaderBand.Width - Left
        else Width := AWidth;
        Height := 1;
{$IFDEF DEBUG}
        SendInteger('HorzShape.Width', Width);
        SendInteger('ColumnHeaderBand.Width', ColumnHeaderBand.Width);
{$ENDIF}
      end;
//      if AutoFit then ADetailShape.Left := CurrentLeft + ALabel.Width + HorzOffset;
    end;
    if VertLines and not IsLastCol and not GetIsChildLastCol then
    begin
      AColumnShape := TQRShape(ColumnHeaderBand.AddPrintable(TQRShape));
      AColumnShape.Shape := qrsVertLine;
      if AColumn.Depth = 0 then AColumnShape.Top := 0
      else AColumnShape.Top := RowHeight * AColumn.Depth;
      AColumnShape.Width := 1;
      AColumnShape.Height := ColumnHeaderBand.Height - AColumnShape.Top;
      {if AutoFit then }AColumnShape.Left := CurrentLefts[AColumn.Depth] + AWidth - 1;
    end;
    if not AColumn.Expanded then
    begin
      AData := TQRDBText(DetailBand.AddPrintable(TQRDBText));
      AData := TQRDBText.Create(Report);
      AData.Parent := DetailBand;
      AData.AutoSize := False;
      AData.DataSet := AColumn.Field.DataSet;
      AData.DataField := AColumn.FieldName;
      if AColumn.Field.DataSet.FindField(AColumn.FieldName) = nil then
        ShowMessage('');
      AData.Top := (DetailBand.Height - AData.Height) div 2;
      AData.Width := ALabel.Width;
      AData.Alignment := AColumn.Alignment;
{$IFDEF DEBUG}
      SendDebug('AData.DataName = ''' + AData.DataField+ '''');
{$ENDIF}
  //    if AutoFit then
      if AData.Alignment = taRightJustify then
        AData.Left := CurrentLefts[AColumn.Depth]
      else AData.Left := CurrentLefts[AColumn.Depth] + HorzOffset;
      if VertLines and not IsLastCol and FHasColLines then
      begin
        ADetailShape := TQRShape(DetailBand.AddPrintable(TQRShape));
        ADetailShape.Shape := qrsVertLine;
        ADetailShape.Top := 0;//ALabel.Top;
        ADetailShape.Left := CurrentLefts[AColumn.Depth] + AWidth - 1;
        ADetailShape.Width := 1;
        ADetailShape.Height := DetailBand.Height;
  //      if AutoFit then ADetailShape.Left := CurrentLeft + ALabel.Width + HorzOffset;
      end;
    end;
    Temp := SummaryFields.Values[AColumn.FieldName];
    if Temp <> '' then
    begin
      AExpr := TQRExpr(SummaryBand.AddPrintable(TQRExpr));
      AExpr.AutoSize := False;
      AExpr.Expression := Temp;
      if IsPublishedProp(AColumn.Field, 'currency') and
        (GetOrdProp(AColumn.Field, 'currency') = 1) then
        AExpr.Mask := CurrencyString + '0.00';
      AExpr.Alignment := AData.Alignment;
      AExpr.Left := AData.Left;
      AExpr.Width := AData.Width;
      AExpr.Top := (SummaryBand.Height - AExpr.Height) div 2;
      AExpr.ResetAfterPrint := True;
    end;
    if (Temp <> '') and VertLines and not IsLastCol and FHasColLines then
    begin
      with TQRShape(SummaryBand.AddPrintable(TQRShape)) do
      begin
        Shape := qrsVertLine;
        Top := 0;
        Left := ADetailShape.Left;
        Width := 1;
        Height := SummaryBand.Height;
      end;
//      if AutoFit then ADetailShape.Left := CurrentLeft + ALabel.Width + HorzOffset;
    end;
{$IFDEF DEBUG}
    SendInteger('AWidth', AWidth);
    SendInteger('ColWidth', ColWidth);
    SendInteger('CurrentLeft', CurrentLefts[AColumn.Depth]);
    SendInteger('RowCount', RowCount);
{$ENDIF}
    if AColumn.Depth = RowCount - 1 then
      for I := Length(CurrentLefts) - 1 downto AColumn.Depth + 1 do
        CurrentLefts[I] := CurrentLefts[I] + AWidth;
    CurrentLefts[AColumn.Depth] := CurrentLefts[AColumn.Depth] + AWidth;
//    if not AColumn.Expanded then
//      CurrentLeft := CurrentLeft + AWidth;
//    else begin
      if FAutoOrientation and (AData <> nil) and (AData.Left + AData.Width > DetailBand.Width) and
        (Orientation = poPortrait) then Orientation := poLandscape;
      if (AData <> nil) and (AData.Left + AData.Width > DetailBand.Width) then
      begin
        ALabel.Free;
        AData.Free;
      end;
//    end;
  end;

begin
  TotalWidth := 0;
  for I := 0 to Grid.Columns.Count - 1 do
    if Grid.Columns[I].Visible and not Grid.Columns[I].Expanded and
      (FieldList.IndexOf(Grid.Columns[I].Field) >= 0) then
      TotalWidth := TotalWidth + Grid.Columns[I].Width + GridLineWidth;
  Font.Assign(Grid.Font);
  HadColHead := ColumnHeaderBand <> nil;
  HadDetail := DetailBand <> nil;
  if HadColHead then
    with TQRLabel(ColumnHeaderBand.AddPrintable(TQRLabel)) do
    try
      Caption := 'Wg';
      Font.Style := Font.Style + [fsBold];
      ColumnHeaderBand.Height := Round(Height * 1.5)
    finally
      Free;
    end;
  if HadDetail then
    with TQRLabel(DetailBand.AddPrintable(TQRLabel)) do
    try
      Caption := 'Wg';
      DetailBand.Height := Round(Height * 1.5)
    finally
      Free;
    end;
  VertLines := DBGrids.dgColLines in Grid.Options;
  HorzLines := DBGrids.dgRowLines in Grid.Options;
  if DBGrids.dgTitles in Grid.Options then
  begin
//    if HadColHead then
//      ColumnHeaderBand.Height := 20;
    if VertLines then
    begin
      if HadColHead then
        with ColumnHeaderBand.Frame do
        begin
          DrawLeft := True;
          DrawRight := True;
        end;
      if FHasColLines then
        with DetailBand.Frame do
        begin
          DrawLeft := True;
          DrawRight := True;
        end;
    end;
    if HorzLines then
    begin
      if HadColHead then
        with ColumnHeaderBand.Frame do
        begin
          DrawTop := True;
          DrawBottom := True;
        end;
      if FHasRowLines then
        with DetailBand.Frame do DrawBottom := True;
    end;
  end;
//  ColumnHeaderBand.Height := ColumnHeaderBand.Height * 2;
  if Grid <> nil then
  begin
//    CurrentLeft := 0;
    TitleRowCount := 0;
    with Grid do
      for I := 0 to Columns.Count - 1 do
        if Columns[I].Depth + 1 > TitleRowCount then
          TitleRowCount := Columns[I].Depth + 1;
    if ColumnHeaderBand <> nil then
      with ColumnHeaderBand do Height := Height * TitleRowCount;
    SetLength(CurrentLefts, TitleRowCount);
    for I := 0 to Grid.Columns.Count - 1 do begin
      AColumn := Grid.Columns[I];
      if AColumn.Visible and (FieldList.IndexOf(AColumn.Field) >= 0) {and not (AField.DataType in ftNonTextTypes +
        [ftUnknown]) }then AddColumn(AColumn);
    end;
  end;
  RenameObjects;
end;

procedure TQLDBGridReportBuilder.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if (AComponent = Report) then Report := nil
    else if AComponent = DBGrid then DBGrid := nil
    else if AComponent = SubDetailDBGrid then SubDetailDBGrid := nil;
end;

function TQLDBGridReportBuilder.GetReport: TCustomQuickRep;
begin
  Result := inherited Report;
end;

procedure TQLDBGridReportBuilder.SetReport(const Value: TCustomQuickRep);
begin
  if Value <> Report then
  begin
//    if Report <> nil then Report.RemoveFreeNotification(Self);
    inherited Report := Value;
    if Value <> nil then Value.FreeNotification(Self);
  end;
end;

procedure TQLDBGridReportBuilder.SetDBGrid(const Value: TDBGrid);
begin
  if FDBGrid <> Value then
  begin
    FDBGrid := Value;
    if Value <> nil then Value.FreeNotification(Self);
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -