qrctrls.pas

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

  aRect : TRect;
  ControlBottom : extended;
  X, Y : extended;
  SavedCaption : string;
  NewCaption : string;
  HasSaved : boolean;
  HasExpanded : boolean;
  Flags : integer;
  TAFlags : integer;
  AAlignment : TAlignment;
  AFExpanded : extended;
  OrgWidth : extended;

  function CanPrint : boolean;
  var
    PrevTop : extended;
  begin
    Result := true;
    if Y + LineHeight > ControlBottom then
    begin
      if CanExpand and TQRCustomBand(Parent).CanExpand(LineHeight) then
      begin
        PrevTop := AFExpanded;
        TQRCustomBand(Parent).ExpandBand(LineHeight, AFExpanded, HasExpanded);
        ControlBottom := aTop + aHeight + 1 + AFExpanded;
        if ParentReport.FinalPass and not Transparent then
          with aCanvas do
          begin
            Pen.Width := 0;
            Brush.Color := Color;
            Brush.Style := bsSolid;
            // there's a gap below ...
            FillRect(rect(QRPrinter.XPos(aLeft),
                          QRPrinter.YPos(aTop + AHeight + PrevTop),
                          QRPrinter.XPos(aLeft + aWidth),
                          QRPrinter.YPos(aTop + aHeight + AFExpanded)));
          end;
      end else
        Result := false;
    end;
  end;

  procedure PrintLine(LineNumber : integer);
  begin
    if ParentReport.FinalPass and (Length(FFormattedLines[LineNumber]) > 0) then
    begin
      ExtTextOut(aCanvas.Handle, QRPrinter.XPos(X), QRPrinter.YPos(Y),
        Flags, @aRect, @FFormattedLines[LineNumber][1], length(FFormattedLines[LineNumber]), nil);
    end;
    if ParentReport.Exporting then
      ParentReport.ExportFilter.TextOut(X, Y, Font, Color, AAlignment, FFormattedLines[LineNumber]);
    Y := Y + LineHeight;
  end;

begin
  Flags := 0;
  AFExpanded := 0;
  OrgWidth := aWidth;
{  if AutoSize then Flags := 0; else Flags := ETO_CLIPPED;}
{  if Transparent then Flags := Flags + ETO_OPAQUE;}
  HasSaved := false;
  if (FPrintCaption <> '') and assigned(FOnPrint) then
  begin
    SavedCaption := FPrintCaption;
    NewCaption := FprintCaption;
    FOnPrint(Self, NewCaption);

    if Font <> aCanvas.Font then
    begin
      aCanvas.Font := Font;
      aHeight := Size.Height;
      LineHeight := aCanvas.TextHeight('W') / QRPrinter.YFactor;
    end;

    if NewCaption <> FPrintCaption then
    begin
      FPrintCaption := NewCaption;
      FormatLines;
      HasSaved := true;
    end;
  end;
  FormatLines;
//  aWidth := Width / QRPrinter.XFactor;
  {if not Autosize then }aWidth := Size.Width;
  if ParentReport.FinalPass and not Transparent then
    with aCanvas do
    begin
      Pen.Width := 0;
      Brush.Color := Color;
      Brush.Style := bsSolid;
      FillRect(rect(QRPrinter.XPos(aLeft),
                    QRPrinter.YPos(aTop),
                    QRPrinter.XPos(aLeft + aWidth),
                    QRPrinter.YPos(aTop + aHeight)));
    end;
  if ParentReport.FinalPass then
    if not AutoSize then;
  if Frame.AnyFrame then
  begin
    if Frame.DrawTop then
      aTop := aTop + round(Frame.Width / 72 * 254 );
    if Frame.DrawLeft then
      aLeft := aLeft + round(Frame.Width / 72 * 254 )
  end;
  { Get our rectangle for the next line }
  aRect := Rect(0, 0, QRPrinter.XSize(aWidth), QRPrinter.YSize(LineHeight));

  AAlignment := Alignment;
  if UseRightToLeftAlignment then
    ChangeBiDiModeAlignment(AAlignment);

  { Calculate some stuff... }
  ControlBottom := aTop + aHeight + 1;
  Y := aTop;
  if not AutoSize then
    X := aLeft
  else
  begin
    case Alignment of
      TaLeftJustify : X := aLeft;
      TaRightJustify: X := aLeft - (aWidth - OrgWidth);
      TaCenter : X := aLeft - ((aWidth - OrgWidth) / 2);
    end;
  end;

  SetBkMode(aCanvas.Handle, Windows.Transparent);
  { Set the attributes and update X for alignment }
