qm_rconsole.pas

一个管理系统

      QRLabels[i].Caption := GetData(i);
    QMQuickRep.QRPrinter.Progress := (Longint(FCurrentIndex) * 100) div FDataRowCount;
  end else
    QMQuickRep.QRPrinter.Progress := 100;
  Inc(FCurrentIndex);
end;

procedure TQMDataReport.SetGrid(const Value: TQMCustomGrid);
begin
  FGrid.Assign(Value);
end;

function TQMDataReport.GridType: TQMGridType;
begin
  Result := gtGrid;
end;

procedure TQMDataReport.DrawQMGrid(HasDataSet: Boolean);
var
  R_TBMargin, R_DetailHeight, R_FooterHeight: Integer;
  R_Titles: array of TStringList;
  R_RepWidth, R_TitleRowCount, R_TitleTextHg: Integer;
  R_TitleRowHeights: array of Integer;
  R_LineWd, R_LRLineWd, R_TitleHeight, R_LftMargin: Integer;
  R_ScaleWL: Real;
  R_LineColor: TColor;
  B_Titles: Boolean;
  LineLft,LineTp,LineHg,LineWd: Integer;
  Vline,Hline,tList: TStringList;
  i,j,k,p,iTmp: Integer;
  tmpStr,s: string;
  PenStyle: Char;

  QRLabel: TQRLabel;
  QRExpr: TQRExpr;
  QRShape: TQRShape;
  QRHBand,QRBBand: TQRBand;

  Columns: TQMColumns;
  
  function DeCaption: Integer;
  var
    ps,i,iCount: Integer;
    InTxt: string;
  begin
    Result := 1;
    for i := 0 to Columns.Count - 1 do
    begin
    InTxt := R_Titles[i][0];
      R_Titles[i].Clear;
      iCount := 0;
      Repeat
        ps := Pos('|', InTxt);
      if ps<1 then ps := Length(InTxt) + 1;
        R_Titles[i].Add(Copy(InTxt,1,ps - 1));
        Delete(InTxt,1,ps);
        Inc(iCount);
        if iCount > Result then Result := iCount;
      Until Length(InTxt)<1;
    end;
  end;

  procedure GetTitleInfo;
  var
    k,p,tmpVal: Integer;
    tmpStr: String;
  begin
    for k := 0 to Columns.Count - 1 do
    begin
      for p := 0 to R_Titles[k].Count - 1 do
      begin
        if Grid.TitleWordWrap then
        begin
          tmpVal := (Columns[k].Width - 3) div ((abs(Columns[k].Title.Font.Height) + 1) div 2);
          if tmpVal < 2 then tmpVal := 2;
          tmpStr := R_Titles[k][p];
          QM_TrunCharA(tmpStr,tmpVal);
        end else
        begin
          tmpStr := R_Titles[k][p];
          QM_TrunCharB(tmpStr, '/');
        end;  
        if RightStr(tmpStr,1) = #13 then tmpStr := Copy(tmpStr, 1, Length(tmpStr) - 1);
        R_Titles[k][p] := tmpStr;
      end;
    end;
  end;

  function TextRow(Txt:String): Integer;
  var
    l: Integer;
  begin
    Result := 1;
    for l := 1 to Length(Txt) do
      if Txt[l]=#13 then Inc(Result);
  end;

  procedure P_DrawTitleLine;
  var
    j:integer;
  begin
    LineTp := 0;
    if rgRowLines in Grid.Options then
    for j := 0 to R_TitleRowCount do
    begin
      LineLft := 0;
      k := 1;
      While (k <= Columns.Count) do
      begin
        PenStyle := HLine[j][k];
        if (PenStyle <> '0') then
        begin
          QRShape := TQRShape.Create(QROwner);
          QRShape.Parent := QRHBand;
          with QRShape do
          begin
            if PenStyle='2' then Height := 2 else Height := 1;
            Brush.Color := R_LineColor;
            pen.Color := R_LineColor;
            Left := LineLft + R_LftMargin;
            Top := LineTp;
            LineWd := 0;
            While (k <= Columns.Count) and (Hline[j][k] = PenStyle)  do
            begin
              LineWd := LineWd + Columns[k - 1].Width;
              LineLft := LineLft + Columns[k - 1].Width;
              inc(k);
            end;
            Width := LineWd + 1;
            if NeedName then
              Name := QM_UniqueName(QROwner, 'QRShape');
          end;
        end
        else
        begin
          LineLft := LineLft + Columns[k - 1].Width;
          inc(k);
        end;
      end;
      LineTp := LineTp + R_TitleRowHeights[j];
    end;

    LineLft := 0;
    if rgColLines in Grid.Options then
    for j := 1 to Columns.Count do
    begin
      k := 0;
      LineTp := 0;

      if (j > 1) or (R_LRLineWd > 0) then
      While k<R_TitleRowCount do
      begin
        PenStyle := Vline[k][j];
        if (PenStyle <> '0') or (k=R_TitleRowCount - 1) then
        begin
          QRShape := TQRShape.Create(QROwner);
          QRShape.Parent := QRHBand;
          with QRShape do
          begin
            if PenStyle='2' then Width := 2 else Width := 1;
            Brush.Color := R_LineColor;
            pen.Color := R_LineColor;
            Top := LineTp;
            Left := LineLft + R_LftMargin;
            LineHg := 0;
            While (k<R_TitleRowCount) and (Vline[k][j]=PenStyle) do
            begin
              LineHg := LineHg + R_TitleRowHeights[k];
              LineTp := LineTp + R_TitleRowHeights[k];
              inc(k);
            end;
            Height := LineHg + 1;
            if NeedName then
              Name := QM_UniqueName(QROwner, 'QRShape');
          end;
        end
        else
        begin
          LineTp := LineTp + R_TitleRowHeights[k];
          inc(k);
        end;
      end;
      LineLft := LineLft + Columns[j-1].Width;
    end;

    if (R_LRLineWd <> 0) and (rgColLines in Grid.Options) then
    begin
      QRShape := TQRShape.Create(QROwner);
      QRShape.Parent := QRHBand;
      with QRShape do
      begin
        Height := QRHBand.Height + 1;
        Brush.Color := R_LineColor;
        pen.Color := R_LineColor;
        Left := LineLft - R_LineWd + 1 + R_LftMargin;
        Top := 0;
        Width := R_LineWd;
        if NeedName then
          Name := QM_UniqueName(QROwner, 'QRShape');
      end;
    end;
  end;

  procedure P_DrawBodyLine;
  var
    i:integer;
  begin
    LineLft := 0;
    if rgColLines in Grid.Options then
    for i := 0 to Columns.Count - 1 do
    begin
      if (R_LRLineWd > 0) or (i > 0) then
      begin
        QRShape := TQRShape.Create(QROwner);
        QRShape.Parent := QRBBand;
        with QRShape do
        begin
          Height := R_DetailHeight + 1;
          Brush.Color := R_LineColor;
          pen.Color := R_LineColor;
          Left := LineLft + R_LftMargin;
          Top := -1;
          if i=0 then Width := R_LineWd else Width := 1;
          if NeedName then
            Name := QM_UniqueName(QROwner, 'QRShape');
        end;
      end;
      LineLft := LineLft + Columns[i].Width;
    end;

    if (R_LRLineWd <> 0) and (rgColLines in Grid.Options) then
    begin
      QRShape := TQRShape.Create(QROwner);
      QRShape.Parent := QRBBand;
      with QRShape do
      begin
        Height := R_DetailHeight + 1;
        Brush.Color := R_LineColor;
        pen.Color := R_LineColor;
        Left := LineLft - R_LineWd + 1 + R_LftMargin;
        Top := -1;
        Width := R_LRLineWd;
        if NeedName then
          Name := QM_UniqueName(QROwner, 'QRShape');
      end;
    end;

    if rgRowLines in Grid.Options then
    begin
      QRShape := TQRShape.Create(QROwner);
      QRShape.Parent := QRBBand;
      with QRShape do
      begin
        Height := 1;
        Brush.Color := R_LineColor;
        pen.Color := R_LineColor;
        Left := R_LftMargin;
        Top := R_DetailHeight - 1;
        Width := R_RepWidth + 1;
        if NeedName then
          Name := QM_UniqueName(QROwner, 'QRShape');
      end;
    end;
  end;

  procedure P_DrawTitle;
  var
    i,j,k: Integer;
  begin
    GetTitleInfo();
    for i := 0 to Columns.Count - 1 do
      for j := 1 to R_TitleRowCount - R_Titles[i].Count do
        R_Titles[i].Add('');
    tList := TStringList.Create;
    for i := 0 to Columns.Count - 1 do
    begin
      j := 1;
      while j < R_TitleRowCount - 1 do
      begin
        if not (((i=0) and (R_Titles[i][j-1]=R_Titles[i+1][j-1])) or
          ((i = Columns.Count - 1) and (R_Titles[i][j-1] = R_Titles[i-1][j-1])) or
          (((i > 0) and (i < Columns.Count - 1)) and ((R_Titles[i][j-1] = R_Titles[i+1][j-1]) or (R_Titles[i][j-1]=R_Titles[i-1][j-1]))))
          then
        begin
          if R_Titles[i][R_TitleRowCount - 1] <> '' then Break;
          tList.Clear;
          for k := R_TitleRowCount - 1 downto j do
            if R_Titles[i][k] <> '' then
            begin
              tList.Add(R_Titles[i][k]);
              R_Titles[i][k] := '';
            end;
          for k := 0 to tList.Count - 1 do
            R_Titles[i][R_TitleRowCount - 1 - k] := tList[k];
          R_Titles[i][j] := '';
          Break;
        end;
        Inc(j);
      end;
    end;
    tList.Free;

    SetLength(R_TitleRowHeights, R_TitleRowCount);
    for i := 0 to R_TitleRowCount - 1 do
      R_TitleRowHeights[i] := R_TitleTextHg + R_TBMargin;
    for i := 0 to Columns.Count - 1 do
    begin
      j := 0;
      while j<R_TitleRowCount do
      begin
        p := 1;
        while (j + p<R_TitleRowCount) and (R_Titles[i][j + p]='') do Inc(p);
        iTmp := (TextRow(R_Titles[i][j])*R_TitleTextHg + R_TBMargin) div p;
        for k := j to j + p - 1 do
          if iTmp > R_TitleRowHeights[k] then R_TitleRowHeights[k] := iTmp;
        j := j + p;
      end;
    end;
    R_TitleHeight := 0;
    for i := 0 to R_TitleRowCount - 1 do
      Inc(R_TitleHeight,R_TitleRowHeights[i]);

    QMQuickRep.Bands.HasColumnHeader := False;
    QRHBand := QM_FindBand(rbColumnHeader, BGColor);
    if not B_Titles then
    begin
      QRHBand.Height := R_TitleHeight;
      Exit;
    end;

    Vline := TStringList.Create;
    for i := 0 to R_TitleRowCount - 1 do
    begin
      s := IntToStr(R_LineWd);
      for j := 0 to Columns.Count - 2 do
      begin
        tmpStr := R_Titles[j + 1][i];
        if ((tmpStr=R_Titles[j][i]) and (tmpStr <> '')) then
          s := s + '0'
        else s := s + '1';
      end;
      s := s + IntToStr(R_LineWd);
      Vline.Add(s);
    end;
    Hline := TStringList.Create;
    s := '';
    tmpStr := IntToStr(R_LineWd);
    for i := 1 to Columns.Count do s := s + tmpStr;
    Hline.Add(s);
    for i := 1 to R_TitleRowCount - 1 do
    begin
      s := '';
      for j := 0 to Columns.Count - 1 do
      begin
        tmpStr := R_Titles[j][i];
        if (tmpStr='') then s := s + '0'
        else s := s + '1';
      end;
      Hline.Add(s);
    end;
    s := '';
    if rgBoldHeaderLine in Grid.Options then tmpStr := '2' else tmpStr := '1';
    for i := 1 to Columns.Count do s := s + tmpStr;
    Hline.Add(s);

    if rgBoldHeaderLine in Grid.Options then
      QRHBand.Height := R_TitleHeight + 2
    else
      QRHBand.Height := R_TitleHeight + 1;
    lineLft := 2;
    for j := 1 to Columns.Count do
    begin
      if Columns[j-1].Width < 6 then
      begin
        LineLft := LineLft + Columns[j-1].Width;
        continue;
      end;
      k := 0;
      LineTp := 1;
      While k < R_TitleRowCount do
      begin
        PenStyle := Vline[k][j];
        if ((PenStyle <> '0') or (k=R_TitleRowCount - 1))
          and (R_Titles[j-1][k] <> '') then
        begin
          LineWd := Columns[j-1].Width;
          if k<R_TitleRowCount - 1 then
          begin
            p := j + 1;
            while (p <= Columns.Count) and (Vline[k][p] = '0') do
            begin
              LineWd := LineWd + Columns[p-1].Width;
              inc(p);
            end;
          end;
          LineHg := R_TitleRowHeights[k];
          p := k + 1;
          while (k<R_TitleRowCount) and (Hline[p][j]='0') do