paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-28 20:40:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented TBitmap.LoadFromDevice

Browse Source 
git-svn-id: trunk@5966 -
This commit is contained in:
mattias 2004-09-11 10:19:07 +00:00
parent a173ca36a9
commit 8a5b39971b
2 changed files with 42 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/graphics.pp
View File

@ -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

40
lcl/include/bitmap.inc
View File

@ -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