// used in QR3.5
  TAFlags := TA_Top + TA_NoUpdateCP;
  AAlignment := Alignment;
  if UseRightToLeftAlignment then
    ChangeBiDiModeAlignment(AAlignment);
  if UseRightToLeftReading then
  begin
    Flags := Flags or ETO_RTLREADING;
    TAFlags := TAFlags + TA_RTLREADING;
  end;
  case AAlignment of
    TaLeftJustify : SetTextAlign(aCanvas.Handle, TA_Left + TAFlags);
    TaRightJustify: begin
      SetTextAlign(aCanvas.Handle, TA_Right + TAFlags);
      X := X + aWidth;
    end;
    TaCenter : begin
      SetTextAlign(aCanvas.Handle, TA_Center + TAFlags);
      X := X + aWidth / 2;
    end;
  end;

  HasExpanded := false;
  if PrintFinished then
    FCurrentLine := 0;

  while (FCurrentLine <= FFormattedLines.Count - 1) and CanPrint do
  begin
    PrintLine(FCurrentLine);
    inc(FCurrentLine);
  end;

  if (FCurrentLine <= FFormattedLines.Count - 1) and AutoStretch then
    PrintFinished := false
  else
    PrintFinished := true;
  SelectClipRgn(QRPrinter.Canvas.Handle, 0);
// end new code

  if HasSaved then
    FPrintCaption := SavedCaption;

  if (ParentReport.FinalPass or ParentReport.Exporting) and Frame.AnyFrame then
    TQRFixFrame(Frame).PaintIt(aCanvas,
      rect(QRPrinter.XPos(ALeft),
        QRPrinter.YPos(ATop),
        QRPrinter.XPos(ALeft + aWidth),
        QRPrinter.YPos(Atop + Size.height+ AFExpanded)),
      QRPrinter.XFactor,
      QRPrinter.YFactor);
end;

procedure TQRCustomLabel.Paint;
begin
  Canvas.Font.Assign(Font);
  if Canvas.Font.Size <> round(Font.Size * Zoom / 100) then
    Canvas.Font.Size := round(Font.Size * Zoom / 100);
  inherited Paint;
  PaintToCanvas(Canvas, rect(0, 0, Width, Height), false, round(Canvas.TextHeight('W')));
  PaintCorners;
end;

procedure TQRCustomLabel.Print(OfsX, OfsY : integer);
var
  aCanvas : TCanvas;
begin
  if IsEnabled then
  begin
    aCanvas := QRPrinter.Canvas;
    aCanvas.Font := Font;
    with QRPrinter do
      PrintToCanvas(QRPrinter.Canvas,
                    OfsX + Size.Left, OfsY + Size.Top,
                    Size.Width, Size.Height,
                    aCanvas.TextHeight('W') / QRPrinter.YFactor, AutoStretch);
//    inherited Print(OfsX, OfsY);
  end;
end;

procedure TQRCustomLabel.SetAutoStretch(Value : boolean);
begin
  FAutoStretch := Value;
  Invalidate;
end;

procedure TQRCustomLabel.SetCaption(Value : string);
begin
  FCaption := Value;
  FPrintCaption := Value;
  DoneFormat := false;
  FormatLines;
  Invalidate;
end;

procedure TQRCustomLabel.SetName(const Value: TComponentName);
begin
  if ((Caption = '') or (Caption = Name)) then
    Caption := Value;
  inherited SetName(Value);
end;

procedure TQRCustomLabel.SetParent(AParent : TWinControl);
begin
  inherited SetParent(AParent);
  FormatLines;
end;

procedure TQRCustomLabel.SetAlignment(Value : TAlignment);
begin
  inherited SetAlignment(Value);
end;

procedure TQRCustomLabel.SetWordWrap(Value : boolean);
begin
  FWordWrap := Value;
  Invalidate;
end;

{ TQRLabel }

function TQRLabel.GetEditorClass : TQRPrintableEditorClass;
begin
  Result := TQRLabelEditor;
end;

{ TQRMemo }
function TQRMemo.GetCaptionBased : boolean;
begin
  Result := false;
end;

procedure TQRMemo.Paint;
begin
  if (Lines.Count > 0) and (Caption > '') then
    Caption := '';
  inherited Paint;
end;

