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

prepared image sharing

Browse Source 
git-svn-id: trunk@4724 -
This commit is contained in:
mattias 2003-10-22 18:43:23 +00:00
parent ae02013fa3
commit 24a046fcf6
6 changed files with 60 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
ide/componentpalette.pas
View File

@ -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;
Result.TransparentColor:=clWhite;
Result.LoadFromLazarusResource('tmouse');
if fSelectButtonIcon=nil then begin
fSelectButtonIcon:=TPixmap.Create;
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;

36
lcl/buttons.pp
View File

@ -65,8 +65,8 @@ type
//fOwner: TControl;
//FOnPressed: TNotifyEvent;
//FOnReleased: TNotifyEvent;
FOnLeave: TNotifyEvent;
FOnEnter: TNotifyEvent;
FOnMouseLeave: 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 OnMouseLeave : TNotifyEvent read FOnLeave write FOnLeave;
property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
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;
FNumGlyphs : TNumGlyphs;
FOnChange : TNotifyEvent;
procedure SetGlyph(Value : TBitmap);
procedure SetNumGlyphs(Value : TNumGlyphs);
FOriginal: TBitmap;
FNumGlyphs: TNumGlyphs;
FOnChange: TNotifyEvent;
procedure SetGlyph(Value: TBitmap);
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;
property Glyph : TBitmap read FOriginal write SetGlyph;
property NumGlyphs : TNumGlyphs read FNumGlyphs write SetNumGlyphs;
property OnChange : TNotifyEvent read FOnChange write FOnChange;
State: TButtonState; Transparent: Boolean;
BiDiFlags: Longint): TRect;
property Glyph: TBitmap read FOriginal write SetGlyph;
property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs;
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

11
lcl/include/bitmap.inc
View File

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

9
lcl/include/buttonglyph.inc
View File

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

13
lcl/include/buttons.inc
View File

@ -113,8 +113,8 @@ procedure TButton.CMMouseEnter(var Message: TMessage);
begin
Assert(False,'Trace:[TButton.CMMouseEnter]');
inherited CMMouseEnter(Message);
If assigned(FOnEnter) then
FOnEnter(Self);
If assigned(FOnMouseEnter) then
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
FOnLeave(Self);
If assigned(FOnMouseLeave) then
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

5
packager/packagedefs.pas
View File

@ -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');