Jump to content
Ian Branch

Print a jpeg from a table blob field?

By Ian Branch, in General Help

Recommended Posts

Ian Branch    127

Ian Branch
Posted

Hi Team,

I have jpegs saved into TTable Blob fields.  1 per record.

How do I extract and print that jpeg to the PCs Printer please?

I have made several 'attempts' without success.

 

Regards & TIA,

Ian

Share this post

Link to post

PeterBelow    238

PeterBelow
Posted
4 hours ago, Ian Branch said:

Hi Team,

I have jpegs saved into TTable Blob fields.  1 per record.

How do I extract and print that jpeg to the PCs Printer please?

I have made several 'attempts' without success.

 

Regards & TIA,

Ian

I found some really ancient code for this in my old snippets file, perhaps you can get it to work. It loads a JPEG from file but you can load it from a TBlobstream attached to your field as well.

  

Printing a JPEG image:

uses jpeg, printers;


// This procedure has been adapted from the one found near the end of
// the Delphi 1 MANUALS.TXT file.
procedure PrintBitmap(Bitmap: TBitmap; printrect: TRect);
var
  Info: PBitmapInfo;
  InfoSize: Cardinal;
  Image: Pointer;
  ImageSize: Cardinal;
begin
  with Bitmap do
  begin
    GetDIBSizes(Handle, InfoSize, ImageSize);
    Info := AllocMem(InfoSize);
    try
      Image := AllocMem(ImageSize);
      try
        GetDIB(Handle, Palette, Info^, Image^);
        with Info^.bmiHeader, printrect do
          StretchDIBits(Printer.Canvas.Handle, Left, Top, Right-Left,
            Bottom-Top, 0, 0, biWidth, biHeight, Image, Info^,
            DIB_RGB_COLORS, SRCCOPY);
      finally
        FreeMem(Image, ImageSize);
      end;
    finally
      FreeMem(Info, InfoSize);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp: TBitmap;
  jpegimage: TJPegImage;
  outputrect: TRect;
  i: Integer;
begin
  jpegimage:= TJPegImage.Create;
  try
    jpegimage.Loadfromfile('d:\daten\pix\fraktal_1.jpg');
    bmp := tbitmap.Create;
    try
      bmp.assign( jpegimage );
      i:= 1;
      While ((i+1)*bmp.Width < printer.pagewidth) and
            ((i+1)*bmp.Height < printer.pageheight)
      Do
        Inc(i);
      outputrect := Rect( 0, 0, i*bmp.width, i*bmp.height );
      try
        printer.Orientation := poLandscape;
        printer.begindoc;
        PrintBitmap( bmp, outputrect );
      except
        printer.abort;
        raise;
      end;
      printer.enddoc;
    finally
      bmp.Free;
    end;

  finally
    jpegimage.free
  end;

end;

 

  • Like 1

Share this post

Link to post

programmerdelphi2k    237

programmerdelphi2k
Posted

basically, you would can read your field using TBLOBField class that is present in any Dataset

see :

https://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TDataSet.CreateBlobStream

 

later that, you can send the stream to another target to process it

 

Share this post

Link to post

Ian Branch    127

Ian Branch
Posted

Hi Team,

I cheated a little bit here and have this att.. 

procedure TJobTicketsForm.btnPrintImageClick(Sender: TObject);
var
  bmp               : TBitmap;
  jpegimage         : TJPegImage;
  outputrect        : TRect;
  i                 : Integer;
  sFilename         : string;
begin
  //
  sFilename := 'TempImage.jpg';
  if TFile.Exists(sFileName) then TFile.Delete(sFileName);
  (dmC.jtImages.FieldByName('JTImage') as TBlobField).SaveToFile(sFilename);
  //
  jpegimage := TJPegImage.Create;
  try
    jpegimage.Loadfromfile(sFileName);
    bmp := tbitmap.Create;
    try
      bmp.assign(jpegimage);
      i := 1;
      while ((i + 1) * bmp.Width < printer.pagewidth) and
        ((i + 1) * bmp.Height < printer.pageheight) do
        Inc(i);
      outputrect := Rect(0, 0, i * bmp.width, i * bmp.height);
      try
        printer.Orientation := poPortrait;
        printer.begindoc;
        PrintBitmap(bmp, outputrect);
      except
        printer.abort;
        raise;
      end;
      printer.enddoc;
    finally
      bmp.Free;
    end;

  finally
    jpegimage.free;
    if TFile.Exists(sFileName) then TFile.Delete(sFileName);
  end;

end;

It appears to work.  The file is created and it contains the right image.  On the disk, TempImage.jpg is only 200KB

If I look at the Print Queue it has the file, 38.4MB,  ostensibly printing but the printer is doing nothing.. 😞

