qrctrls.pas

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

        round(Picture.Width / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.XFactor)) div 2,
      (QRPrinter.YSize(Size.Height) -
        round(Picture.Height / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.YFactor)) div 2);
    QRPrinter.Canvas.StretchDraw(Dest, Picture.Graphic);
   RestoreDC(DC, SavedDC);
   SelectClipRgn(QRPrinter.Canvas.Handle, 0);
  end;
  inherited Print(OfsX,OfsY);
end;

function TQRImage.GetCanvas: TCanvas;
var
  Bitmap: TBitmap;
begin
  if Picture.Graphic = nil then
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.Width := Width;
      Bitmap.Height := Height;
      Picture.Graphic := Bitmap;
    finally
      Bitmap.Free;
    end;
  end;
  if Picture.Graphic is TBitmap then
    Result := TBitmap(Picture.Graphic).Canvas
  else
    Result := nil;
{    raise EInvalidOperation.CreateRes(SImageCanvasNeedsBitmap)};
end;

procedure TQRImage.SetCenter(Value: Boolean);
begin
  if FCenter <> Value then
  begin
    FCenter := Value;
    PictureChanged(Self);
  end;
end;

procedure TQRImage.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TQRImage.SetStretch(Value: Boolean);
begin
  if Value <> FStretch then
  begin
    FStretch := Value;
    PictureChanged(Self);
  end;
end;

procedure TQRImage.PictureChanged(Sender: TObject);
begin
  if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
    SetBounds(Left, Top, Picture.Width, Picture.Height);
  if (Picture.Graphic is TBitmap) and (Picture.Width >= Width) and
    (Picture.Height >= Height) then
    ControlStyle := ControlStyle + [csOpaque] else
    ControlStyle := ControlStyle - [csOpaque];
  Invalidate;
end;

{ TQRDBImage }

constructor TQRDBImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csFramed, csOpaque];
  Width := 105;
  Height := 105;
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
  FCenter := True;
end;

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

procedure TQRDBImage.Prepare;
begin
  inherited Prepare;
  if assigned(FDataSet) then
  begin
    FField := DataSet.FindField(FDataField);
    if Field is TBlobField then
    begin
      Caption := '';
    end;
  end else
    FField := nil;
end;

// return value in screen pixels
procedure TQRDBImage.GetExpandedHeight(var newheight : extended );
var
  DrawPict: TPicture;
begin
    newheight := self.Height; // default in case of failure.
    DrawPict := TPicture.Create;
    try
      if assigned(FField) and (FField is TBlobField) then
      begin
        DrawPict.Assign(FField);
        newheight := DrawPict.Bitmap.Height;
      end
    finally
       drawpict.free;
    end;
end;

procedure TQRDBImage.GetFieldString( var DataStr : string);
begin
end;

procedure TQRDBImage.Print(OfsX, OfsY : integer);
var
  H: integer;
  Dest: TRect;
  DrawPict: TPicture;
begin
  if parentreport.Exporting then
  begin
         TQRExportFilter(ParentReport.ExportFilter).acceptgraphic(
                              qrprinter.XPos(OfsX + self.Size.Left),
                              qrprinter.YPos(OfsY+ self.size.top ), self );
  end;
  with QRPrinter.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := Color;
    DrawPict := TPicture.Create;
    H := 0;
    try
      if assigned(FField) and (FField is TBlobField) then
      begin
        DrawPict.Assign(FField);
        if (DrawPict.Graphic is TBitmap) and
          (DrawPict.Bitmap.Palette <> 0) then
        begin
          H := SelectPalette(Handle, DrawPict.Bitmap.Palette, false);
          RealizePalette(Handle);
        end;
        Dest.Left := QRPrinter.XPos(OfsX + Size.Left);
        Dest.Top := QRPrinter.YPos(OfsY + Size.Top);
        Dest.Right := QRPrinter.XPos(OfsX + Size.Width + Size.Left);
        Dest.Bottom := QRPrinter.YPos(OfsY + Size.Height + Size.Top);
        if Stretch then
        begin
          if (DrawPict.Graphic = nil) or DrawPict.Graphic.Empty then
            FillRect(Dest)
          else
            with QRPrinter.Canvas do
              StretchDraw(Dest, DrawPict.Graphic);
        end else
        begin
          IntersectClipRect(Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom);
          Dest.Right := Dest.Left +
            round(DrawPict.Width / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.XFactor);
          Dest.Bottom := Dest.Top +
            round(DrawPict.Height / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.YFactor);
          if Center then OffsetRect(Dest,
            (QRPrinter.XSize(Size.Width) -
              round(DrawPict.Width / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.XFactor)) div 2,
            (QRPrinter.YSize(Size.Height) -
              round(DrawPict.Height / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.YFactor)) div 2);
          QRPrinter.Canvas.StretchDraw(Dest, DrawPict.Graphic);
          SelectClipRgn(Handle, 0);
        end;
      end;
    finally
      if H <> 0 then SelectPalette(Handle, H, True);
      DrawPict.Free;
    end;
  end;
  inherited Print(OfsX,OfsY);
