paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-03 22:40:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed unsharing TBitmap

Browse Source 
git-svn-id: trunk@5176 -
This commit is contained in:
mattias 2004-02-05 16:28:38 +00:00
parent 0392591fb0
commit 8460750bce
6 changed files with 59 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/graphics.pp
View File

@ -956,8 +956,8 @@ type
Procedure FreeCanvasContext;
function GetCanvas: TCanvas;
procedure CreateCanvas;
Procedure NewImage(NHandle: HBITMAP; NPallette: HPALETTE;
const NDIB : TDIBSection; OS2Format : Boolean);
Procedure CreateNewImage(NHandle: HBITMAP; NPallette: HPALETTE;
const NDIB : TDIBSection; OS2Format : Boolean);
procedure SetHandle(Value: HBITMAP);
procedure SetMaskHandle(Value: HBITMAP);
function GetHandleType: TBitmapHandleType;
@ -1193,8 +1193,6 @@ type
constructor Create(ABitmap : TBitmap);
destructor Destroy; override;
// TODO: replace this by property BitmapHandle;
// MWE: Not needed
//property Bitmap: TBitmap read FBitmap;
end;
@ -1446,6 +1444,9 @@ end.
{ =============================================================================
$Log$
Revision 1.111 2004/02/05 16:28:38 mattias
fixed unsharing TBitmap
Revision 1.110 2004/02/04 22:17:09 mattias
removed workaround VirtualCreate

48
lcl/include/bitmap.inc
View File

@ -163,8 +163,7 @@ end;
function TBitmap.GetHandle: HBITMAP;
begin
UnshareImage;
if FImage.FHandle=0 then
if not FImage.HandleAllocated then
HandleNeeded;
Result := FImage.FHandle;
end;
@ -258,6 +257,8 @@ begin
if UseWidth<1 then UseWidth:=1;
if UseHeight<1 then UseHeight:=1;
FImage.FHandle:= CreateBitmap(UseWidth, UseHeight, 1, n, nil);
FImage.FDIB.dsbm.bmWidth := Width;
FImage.FDIB.dsbm.bmHeight := Height;
end;
end;
@ -337,7 +338,7 @@ Begin
end;
end;
Procedure TBitmap.NewImage(NHandle: HBITMAP; NPallette: HPALETTE;
Procedure TBitmap.CreateNewImage(NHandle: HBITMAP; NPallette: HPALETTE;
const NDIB : TDIBSection; OS2Format : Boolean);
Begin
@ -345,18 +346,44 @@ end;
procedure TBitMap.PaletteNeeded;
begin
// ToDo
end;
procedure TBitmap.UnshareImage;
var
NewImage: TBitmapImage;
IntfImage: TLazIntfImage;
OldImage: TBitmapImage;
begin
if (FImage.RefCount>1) then begin
//writeln('TBitmap.UnshareImage ',ClassName);
//writeln('TBitmap.UnshareImage ',ClassName,' ',Width,',',Height,' ',HexStr(Cardinal(Self),8));
// release old FImage and create a new one
FreeCanvasContext;
FImage.Release;
FImage := TBitmapImage.Create;
FImage.Reference;
NewImage:=TBitmapImage.Create;
try
NewImage.Reference;
if FImage.HandleAllocated and (Width>0) and (Height>0) then begin
// copy content
IntfImage:=TLazIntfImage.Create(0,0);
try
IntfImage.LoadFromBitmap(FImage.FHandle,FImage.FMaskHandle);
IntfImage.CreateBitmap(NewImage.FHandle,NewImage.FMaskHandle);
FillChar(NewImage.FDIB, SizeOf(NewImage.FDIB), 0);
if NewImage.HandleAllocated then
GetObject(NewImage.FHandle, SizeOf(NewImage.FDIB), @NewImage.FDIB);
finally
IntfImage.Free;
end;
end;
FreeCanvasContext;
OldImage:=FImage;
FImage:=NewImage;
NewImage:=nil; // transaction sucessful
OldImage.Release;
finally
// in case something goes wrong, keep old and free new
NewImage.Free;
end;
//writeln('TBitmap.UnshareImage END ',ClassName,' ',Width,',',Height,' ',HexStr(Cardinal(Self),8));
end;
end;
@ -1011,6 +1038,9 @@ end;
{ =============================================================================
$Log$
Revision 1.59 2004/02/05 16:28:38 mattias
fixed unsharing TBitmap
Revision 1.58 2004/02/04 22:17:09 mattias
removed workaround VirtualCreate

5
lcl/include/bitmapcanvas.inc
View File

@ -50,7 +50,7 @@ begin
Assert(False, Format('trace:[TBitmapCanvas.CreateHandle] Got Handle 0x%x', [FBitmap.Handle]));
if FBitmap.Handle = 0 then
if not FBitmap.HandleAllocated then
FOldBitmap := 0
else
FOldBitmap := SelectObject(DC, FBitmap.Handle);
@ -112,6 +112,9 @@ end;
{ =============================================================================
$Log$
Revision 1.8 2004/02/05 16:28:38 mattias
fixed unsharing TBitmap
Revision 1.7 2003/06/30 10:09:46 mattias
fixed Get/SetPixel for DC without widget

5
lcl/include/customimage.inc
View File

@ -41,7 +41,8 @@ end;
procedure TCustomImage.SetPicture(const AValue: TPicture);
begin
if FPicture=AValue then exit;
FPicture.Assign(AValue); //the onchange of the picture gets called and notifies that something changed.
FPicture.Assign(AValue); //the OnChange of the picture gets called and
// notifies this TCustomImage that something changed.
end;
procedure TCustomImage.DoAutoSize;
@ -172,6 +173,8 @@ begin
Brush.Color := clWhite;
FillRect(iRect);
end;
Brush.Color:=clBlue;
FillRect(iRect);
StretchDraw(iRect, Picture.Graphic);
end;

2
lcl/include/picture.inc
View File

@ -368,7 +368,7 @@ end;
procedure TPicture.ForceType(GraphicType: TGraphicClass);
begin
if not (Graphic is GraphicType) then
if not (FGraphic is GraphicType) then
begin
FGraphic.Free;
FGraphic := nil;

6
lcl/interfaces/gtk/gtkobject.inc
View File

@ -6258,6 +6258,7 @@ var
AccelKey : guint;
SetupProps : boolean;
AWindow: PGdkWindow;
WidgetInfo: PWinWidgetInfo;
begin
p := nil;
SetupProps:= false;
@ -6697,6 +6698,8 @@ begin
Accelerate(TComponent(Sender),PGtkWidget(P),AccelKey,0,'clicked');
end;
StrDispose(AccelText);
WidgetInfo:=GetWidgetInfo(P,true);
Include(WidgetInfo^.Flags,wwiNotOnParentsClientArea);
gtk_widget_show (P);
end;
@ -9184,6 +9187,9 @@ end;
{ =============================================================================
$Log$
Revision 1.463 2004/02/05 16:28:38 mattias
fixed unsharing TBitmap
Revision 1.462 2004/02/04 00:04:37 mattias
added some TEdit ideas to TSpinEdit