procedure TQRMemo.Print(OfsX, OfsY : integer);
begin
{  if (Lines.Count > 0) then}
  Caption := '';
  inherited Print(OfsX, OfsY);
  Caption := Name;
end;

procedure TQRMemo.GetExpandedHeight(var newheight : extended );
var
     Nlines : integer;
     lineheight : extended;
begin
      FormatLines;
      if parentreport.QRPrinter.canvas <> nil then
      begin
             parentreport.QRPrinter.canvas.font := self.font;
             LineHeight := parentreport.QRPrinter.Canvas.TextHeight('W');
      end
      else
             LineHeight := self.Canvas.TextHeight('W');

      Nlines := FFormattedLines.Count;
      // pixels
      newheight := nlines * (lineheight + 2);
end;
{ TQRDBText }

constructor TQRDBText.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  DataSourceName := '';
  ComboBox := nil;
  IsMemo := false;
end;

procedure TQRDBText.GetExpandedHeight(var newheight : extended );
var
     Nlines : integer;
     lineheight : extended;
begin
      self.getfieldstring( FPrintCaption );
      FormatLines;
      if parentreport.QRPrinter.canvas <> nil then
      begin
             parentreport.QRPrinter.canvas.font := self.font;
             LineHeight := parentreport.QRPrinter.Canvas.TextHeight('W');
      end
      else
             LineHeight := self.Canvas.TextHeight('W');

      Nlines := FFormattedLines.Count;
      newheight := nlines * (lineheight);
end;

procedure TQRDBText.GetFieldString( var DataStr : string);
begin
  if IsEnabled then
  begin
    if FieldOK then
    begin
      if FDataSet.DefaultFields then
        Field := FDataSet.Fields[FieldNo];
    end
    else
      Field := nil;
    if assigned(Field) then
    begin
      try
        if (Field is TMemoField) or
           (Field is TBlobField) then
        begin
          // caution : Lines is a property of self
          Lines.Text := TMemoField(Field).AsString;
        end
        else
          if (Mask = '') or (Field is TStringField) then
            if not (Field is TBlobField) then
              DataStr := Field.DisplayText
            else
              DataStr := Field.AsString
          else
          begin
            if (Field is TIntegerField) or
               (Field is TSmallIntField) or
               (Field is TWordField) then
               DataStr := FormatFloat(Mask, TIntegerField(Field).Value * 1.0)
            else
              if (Field is TFloatField) or
                 (Field is TCurrencyField) or
                 (Field is TBCDField) then
                 DataStr := FormatFloat(Mask,TFloatField(Field).Value)
              else
                if (Field is TDateTimeField) or
                   (Field is TDateField) or
                   (Field is TTimeField) then
                  DataStr := FormatDateTime(Mask,TDateTimeField(Field).Value);
          end;
      except
        DataStr := '';
      end;
    end else
      DataStr := '';
  end;
end;

procedure TQRDBText.SetDataSet(Value : TDataSet);
begin
  FDataSet := Value;
  if Value <> nil then
    Value.FreeNotification(self);
end;

function TQRDBText.GetCaptionBased : boolean;
begin
  Result := not IsMemo;
end;

procedure TQRDBText.SetDataField(Value : string);
begin
  FDataField := Value;
  Caption := Value;
end;

procedure TQRDBText.Loaded;
var
  aComponent : TComponent;
begin
  inherited Loaded;
  if DataSourceName<>'' then
  begin
    aComponent := Owner.FindComponent(DataSourceName);
    if (aComponent <> nil) and (aComponent is TDataSource) then
      DataSet:=TDataSource(aComponent).DataSet;
  end;
end;

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

procedure TQRDBText.SetMask(Value : string);
begin
  FMask := Value;
end;

procedure TQRDBText.Prepare;
begin
  inherited Prepare;
  if assigned(FDataSet) then
  begin
    Field := FDataSet.FindField(FDataField);
    if Field <> nil then
    begin
      FieldNo := Field.Index;
      FieldOK := true;
      if (Field is TMemoField) or (Field is TBlobField) then
      begin
        FPrintCaption := '';
        IsMemo := true;
      end
        else IsMemo := false;
    end;
  end else
  begin
    Field := nil;
    FieldOK := false;
  end;
end;

procedure TQRDBText.Print(OfsX, OfsY : integer);
begin
  if IsEnabled then
  begin
    if FieldOK then
    begin
      if FDataSet.DefaultFields then
        Field := FDataSet.Fields[FieldNo];