end;

procedure TQRDBImage.Unprepare;
begin
  FField := nil;
  inherited Unprepare;
end;

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

procedure TQRDBImage.SetDataField(const Value: string);
begin
  FDataField := Value;
end;

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

procedure TQRDBImage.SetCenter(Value: Boolean);
begin
  if FCenter <> Value then
  begin
    FCenter := Value;
    Invalidate;
  end;
end;

procedure TQRDBImage.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TQRDBImage.SetStretch(Value: Boolean);
begin
  if FStretch <> Value then
  begin
    FStretch := Value;
    Invalidate;
  end;
end;

procedure TQRDBImage.Paint;
var
  W, H: Integer;
  R: TRect;
  S: string;
begin
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := Color;
    Font := Self.Font;
    if Field <> nil then
      S := Field.DisplayLabel
    else S := Name;
    S := '(' + S + ')';
    W := TextWidth(S);
    H := TextHeight(S);
    R := ClientRect;
    TextRect(R, (R.Right - W) div 2, (R.Bottom - H) div 2, S);
  end;
  Inherited Paint;
end;

procedure TQRDBImage.PictureChanged(Sender: TObject);
begin
  FPictureLoaded := True;
  Invalidate;
end;

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

procedure TQRDBImage.LoadPicture;
begin
  if not FPictureLoaded and (Field is TBlobField) then
    Picture.Assign(FField);
end;


{ TQRCusomRichText }

constructor TQRCustomRichText.Create(AOwner : TComponent);
begin
  FRichEdit := nil;
  inherited Create(AOwner);
  FRichEdit := TQRRichEdit.Create(Self);
  FRichEdit.Parent := self;
  FRichEdit.BorderStyle := bsNone;
  AutoStretch := false;
  PrintFinished := true;
  Width := 100;
  Height := 100;
end;

destructor TQRCustomRichText.Destroy;
begin
  FRichEdit.Free;
  inherited Destroy;
end;

function TQRCustomRichText.GetControlsAlignment: TAlignment;
begin
  Result := FRichEdit.Alignment;
end;

function TQRCustomRichText.GetAlignment : TAlignment;
begin
  result := FRichEdit.Alignment;
end;

function TQRCustomRichText.GetColor : TColor;
begin
  result := FRichEdit.Color;
end;

function TQRCustomRichText.GetFont : TFont;
begin
  result := FRichEdit.Font;
end;

function TQRCustomRichText.GetLines : TStrings;
begin
  result := FRichEdit.Lines;
end;

