qr2rmconv.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 509 行 · 第 1/2 页

PAS
509
字号
begin
  if FSource = nil then
    raise Exception.Create('(TQuickRep)');

  CreateRMReport;
  for i := 0 to FSource.BandList.Count - 1 do
  begin
    qrb := TQRBand(FSource.BandList[i]);
    maxdy := qrb.Height;
    lBand := nil;
    case qrb.BandType of
      rbTitle:
        begin
          lBand := RMCreateBand(rmbtReportTitle);
          TRMBandReportTitle(lBand).Stretched := True;
        end;
      rbPageHeader:
        begin
          lBand := RMCreateBand(rmbtPageHeader);
          TRMBandPageHeader(lBand).Stretched := True;
        end;
      rbDetail:
        begin
          lBand := RMCreateBand(rmbtMasterData);
          TRMBandMasterData(lBand).DataSetName := RMDBDataSet.Name;
          TRMBandMasterData(lBand).Stretched := True;
        end;
      rbPageFooter:
      	begin
          lBand := RMCreateBand(rmbtPageFooter);
        end;
      rbSummary:
      	begin
          lBand := RMCreateBand(rmbtReportSummary);
          TRMBandReportSummary(lBand).Stretched := True;
        end;
      rbGroupHeader:
        begin
          lBand := RMCreateBand(rmbtGroupHeader);
          TRMBandGroupHeader(lBand).GroupCondition := '[' + TQRGroup(qrb).Expression + ']';
        end;
      rbGroupFooter:
      	begin
          lBand := RMCreateBand(rmbtGroupFooter);
        end;
      rbSubDetail:
        begin
          lBand := RMCreateBand(rmbtDetailData);
          TRMBandDetailData(lBand).Stretched := True;
          CreateSubDetailDataSet;
          TRMBandDetailData(lBand).DataSetName := RMDBSubDetailDataSet.Name;
        end;
      rbColumnHeader:
      	begin
          lBand := RMCreateBand(rmbtColumnHeader);
          TRMBandColumnHeader(lBand).Stretched := True;
        end;
      rbOverlay:
      	begin
          lBand := RMCreateBand(rmbtOverlay);
        end;
      rbChild:
      	begin
        end;
    else
      lBand := RMCreateBand(rmbtNone);
    end;

    lBand.ParentPage := liPage;
    lBand.SetspBounds(qrb.Left, qrb.Top, qrb.Width, qrb.Height);
    lBand.Name := qrb.Name;

    if TRMBand(lBand).BandType <> rmbtPageFooter then
    begin
//      if Assigned(qrb.ChildBand) then
//        lBand.ChildBand := qrb.ChildBand.Name;
    end;

    bkView := nil;
    if qrb.Color <> clWhite then
    begin
	    bkView := RMCreateObject(gtMemo, '');
      bkView.SetspBounds(qrb.Left, qrb.Top, qrb.Width, qrb.Height);
      bkView.FillColor := qrb.Color;
      bkView.ParentPage := liPage;
    end;

    for j := 0 to qrb.ControlCount - 1 do
    begin
      Control := qrb.Controls[j];
      if Control is TQRCustomLabel then
      begin
        _CreateMemoView(Control);
        TRMMemoView(v).spGapLeft := 0;
        TRMMemoView(v).spGapTop := 0;
        if Control is TQRDBText then
        begin
          v.Memo.Text := Format('[%s.%s."%s"]', [TQRDBText(Control).DataSet.Owner.Name, TQRDBText(Control).DataSet.Name, TQRDBText(Control).DataField]);
					_SetSubDetailDataSet(TQRDBText(Control).DataSet);
				end
        else if Control is TQRLabel then
          v.Memo.Add(TQRLabel(Control).Caption)
        else if Control is TQRMemo then
          v.Memo.Assign(TQRMemo(Control).Lines)
        else if Control is TQRExprMemo then
        begin
          v.Memo.Assign(TQRExprMemo(Control).Lines);
          v.Memo.Text := RMReplaceStr(v.Memo.Text, '{', '[');
          v.Memo.Text := RMReplaceStr(v.Memo.Text, '}', ']');
        end
        else if Control is TQRExpr then
          v.Memo.Add('[' + TQRExpr(Control).Expression + ']')
        else if Control is TQRSysData then
        begin
          _CreateMemoView(Control);
          case TQRSysData(Control).Data of
            qrsDate: v.Memo.Text := '[Date]';
            qrsDateTime: v.Memo.Text := '[Date] [Time]';
            qrsDetailCount: v.Memo.Text := '';
            qrsDetailNo: v.Memo.Text := '[Line#]';
            qrsPageNumber: v.Memo.Text := '[Page#]';
