I have some codding/performance problem and I'm stuck.
I have an application in Delphi that needs to have a page transition between screens like page scrolling with a wipe.
I'm using the BitBlt function which I thought it was the fastest, but I still can't get smooth transitions like we can see on web pages or on mobile.
I know that my screen is larger (1920x1080) but still it should be possible in some way.
Here is my code.
procedure TForm1.Button5Click(Sender: TObject);
var
imgFirst, imgSecond, imgTmp : TBitmap;
i, step : integer;
frejmovi : Array[1..160] of TBitmap;
begin
imgFirst := TBitmap.Create;
imgFirst.LoadFromFile('C:\TransitionTest\bg1.bmp');
imgSecond := TBitmap.Create;
imgSecond.LoadFromFile('C:\TransitionTest\bg2.bmp');
imgTmp := TBitmap.Create;
step := 24;
for i := 1 to 80 do
begin
imgTmp.Assign(imgFirst);
BitBlt(imgTmp.Canvas.Handle, 0, 0, i * step, 1080, imgSecond.Canvas.Handle, 1920 - i * step, 0, srcCopy);
BitBlt(imgTmp.Canvas.Handle, i * step, 0, 1920 - (i * step), 1080, imgFirst.Canvas.Handle, 0, 0, srcCopy);
BitBlt(Form1.Canvas.Handle, 0, 0, 1920, 1080, imgTmp.Canvas.Handle, 0, 0, srcCopy);
//Sleep(5);
end;
end;
I've tried different values for step and max value in for loop but with no luck. If I put a small step (for example 2px), it even hangs.
I need smooth transition like on slot machines. My app is a similar project. And I think if I get it done right on large screen it will work for sure on smaller images 300x300 px.
I'm open for any suggestions GDI, DIRECTX, ....
The application must be in Delphi (rewriting old code), but example how to solve this from C#, C++, ... Can also help me I think.
At the end I should be able to have smooth scrolling of area that will be 1530x870 px.
I'm doing something wrong. Here is my code for the timer that should start page transition.
for i := 0 to 1919 do
begin
timeend := 0;
QueryPerformanceCounter(timestart);
repeat
QueryPerformanceCounter(timeend);
timelap := timeend - timestart;
until (timelap > 200);
fx := i;
invalidate;
end;
But result is that pages are just replaced without moving second page to the right while pushing first page.
Thanks....
Related
I need to print an image that is aquired from a scanner.
When the scan fits on one A4 page, there is no problem and my code prints perfect.
However, when the scan does not fits, but needs 2 pages, only one page is printed. The first.
This is my code so far
procedure TFormMain.PrintPicture;
var
MyRect: TRect;
Scale: Double;
begin
try
Printer.BeginDoc;
Scale := Printer.PageWidth / ImgHolder.Picture.Bitmap.Width;
MyRect.Left := 0;
MyRect.Top := 0;
MyRect.Right := trunc(ImgHolder.Picture.Bitmap.Width * Scale);
MyRect.Bottom := trunc(ImgHolder.Picture.Bitmap.Height * Scale);
Printer.Canvas.StretchDraw(MyRect, ImgHolder.Picture.Bitmap);
Printer.EndDoc;
except
on E:Exception do
begin
MessageBox(Handle, PChar('Printing failed' + chr(13) + E.Message), PChar(Caption), MB_OK or MB_ICONWARNING);
end;
end;
end;
when the image holds one page, the height of MyRect = 13092
when the image holds 2 pages, the height is 26185
This seems correct to me, but still only the first page is printed.
So I must be doing it all wrong, can someone please point me in the correct direction on how to print an image that is higher then the height of one page
EDIT
I want to print on more than one page if the image is larger.
I do not want to scale down the image to one page.
The reason for the scale in my code is because I could not print correct at first, and I find this code in another question that solved that for me.
But now it seems this approach is wrong.
So I would appreciate if I could get some help in setting up my printing correct.
If the user scans 2 or 3 times, the image will be made larger and the new scan will be added to the image at the bottom.
This is how the image gets longer than one page.
Now I need to print this image complete, so on more than one page if needed
There are many ways to print an image.
First, please remember that your screen and your printer have different resolutions (in pixels per inch, say). Typically, a printer has much higher resolution than a PC monitor, so if you print your full-screen 1920×1080 image on an A4 page, you will get a very small image on the page unless you magnify it.
Now, having said that, let's us consider two common scenarios (you want the second one).
Scaling the image so it fits perfectly on a single page
By "fits perfectly", I mean the image is scaled proportionally, preserving its aspect ratio, so that it is as large as possible on the page without being clipped.
Let (uses Math)
ScaleX := Printer.PageWidth / Bitmap.Width;
ScaleY := Printer.PageHeight / Bitmap.Height;
Scale := Min(ScaleX, ScaleY).
Then Scale is your scaling factor.
Indeed, ScaleX is the greatest scaling factor that allows the image to fit the page horizontally. For instance, if the paper is 1000×1000 and the image 2000×1000, you clearly need to shrink it to at least ScaleX = 50% to make it fit horizontally. On the other hand, if the image is 1000×5000, the problem is not the width but the height, and you clearly need to shrink it to at least ScaleY = 20% to make it fit vertically.
So if the image is 2000×5000, you need the scale factor to be 50% or less to make it fit horizontally, and you need the scale factor to be 20% or less to make it fit vertically. The greatest scale factor satisfying these two restrictions is 20%, the minimum of 50% and 20%.
procedure PrintBitmap(ABitmap: TBitmap);
begin
Printer.BeginDoc;
var ScaleX := Printer.PageWidth / ABitmap.Width;
var ScaleY := Printer.PageHeight / ABitmap.Height;
var Scale := Min(ScaleX, ScaleY);
var W := Round(ABitmap.Width * Scale); // Note: scaling proportionally,
var H := Round(ABitmap.Height * Scale); // same factor
Printer.Canvas.Brush.Color := clRed;
Printer.Canvas.StretchDraw(
TRect.Create( // Centre on page
Point((Printer.PageWidth - W) div 2, (Printer.PageHeight - H) div 2),
W, H
),
ABitmap
);
Printer.EndDoc;
end;
For example,
procedure TForm1.FormCreate(Sender: TObject);
begin
var bm := TBitmap.Create;
try
bm.LoadFromFile('K:\Sally.bmp');
PrintBitmap(bm);
finally
bm.Free;
end;
end;
Having a fixed image size, potentially spanning several pages
Now, instead suppose you have a fixed image size (W, H) and you want to print it on as many pages as needed. Then you need to loop through the 2D paper grid and draw each page separately:
procedure PrintBitmap(ABitmap: TBitmap);
var
W, H: Integer;
ImgPageWidth, ImgPageHeight: Integer;
function GetSourceRect(Row, Col: Integer): TRect;
begin
Result := TRect.Create(
Point(Col * ImgPageWidth, Row * ImgPageHeight),
ImgPageWidth, ImgPageHeight
);
end;
function GetDestRect(Row, Col: Integer): TRect;
begin
Result := Rect(0, 0, Printer.PageWidth, Printer.PageHeight);
end;
begin
Printer.BeginDoc;
W := ABitmap.Width * 4; // Hardcoding these in this example
H := ABitmap.Height * 4;
ImgPageWidth := Round(ABitmap.Width * (Printer.PageWidth / W));
ImgPageHeight := Round(ABitmap.Height * (Printer.PageHeight / H));
var PageCountX := Ceil(W / Printer.PageWidth); // Image width in pages
var PageCountY := Ceil(H / Printer.PageHeight); // Image height in pages
// Notice that the total page count is PageCountX * PageCountY.
for var y := 0 to PageCountY - 1 do
for var x := 0 to PageCountX - 1 do
begin
if x + y > 0 then
Printer.NewPage;
Printer.Canvas.CopyRect(
GetDestRect(y, x),
ABitmap.Canvas,
GetSourceRect(y, x)
);
end;
Printer.EndDoc;
end;
or
To print a big image on several pages, you have to loop on the width and on the height (two loops) to create pages with partial image. To print one partial image, you can use TCanvas.CopyRect
I am trying to build an avionic attitude indicator with Delphi XE2.
I am using tRotateimage for the horizon
http://www.delphiarea.com/products/delphi-components/rotateimage/
This is behind a regular image which has transparent section in the middle.
Being able to rotate the image for roll and move the tRotateimage.top for pitch works well but I am getting a lot of flickering event with double buffered turned on my form. It flickers when I rotate the image or when I move it up via .top
Is there something else I can do to eliminate this flickering?
if tryStrToFloat(GetHashtag('#ROLL',',',Memo1.Lines.Text),MyDouble) then
Begin
rtAttitudeNeedle.Angle := 0- MyDouble;
rtAttitude.Angle :=0- MyDouble;
end;
if tryStrToFloat(GetHashtag('#PITCH',',',Memo1.Lines.Text),MyDouble) then
Begin
rtAttitude.Top := Round(iAttitudeTop + MyDouble);
end;
Double buffering a form is not always the magic trick to solve all your flicker problems.
you need to understand why you are having that flicker in the first place.
if you use the canvas object directly a lot in the paint routine, then you are doing nothing.
Most the time to solve this problem and reduce the flicker, you need to draw on a memory bitmap then at last CopyRect that to your canvas object.
Something like this for your component (Replace the Paint procedure with this code)
procedure TRotateImage.Paint;
var
SavedDC: Integer;
PaintBmp: TBitmap;
begin
PaintBmp := TBitmap.Create;
try
PaintBmp.SetSize(Width, Height);
if not RotatedBitmap.Empty then
begin
if RotatedBitmap.Transparent then
begin
PaintBmp.Canvas.StretchDraw(ImageRect, RotatedBitmap);
end
else
begin
SavedDC := SaveDC(PaintBmp.Canvas.Handle);
try
SelectClipRgn(PaintBmp.Canvas.Handle, ImageRgn);
IntersectClipRect(PaintBmp.Canvas.Handle, 0, 0, Width, Height);
PaintBmp.Canvas.StretchDraw(ImageRect, RotatedBitmap);
finally
RestoreDC(PaintBmp.Canvas.Handle, SavedDC);
end;
end;
end;
if csDesigning in ComponentState then
begin
PaintBmp.Canvas.Pen.Style := psDash;
PaintBmp.Canvas.Brush.Style := bsClear;
PaintBmp.Canvas.Rectangle(0, 0, Width, Height);
end;
Canvas.CopyRect(ClientRect, PaintBmp.Canvas, PaintBmp.Canvas.ClipRect);
finally
PaintBmp.Free;
end;
end;
if this does not solve the problem entirely then you could take a look at this flicker free set of components and try to adapt the rotating code you have on one of his components or inherit from it (I'm not the author and he is the one claiming flicker free functionality).
the FreeEsVclComponents GitHub repository
Edit: after debugging I found a lot of problems with that control, so I decided to go with my recommendation to you.
I created the following control for you
All what I did is that inheriting from TEsImage and doing some changes to the way it work. From the old control I used the routine below to do the rotation transformation.
function CreateRotatedBitmap(Bitmap: TBitmap; const Angle: Extended; bgColor: TColor): TBitmap;
As you can see in the gif above the rotation routine is not perfect. I suggest you look for an alternative.
I also forked the repository of FreeEsVclComponents and added the TAttitudeControl to the Es.Images unit, so you have all what you need to install the control in your system. Click here
At last I tested this on Tokyo and from the readme of the repository it should work on XE2 without problems.
Edit2: I changed the CreateRotatedBitmap with a better one (based on the GDI+), this is the result:
I already pushed the changes to Github so you can git the code from there.
I'm adding the code here as well in case Github goes down (highly unlikely :))
uses
WinApi.Windows, WinApi.GDIPApi, WinApi.GDIPObj, Vcl.Graphics, System.Types;
function RotateImage(Source: TBitmap; Angle: Extended; AllowClip: Boolean): TBitmap;
var
OutHeight, OutWidth: Integer;
Graphics: TGPGraphics;
GdiPBitmap: TGPBitmap;
begin
if AllowClip then
begin
OutHeight := Source.Height;
OutWidth := Source.Width;
end
else
begin
if (Source.Height > Source.Width) then
begin
OutHeight := Source.Height + 5;
OutWidth := Source.Height + 5;
end
else
begin
OutHeight := Source.Width + 5;
OutWidth := Source.Width + 5;
end;
end;
Result := TBitmap.Create;
Result.SetSize(OutWidth, OutHeight);
GdiPBitmap := nil;
Graphics := TGPGraphics.Create(Result.Canvas.Handle);
try
Graphics.SetSmoothingMode(SmoothingModeDefault);
Graphics.SetPixelOffsetMode(PixelOffsetModeHalf);
Graphics.SetInterpolationMode(InterpolationModeLowQuality);
Graphics.TranslateTransform(OutWidth / 2, OutHeight / 2);
Graphics.RotateTransform(Angle);
Graphics.TranslateTransform(-OutWidth / 2, -OutHeight / 2);
GdiPBitmap := TGPBitmap.Create(Source.Handle, Source.Palette);
try
Graphics.DrawImage(GdiPBitmap, 0, 0);
finally
GdiPBitmap.Free;
end;
finally
Graphics.Free;
end;
end;
Please check this code:
procedure ScreenShotBMP(DestBitmap : TBitmap; AActiveWindow: Boolean = True) ;
var
DC: HDC;
begin
if AActiveWindow then
DC := GetDC(GetForegroundWindow)
else
DC := GetDC(GetDesktopWindow);
try
DestBitmap.Width := GetDeviceCaps(DC, HORZRES);
DestBitmap.Height := GetDeviceCaps(DC, VERTRES);
BitBlt(DestBitmap.Canvas.Handle, 0, 0, DestBitmap.Width, DestBitmap.Height, DC, 0, 0, SRCCOPY);
finally
if AActiveWindow then
ReleaseDC(GetForegroundWindow, DC)
else
ReleaseDC(GetDesktopWindow, DC);
end;
end;
It generates screenshot properly, of Desktop or Active screen but computer stuck a little big during that operation.
I need app to make screenshots on regular time frames (less then one sec), but running this slows down computer.
It's not CPU consuming, taskmanager doesn't show any abnormal activity, simple entire system is stuck. No matter if I run this code inside main thread or another thread.
Is there any other method to create screenshot that won't slow down machine?
Thanks.
I can't reproduce your problem, based on a quick test on XE5 VCL Win32 application, running on Win7 64-bit, 1280x1024 resolution, on an Intel Core i7 860 #2.80GHz (according to CPU-Z), 4GB DDR3 RAM, using the following test code:
function CaptureWindow(const WindowHandle: HWnd): TBitmap;
var
DC: HDC;
wRect: TRect;
Width, Height: Integer;
begin
DC := GetWindowDC(WindowHandle);
Result := TBitmap.Create;
try
GetWindowRect(WindowHandle, wRect);
Width := wRect.Right - wRect.Left;
Height := wRect.Bottom - wRect.Top;
Result.Width := Width;
Result.Height := Height;
Result.Modified := True;
BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
finally
ReleaseDC(WindowHandle, DC);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp: TBitmap;
SW: TStopwatch;
W, H: Integer;
begin
SW := TStopwatch.StartNew;
Bmp := CaptureWindow(GetDesktopWindow);
try
Image1.Picture.Assign(Bmp);
W := Bmp.Width;
H := Bmp.Height;
finally
Bmp.Free;
end;
SW.Stop;
Self.Caption := Format('W: %d H: %d %d:%d %d',
[W,
H,
SW.Elapsed.Minutes,
SW.Elapsed.Seconds,
SW.Elapsed.Milliseconds]);
end;
The caption displays: W: 1280 H: 1024 0:0 42, which is an elapsed time of 42 milliseconds for creating the bitmap, capturing the screen and BitBlting it, assigning it to a TImage for display, and freeing the bitmap (not to mention two calls to the high resolution timer within the stopwatch code and the calculations for the elapsed time).
Note: The CaptureWindow code is adapted from something someone posted here a while back. The Aero-aware parts of it didn't seem necessary, as testing showed it worked fine both with and without Aero enabled on Windows 7. (I'm guessing it was something needed under Vista originally.)
1) Which value PixelFormat property of DestBitmap has? For fast BitBlt color format of source and destination must be the same. In your case PixelFormat must has pfDevice value.
2) Why do you use GetDeviceCaps instead of GetWindowRect in case of GetForegroundWindow? You use larger dimension -> BitBlt tries copy more bytes -> BitBlt works slower.
3) Foreground window may be changed between GetForegroundWindow and ReleaseDC(GetForegroundWindow, DC) -> it is better to keep window handle in the separate variable.
My application is developed in Delphi 6. This is a resource intesive application due to background processing and large volume of data (It consumes around 60MB - 120MB of physical memory). One of the functionality of this application is to create barcode images and print them. If user keeps on generating the Barcodes, then at least One out of Ten Barcode has missing lines in it.
I was able to resolve this issue using TExcellenImagePrinter component. But, it diminished the performance a lot. This resolution was rejected by my client and hence, now I am trying to replace the WinAPI StretchDIBits call with GDI+.
The original source code is as following:
procedure PrintBitmap(ARect:TRect; Bitmap:TBitmap);
var
Info: PBitmapInfo;
InfoSize: dword{Integer};
Image: Pointer;
ImageSize: dword{ integer};
iWidth,iHeight :integer;
iReturn : integer ;
begin
GetDIBSizes(Bitmap.handle,InfoSize,ImageSize);
if (LoadDIBFromTBitmap(Bitmap,Pointer(Info),Image,iWidth,iHeight)) then
begin
SetStretchBltMode(Printer.Canvas.handle,STRETCH_HALFTONE);
SetBrushOrgEx(Printer.Canvas.handle, 0, 0, NIL);
iReturn := StretchDIBits(Printer.Canvas.Handle, ARect.Left, ARect.Top,
ARect.Right - ARect.Left, ARect.Bottom - ARect.Top,
0, 0, Info^.bmiHeader.biWidth,
Info^.bmiHeader.biHeight, Image, Info^,DIB_RGB_COLORS, SRCCOPY);
end;
FreeMemEx(Info);
FreeMemEx(Image);
end;
I got the GDI+ header from the (http://www.progdigy.com/?page_id=7) as suggested by Joe in embarcadero forums (https://forums.embarcadero.com/thread.jspa?messageID=471501#471501).
I have modified my source code as following :
Created an object of TGPGraphics class and assigned the printer's handle to it.
gp := TGPGraphics.Create(Printer.Canvas.Handle);
Created an onject of TGPBitmap class and assigned the barcode image to it.
bmp := TGPBitmap.Create(Info^,Image);
Info is TBitmapInfo and Image is an pointer.
Assigned the Printer's dimension to the an instance rect of TGPRect record
Called the DrawImage function :
gp.DrawImage(bmp,rect);
But, after making these changes, empty image is shown in the printer's output.
Can you point out if I have missed something or my implementation is wrong.
Can you provide any pointers regarding this?
I have found the following code demonstrating creation of compatible bitmap (DBB) from a dib.
That should work for you. Probably it could be written better but all in all it just works ... at least for me..
procedure PRPrintBitmapOnCanvas(Canvas: TMetafileCanvas; Bitmap: TBitmap; posLeft, posTop: Integer);
var
lpbmih: TBitmapInfoHeader;
lpbmi: TBitmapInfo;
aBitmap: HBITMAP;
aDC: LongWord;
begin
Fillchar(lpbmih, SizeOf(lpbmih), 0);
lpbmih.biSize := SizeOf(lpbmih);
lpbmih.biWidth := bitmap.width;
lpbmih.biHeight := bitmap.height;
lpbmih.biPlanes := 1;
lpbmih.biBitCount := 32;
lpbmih.biCompression := BI_RGB;
Fillchar(lpbmi, SizeOf(lpbmi), 0);
lpbmi.bmiHeader.biSize := SizeOf(lpbmi.bmiHeader);
lpbmi.bmiHeader.biPlanes := 1;
lpbmi.bmiHeader.biBitCount := 32;
lpbmi.bmiHeader.biCompression := BI_RGB;
aBitmap := CreateDIBitmap(Canvas.Handle, lpbmih, 0, nil, lpbmi, DIB_RGB_COLORS);
if aBitmap = 0 then RaiseLastOSError;
try
aDC := CreateCompatibleDC(Canvas.Handle);
SelectObject(aDC, aBitmap);
BitBlt(aDC, 0, 0, bitmap.Width, bitmap.Height, bitmap.Canvas.Handle, 0, 0, SRCCOPY);
BitBlt(canvas.handle, posLeft, posTop, bitmap.Width, bitmap.Height, aDC, 0, 0, SRCCOPY);
DeleteDC(aDC);
finally
DeleteObject(aBitmap)
end;
end;
My application is developed in Delphi 6. This is a resource intesive application due to background processing and large volume of data (It consumes around 60MB - 120MB of physical memory). One of the functionality of this application is to create barcode images after doing certain procesing.
If user keeps on generating the Barcodes, then at least One out of Ten Barcode has missing lines in it.
We have following steps in generating the output:
Create a Barcode image (TImage) in the memory. The height of the image is 10 pixels. We use pf24bit pixel format.
Resizing the image in the memory according to printer's canvas and passing it to the printer's canvas.
The code for Step # 2 is as following :
procedure PrintBitmap(ARect:TRect; Bitmap:TBitmap);
var
Info: PBitmapInfo;
InfoSize: dword{Integer};
Image: Pointer;
ImageSize: dword{ integer};
iReturn : integer ;
iWidth,iHeight :integer;
begin
try
with Bitmap do
begin
iReturn := 1;
GetDIBSizes( Handle, InfoSize, ImageSize );
GetMem( Info, InfoSize );
try
getMem( Image, ImageSize );
try
GetDIB(Handle, Palette, Info^, Image^);
try
with Info^.bmiHeader do
begin
SetStretchBltMode(Printer.Canvas.handle,HALFTONE);
iReturn := **StretchDIBits**(Printer.Canvas.Handle, ARect.Left, ARect.Top,
ARect.Right - ARect.Left, ARect.Bottom - ARect.Top,
0, 0, biWidth, biHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
end;
except on E:Exception do
begin
gobjLog.pWritetoLog(0,'RptWrks2','PrintBitmap','Exception in StretchDIBits with message '+e.Message);
end;
end
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end
except on E:Exception do
begin
gobjLog.pWritetoLog(0,'RptWrks2','PrintBitmap','Exception in PrintBitMap with message '+e.Message);
end;
end;
We checked that the issue lies in the Step # 2 , as the barcode image is generated without any issue. (We commented out Step # 2 and took the output as BMP files to confirm this).
Also, we tried following workarounds :
We used TExcellentImagePrinter component to perform the resizing operation. But, issue was not resolved.
We included SETPROCESSWORKINGSETSIZE WinAPI call to reduce/refresh the current memry used by the application.
We included Sleep(3000) in the code so that the Windows is able to allocate the memory for the image. Including Sleep however reduced the frequency of occurrence of this error.
Can you please provide any suggestions?
I use this function for printing barcodes with great success. It assumes that the bitmap is 100% scaled barcode (each x-pixel is a barcode stripe), the height does not matter, it may be only 1px.
The clue is to print the barcode with fillrect and not as a bitmap:
The function just "reads" the barcode and draws it with fillrect to some canvas. If the resulting scale (xFactor = aToRect width to barcode width) is either an integer number or a big enough real number (for printers no problem) the printed barcode can be read without any problems. It also works great with PDF Printers.
You just have to generate a 100% scaled barcode to bitmap (as you already do; height may be 1px; color of the barcode must be clBlack) and pass it in the aFromBMP parameter. aToCanvas will then be your printer canvas. aToRect is the destination rect in printer canvas. aColor is the color of the destination barcode (may be everything).
procedure PrintBarCodeFromBitmap(const aFromBMP: TBitmap;
const aToCanvas: TCanvas; const aToRect: TRect;
const aColor: TColor = clBlack);
var I, xStartRect: Integer;
xFactor: Double;
xColor: TColor;
xLastBrush: TBrush;
begin
xLastBrush := TBrush.Create;
try
xLastBrush.Assign(aToCanvas.Brush);
aToCanvas.Brush.Color := aColor;
aToCanvas.Brush.Style := bsSolid;
xFactor := (aToRect.Right-aToRect.Left)/aFromBMP.Width;
xStartRect := -1;
for I := 0 to aFromBMP.Width do begin
if I < aFromBMP.Width then
xColor := aFromBMP.Canvas.Pixels[I, 0]
else
xColor := clWhite;
if (xStartRect < 0) and (xColor = clBlack) then begin
xStartRect := I;
end else if (xStartRect >= 0) and (xColor <> clBlack) then begin
aToCanvas.FillRect(
Rect(
Round(aToRect.Left+xStartRect*xFactor),
aToRect.Top,
Round(aToRect.Left+I*xFactor),
aToRect.Bottom));
xStartRect := -1;
end;
end;
finally
aToCanvas.Brush.Assign(xLastBrush);
xLastBrush.Free;
end;
end;
Finally I was able to resolve the issue using TExcellentImagePrinter.
I replaced GETDIB with LoadDIBFromTBitmap function and StretchDIBits with PrintDIBitmapXY in the above code snippet (my post).
Thanks to Joe for providing proper guidelines.