From 8a5b39971b7a314b48951f0d7f3955f25d528e47 Mon Sep 17 00:00:00 2001
From: mattias <nc-gaertnma@netcologne.de>
Date: Sat, 11 Sep 2004 10:19:07 +0000
Subject: [PATCH] implemented TBitmap.LoadFromDevice

git-svn-id: trunk@5966 -
---
 lcl/graphics.pp        |  4 ++++
 lcl/include/bitmap.inc | 40 ++++++++++++++++++++++++++++++++++++++--
 2 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/lcl/graphics.pp b/lcl/graphics.pp
index 026287a65c..e1ca5a40ec 100644
--- a/lcl/graphics.pp
+++ b/lcl/graphics.pp
@@ -1065,6 +1065,7 @@ type
     function PaletteAllocated: boolean;
     procedure CreateFromBitmapHandles(SrcBitmap, SrcMaskBitmap: HBitmap;
                                       const SrcRect: TRect);
+    procedure LoadFromDevice(DC: HDC); virtual;
     function LazarusResourceTypeValid(const ResourceType: string): boolean; virtual;
     procedure LoadFromStream(Stream: TStream); override;
     procedure LoadFromLazarusResource(const ResName: String); override;
@@ -1746,6 +1747,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.146  2004/09/11 10:19:07  mattias
+  implemented TBitmap.LoadFromDevice
+
   Revision 1.145  2004/09/04 22:24:16  mattias
   added default values for compiler skip options and improved many parts of synedit for UTF8
 
diff --git a/lcl/include/bitmap.inc b/lcl/include/bitmap.inc
index d8ff27ed29..4c2bf4d5e9 100644
--- a/lcl/include/bitmap.inc
+++ b/lcl/include/bitmap.inc
@@ -188,17 +188,50 @@ var
   NewRawImage: TRawImage;
   ImgHandle, ImgMaskHandle: HBitmap;
 begin
-  DebugLn('TBitmap.CreateFromBitmapHandles A SrcRect=',dbgs(SrcRect));
+  //DebugLn('TBitmap.CreateFromBitmapHandles A SrcRect=',dbgs(SrcRect));
   if not GetRawImageFromBitmap(SrcBitmap,SrcMaskBitmap,SrcRect,NewRawImage) then
     raise EInvalidGraphicOperation.Create('TBitmap.CreateFromBitmapHandles Get RawImage');
+  ImgHandle:=0;
+  ImgMaskHandle:=0;
   try
-    DebugLn('TBitmap.CreateFromBitmapHandles B SrRect=',dbgs(SrcRect));
+    //DebugLn('TBitmap.CreateFromBitmapHandles B SrRect=',dbgs(SrcRect));
     if not CreateBitmapFromRawImage(NewRawImage,ImgHandle,ImgMaskHandle,false) then
       raise EInvalidGraphicOperation.Create('TBitmap.CreateFromBitmapHandles Create bitmaps');
     Handle:=ImgHandle;
+    ImgHandle:=0;
     MaskHandle:=ImgMaskHandle;
+    ImgMaskHandle:=0;
   finally
     FreeRawImageData(@NewRawImage);
+    if ImgHandle<>0 then DeleteObject(ImgHandle);
+    if ImgMaskHandle<>0 then DeleteObject(ImgMaskHandle);
+  end;
+end;
+
+procedure TBitmap.LoadFromDevice(DC: HDC);
+var
+  IntfImg: TLazIntfImage;
+  ImgHandle, ImgMaskHandle: HBitmap;
+begin
+  ImgHandle:=0;
+  ImgMaskHandle:=0;
+  IntfImg:=nil;
+  try
+    // create the interface image
+    IntfImg:=TLazIntfImage.Create(0,0);
+    // get a snapshot
+    IntfImg.LoadFromDevice(DC);
+    // create HBitmap
+    IntfImg.CreateBitmap(ImgHandle,ImgMaskHandle,false);
+    // feed HBitmap into a TBitmap
+    Handle:=ImgHandle;
+    ImgHandle:=0;
+    MaskHandle:=ImgMaskHandle;
+    ImgMaskHandle:=0;
+  finally
+    IntfImg.Free;
+    if ImgHandle<>0 then DeleteObject(ImgHandle);
+    if ImgMaskHandle<>0 then DeleteObject(ImgMaskHandle);
   end;
 end;
 
@@ -1201,6 +1234,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.89  2004/09/11 10:19:07  mattias
+  implemented TBitmap.LoadFromDevice
+
   Revision 1.88  2004/05/14 14:32:49  mattias
   fix for fpc 1.0.10