. 

 

image.png

Share this post

Link to post

programmerdelphi2k    237

programmerdelphi2k
Posted (edited)

hi @Ian Branch

 

try my sample:

  • my "resize proc" it's not reliable ok (but it's good for me), use any other library for better result!!!
  • my Firebird table with a BLOB field storing just "JPEG" for this test (any other type needs re-draw my procedure below)
  • no needs store on file, send it directly to printer!
  • tested in a PDF default printer on MSWin10  -> JPEG 1920x1080 generated  a file 707KB. 
type
  TForm1 = class(TForm)
    FDGUIxWaitCursor1: TFDGUIxWaitCursor;
    FDPhysFBDriverLink1: TFDPhysFBDriverLink;
    FDConnection1: TFDConnection;
    FDQuery1: TFDQuery;
    FDQuery1ID: TIntegerField;
    FDQuery1MYJPEG: TBlobField;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
...

implementation

procedure MyResizeBitmap2(           { }
  const AJPEGsource: TJPEGImage;     { }
  const ABitmapTarget: TBitmap;      { }
  const LPrinterPageWidth: integer;  { }
  const LPrinterPageHeigth: integer; { }
  const AScaled: boolean);
var
  ANewWidth : integer;
  ANewHeight: integer;
  //
  LPrinterScale: double;
  //
  LJPEGWidth : integer;
  LJPEGHeight: integer;
  //
  LScaleW: double;
  LScaleH: double;
begin
  LJPEGWidth    := AJPEGsource.Width;
  LJPEGHeight   := AJPEGsource.Height;
  LPrinterScale := 1;
  //
  if AScaled then
    begin
      LScaleW := LPrinterPageWidth / LJPEGWidth;
      if (LJPEGWidth > LPrinterPageWidth) then
        LScaleW := LJPEGWidth / LPrinterPageWidth;
      //
      LScaleH := LPrinterPageHeigth / LJPEGHeight;
      if (LJPEGHeight > LPrinterPageHeigth) then
        LScaleH := LJPEGHeight / LPrinterPageHeigth;
      //
      LPrinterScale := LScaleW;
      if LScaleW > LScaleH then
        LPrinterScale := LScaleH;
    end;
  //
  ANewWidth  := Trunc(AJPEGsource.Width * LPrinterScale);
  ANewHeight := Trunc(AJPEGsource.Height * LPrinterScale);
  //
  { Form1.Memo1.Lines.Add('-----------');
    Form1.Memo1.Lines.Add(format('Printer: W=%d, H=%d', [LPrinterPageWidth, LPrinterPageHeigth]));
    Form1.Memo1.Lines.Add(format('Printer scales: %f', [LPrinterScale]));
    Form1.Memo1.Lines.Add(format('New W=%d, H=%d', [ANewWidth, ANewHeight])); }
  //
  ABitmapTarget.PixelFormat := pf24bit;
  ABitmapTarget.Width       := ANewWidth;
  ABitmapTarget.Height      := ANewHeight;
  //
  ABitmapTarget.Canvas.StretchDraw(Rect(0, 0, ANewWidth, ANewHeight), AJPEGsource);
  //
  AJPEGsource.Assign(ABitmapTarget);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  // temp for memory works...
  LPrinter       : TPrinter;
  LJPEG          : TJPEGImage;
  LJPEGStream    : TMemoryStream;
  LBitmapToResize: TBitmap;
begin
  LJPEGStream     := TMemoryStream.Create;
  LJPEG           := TJPEGImage.Create;
  LBitmapToResize := TBitmap.Create(1, 1);
  try
    // my field BLOB with only "JPEG" files!!! any other raise an exception!!!
    // header: ($FF, $D8, $FF);      // 255, 216, 255
    FDQuery1MYJPEG.SaveToStream(LJPEGStream);
    //
    LJPEGStream.Position := 0;
    LJPEG.LoadFromStream(LJPEGStream);
    //
    Memo1.Text := format('JPEG: %dx%d', [LJPEG.Width, LJPEG.Height]);
    //
    if not(LJPEG.Empty) then
      begin
        LPrinter := TPrinter.Create;
        try
          LPrinter.PrinterIndex := -1; // current printer ( if any one ??? )
          LPrinter.Orientation  := TPrinterOrientation(integer(not chkbxPortrait.Checked));
          //
          // try resize to fill the page on printing...
          MyResizeBitmap2(                           { }
            LJPEG,                                   { }
            LBitmapToResize,                         { }
            GetDeviceCaps(LPrinter.Handle, HORZRES), { }
            GetDeviceCaps(LPrinter.Handle, VERTRES), { }
            chkbxScaled.Checked);
          //
          Memo1.Lines.Add(format('JPEG loaded: %dx%d', [LJPEG.Width, LJPEG.Height]));
          //
          LPrinter.BeginDoc;
          LPrinter.Canvas.Draw(0, 0, LJPEG);
          LPrinter.EndDoc;
        finally
          LPrinter.Free;
        end;
      end;
  finally
    LBitmapToResize.Free;
    LJPEG.Free;
    LJPEGStream.Free;
  end;
