Freebie Friday: capture controls or forms
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; To use these routines, you can do this with: 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; To capture a control to bitmap, use: 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!
