qm_pcontrol.pas

商品销售管理系统-毕业设计有代码和论文,可以做毕业设计

{*******************************************************}
{                                                       }
{                   QReportMaker 2.0                    }
{              TQMPrintControl Component                }
{                                                       }
{            Copyright (c) 2003,2004 by Zwm.            }
{                                                       }
{*******************************************************}

unit QM_PControl;

interface


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Typinfo, ComCtrls,
  StdCtrls, ExtCtrls, Mask, QM_RConsole;

type
  { TQMPrintControl }
  TQMPrintControl = class(TQMReportConsole)
  private
    FControl: TWinControl;
    FFitToPageWidth: Boolean;
    FOverPrint: Boolean;
    procedure SetControl(const Value: TWinControl);
  protected
    procedure DrawReport; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
  published
    property Control: TWinControl read FControl write SetControl;
    property FitToPageWidth: Boolean read FFitToPageWidth write FFitToPageWidth default False;
    property OverPrint: Boolean read FOverPrint write FOverPrint default False;
  end;

implementation

uses QuickRpt, QRPrntr, QRCtrls, QM_Utils, QM_QRFuns;

{ TQMPrintControl }

procedure TQMPrintControl.DrawReport;
var
  QRBand: TQRBand;
  RepWidth,iHeight,iWidth,iTop,iLeft: Integer;
  clr: TColor;

  procedure DrawQRLabel(cCaption:String; cColor:TColor; cFont:TFont;
     bAutoSize,bTransparent:Boolean; iAlignment:TAlignment);
  var
    QRLabel:TQRLabel;
  begin
    QRLabel := TQRLabel.Create(QROwner);
    QrLabel.Parent := QRBand;
    With QRLabel do
    begin
      AutoSize := bAutoSize;
      Font.Assign(cFont);
      Font.Height := Round(Font.Height * ScaleHT);
      Font.Color := QM_PrintColor(self, Font.Color);
      Top := iTop;
      Left := iLeft;
      Width := iWidth;
      Height := iHeight;
      Caption := cCaption;
      Alignment := iAlignment;
      Color := QM_BGColor(self, cColor);
      TransParent := bTransparent;
      if (not TransParent) and QM_CompareColor(clr, cColor) then
        TransParent := True;
      if NeedName then
        Name := QM_UniqueName(QROwner,'QRLabel');
    end;
  end;

  procedure DrawQRMemo(sLines:TStrings; cColor:TColor; cFont:TFont;
    bAutoSzie,bTransparent,bWordWrap:boolean; iAlignment:TAlignment);
  var
    QRMemo:TQRMemo;
  begin
    QRMemo := TQRMemo.Create(QROwner);
    QRMemo.Parent := QRBand;
    with QRMemo do
    begin
      AutoSize := bAutoSzie;
      Font.Assign(cFont);
      Font.Height := Round(Font.Height * ScaleHT);
      Font.Color := QM_PrintColor(self, Font.Color);
      Top := iTop;
      Left := iLeft;
      Width := iWidth;
      Height := iHeight;
      WordWrap := bWordWrap;
      Lines.Assign(sLines);
      Alignment := iAlignment;
      Color := QM_BGColor(self, cColor);
      TransParent := bTransparent;
      if (not TransParent) and QM_CompareColor(clr, cColor) then
        TransParent := True;
      if NeedName then
        Name := QM_UniqueName(QROwner,'QRMemo');
    end;
  end;

  procedure DrawQRShape(cBrush:TBrush; cPen:TPen; cShape:TQRShapeType);
  var
    QRShape:TQRShape;
  begin
    QRShape := TQRShape.Create(QROwner);
    QRShape.Parent := QRBand;
    with QRShape do
    begin
      Top := iTop;
      Left := iLeft;
      Width := iWidth;
      Height := iHeight;
      Brush.Assign(cBrush);
      Brush.Color := QM_BGColor(self, Brush.Color);
      Brush.Style := cBrush.Style;
      Pen.Assign(cPen);
      Pen.Color := QM_PrintColor(self, Pen.Color);
      Shape := cShape;
      if NeedName then
        Name := QM_UniqueName(QROwner,'QRShape');
    end;
  end;

  procedure DrawQRImage(cPicture:TPicture; bAutoSize,bCenter,bStretch:Boolean);
  var
    QRImage:TQRImage;
  begin
    QRImage := TQRImage.Create(QROwner);
    QRImage.Parent := QRBand;
    with QRImage do
    begin
      AutoSize := bAutoSize;
      QRImage.Picture := cPicture;
      Top := iTop;
      Left := iLeft;
      Width := iWidth;
      Height := iHeight;
      Stretch := bStretch;
      Center := bCenter;
      if NeedName then
        Name := QM_UniqueName(QROwner,'QRImage');
    end;
  end;

  procedure DrawQRRichText(cRichEdit:TRichEdit);
  var
    QRRichText: TQRRichText;
  begin
    QRRichText := TQRRichText.Create(QROwner);
    QRRichText.Parent := QRBand;
    with QRRichText do
    begin
      Top := iTop;
      Left := iLeft;
      Width := iWidth;
      Height := iHeight;
      ParentRichEdit := cRichEdit;
      if NeedName then
        Name := QM_UniqueName(QROwner,'QRRichText');
    end;
  end;

  function IsPrintCtrl(pctrl:TControl;pTp,pLft:Integer):boolean;
  var
    cShape: TQRShapeType;
    s: String;
    procedure gtTLWH(iTp,iLft,iWd,iHg: Integer);
    begin
      with pctrl do
      begin
        iTop := Round((pTp + Top + iTp) * ScaleHT);
        iHeight := Round((Height + iHg) * ScaleHT + 0.49);
        iLeft := Round((pLft + Left + iLft) * ScaleWL);
        iWidth := Round((Width + iWd) * ScaleWL + 0.49);
      end;
    end;
  begin
    Result := False;
    if (pctrl.Visible = False) or (OverPrint and (pctrl.Tag > 99)) then
    begin
      Result := True;
      exit;
    end;
    if pctrl is TLabel then
    begin
      Result := True;
      gtTLWH(0,0,0,0);
      with pctrl as TLabel do
        DrawQRLabel(Caption,Color,Font,AutoSize,TransParent,Alignment);
    end
    else if pctrl is TShape then
    begin
      Result := True;
      gtTLWH(0,0,0,0);
      with pctrl as TShape do
      begin
        if (Shape=stCircle) or (Shape=stEllipse) then cShape := qrsCircle
        else cShape := qrsRectangle;
        DrawQRShape(Brush,Pen,cShape);
      end
    end
    else if pctrl is TEdit then
    begin
      Result := True;
      gtTLWH(3,2,-3,-3);
      with pctrl as TEdit do
        DrawQRLabel(Text,Color,Font,False,False,taLeftJustify);
    end
    else if pctrl is TCombobox then
    begin
      Result := True;
      gtTLWH(3,2,-3,-3);
      with pctrl as TCombobox do
        DrawQRLabel(Text,Color,Font,False,False,taLeftJustify);
    end
    else if pctrl is TDateTimePicker then
    begin
      Result := True;
      gtTLWH(3,2,-3,-3);
      {$IFDEF QRMaker_6}
      s := TDateTimePicker(pctrl).Format;
      if s = '' then
        if TDateTimePicker(pctrl).DateFormat = dfShort then
          s := ShortDateFormat
        else s := LongDateFormat;
      try
        s := FormatDateTime(s, TDateTimePicker(pctrl).DateTime);
      except
        s := '';
      end;
      {$ELSE}
      if TDateTimePicker(pctrl).DateFormat = dfShort then
        s := ShortDateFormat
      else s := LongDateFormat;
      s := FormatDateTime(s, TDateTimePicker(pctrl).DateTime);
      {$ENDIF}
      with pctrl as TDateTimePicker do
        DrawQRLabel(s,Color,Font,False,False,taLeftJustify);
    end
    else if pctrl is TMaskEdit then
    begin
      Result := True;
      gtTLWH(3,2,-3,-3);
      with pctrl as TMaskEdit do
        DrawQRLabel(Text,Color,Font,False,False,taLeftJustify);
    end
    else if pctrl is TMemo then
    begin
      Result := True;
      gtTLWH(3,2,-3,-3);
      with pctrl as TMemo do
        DrawQRMemo(Lines,Color,Font,False,False,WordWrap,Alignment);
    end
    else if pctrl is TRichEdit then
    begin
      Result := True;
      gtTLWH(2,1,-1,-2);
      with pctrl as TRichEdit do
        DrawQRRichText(TRichEdit(pctrl));
    end
    else if pctrl is TImage then
    begin
      Result := True;
      gtTLWH(0,0,0,0);
      with pctrl as TImage do
        DrawQRImage(Picture,AutoSize,Center,Stretch);
   end;
    {
    else if pctrl is TCheckBox then  //TQRMemo
    begin
      Result := True;
      with pctrl as TCheckBox do
      begin

      end
    end
    else if pctrl is TRadioButton then  //TQRLabel
    begin
      Result := True;
      with pctrl as TRadioButton do
      begin

      end
    end
    else if pctrl is TCheckList then  //TQRMemo
    begin
      Result := True;
      with pctrl as TCheckList do
      begin

      end
    end;
    }
  end;

  procedure DrawControl(Ctrl:TWinControl; pTop,pLeft: integer);
  var
    i:integer;
  begin
    for i := 0 to Ctrl.ControlCount-1 do
    begin
      if (not IsPrintCtrl(Ctrl.Controls[i], pTop, pLeft)) and
        (Ctrl.Controls[i] is TWinControl) then
        DrawControl(TWinControl(Ctrl.Controls[i]),
          pTop+Ctrl.Controls[i].Top, pleft + Ctrl.Controls[i].Left);
    end;
  end;

begin
  if Assigned(OnBeforeDraw) then OnBeforeDraw(self);
  if FitToPageWidth or (Control=nil) then RepWidth := 0
  else RepWidth := Control.Width;
  FormatReport(RepWidth);
  inherited DrawReport;
  if Control=nil then exit;
  clr := clBtnFace;
  if IsPublishedProp(Control, 'Color') then
    try
      clr := TColor(GetPropValue(Control, 'Color'));
    except end;
  QRBand := QM_FindBand(rbTitle, BGColor);
  if QRBand.Tag = 1 then
    QRBand.Height := Round(Control.Height * ScaleHT)
  else QRBand.Height := QRBand.Height + Round(Control.Height * ScaleHT);
  DrawControl(Control, QRBand.Height - Round(Control.Height * ScaleHT), LftMargin);
end;

procedure TQMPrintControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FControl) then FControl := nil;
end;

procedure TQMPrintControl.SetControl(const Value: TWinControl);
begin
  FControl := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

end.