Re: [lazarus] TBitmap.Mask

[Bogusław Brandys]

Micha Nelissen wrote:

Bogusław Brandys wrote:

Attached modified patch for review.I've implemented also

Did you forget the patch ?

Micha

Right.Thank you.
Patch attached.

Regards
Boguslaw






Index: bitmap.inc
===================================================================
--- bitmap.inc  (revision 9438)
+++ bitmap.inc  (working copy)
@@ -249,8 +249,18 @@
 end;
 
 procedure TBitMap.Mask(ATransparentColor: TColor);
+const
+ colors : array [boolean] of TColor = (clBlack, clWhite);
+var
+  i , j : Integer ;
 begin
-  DebugLn('TBitMap.Mask not implemented');
+  DebugLn('TBitMap.Mask implemented but really slow.Fix it please');
+  for i := 0 to self.Height - 1 do
+  begin
+    for j := 0 to self.Width - 1 do
+     self.Canvas.Pixels[j, i] := colors [ self.Canvas.Pixels[j , i] =
+      ATransparentColor ]; 
+  end;
 end;
 
 function TBitmap.GetHandle: HBITMAP;
@@ -432,16 +442,34 @@
   ReadStream(Stream, true, Stream.Size - Stream.Position);
 end;
 
+
 procedure TBitMap.LoadFromResourceName(Instance: THandle; const ResName: 
String);
 begin
-  DebugLn('ToDo: TBitMap.LoadFromResourceName');
+  DebugLn('ToDo: Fix TBitMap.LoadFromResourceName.Instance not used.');
+  LoadFromLazarusResource(ResName);
 end;
 
 procedure TBitMap.LoadFromResourceID(Instance: THandle; ResID: Integer);
+var
+  ms:TMemoryStream;
+  res:TLResource;
 begin
-  DebugLn('ToDo: TBitMap.LoadFromResourceID');
+  DebugLn('ToDo: Fix TBitMap.LoadFromResourceID.Instance not used.');
+  res:=LazarusResources.Items[ResID];
+  if (res=nil) or (res.Value='') or not LazarusResourceTypeValid(res.ValueType)
+  then exit;
+  ms:=TMemoryStream.Create;
+  try
+    ms.Write(res.Value[1],length(res.Value));
+    ms.Position:=0;
+    LoadFromStream(ms);
+  finally
+    ms.Free;
+  end;
 end;
 
+
+
 procedure TBitmap.GetSupportedSourceMimeTypes(List: TStrings);
 begin
   if (ClassType=TBitmap) or (ClassType=TPixmap) or (ClassType=TIcon) then