qrctrls.pas

delphi7报表打印控件源码 可以设计报表

    end
    else
      Field := nil;
    if assigned(Field) then
    begin
      try
        if (Field is TMemoField) or
           (Field is TBlobField) then
        begin
          Lines.Text := TMemoField(Field).AsString;
        end else
          if (Mask = '') or (Field is TStringField) then
            if not (Field is TBlobField) then
              FPrintCaption := Field.DisplayText
            else
              FPrintCaption := Field.AsString
          else
          begin
            if (Field is TIntegerField) or
               (Field is TSmallIntField) or
               (Field is TWordField) then
               FPrintCaption := FormatFloat(Mask, TIntegerField(Field).Value * 1.0)
            else
              if (Field is TFloatField) or
                 (Field is TCurrencyField) or
                 (Field is TBCDField) then
                 FPrintCaption := FormatFloat(Mask,TFloatField(Field).Value)
              else
                if (Field is TDateTimeField) or
                   (Field is TDateField) or
                   (Field is TTimeField) then
                  FPrintCaption := FormatDateTime(Mask,TDateTimeField(Field).Value);
          end;
      except
        FPrintCaption := '';
      end;
    end else
      FPrintCaption := '';
    DoneFormat := false;
    inherited Print(OfsX,OfsY);
  end;
end;

procedure TQRDBText.Unprepare;
begin
  Field := nil;
  inherited Unprepare;
  if DataField <> '' then
    SetDataField(DataField) { Reset component caption }
  else
    SetDataField(Name);
end;

function TQRDBText.UseRightToLeftAlignment: Boolean;
begin
  Result := QRDBUseRightToLeftAlignment(Self, Field);
end;

{ TQRExpr }

constructor TQRExpr.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Evaluator := TQREvaluator.Create;
  FExpression := '';
  FMask := '';
end;

destructor TQRExpr.Destroy;
begin
  Evaluator.Free;
  inherited Destroy;
end;

function TQRExpr.GetValue : TQREvResult;
begin
  if Evaluator.Prepared then
    result := Evaluator.Value
  else
    result.Kind := resError;
end;

procedure TQRExpr.Reset;
begin
   Evaluator.Reset;
end;

procedure TQRExpr.SetMaster(AComponent : TComponent);
begin
  FMaster := AComponent;
end;

procedure TQRExpr.QRNotification(Sender : TObject; Operation : TQRNotifyOperation);
begin
  inherited QRNotification(Sender, Operation);
  case Operation of
    qrMasterDataAdvance : Evaluator.DoAggregate;
  end;
end;

{$ifndef QRSTANDARD}
function TQRExpr.GetEditorClass : TQRPrintableEditorClass;
begin
  Result := TQRExprEditor;
end;
{$endif}

procedure TQRExpr.Prepare;
begin
  inherited Prepare;
  Evaluator.DataSets := ParentReport.AllDataSets;
  Evaluator.Environment := ParentReport.Functions;
  Evaluator.Prepare(FExpression);
  if assigned(FMaster) then
  begin
    if Master is TQuickRep then
      TCustomQuickRep(Master).AddNotifyClient(Self)
    else
      if Master is TQRSubDetail then
        TQRSubDetail(Master).AddNotifyClient(Self);
  end else
    if Evaluator.IsAggreg then ParentReport.AddNotifyClient(Self);
  Reset;
end;

procedure TQRExpr.Unprepare;
begin
  Evaluator.DataSets := nil;
  Evaluator.Unprepare;
  inherited Unprepare;
  SetExpression(Expression); { Reset component caption... }
end;

procedure TQRExpr.Print(OfsX, OfsY : integer);
var
  aValue : TQREvResult;
begin
  if IsEnabled then
  begin
    aValue := Evaluator.Value;
    case aValue.Kind of
      resInt : FPrintCaption := FormatFloat(Mask, aValue.IntResult * 1.0);
      resString : FPrintCaption := aValue.strResult;
      resDouble : FPrintCaption := FormatFloat(Mask,aValue.DblResult);
      resBool : if aValue.booResult then FPrintCaption := 'True' else FPrintCaption := 'False'; {<-- do not resource }
      resError : FPrintCaption := aValue.strResult;
    end;
    inherited Print(OfsX, OfsY);
    if ResetAfterPrint then Reset;
  end;
end;

procedure TQRExpr.SetExpression(Value : string);
begin
  FExpression := Value;
  if Value='' then
    Caption := '(' + SqrNone + ')'
  else
    Caption := Value;
  Invalidate;
end;

procedure TQRExpr.SetMask(Value : string);
begin
  FMask := Value;
  SetExpression(Expression);
