grimgctrl.pas

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

  FPicture.Free;
  inherited Destroy;
end;

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

procedure TQRGRImage.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 TQRGRImage.Print(OfsX,OfsY : Integer);
var
  Dest : TRect;
  DC, SavedDC : THandle;
begin
  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
    if Picture.Graphic is TBitmap then
      PrintBitmap(QRPrinter.Canvas, Dest, TBitmap(Picture.Graphic))
    else
      with QRPrinter.Canvas do
        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);
    if FClipImage then
    begin
      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) -
        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);
    end;
    if Picture.Graphic is TBitmap then
      PrintBitmap(QRPrinter.Canvas, Dest, TBitmap(Picture.Graphic))
    else
      QRPrinter.Canvas.StretchDraw(Dest, Picture.Graphic);
   RestoreDC(DC, SavedDC);
   SelectClipRgn(QRPrinter.Canvas.Handle, 0);
  end;
  inherited Print(OfsX,OfsY);
  if parentreport.Exporting then
  begin
         ParentReport.ExportFilter.acceptgraphic(
                              qrprinter.XPos(OfsX + self.Size.Left),
                              qrprinter.YPos(OfsY + self.Size.Top), self );
  end;
end;

function TQRGRImage.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 TQRGRImage.SetAutoSize(Value: Boolean);
begin
  FAutoSize := Value;
  PictureChanged(Self);
end;

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

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

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

procedure TQRGRImage.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;
{ TQRGrDBImage }
constructor TQRGrDBImage.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 TQRGrDBImage.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

procedure TQRGrDBImage.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;

procedure TQRGrDBImage.Print(OfsX, OfsY : integer);
var
  H, coffset : integer;
  Dest: TRect;
  DrawPict: TPicture;
  aspectratio : double;
begin
  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);
        AspectRatio := 1.0 * drawpict.Graphic.Width / drawpict.Graphic.height;
        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);
        FKeepHeight := false;
        FKeepWidth := false;
        if not FStretch then
        begin
          // adjust dest rect to keep aspect ratio of picture
          if FFitMode=fmKeepWidth then
                FKeepWidth := true
          else if FFitMode=fmKeepHeight then
                FKeepHeight := true
          else if FFitMode=fmInsideprop then
          begin
             // picture must shrink or grow to fit control
             if (drawpict.Width/self.width) < (drawpict.Height/self.Height) then
             begin
                  // the height ratio is greater so shrink the width and center horiz
                  coffset := dest.right-dest.left;
                  Dest.Right := QRPrinter.XPos(OfsX + Size.Left)
                            + round(drawpict.width/(drawpict.Height/self.Height));
                  coffset := ( coffset + dest.left-dest.right) div 2;
                  dest.left := dest.left + coffset;
                  dest.right := dest.right + coffset;
             end
             else
             begin
                  coffset := dest.bottom-dest.top;
                  Dest.Bottom := QRPrinter.YPos(OfsY + Size.Top)
                                  + round(drawpict.Height/(drawpict.Width/self.width));
                  coffset := ( coffset - dest.bottom+dest.top) div 2;
                  dest.top := dest.top + coffset;
                  dest.Bottom := dest.Bottom + coffset;
             end;
          end
          else // fmProportional : control grows to fit picture
          begin
             if (drawpict.Width/self.width) < (drawpict.Height/self.Height) then
             begin
                 FKeepWidth := true;
                 FKeepHeight := false;
             end
             else
             begin
                 FKeepWidth := false;
                 FKeepHeight := true;
             end;
          end;
          if FKeepWidth then
                 Dest.Bottom := QRPrinter.YPos(OfsY + (Size.width/aspectratio) + Size.Top)
          else if FKeepHeight then
                 Dest.Right := QRPrinter.XPos(OfsX + (Size.height*aspectratio) + Size.Left);
        end;

        if Stretch then
        begin
          if (DrawPict.Graphic = nil) or DrawPict.Graphic.Empty then
            FillRect(Dest)
          else
              QRPrinter.Canvas.StretchDraw(Dest, DrawPict.Graphic);
        end
        else
        begin // stretch is false
          IntersectClipRect(Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom);
          if FClipImage then
          begin
            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);
          end;
          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);
  if parentreport.Exporting then
  begin
         ParentReport.ExportFilter.acceptgraphic(
                              qrprinter.XPos(OfsX + self.Size.Left),
                              qrprinter.YPos(OfsY + self.Size.Top), self );
  end;

end;

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

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

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

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

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

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

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

procedure TQRGrDBImage.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 TQRGrDBImage.PictureChanged(Sender: TObject);
begin
  FPictureLoaded := True;
  Invalidate;
end;

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

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

{ TQRHTMLLabel }
function TQRHTMLLabel.GetEditorClass : TQRPrintableEditorClass;
begin
  Result := TQRLabelEditor;
end;

procedure TQRHTMLLabel.PrintToCanvas(aCanvas : TCanvas;
                     aLeft, aTop, aWidth, aHeight, LineHeight : extended;
                     CanExpand : boolean);
var
  aRect : TRect;
  ControlBottom : extended;
  X, Y : extended;
  SavedCaption : string;
  NewCaption : string;
  HasSaved : boolean;
  HasExpanded : boolean;
  Flags : integer;
  AAlignment : TAlignment;
  AFExpanded : extended;
  OrgWidth : extended;
  framew : integer;

  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;
            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(caption) > 0) and FShowOnDocs then
    begin
      ExtTextOut(aCanvas.Handle, QRPrinter.XPos(X), QRPrinter.YPos(Y),
        Flags, @aRect, pointer(pchar(caption)), length(caption), nil);
    end;
    if ParentReport.Exporting then
       if ParentReport.ExportFilter is TQRGHTMLDocumentFilter then
         ParentReport.ExportFilter.TextOut(X, Y, Font, Color, AAlignment,  '%!'+self.name+'!%' );
    Y := Y + LineHeight;
  end;

begin
  Flags := 0;
  AFExpanded := 0;
  OrgWidth := aWidth;
  HasSaved := false;
  if (caption <> '' ) {and (print event assigned)} then
  begin
    SavedCaption := Caption;
    NewCaption := Caption;
    //FOnPrint(Self, NewCaption);

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

    if NewCaption <> Caption then
    begin
      Caption := NewCaption;
      HasSaved := true;