//            qrsReportTitle: v.Memo.Text := FTarget.Title;
            qrsTime: v.Memo.Text := '[Time]';
          end;
        end;
        liPage.Objects.Add(v);
      end
      else if (Control is TQRDBImage) or (Control is TQRImage) then
      begin
        v := RMCreateObject(gtPicture, '');
        SetFrame(Control);
        TRMPictureView(v).PictureStretched := TQRImage(Control).Stretch;
        TRMPictureView(v).PictureCenter := TQRImage(Control).Center;
        if Control is TQRDBImage then
        begin
          v.Memo.Text := Format('[%s.%s."%s"]', [TQRDBImage(Control).DataSet.Owner.Name, TQRDBImage(Control).DataSet.Name, TQRDBImage(Control).DataField]);
					_SetSubDetailDataSet(TQRDBImage(Control).DataSet);
				end
        else
          TRMPictureView(v).Picture.Assign(TQRImage(Control).Picture);

        liPage.Objects.Add(v);
      end
      else if Control is TQRShape then
      begin
        v := RMCreateObject(gtAddin, 'TRMShapeView');
        SetFrame(Control);
        case TQRShape(Control).Shape of
        	qrsCircle: TRMShapeView(v).Shape := rmskEllipse;
					qrsHorLine: TRMShapeView(v).Shape := rmHorLine;
          qrsRectangle: TRMShapeView(v).Shape := rmskRectangle;
          qrsRightAndLeft: TRMShapeView(v).Shape := rmRightAndLeft;
          qrsTopAndBottom: TRMShapeView(v).Shape := rmTopAndBottom;
          qrsVertLine: TRMShapeView(v).Shape := rmVertLine;
        end;
        TRMShapeView(v).Pen.Mode := TQRShape(Control).Pen.Mode;
        TRMShapeView(v).TopFrame.Color := TQRShape(Control).Pen.Color;
        TRMShapeView(v).TopFrame.Width := TQRShape(Control).Pen.Width;
        TRMShapeView(v).TopFrame.Style := TRMPenStyle(TQRShape(Control).Pen.Style);

        liPage.Objects.Add(v);
      end
			else if (Control is TQRRichText) or (Control is TQRDBRichText) then
      begin
      	v := RMCreateObject(gtAddin, 'TRMRichView');
        SetFrame(Control);
        TRMRichView(v).Stretched := TQRRichText(Control).AutoStretch;
        TRMRichView(v).RichEdit.Alignment := TQRRichText(Control).Alignment;
        v.FillColor := TQRRichText(Control).Color;
        if Control is TQRDBRichText then
        begin
					if TQRDBRichText(Control).DataSet <> nil then
	          v.Memo.Text := Format('[%s.%s."%s"]', [TQRDBRichText(Control).DataSet.Owner.Name, TQRDBRichText(Control).DataSet.Name, TQRDBRichText(Control).DataField]);
					_SetSubDetailDataSet(TQRDBRichText(Control).DataSet);
				end
        else
        begin
        	if TQRRichText(Control).ParentRichEdit <> nil then
          	AssignRich(TRMRichView(v).RichEdit, TQRRichText(Control).ParentRichEdit)
          else
          	TRMRichView(v).RichEdit.Lines.Assign(TQRRichText(Control).Lines);
        end;

        liPage.Objects.Add(v);
      end;
    end;

    lBand.spHeight := maxdy;
    if bkView <> nil then bkView.spHeight := maxdy;
  end;
end;

procedure TQR2RMConv.SetBandAlignment(Control: TControl; v: TRMReportView);
var
  Alignment: TAlignment;
  AlignToBand: Boolean;
begin
  if Control is TQRCustomLabel then
  begin
    AlignToBand := False;
    Alignment := TQRCustomLabel(Control).Alignment;
    if (Control is TQRDBText) then
      AlignToBand := TQRDBText(Control).AlignToBand
    else if (Control is TQRExpr) then
      AlignToBand := TQRExpr(Control).AlignToBand
    else if (Control is TQRLabel) then
      AlignToBand := TQRLabel(Control).AlignToBand
    else if (Control is TQRMemo) then
      AlignToBand := TQRMemo(Control).AlignToBand
    else if (Control is TQRSysData) then
      AlignToBand := TQRSysData(Control).AlignToBand;
    if AlignToBand then
    begin
      case Alignment of
        taLeftJustify: THackReportView(v).BandAlign := rmbaLeft;
        taRightJustify: THackReportView(v).BandAlign := rmbaRight;
        taCenter: THackReportView(v).BandAlign := rmbaCenter;
      end;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TQR2RMConvEditor }
procedure TQR2RMConvEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: TQR2RMConv(Component).Convert;
    1:
      begin
        if TQR2RMConv(Component).FTarget <> nil then
          TQR2RMConv(Component).FTarget.DesignReport;
      end;
  end;
end;

function TQR2RMConvEditor.GetVerb(Index: Integer): string;
begin
  Result := 'Unknown method';
  case Index of
    0: Result := 'Convert';
    1: Result := 'Design Report';
  end;
end;

function TQR2RMConvEditor.GetVerbCount: Integer;
begin
  Result := 2;
end;

end.

⌨️ 快捷键说明

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