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

fixed saving custom TBitBtn kind

Browse Source 
git-svn-id: trunk@5180 -
This commit is contained in:
mattias 2004-02-07 20:25:37 +00:00
parent c0b7b7163f
commit b18c387c58
5 changed files with 96 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
lcl/buttons.pp
View File

@ -144,38 +144,37 @@ type
TBitBtn = class(TButton)
private
FCanvas : TCanvas;
FGlyph : TButtonGlyph;
FKind : TBitBtnKind;
FLayout : TButtonLayout;
FSpacing : Integer;
Function GetGlyph : TBitmap;
Function IsCustom : Boolean;
Function IsGlyphStored : Boolean;
Procedure SetGlyph(Value : TBitmap);
Procedure SetKind(Value : TBitBtnKind);
Procedure SetLayout(Value : TButtonLayout);
Procedure SetSpacing(Value : Integer);
FButtonGlyph: TButtonGlyph;
FKind: TBitBtnKind;
FLayout: TButtonLayout;
FSpacing: Integer;
Function GetGlyph: TBitmap;
Function IsGlyphStored: Boolean;
Procedure SetGlyph(AValue: TBitmap);
Procedure SetKind(AValue: TBitBtnKind);
Procedure SetLayout(AValue: TButtonLayout);
Procedure SetSpacing(AValue: Integer);
procedure RealizeKind;
//Return the caption associated with the aKind value.
function GetCaptionOfKind(aKind :TBitBtnKind) : String;
function GetCaptionOfKind(aKind: TBitBtnKind) : String;
protected
Procedure Click; override;
procedure GlyphChanged(Sender : TObject);
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
public
constructor Create(AOwner : TComponent); override;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; Override;
published
property Action;
property Align;
property Anchors;
property Constraints;
property Default stored IsCustom;
property Glyph : TBitmap read GetGlyph write SetGlyph stored IsGlyphStored;
property Kind : TBitBtnKind read FKind write SetKind;
property Layout: TButtonLayout read FLayout write SetLayout;
property ModalResult stored IsCustom;
property Default;
property Glyph: TBitmap read GetGlyph write SetGlyph stored IsGlyphStored;
property Kind: TBitBtnKind read FKind write SetKind default bkCustom;
property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
property ModalResult;
property OnChangeBounds;
property OnClick;
property OnEnter;
@ -187,7 +186,7 @@ type
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Spacing : Integer read FSpacing write SetSpacing;
property Spacing : Integer read FSpacing write SetSpacing default 3;
property Visible;
end;
@ -332,6 +331,9 @@ end.
{ =============================================================================
$Log$
Revision 1.57 2004/02/07 20:25:37 mattias
fixed saving custom TBitBtn kind
Revision 1.56 2004/02/02 18:01:31 mattias
added TSpeedButton.Action and TBitBtn.Action

15
lcl/graphics.pp
View File

@ -906,8 +906,6 @@ type
FDIBHandle: HBITMAP;// output device independent handle
FSaveStream: TMemoryStream;
FSaveStreamType: TBitmapNativeType;
//FOS2Format: Boolean;
//FHalftone: Boolean;
protected
procedure FreeHandle; override;
function ReleaseHandle: HBITMAP;
@ -925,14 +923,14 @@ type
{ TBitmap }
{ Not completed!
TBitmap is the data of an image. The image can be loaded from a file,
{ TBitmap is the data of an image. The image can be loaded from a file,
stream or resource in .bmp (windows bitmap format) or .xpm (XPixMap format)
The loading routine automatically recognizes the format, so it also load
the streams of Delphi form streams (e.g. .dfm files).
The loading routine automatically recognizes the format, so it is also used
to load the imagess from Delphi form streams (e.g. .dfm files).
When the handle is created, it is up to the interface (gtk, win32, ...)
to convert it automatically to the best internal format. That is why the
Handle is interface dependent. }
Handle is interface dependent.
To access the raw data, see TLazIntfImage in IntfGraphics.pas }
TBitmapInternalStateFlag = (
bmisCreatingCanvas
@ -1444,6 +1442,9 @@ end.
{ =============================================================================
$Log$
Revision 1.112 2004/02/07 20:25:37 mattias
fixed saving custom TBitBtn kind
Revision 1.111 2004/02/05 16:28:38 mattias
fixed unsharing TBitmap

115
lcl/include/bitbtn.inc
View File

@ -16,30 +16,28 @@
}
{------------------------------------------------------------------------------}
{ TBitbtn Constructor }
{ TBitBtn Constructor }
{------------------------------------------------------------------------------}
constructor TBitBtn.Create(AOwner: TComponent);
constructor TBitBtn.Create(TheOwner: TComponent);
begin
Inherited Create(AOwner);
inherited Create(TheOwner);
FCompStyle := csBitBtn;
FGlyph := TButtonGlyph.Create;
TButtonGlyph(FGlyph).OnChange := @GlyphChanged;
{set default alignment}
Align := alNone;
FCanvas := TCanvas.Create;
FKind := bkCustom;
FLayout := blGlyphLeft;
FSpacing := 3;
Setbounds(1,1,75,25);
FButtonGlyph := TButtonGlyph.Create;
FButtonGlyph.OnChange := @GlyphChanged;
Align := alNone;
SetInitialBounds(1,1,75,25);
RealizeKind;
end;
{------------------------------------------------------------------------------}
{ TBitbtn destructor }
{ TBitBtn destructor }
{------------------------------------------------------------------------------}
destructor TBitbtn.Destroy;
destructor TBitBtn.Destroy;
Begin
FreeThenNil(FCanvas);
FreeThenNil(FGlyph);
FreeThenNil(FButtonGlyph);
inherited Destroy;
end;
@ -57,29 +55,21 @@ Begin
inherited Click;
End;
Function TBitbtn.GetGlyph : TBitmap;
Function TBitBtn.GetGlyph : TBitmap;
Begin
Result := TButtonGlyph(FGlyph).Glyph;
Result := FButtonGlyph.Glyph;
end;
Function TBitBtn.IsCustom : Boolean;
Begin
Result := Kind = bkCustom;
end;
Function TBitbtn.IsGlyphStored : Boolean;
Function TBitBtn.IsGlyphStored: Boolean;
begin
Result := IsCustom;
If Result then
Result := TButtonGlyph(FGlyph).Glyph <> nil;
If Result then
Result := not TButtonGlyph(FGlyph).Glyph.Empty;
Result := (Kind = bkCustom) and (FButtonGlyph.Glyph <> nil)
and (not FButtonGlyph.Glyph.Empty)
and (FButtonGlyph.Glyph.Width>0) and (FButtonGlyph.Glyph.Height>0);
end;
Procedure TBitbtn.SetGlyph(Value : TBitmap);
Procedure TBitBtn.SetGlyph(AValue: TBitmap);
Begin
Assert(False, 'Trace:SETGLYPH');
TButtonGlyph(FGlyph).Glyph := Value;
FButtonGlyph.Glyph := AValue;
end;
procedure TBitBtn.GlyphChanged(Sender: TObject);
@ -93,14 +83,17 @@ end;
procedure TBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
var
CurGlyph: TBitmap;
begin
with Glyph do
begin
CurGlyph:=Glyph;
with CurGlyph do begin
// ToDo: transparency
Width := ImageList.Width;
Height := ImageList.Height;
Canvas.Brush.Color := clMaroon; // whatever
Canvas.FillRect(Rect(0,0, Width, Height));
ImageList.Draw(Canvas, 0, 0, Index,true);
Canvas.FillRect(Rect(0,0,Width, Height));
ImageList.Draw(Canvas,0,0,Index,true);
end;
end;
@ -115,44 +108,54 @@ begin
end;
end;
Procedure TBitBtn.SetKind(Value : TBitBtnKind);
var
Bitmap1 : TBitmap;
Procedure TBitBtn.SetKind(AValue: TBitBtnKind);
Begin
FKind := Value;
if FKind=AValue then exit;
FKind := AValue;
if FKind = bkCustom then Exit;
Bitmap1 := TBitmap.Create;
Bitmap1.Handle := LoadStockPixmap(BitBtnImages[Value]);
Glyph := Bitmap1;
Caption :=GetCaptionOfKind(fKind);
ModalResult := BitBtnModalResults[Value];
if not (csLoading in ComponentState) then
Default := FKind in [bkOk,bkYes];
RealizeKind;
end;
Procedure TBitBtn.SetLayout(Value : TButtonLayout);
Procedure TBitBtn.SetLayout(AValue: TButtonLayout);
Begin
if FLayout = Value then Exit;
FLayout := Value;
if FLayout = AValue then Exit;
FLayout := AValue;
if HandleAllocated then
CNSendMessage(LM_LAYOUTCHANGED,Self,nil);
end;
Procedure TBitBtn.SetSpacing(Value : Integer);
Procedure TBitBtn.SetSpacing(AValue: Integer);
Begin
if (FSpacing = Value) or (Value < 0) then Exit;
FSpacing := Value;
if (FSpacing = AValue) or (AValue < 0) then Exit;
FSpacing := AValue;
if HandleAllocated then
//still send the layout message because it still calls the same procedure
CNSendMessage(LM_LAYOUTCHANGED,Self,nil);
end;
//Return the caption associed with the akind value.
//This function replace BitBtnCaption const because the localizing
//dont work with an const (optimisation of FPC i supose)
procedure TBitBtn.RealizeKind;
var
ABitmap: TBitmap;
begin
if (Kind<>bkCustom) then begin
ABitmap:=Glyph;
if ABitmap=nil then
ABitmap := TBitmap.Create;
ABitmap.Handle := LoadStockPixmap(BitBtnImages[FKind]);
Glyph := ABitmap;
end;
if not (csLoading in ComponentState) then begin
Caption :=GetCaptionOfKind(fKind);
ModalResult := BitBtnModalResults[FKind];
Default := FKind in [bkOk,bkYes];
end;
end;
{ Return the caption associated with the akind value.
This function replaces BitBtnCaption const because the localizing
dont work with an const array }
function TBitBtn.GetCaptionOfKind(aKind: TBitBtnKind): String;
begin
Result:='';

7
lcl/include/bitmap.inc
View File

@ -429,7 +429,6 @@ begin
else
RaiseInvalidBitmapHeader;
end;
//writeln('TBitmap.ReadStream ',ClassName,' Size=',Size,' Reader=',ReaderClass.ClassName,' Stream=',Stream.ClassName);
ReadStreamWithFPImage(MemStream,Size,ReaderClass);
finally
if MemStream<>Stream then
@ -903,8 +902,9 @@ procedure TBitmap.SetHandle(Value: HBITMAP);
begin
if FImage.FHandle = Value then exit;
if FImage.FHandle<>0 then begin
UnshareImage;
// free old handles
FreeCanvasContext;
UnshareImage;
end;
// TODO: get the properties from new bitmap
with FImage do begin
@ -1038,6 +1038,9 @@ end;
{ =============================================================================
$Log$
Revision 1.60 2004/02/07 20:25:37 mattias
fixed saving custom TBitBtn kind
Revision 1.59 2004/02/05 16:28:38 mattias
fixed unsharing TBitmap

3
lcl/include/bitmapimage.inc
View File

@ -87,7 +87,8 @@ end;
function TBitmapImage.IsEmpty: boolean;
begin
Result := (FHandle = 0) and (FDIBHandle = 0);
Result := (FHandle = 0) and (FDIBHandle = 0)
and (SaveStream=nil);
end;
function TBitmapImage.GetPixelFormat: TPixelFormat;