prepared image sharing

git-svn-id: trunk@4724 -

ide/componentpalette.pas

@@ -62,6 +62,7 @@ type
     FOnOpenUnit: TNotifyEvent;
     FSelected: TRegisteredComponent;
     fUnregisteredIcon: TBitmap;
+    fSelectButtonIcon: TBitmap;
     fUpdatingNotebook: boolean;
     procedure SetNoteBook(const AValue: TNotebook);
     procedure SelectionToolClick(Sender: TObject);
@@ -284,6 +285,10 @@ begin
     fUnregisteredIcon.Free;
     fUnregisteredIcon:=nil;
   end;
+  if fSelectButtonIcon<>nil then begin
+    fSelectButtonIcon.Free;
+    fSelectButtonIcon:=nil;
+  end;
   PopupMenu.Free;
   PopupMenu:=nil;
   inherited Destroy;
@@ -310,9 +315,12 @@ end;
 
 function TComponentPalette.GetSelectButtonIcon: TBitmap;
 begin
-  Result:=TPixmap.Create;
+  if fSelectButtonIcon=nil then begin
-  Result.TransparentColor:=clWhite;
+    fSelectButtonIcon:=TPixmap.Create;
-  Result.LoadFromLazarusResource('tmouse');
+    fSelectButtonIcon.TransparentColor:=clWhite;
+    fSelectButtonIcon.LoadFromLazarusResource('tmouse');
+  end;
+  Result:=fSelectButtonIcon;
 end;
 
 procedure TComponentPalette.ClearButtons;
@@ -396,7 +404,7 @@ begin
         Name:='PaletteSelectBtn'+IntToStr(i);
         Parent:=CurNoteBookPage;
         OnClick := @SelectionToolClick;
-        Glyph:=GetSelectButtonIcon;
+        Glyph.LoadFromLazarusResource('tmouse');
         Flat := True;
         GroupIndex:= 1;
         Down := True;
@@ -417,7 +425,7 @@ begin
             Name:='PaletteBtnPage'+IntToStr(i)+'_'+IntToStr(j)
                   +'_'+CurComponent.ComponentClass.ClassName;
             Parent := CurNoteBookPage;
-            Glyph:=CurComponent.GetIconCopy;
+            Glyph := CurComponent.Icon;
             Width := ComponentPaletteBtnWidth;
             Height := ComponentPaletteBtnHeight;
             GroupIndex := 1;

lcl/buttons.pp

@@ -65,8 +65,8 @@ type
     //fOwner: TControl;
     //FOnPressed: TNotifyEvent;
     //FOnReleased: TNotifyEvent;
-    FOnLeave: TNotifyEvent;
+    FOnMouseLeave: TNotifyEvent;
-    FOnEnter: TNotifyEvent;
+    FOnMouseEnter: TNotifyEvent;
     //FOnResize: TNotifyEvent;
     FShortCut : TLMShortcut;
     Procedure SetDefault(Value : Boolean);
@@ -79,8 +79,8 @@ type
     procedure CreateWnd; override;
     procedure DoSendBtnDefault; virtual;
 
-    property OnMouseEnter : TNotifyEvent read FOnEnter write FOnEnter;
+    property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
-    property OnMouseLeave : TNotifyEvent read FOnLeave write FOnLeave;
+    property OnMouseLeave : TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
     procedure SetParent(AParent: TWinControl); override;
     procedure SetText(const Value: TCaption); override;
   public
@@ -117,24 +117,23 @@ type
 
   TButtonGlyph = class
   private
-    FOriginal : TBitmap;
+    FOriginal: TBitmap;
-    FNumGlyphs : TNumGlyphs;
+    FNumGlyphs: TNumGlyphs;
-
+    FOnChange: TNotifyEvent;
-    FOnChange  : TNotifyEvent;
+    procedure SetGlyph(Value: TBitmap);
-    procedure SetGlyph(Value : TBitmap);
+    procedure SetNumGlyphs(Value: TNumGlyphs);
-    procedure SetNumGlyphs(Value : TNumGlyphs);
   protected
-    procedure GlyphChanged(Sender : TObject);
+    procedure GlyphChanged(Sender: TObject);
   public
     constructor Create;
     destructor Destroy; override;
-
     function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
-      State: TButtonState; Transparent: Boolean; BiDiFlags: Longint): TRect;
+                  State: TButtonState; Transparent: Boolean;
-    property Glyph : TBitmap read FOriginal write SetGlyph;
+                  BiDiFlags: Longint): TRect;
-    property NumGlyphs : TNumGlyphs read FNumGlyphs write SetNumGlyphs;
+    property Glyph: TBitmap read FOriginal write SetGlyph;
-
+    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs;
-    property OnChange : TNotifyEvent read FOnChange write FOnChange;
+  public
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
   end;
 
 
