{ Clipping Demo Vampyre Imaging Library http://imaginglib.sourceforge.net I used this demo during fixing of clipping for CopyRect/StretchRect functions. You have a source and destination images on the form and few movable and resizable bevels that represent source, destnation, and clipping rectangle. Fiddle with them as you want and then click CopyRect Test or StretchRect Test button. New form will be shown with results. One image created by Imaging's Copy/Stretch rect functions (wrapped in TBaseImage here) and the second created by WinAPI's BitBlt and StretchBlt functions. Copied images should look exactly the same and stretched ones should have the same clipping and very similar looks (Imaging's stretch is filtered, WinAPI's not). Demo shows usage of high level Imaging classes (TBaseImage->TSingleImage) and VCL component support (TImagingBitmap). Needs JVCL library to compile. } unit ClipForm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, JvExExtCtrls, JvMovableBevel, StdCtrls, Buttons, ImagingTypes, Imaging, ImagingClasses, ImagingComponents, ImagingCanvases, ImagingFormats, ImagingUtility; type TMainForm = class(TForm) PanelConf: TPanel; ImageSrc: TImage; ImageDst: TImage; SelDst: TJvMovableBevel; SelSrc: TJvMovableBevel; PanelCmd: TPanel; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; ClipDst: TJvMovableBevel; Button5: TButton; Button6: TButton; CheckGenCanvas: TCheckBox; procedure BtnLoadImagesClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button6Click(Sender: TObject); public SrcImage, DstImage: TSingleImage; SrcBitmap, DstBitmap: TImagingBitmap; procedure DoTest(Stretch, CanvasDraw: Boolean); end; const DefaultSrc = 'Vezyr.png'; DefaultDst = 'Tigers.jpg'; ForceFormat = ifA8R8G8B8; var MainForm: TMainForm; implementation uses ResultsForm; {$R *.dfm} function GetTestImage(const FileName: string): string; begin Result := ExtractFileDir(ExtractFileDir(ExtractFileDir(GetAppDir))) + PathDelim + 'Demos' + PathDelim + 'Data' + PathDelim + FileName; end; procedure TMainForm.FormCreate(Sender: TObject); begin // Create working images SrcImage := TSingleImage.Create; DstImage := TSingleImage.Create; // Create our bitmaps which will be assigned to TImage components. // Standard TBitmap could be used but our bitmaps can be assigned directly // from TSingleImage. SrcBitmap := TImagingBitmap.Create; DstBitmap := TImagingBitmap.Create; ImageSrc.Picture.Graphic := SrcBitmap; ImageDst.Picture.Graphic := DstBitmap; BtnLoadImagesClick(Self); end; procedure TMainForm.FormDestroy(Sender: TObject); begin // Free used images SrcImage.Free; DstImage.Free; // Free bitmaps asigned to TImage too - it wont free them automatically SrcBitmap.Free; DstBitmap.Free; end; procedure TMainForm.BtnLoadImagesClick(Sender: TObject); begin // Load test images SrcImage.LoadFromFile(GetTestImage(DefaultSrc)); DstImage.LoadFromFile(GetTestImage(DefaultDst)); // Change their format to A8R8G8B8 (for faster drawing later) SrcImage.Format := ForceFormat; DstImage.Format := ForceFormat; // Resize them to fit in TImages on form SrcImage.Resize(ImageSrc.Width, ImageSrc.Height, rfNearest); DstImage.Resize(ImageDst.Width, ImageDst.Height, rfNearest); // Finally assign them to those TImages ImageSrc.Picture.Graphic.Assign(SrcImage); ImageDst.Picture.Graphic.Assign(DstImage); end; procedure TMainForm.Button1Click(Sender: TObject); begin SelSrc.SetBounds(ImageSrc.Left, ImageSrc.Top, ImageSrc.Width, ImageSrc.Height); SelDst.SetBounds(ImageDst.Left, ImageDst.Top, ImageSrc.Width, ImageSrc.Height); ClipDst.SetBounds(ImageDst.Left - 20, ImageDst.Top - 20, ImageDst.Width + 40, ImageDst.Height + 40); end; procedure TMainForm.Button2Click(Sender: TObject); begin SelSrc.SetBounds(ImageSrc.Left, ImageSrc.Top, ImageSrc.Width, ImageSrc.Height); SelDst.SetBounds(ImageDst.Left, ImageDst.Top, ImageDst.Width, ImageDst.Height); ClipDst.SetBounds(ImageDst.Left - 20, ImageDst.Top - 20, ImageDst.Width + 40, ImageDst.Height + 40); end; procedure TMainForm.Button3Click(Sender: TObject); begin DoTest(False, False); end; procedure TMainForm.Button4Click(Sender: TObject); begin DoTest(True, False); end; procedure TMainForm.Button5Click(Sender: TObject); begin DoTest(False, True); end; procedure TMainForm.Button6Click(Sender: TObject); begin DoTest(True, True); end; procedure TMainForm.DoTest(Stretch, CanvasDraw: Boolean); var Result: TSingleImage; SrcBounds, DstBounds, DstClip: TRect; SrcBmp, DstBmp: TImagingBitmap; Rgn: HRGN; SrcCanvas, DestCanvas: TImagingCanvas; begin // First use Imaging to copy/stretch images ---------------- // Create result image and get rects from movable bevels on the form Result := TSingleImage.CreateFromImage(DstImage); SrcBounds := Rect(SelSrc.Left - ImageSrc.Left, SelSrc.Top - ImageSrc.Top, SelSrc.Width, SelSrc.Height); DstBounds := Rect(SelDst.Left - ImageDst.Left, SelDst.Top - ImageDst.Top, SelDst.Width, SelDst.Height); DstClip := Rect(ClipDst.Left - ImageDst.Left, ClipDst.Top - ImageDst.Top, ClipDst.Left - ImageDst.Left + ClipDst.Width, ClipDst.Top - ImageDst.Top + ClipDst.Height); if not CanvasDraw then begin if Stretch then begin // Clips rects for stretching ImagingUtility.ClipStretchBounds(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, DstBounds.Left, DstBounds.Top, DstBounds.Right, DstBounds.Bottom, SrcImage.Width, SrcImage.Height, DstClip); // Call image's stretch method SrcImage.StretchTo(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, Result, DstBounds.Left, DstBounds.Top, DstBounds.Right, DstBounds.Bottom, rfBilinear); end else begin // Clips rects for copying ImagingUtility.ClipCopyBounds(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, DstBounds.Left, DstBounds.Top, SrcImage.Width, SrcImage.Height, DstClip); // Call image's copy method SrcImage.CopyTo(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, Result, DstBounds.Left, DstBounds.Top); end; end else begin if CheckGenCanvas.Checked then begin SrcCanvas := TImagingCanvas.CreateForImage(SrcImage); DestCanvas := TImagingCanvas.CreateForImage(Result); end else begin SrcCanvas := FindBestCanvasForImage(SrcImage).CreateForImage(SrcImage); DestCanvas := FindBestCanvasForImage(Result).CreateForImage(Result); end; if Stretch then begin // Clips rects for stretching ImagingUtility.ClipStretchBounds(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, DstBounds.Left, DstBounds.Top, DstBounds.Right, DstBounds.Bottom, SrcImage.Width, SrcImage.Height, DstClip); // Call stretch method SrcCanvas.StretchDrawAlpha(Rect(SrcBounds.Left, SrcBounds.Top, SrcBounds.Left + SrcBounds.Right, SrcBounds.Top + SrcBounds.Bottom), DestCanvas, Rect(DstBounds.Left, DstBounds.Top, DstBounds.Left + DstBounds.Right, DstBounds.Top + DstBounds.Bottom), rfBilinear); end else begin // Clips rects for copying ImagingUtility.ClipCopyBounds(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, DstBounds.Left, DstBounds.Top, SrcImage.Width, SrcImage.Height, DstClip); // Call draw method SrcCanvas.DrawAlpha(Rect(SrcBounds.Left, SrcBounds.Top, SrcBounds.Left + SrcBounds.Right, SrcBounds.Top + SrcBounds.Bottom), DestCanvas, DstBounds.Left, DstBounds.Top); end; SrcCanvas.Free; DestCanvas.Free; end; // Assign Imaging result to TImage on Result form ResultForm.ImageMy.Picture.Graphic.Assign(Result); // Now use WinAPI to copy/stretch images ---------------------- // Create bitmaps and assign source and dest images to them SrcBmp := TImagingBitmap.Create; SrcBmp.Assign(SrcImage); DstBmp := TImagingBitmap.Create; DstBmp.Assign(DstImage); // Get fresh bounds SrcBounds := Rect(SelSrc.Left - ImageSrc.Left, SelSrc.Top - ImageSrc.Top, SelSrc.Width, SelSrc.Height); DstBounds := Rect(SelDst.Left - ImageDst.Left, SelDst.Top - ImageDst.Top, SelDst.Width, SelDst.Height); // Now create and set clipping region Rgn := CreateRectRgn(DstClip.Left, DstClip.Top, DstClip.Right, DstClip.Bottom); SelectClipRgn(DstBmp.Canvas.Handle, Rgn); // Now stretch or copy if Stretch then begin StretchBlt(DstBmp.Canvas.Handle, DstBounds.Left, DstBounds.Top, DstBounds.Right, DstBounds.Bottom, SrcBmp.Canvas.Handle, SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, SRCCOPY); end else begin BitBlt(DstBmp.Canvas.Handle, DstBounds.Left, DstBounds.Top, SrcBounds.Right, SrcBounds.Bottom, SrcBmp.Canvas.Handle, SrcBounds.Left, SrcBounds.Top, SRCCOPY); end; // Assign Imaging result to TImage on Result form ResultForm.ImageWin.Picture.Graphic.Assign(DstBmp); Result.Free; SrcBmp.Free; DstBmp.Free; //SelectClipRgn(DstBmp.Canvas.Handle, 0); //DeleteObject(Rgn); // Show results ResultForm.ShowModal; end; end.