end;

image.thumb.png.c1a5848f90e92da0517e9e28dd46209a.png

Edited by programmerdelphi2k

Share this post

Link to post

programmerdelphi2k    237

programmerdelphi2k
Posted (edited)
1 hour ago, Ian Branch said: 

finally
    jpegimage.free;
    if TFile.Exists(sFileName) then TFile.Delete(sFileName);
  end;

are you deleting your file here?

Edited by programmerdelphi2k

Share this post

Link to post

Ian Branch    127

Ian Branch
Posted

I have just implemented you code.   

procedure TJobTicketsForm.btnPrintImageClick(Sender: TObject);
var
  // temp for memory works...
  LPrinter          : TPrinter;
  LJPEG             : TJPEGImage;
  LJPEGStream       : TMemoryStream;
  LBitmapToResize   : TBitmap;
begin
  LJPEGStream := TMemoryStream.Create;

  LJPEG := TJPEGImage.Create;
  LBitmapToResize := TBitmap.Create(1, 1);
  try
    // my field BLOB with only "JPEG" files!!! any other raise an exception!!!
    // header: ($FF, $D8, $FF);      // 255, 216, 255
    (dmC.jtImages.FieldByName('JTImage') as TBlobField).SaveToStream(LJPEGStream);
    //
    LJPEGStream.Position := 0;
    LJPEG.LoadFromStream(LJPEGStream);
    //
    //Memo1.Text := format('JPEG: %dx%d', [LJPEG.Width, LJPEG.Height]);
    //
    if not (LJPEG.Empty) then
    begin
      LPrinter := TPrinter.Create;
      try
        LPrinter.PrinterIndex := -1; // current printer ( if any one ??? )
        LPrinter.Orientation := poPortrait;
        //TPrinterOrientation(integer(not chkbxPortrait.Checked));
        //
        // try resize to fill the page on printing...
        MyResizeBitmap2({ }
          LJPEG, { }
          LBitmapToResize, { }
          GetDeviceCaps(LPrinter.Handle, HORZRES), { }
          GetDeviceCaps(LPrinter.Handle, VERTRES), { }
          True);
        //chkbxScaled.Checked);
      //
      //Memo1.Lines.Add(format('JPEG loaded: %dx%d', [LJPEG.Width, LJPEG.Height]));
      //
        LPrinter.BeginDoc;
        LPrinter.Canvas.Draw(0, 0, LJPEG);
        LPrinter.EndDoc;
      finally
        LPrinter.Free;
      end;
    end;
  finally
    LBitmapToResize.Free;
    LJPEG.Free;
    LJPEGStream.Free;
  end;

end;

Same result. 

image.thumb.png.320cd4c8548fa3c3e4182f1496ddc741.png

No printing..

Could well be my printer.

 

Ian

Share this post

Link to post

programmerdelphi2k    237

programmerdelphi2k
Posted (edited)

@Ian Branch

 

normally, USB/Wifi ports causing problem... try print a "Demo page" (from Driver) for test the communication between PC/Printer

  • if necessary "Create a new port to printer" for tests
Edited by programmerdelphi2k

Share this post

Link to post

Ian Branch    127

Ian Branch
Posted (edited)

Yep.  Did that.  All works fine.

It is a LAN connected Printer.

Word, PDF, emails, etc all print OK.

I can print a jpg from IrfanView fine.

Edited by Ian Branch

Share this post

Link to post

Ian Branch    127

Ian Branch
Posted

No progress at all for the printing of the image.  It just sits there in the printer queue.

No privilages needed.

Share this post

Link to post

programmerdelphi2k    237

programmerdelphi2k
Posted

a simple... maybe? 

        LPrinter := TPrinter.Create;
        try
          LPrinter.PrinterIndex := -1; // current printer ( if any one ??? )
          LPrinter.BeginDoc;
          LPrinter.Canvas.TextOut(0, 0, 'Hello there...');
          LPrinter.EndDoc;
        finally
          LPrinter.Free;
        end;

 

Share this post

Link to post

Ian Branch    127

Ian Branch
Posted

Nope.  That didn't work.  I can see it in the queue but it isn't printing.  😞

Share this post

Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Go To Topic Listing General Help
×