Blog
All Blog Posts | Next Post | Previous Post
Freebie Friday: capture controls or forms
Friday, January 22, 2021
New year, new ideas. So, I'm happy to kick off with one of the many new ideas we have, which is the Freebie Friday!
Freebie Friday is simple. We share a useful code snippet that might be handy in your projects. We present it, you copy and paste it and you use it in your applications where you see use for it. Freebie Friday free source code snippets are the result of our daily work, writing components, offering support & consulting for customers ... Over time, a huge collection of useful code builds up and instead of letting this collect dust, we cheer up your Friday, just before the weekend and present it here.
This first freebie is two routines that enable you to capture a control as image. The first that might come up is, why write a routine for this, a control offers control.PaintTo() and we can just use that to have the control paint to a canvas and save that to a file.
In theory yes, in practice, sadly this doesn't work well with many controls. So, therefore these two routines that do work with any VCL control and as a bonus, it works with a VCL form as well, so you can capture entire forms to a bitmap or image.
Here we go, here is the code:
interface
uses
Classes, Windows, Messages, Graphics, JPEG, Controls, Types, Forms;
procedure CaptureControl(AControl: TControl; ABitmap: TBitmap);
procedure CaptureControlToJpeg(AControl: TControl; AFileName: string; AQuality: integer = 70);
implementation
uses
Winapi.DwmApi, SysUtils;
procedure CaptureControl(AControl: TControl; ABitmap: TBitmap);
var
LDesktopDC: HDC;
LRect: TRect;
LDWMRect: TRect;
LPt: TPoint;
begin
LPt := AControl.ClientToScreen(Point(0,0));
LRect := Rect(LPt.X, LPt.Y, LPt.X + AControl.Width, LPt.Y + AControl.Height);
if (AControl is TWinControl) and (AControl as TWinControl).HandleAllocated then
begin
GetWindowRect((AControl as TWinControl).Handle, LRect);
end;
if (AControl is TCustomForm) and (AControl as TCustomForm).HandleAllocated then
begin
GetWindowRect((AControl as TCustomForm).Handle, LRect);
if (Win32MajorVersion >= 6) and DwmCompositionEnabled then
begin
if (DwmGetWindowAttribute((AControl as TCustomForm).Handle, DWMWA_EXTENDED_FRAME_BOUNDS, @LDWMRect, SizeOf(LDWMRect)) = S_OK) then
begin
LRect := LDWMRect;
end;
end;
end;
LDesktopDC := GetWindowDC(GetDesktopWindow);
try
ABitmap.PixelFormat := pf24bit;
ABitmap.Height := LRect.Bottom - LRect.Top;
ABitmap.Width := LRect.Right - LRect.Left;
BitBlt(ABitmap.Canvas.Handle, 0, 0, ABitmap.Width, ABitmap.Height, LDesktopDC, LRect.Left, LRect.Top, SRCCOPY);
finally
ReleaseDC(GetDesktopWindow, LDesktopDC);
end;
end;
procedure CaptureControlToJpeg(AControl: TControl; AFileName: string; AQuality: integer = 70);
var
LJpeg: TJpegImage;
LBmp: TBitmap;
begin
LBmp := TBitmap.Create;
try
CaptureControl(AControl, LBmp);
LJpeg := TJpegImage.Create;
try
LJpeg.Assign(LBmp);
LJpeg.CompressionQuality := AQuality;
LJpeg.SaveToFile(AFileName);
finally
LJpeg.Free;
end;
finally
LBmp.Free;
end;
end;
begin // capture a control to JPEG file setting JPEG quality to 90 CaptureControlToJpeg(mycontrol, 'mycontrol.jpg', 90); // capture a form (Self) to JPEG file setting JPEG quality to 50 CaptureControlToJpeg(Self, 'myform.jpg', 50); end;
var
LBmp: TBitmap;
begin
LBmp := TBitmap.Create;
try
CaptureControl(mycontrol, LBmp);
// do what you want with the bitmap here
finally
LBmp.Free;
end;
end;
Enjoy and have a good weekend!
Bruno Fierens
This blog post has received 2 comments.
2. Monday, January 25, 2021 at 10:43:52 AM
??Thank you
Frans Link
All Blog Posts | Next Post | Previous Post
Gomezel Dino