procedure TQRCustomRichText.Print(OfsX, OfsY : integer);
var
  Range: TFormatRange;
  LogX, LogY : integer;
  TextLength : integer;
  HasExpanded : boolean;
  OldMapMode : integer;
  ARichEdit : TCustomRichEdit;
  Expanded : extended;
  RTFImage : TQRImage;
  expht, expwid : integer;
  RTFMeta : TMetafile;
  metacanvas : TMetafilecanvas;

  function Render(RenderIt : boolean) : integer;
  begin
    if RenderIt then
      Result := SendMessage(ARichEdit.Handle, EM_FORMATRANGE, 0, Longint(@Range))
    else
      Result := SendMessage(ARichEdit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
  end;

begin
  if assigned(FParentRichEdit) then
    ARichEdit := ParentRichEdit
  else
    ARichEdit := FRichEdit;
  FillChar(Range, SizeOf(TFormatRange), 0);
  with Range do
  begin
    hdc := ParentReport.QRPrinter.Canvas.Handle;
    if ParentReport.QRPrinter.Destination = qrdMetafile then
            hdcTarget := hdc
    else
            hdcTarget := ParentReport.QRPrinter.PrinterHandle;

    LogX := GetDeviceCaps(hdc, LOGPIXELSX);
    LogY := GetDeviceCaps(hdc, LOGPIXELSY);

    rc := Rect(QRPrinter.XPos(OfsX + Size.Left) * 1440 div LogX,
               QRPrinter.YPos(OfsY + Size.Top) * 1440 div LogY,
               QRPrinter.XPos(OfsX + Size.Left + Size.Width) * 1440 div LogX,
               QRPrinter.YPos(OfsY + Size.Top + Size.Height) * 1440 div LogY);
    rcPage := Rect(0, 0, QRPrinter.XSize(QRPrinter.PaperWidth) * 1440 div LogX,
                         QRPrinter.YSize(QRPrinter.PaperLength) * 1440 div LogY);

    if PrintFinished then
      LastChar := 0;
    HasExpanded := false;
    Expanded := 0;
    TextLength := ARichEdit.GetTextLen;
    chrg.cpMax := -1;
    chrg.cpMin := LastChar;
    OldMapMode := SetMapMode(hdc, MM_TEXT);
    LastChar := Render(false);
    if (LastChar < TextLength) and AutoStretch and (Parent is TQRCustomBand) and (TextLength > 0) then
    begin
      PrintFinished := false;
      while (LastChar <= TextLength) and TQRCustomBand(Parent).CanExpand(50) do
      begin
        TQRCustomBand(Parent).ExpandBand(50, Expanded, HasExpanded);
        rc.Bottom := QRPrinter.YPos(OfsY + Size.Top + Size.Height + Expanded) * 1440 div LogY;
        LastChar := Render(false);
      end;
      LastChar := Render(true);
      if (LastChar >= TextLength) or (LastChar = -1) then
      begin
        LastChar := TextLength;
        PrintFinished := true;
      end
    end else
    begin
      LastChar := Render(true);
      PrintFinished := true;
      inherited;
    end;
  end;

  if parentreport.Exporting then
  begin
       RTFImage := TQRImage.create(nil);
       rtfimage.FAutoSize := true;

       rtfmeta := TMetafile.Create;
       rtfmeta.height := round((range.rc.bottom-range.rc.top) *LogX/1440.0);
       rtfmeta.width := round((range.rc.Right-range.rc.left) *LogX/1440.0);
       metacanvas := TMetafilecanvas.Create( rtfmeta, qrprinter.Canvas.handle);

       expwid := round((range.rc.Right-range.rc.left) *LogX/1440.0);
       expht := round((range.rc.bottom-range.rc.top) *LogX/1440.0);
       range.hdc := metaCanvas.Handle;
       range.hdcTarget := metaCanvas.Handle;
       SetMapMode(range.hdc, MM_TEXT);
       range.rc := rect( 0, 0, expwid * 1440 div LogX, expht * 1440 div LogY);
       range.rcPage := rect( 0, 0, expwid * 1440 div LogX, 2*expht * 1440 div LogY);
       SendMessage(ARichEdit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
       // MUST free the canvas before the metafile has an image (thanks, Bill)
       metacanvas.free;
       rtfimage.FPicture.Assign( rtfMeta);
       // set up the image control export
       rtfimage.Size.Left := size.Left;
       rtfimage.Size.width := size.width;
       rtfimage.Size.top := size.top;
       rtfimage.Size.height := size.height;
       rtfimage.Width := round((range.rc.Right-range.rc.left) *LogX/1440.0);
       rtfimage.Height := round((range.rc.bottom-range.rc.top) *LogX/1440.0);

       TQRExportFilter(ParentReport.ExportFilter).acceptgraphic(
                              qrprinter.XPos(OfsX + rtfimage.Size.Left),
                              qrprinter.YPos(OfsY+ rtfimage.size.top ), rtfimage );
       rtfimage.free;
       rtfMeta.free;
  end;

  SetMapMode(ParentReport.QRPrinter.Canvas.Handle, OldMapMode);
  if PrintFinished then
    SendMessage(ARichEdit.Handle, EM_FORMATRANGE, 0, 0);
end;


procedure TQRCustomRichText.SetAlignment(Value : TAlignment);
begin
  FRichEdit.Alignment := Value;
end;

proced