end;

{ TQRSysData }

constructor TQRSysData.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FText := '';
  CreateCaption;
end;

procedure TQRSysData.Print(OfsX,OfsY : integer);
begin
  case FData of
    qrsTime : Caption := FText + FormatDateTime('t',SysUtils.Time);
    qrsDate : Caption := FText + FormatDateTime('c',SysUtils.Date);
    qrsDateTime : Caption := FText + FormatDateTime('c',Now);
    qrsPageNumber : Caption := FText + IntToStr(ParentReport.PageNumber);
    qrsReportTitle: Caption := FText + ParentReport.ReportTitle;
    qrsDetailCount: if ParentReport is TQuickRep then
      Caption := FText+IntToStr(TQUickRep(ParentReport).RecordCount);
    qrsDetailNo : if ParentReport is TQuickRep then
      Caption := FText+IntToStr(TQuickRep(ParentReport).RecordNumber);
  end;
  inherited Print(OfsX,OfsY);
end;

procedure TQRSysData.CreateCaption;
begin
  case FData of
    qrsTime : Caption := FText + '(' + SqrTime + ')';
    qrsDate : Caption := FText + '(' + SqrDate + ')';
    qrsDateTime : Caption := FText + '(' + SqrDateTime + ')';
    qrsPageNumber : Caption := FText + '(' + SqrPageNum + ')';
    qrsReportTitle: Caption := FText + '(' + SqrReportTitle + ')';
    qrsDetailCount: Caption := FText + '(' + SqrDetailCount + ')';
    qrsDetailNo : Caption := Ftext + '(' + SqrDetailNo + ')';
  end;
  Invalidate;
end;

procedure TQRSysData.SetData(Value : TQRSysDataType);
begin
  FData := Value;
  CreateCaption;
end;

procedure TQRSysData.SetText(Value : String);
begin
  FText := Value;
  CreateCaption;
end;

{ TQRShape }

constructor TQRShape.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  width := 65;
  Height := 65;
  FPen := TPen.Create;
  FBrush := TBrush.Create;
  FBrush.OnChange := StyleChanged;
  FPen.OnChange := StyleChanged;
end;

procedure TQRShape.StyleChanged(Sender : TObject);
begin
  invalidate;
end;

procedure TQRShape.SetShape(Value : TQRShapeType);
begin
  if FShape <> value then
  begin
    FShape := Value;
    Invalidate;
  end
end;

procedure TQRShape.SetBrush(Value : TBrush);
begin
  FBrush.Assign(Value);
end;

procedure TQRShape.SetPen(Value : TPen);
begin
  FPen.Assign(value);
end;

procedure TQRShape.SetRoundFactor(Value : single);
begin
  if FRoundFactor <> Value then
  begin
    FRoundFactor := Value;
    Invalidate;
  end;
end;

procedure TQRShape.Paint;
begin
  inherited paint;
  with Canvas do
  begin
    Pen := FPen;
    Brush := FBrush;
    Case FShape of
      qrsRectangle : Rectangle(0,0,Width,Height);
      qrsRoundRect : RoundRect( 0, 0, Width, Height,
             Trunc(Width * RoundFactor), Trunc(Width * RoundFactor));
      qrsCircle : Ellipse(0,0,Width,Height);
      qrsHorLine : begin
          MoveTo(0,Height div 2);
          LineTo(Width,Height div 2);
        end;
      qrsVertLine : begin
          MoveTo(Width div 2,0);
          LineTo(Width div 2,Height);
        end;
      qrsTopAndBottom : begin
          MoveTo(0,0);
          LineTo(Width,0);
          MoveTo(0,Height-1);
          LineTo(Width,Height-1);
        end;
      qrsRightAndLeft : begin
          MoveTo(0,0);
          LineTo(0,Height);
          MoveTo(Width-1,0);
          LineTo(Width-1,Height);
        end
    end
  end
end;
                                