@@ -307,6 +306,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.52  2003/10/22 18:43:23  mattias
+  prepared image sharing
+
   Revision 1.51  2003/09/27 09:49:30  mattias
   fix for speedbutton from Micha
 

lcl/include/bitmap.inc

@@ -52,12 +52,13 @@ var
 begin
   if Source=Self then exit;
   if Source is TBitmap then begin
-    //writeln('TBitMap.Assign ',ClassName,' ',Source.ClassName);
+    writeln('TBitMap.Assign ',ClassName,' ',Source.ClassName);
     // TBitmap can share image data
     // -> check if already shared
     SrcBitmap:=TBitmap(Source);
     if SrcBitmap.FImage=FImage then exit;
     
+    writeln('TBitMap.Assign A  RefCount=',FImage.RefCount);
     // image is not shared => new image data
     // -> free canvas (interface handles)
     FreeCanvasContext;
@@ -66,6 +67,7 @@ begin
     // share FImage with assign graphic
     FImage:=SrcBitmap.FImage;
     FImage.Reference;
+    writeln('TBitMap.Assign B ',Width,',',Height,' ',HandleAllocated,' RefCount=',FImage.RefCount);
   {$IFDEF UseFPImage}
   end else if Source is TFPCustomImage then begin
     SrcFPImage:=TFPCustomImage(Source);
@@ -149,7 +151,9 @@ end;
 
 function TBitmap.LazarusResourceTypeValid(const ResourceType: string): boolean;
 begin
-  Result:=true;
+  Result:=((ClassType=TBitmap) or (ClassType=TPixmap))
+     and ((AnsiCompareText(ResourceType,'XPM')=0)
+       or (AnsiCompareText(ResourceType,'BMP')=0));
 end;
 
 procedure TBitMap.Mask(ATransparentColor: TColor);
@@ -949,6 +953,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.49  2003/10/22 18:43:23  mattias
+  prepared image sharing
+
   Revision 1.48  2003/10/22 17:50:16  mattias
   updated rpm scripts
 

lcl/include/buttonglyph.inc

@@ -43,12 +43,19 @@ var
   GlyphCount : integer;
 begin
   if FOriginal = Value then exit;
-//  FOriginal.Assign(Value);
+  {$IFDEF BitmapSharingWorks}
+  if FOriginal=nil then begin
+    FOriginal:=TBitmap.Create;
+  end;
+  FOriginal.OnChange:=nil;
+  FOriginal.Assign(Value);
+  {$ELSE}
   if FOriginal<>nil then begin
     FOriginal.OnChange:=nil;
     FOriginal.Free;
   end;
   FOriginal:= Value;
+  {$ENDIF}
   FOriginal.OnChange := @GlyphChanged;
   FNumGlyphs:=1;
   if (FOriginal <> nil) and (FOriginal.Height > 0) then begin

lcl/include/buttons.inc

@@ -113,8 +113,8 @@ procedure TButton.CMMouseEnter(var Message: TMessage);
 begin 
   Assert(False,'Trace:[TButton.CMMouseEnter]');
   inherited CMMouseEnter(Message);
-  If assigned(FOnEnter) then
+  If assigned(FOnMouseEnter) then
-    FOnEnter(Self);
+    FOnMouseEnter(Self);
 end; 
 
 {------------------------------------------------------------------------------
@@ -122,14 +122,14 @@ end;
   Params:  None
   Returns: Nothing
 
-  Handles the event when the button Leaves
+  Handles the event when the mouse leaves the button
  ------------------------------------------------------------------------------}
 procedure TButton.CMMouseLeave(var Message: TMessage); 
 begin 
   Assert(False,'Trace:[TButton.CMMouseLeave]');
   inherited CMMouseLeave(Message);
-  If assigned(FOnLeave) then
+  If assigned(FOnMouseLeave) then
-    FOnLeave(Self);
+    FOnMouseLeave(Self);
 end; 
 
 {------------------------------------------------------------------------------
@@ -165,6 +165,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.14  2003/10/22 18:43:23  mattias
+  prepared image sharing
+
   Revision 1.13  2003/06/10 00:46:16  mattias
   fixed aligning controls
 

packager/packagedefs.pas

@@ -2652,11 +2652,12 @@ var
   ResName: string;
   res: TLResource;
 begin
-  Result:=TPixmap.Create;
+  Result:=TBitmap.Create;
   Result.TransparentColor:=clWhite;
   ResName:=ComponentClass.ClassName;
   res:=LazarusResources.Find(ResName);
-  if (res<>nil) and (res.Value<>'') and (res.ValueType='XPM') then begin
+  if (res<>nil) and (res.Value<>'')
+  and Result.LazarusResourceTypeValid(res.ValueType) then begin
     Result.LoadFromLazarusResource(ResName);
   end else begin
     Result.LoadFromLazarusResource('default');