procedure TQRShape.Print(OfsX,OfsY : Integer);
begin
  if parentreport.Exporting then
  begin
         TQRExportFilter(ParentReport.ExportFilter).acceptgraphic(
                              qrprinter.XPos(OfsX + self.Size.Left),
                              qrprinter.YPos(OfsY+ self.size.top ), self );
  end;

  if ParentReport.FinalPass and IsEnabled then
  begin
    QRPrinter.Canvas.Brush := Brush;
    QRPrinter.Canvas.Pen := Pen;
    with QRPrinter do
    begin
      with Canvas do
      begin
        case FShape of
          qrsRectangle : Rectangle(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top),
            XPos(OfsX+Size.Left + Size.Width), YPos(OfsY + Size.Top + Size.Height));
          qrsCircle : Ellipse(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top),
            XPos(OfsX+Size.Left + Size.Width), YPos(OfsY + Size.Top + Size.Height));
          qrsHorLine : begin
              MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top + Size.Height / 2));
              LineTo(XPos(OfsX + Size.Left + Size.Width),YPos(OfsY + Size.Top + Size.Height/2));
            end;
          qrsVertLine : begin
                MoveTo(XPos(OfsX+Size.Left + Size.Width / 2), YPos(OfsY + Size.Top));
                LineTo(XPos(OfsX+Size.Left + Size.Width / 2), Ypos(OfsY + Size.Height + Size.Top));
            end;
          qrsRoundRect : RoundRect(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top),
                         XPos(OfsX+Size.Left + Size.Width), YPos(OfsY + Size.Top + Size.Height),
                         Trunc(Width * RoundFactor), Trunc(Width * Roundfactor));
          qrsTopAndBottom : begin
              MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top));
              LineTo(Xpos(OfsX + Size.Left + Size.Width), YPos(OfsY + Size.Top));
              MoveTo(Xpos(OfsX + Size.Left), YPos(OfsY + Size.Top + Size.Height));
              LineTo(Xpos(OfsX + Size.Left + Size.Width), Ypos(OfsY + Size.Top + Size.Height));
            end;
          qrsRightAndLeft : Begin
              MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top));
              LineTo(Xpos(OfsX + Size.Left), YPos(OfsY + Size.Top + Size.Height));
              MoveTo(XPos(OfsX + Size.Left + Size.Width), YPos(OfsY + Size.Top));
              LineTo(XPos(OfsX + Size.Left + Size.Width), YPos(OfsY + Size.Top + Size.Height));
            end
        end
      end
    end
  end
end;

destructor TQRShape.Destroy;
begin
  FPen.Free;
  FBrush.Free;
  inherited Destroy;
end;

{ TQRImage }

constructor TQRImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
  Height := 105;
  Width := 105;
end;

destructor TQRImage.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

procedure TQRImage.SetAutoSize(Value: Boolean);
begin
  FAutoSize := Value;
  PictureChanged(Self);
end;

function TQRImage.GetPalette: HPALETTE;
begin
  Result := 0;
  if FPicture.Graphic is TBitmap then
    Result := TBitmap(FPicture.Graphic).Palette;
end;

procedure TQRImage.Paint;
var
  Dest: TRect;
begin
  if csDesigning in ComponentState then
    with inherited Canvas do
    begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
  if Stretch then
    Dest := ClientRect
  else if Center then
    Dest := Bounds((Width - Picture.Width) div 2, (Height - Picture.Height) div 2,
      Picture.Width, Picture.Height)
  else
    Dest := Rect(0, 0, Picture.Width, Picture.Height);
  if Zoom <> 100 then
  begin
    Dest.Right := Dest.Left + (Dest.Right - Dest.Left) * Zoom div 100;
    Dest.Bottom := Dest.Top + (Dest.Bottom - Dest.Top) * Zoom div 100;
  end;
  with inherited Canvas do
    StretchDraw(Dest, Picture.Graphic);
//  Inherited Paint;
end;

procedure TQRImage.Print(OfsX,OfsY : Integer);
var
  Dest : TRect;
  DC, SavedDC : THandle;
begin
  if parentreport.Exporting then
  begin
         TQRExportFilter(ParentReport.ExportFilter).acceptgraphic(
                              qrprinter.XPos(OfsX + self.Size.Left),
                              qrprinter.YPos(OfsY+ self.size.top ), self );
  end;
  Dest.Top := QRPrinter.YPos(OfsY + Size.Top);
  Dest.Left := QRPrinter.XPos(OfsX + Size.Left);
  Dest.Right := QRPrinter.XPos(OfsX + Size.Width + Size.Left);
  Dest.Bottom := QRPrinter.YPos(OfsY + Size.Height + Size.Top);
  if Stretch then
  begin
        QRPrinter.Canvas .StretchDraw(Dest, Picture.Graphic);
  end
  else
  begin
    IntersectClipRect(QRPrinter.Canvas.Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom);
    DC := GetDC(QRPrinter.Canvas.Handle);
    SavedDC := SaveDC(DC);
    Dest.Right := Dest.Left +
      round(Picture.Width / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.XFactor);
    Dest.Bottom := Dest.Top +
      round(Picture.Height / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.YFactor);
    if Center then OffsetRect(Dest,
      (QRPrinter.XSize(Size.Width) -