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

ImageList:

Browse Source 
- InsertBitmap improved to add multiple bitmaps from one big
- GetBitmap extended to get Bitmaps with different effects
- add DrawToDC to win32 imagelist to give ability to draw without TCanvas (having only HDC)

TButtonGlyph:
- use internal imagelist to perform different state drawing of glyph

TBitBtn:
- send ButtonGlyph to widgetset instead of TBitmap to perform different state drawing

git-svn-id: trunk@12779 -
This commit is contained in:
paul 2007-11-08 08:36:03 +00:00
parent 95f6b902b7
commit ee80b0fd46
12 changed files with 225 additions and 181 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
lcl/buttons.pp
View File

@ -38,20 +38,27 @@ interface
{$endif}
uses
Types, Classes, SysUtils, LCLType, LCLProc, LCLIntf, LCLStrConsts,
Types, Classes, SysUtils, Math, LCLType, LCLProc, LCLIntf, LCLStrConsts,
GraphType, Graphics, ImgList, ActnList, Controls, StdCtrls, LMessages, Forms,
Themes, Menus{for ShortCut procedures}, LResources;
type
{ TButton }
TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
TButtonState = (
TButtonLayout =
(
blGlyphLeft,
blGlyphRight,
blGlyphTop,
blGlyphBottom
);
TButtonState =
(
bsUp, // button is up
bsDisabled, // button disabled (grayed)
bsDown, // button is down
bsExclusive // button is the only down in his group
);
);
{TNumGlyphs holds the number of glyphs in an image.
We restrict it to 4 to stay compatible but we don't NEED to.
@ -68,6 +75,7 @@ type
TButtonGlyph = class
private
FImages: TCustomImageList;
FOriginal: TBitmap;
FNumGlyphs: TNumGlyphs;
FOnChange: TNotifyEvent;
@ -78,11 +86,13 @@ type
public
constructor Create;
destructor Destroy; override;
procedure GetImageIndexAndEffect(State: TButtonState; var AIndex: Integer; var AEffect: TGraphicsDrawEffect);
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 Images: TCustomImageList read FImages;
public
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
@ -98,7 +108,6 @@ type
TCustomBitBtn = class(TCustomButton)
private
FButtonGlyph: TButtonGlyph;
FKind: TBitBtnKind;
FLayout: TButtonLayout;
FMargin: integer;
@ -114,10 +123,10 @@ type
procedure SetNumGlyphs(AValue: Integer);
Procedure SetSpacing(AValue: Integer);
procedure RealizeKind;
procedure DrawGlyph;
//Return the caption associated with the aKind value.
function GetCaptionOfKind(aKind: TBitBtnKind): String;
protected
FButtonGlyph: TButtonGlyph;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure GlyphChanged(Sender: TObject);
procedure InitializeWnd; override;

3
lcl/imglist.pp
View File

@ -196,7 +196,8 @@ type
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; AEnabled: Boolean = True); overload;
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawEffect: TGraphicsDrawEffect); overload;
procedure FillDescription(out ADesc: TRawImageDescription);
procedure GetBitmap(Index: Integer; Image: TBitmap);
procedure GetBitmap(Index: Integer; Image: TBitmap); overload;
procedure GetBitmap(Index: Integer; Image: TBitmap; AEffect: TGraphicsDrawEffect); overload;
procedure GetRawImage(Index: Integer; out Image: TRawImage);
{$ifdef IMGLIST_KEEP_EXTRA}
procedure GetInternalImage(Index: integer; var Image, Mask: TBitmap;

44
lcl/include/bitbtn.inc
View File

@ -84,13 +84,8 @@ procedure TCustomBitBtn.GlyphChanged(Sender: TObject);
begin
if HandleAllocated
then begin
if NumGlyphs > 1 then begin
DrawGlyph;
TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, FMultiGlyph);
end
else
TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, Glyph);
end;
TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, FButtonGlyph);
end;
InvalidatePreferredSize;
AdjustSize;
end;
@ -227,34 +222,6 @@ begin
end;
end;
procedure TCustomBitBtn.DrawGlyph;
var
AGlyphRect: TRect;
AOffset: TPoint;
AState :TButtonState;
begin
if FButtonGlyph.FOriginal = nil then exit;
AOffset.X:= 0;
AOffset.Y:= 0;
AGlyphRect.Left :=0;
AGlyphRect.Top := 0;
AGlyphRect.Bottom:= FButtonGlyph.Glyph.Height;
if NumGlyphs > 1 then
AGlyphRect.Right:= FButtonGlyph.Glyph.Width div NumGlyphs
else
AGlyphRect.Right:= FButtonGlyph.Glyph.Width;
if FMultiGlyph =nil then FMultiGlyph := TBitmap.Create;
FMultiGlyph.Height:=AGlyphRect.Bottom;
FMultiGlyph.Width:=AGlyphRect.Right;
FMultiGlyph.Canvas.Brush.Color:=Color;
FMultiGlyph.Canvas.FillRect(AGlyphRect);
if Enabled then AState := bsUp
else AState := bsDisabled;
FButtonGlyph.Draw(FMultiGlyph.Canvas,AGlyphRect,AOffset,AState,True,0);
end;
{ Return the caption associated with the akind value.
This function replaces BitBtnCaption const because the localizing
dont work with an const array }
@ -280,12 +247,7 @@ end;
procedure TCustomBitBtn.InitializeWnd;
begin
inherited InitializeWnd;
if NumGlyphs > 1 then begin
DrawGlyph;
TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, FMultiGlyph);
end
else
TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, Glyph);
TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, FButtonGlyph);
TWSBitBtnClass(WidgetSetClass).SetLayout(Self, FLayout);
TWSBitBtnClass(WidgetSetClass).SetMargin(Self, FMargin);
TWSBitBtnClass(WidgetSetClass).SetSpacing(Self, FSpacing);

125
lcl/include/buttonglyph.inc
View File

@ -20,10 +20,10 @@
{------------------------------------------------------------------------------}
constructor TButtonGlyph.Create;
begin
// Inherited Create;
FOriginal := TBitmap.Create;
FOriginal.Handle := 0;
FOriginal.OnChange := @GlyphChanged;
FImages := TCustomImageList.Create(nil);
end;
{------------------------------------------------------------------------------
@ -32,10 +32,39 @@ end;
destructor TButtonGlyph.Destroy;
begin
FOriginal.Free;
FOriginal:=nil;
FOriginal := nil;
FImages.Free;
inherited Destroy;
end;
procedure TButtonGlyph.GetImageIndexAndEffect(State: TButtonState;
var AIndex: Integer; var AEffect: TGraphicsDrawEffect);
begin
AIndex := 0;
AEffect := gdeNormal;
case State of
bsDisabled:
begin
if NumGlyphs > 1 then
AIndex := 1
else
AEffect := gdeDisabled;
end;
bsDown:
begin
if NumGlyphs > 2 then
AIndex := 2
else
AEffect := gdeShadowed;
end;
bsExclusive:
if NumGlyphs > 3 then
AIndex := 3
else
AEffect := gdeHighlighted;
end;
end;
{------------------------------------------------------------------------------
TButtonGlyph SetGlyph
------------------------------------------------------------------------------}
@ -43,18 +72,21 @@ procedure TButtonGlyph.SetGlyph(Value : TBitmap);
var
GlyphCount : integer;
begin
if FOriginal = Value then exit;
if FOriginal=nil then begin
FOriginal:=TBitmap.Create;
end;
FOriginal.OnChange:=nil;
if FOriginal = Value then
exit;
if FOriginal = nil then
FOriginal := TBitmap.Create;
FOriginal.OnChange := nil;
FOriginal.Assign(Value);
FOriginal.OnChange := @GlyphChanged;
FNumGlyphs:=1;
if (FOriginal <> nil) and (FOriginal.Height > 0) then begin
if FOriginal.Width mod FOriginal.Height = 0 then begin
FNumGlyphs := 1;
if (FOriginal <> nil) and (FOriginal.Height > 0) then
begin
if FOriginal.Width mod FOriginal.Height = 0 then
begin
GlyphCount:= FOriginal.Width div FOriginal.Height;
if GlyphCount > 4 then GlyphCount:= 1;
if GlyphCount > 4 then
GlyphCount:= 1;
FNumGlyphs:= TNumGlyphs(GlyphCount);
end;
end;
@ -63,14 +95,20 @@ end;
procedure TButtonGlyph.GlyphChanged(Sender: TObject);
begin
FImages.Clear;
FImages.Width := FOriginal.Width div Max(1, FNumGlyphs);
FImages.Height := FOriginal.Height;
FImages.Add(FOriginal, nil);
if Sender = FOriginal then
if Assigned(FOnChange) then FOnChange(Self);
if Assigned(FOnChange) then
FOnChange(Self);
end;
{------------------------------------------------------------------------------
TButtonGlyph Draw
------------------------------------------------------------------------------}
Function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
const Offset: TPoint; State: TButtonState; Transparent: Boolean;
BiDiFlags: Longint): TRect;
var
@ -78,53 +116,49 @@ var
gHeight: integer;
DestRect, SrcRect: TRect;
ImgID: integer;
UseMaskHandle: HBitmap;
src_wh, dst_wh: Integer;
AEffect: TGraphicsDrawEffect;
begin
Result:=Client;
if (FOriginal = nil) then exit;
if (FOriginal = nil) then
exit;
gWidth := FOriginal.Width;
gHeight := FOriginal.Height;
if (gWidth = 0) or (gHeight = 0)
or (Client.Left>=Client.Right) or (Client.Top>=Client.Bottom) then Exit;
if (gWidth = 0) or (gHeight = 0) or
(Client.Left >= Client.Right) or (Client.Top >= Client.Bottom) then
Exit;
if NumGlyphs > 1 then
gWidth := gWidth div NumGlyphs;
ImgID:=0;
case State of
bsDisabled: if NumGlyphs>1 then ImgID:=1;
bsDown: if NumGlyphs>2 then ImgID:=2;
bsExclusive: if NumGlyphs>3 then ImgID:=3;
end;
GetImageIndexAndEffect(State, ImgID, AEffect);
SrcRect := Rect((ImgID*gWidth), 0, ((ImgID+1)*gWidth), gHeight);
DestRect:=Client;
SrcRect := Rect((ImgID * gWidth), 0, ((ImgID+1) * gWidth), gHeight);
DestRect := Client;
Inc(DestRect.Left, Offset.X);
src_wh:=SrcRect.Right-SrcRect.Left; dst_wh:=DestRect.Right-DestRect.Left;
if (dst_wh>src_wh) then
DestRect.Right:=DestRect.Left+src_wh // if window for image is wider
else if (dst_wh<src_wh) then
SrcRect.Right:=SrcRect.Left+dst_wh; // if image not fits in their window width
src_wh := SrcRect.Right - SrcRect.Left;
dst_wh := DestRect.Right - DestRect.Left;
if (dst_wh > src_wh) then
DestRect.Right := DestRect.Left+src_wh // if window for image is wider
else
if (dst_wh < src_wh) then
SrcRect.Right := SrcRect.Left + dst_wh; // if image not fits in their window width
Inc(DestRect.Top, Offset.Y);
src_wh:=SrcRect.Bottom-SrcRect.Top; dst_wh:=DestRect.Bottom-DestRect.Top;
if (dst_wh>src_wh) then
DestRect.Bottom:=DestRect.Top+src_wh // if window for image is higher
else if (dst_wh<src_wh) then
SrcRect.Bottom:=SrcRect.Top+dst_wh; // if image not fits in their window height
src_wh := SrcRect.Bottom - SrcRect.Top;
dst_wh := DestRect.Bottom - DestRect.Top;
if (dst_wh > src_wh) then
DestRect.Bottom := DestRect.Top + src_wh // if window for image is higher
else
if (dst_wh < src_wh) then
SrcRect.Bottom := SrcRect.Top + dst_wh; // if image not fits in their window height
//Canvas.CopyRect(DestRect, FOriginal.Canvas, SrcRect)
UseMaskHandle:=FOriginal.MaskHandle;
MaskBlt(Canvas.GetUpdatedHandle([csHandleValid]),
DestRect.Left,DestRect.Top,
DestRect.Right-DestRect.Left,DestRect.Bottom-DestRect.Top,
FOriginal.Canvas.GetUpdatedHandle([csHandleValid]),
SrcRect.Left,SrcRect.Top,
UseMaskHandle,SrcRect.Left,SrcRect.Top);
FImages.Draw(Canvas, DestRect.Left, DestRect.Top, ImgID, AEffect);
// ToDo: VCL returns the text rectangle
Result:=SrcRect;
@ -136,7 +170,8 @@ end;
------------------------------------------------------------------------------}
procedure TButtonGlyph.SetNumGlyphs(Value : TNumGlyphs);
begin
if Value <> FNumGlyphs then begin
if Value <> FNumGlyphs then
begin
FNumGlyphs := Value;
GlyphChanged(FOriginal);
end;

40
lcl/include/imglist.inc
View File

@ -59,6 +59,7 @@ end;
The image is copied. To add it directly use AddDirect.
------------------------------------------------------------------------------}
function TCustomImageList.Add(Image, Mask: TBitmap): Integer;
begin
{$ifdef IMGLIST_OLDSTYLE}
@ -629,6 +630,12 @@ end;
Creates a copy of the index'th image.
------------------------------------------------------------------------------}
procedure TCustomImageList.GetBitmap(Index: Integer; Image: TBitmap);
begin
GetBitmap(Index, Image, gdeNormal);
end;
procedure TCustomImageList.GetBitmap(Index: Integer; Image: TBitmap;
AEffect: TGraphicsDrawEffect);
{$ifndef IMGLIST_OLDSTYLE}
var
RawImg: TRawImage;
@ -636,12 +643,14 @@ var
ImgHandle, MskHandle: HBitmap;
{$endif}
begin
if (FCount = 0) or (Image = nil) then Exit;
if (FCount = 0) or (Image = nil) then Exit;
{$ifdef IMGLIST_OLDSTYLE}
Image.Assign(TBitMap(FImageList.Items[Index]));
{$else}
GetRawImage(Index, RawImg);
RawImg.PerformEffect(AEffect, True);
if not RawImage_CreateBitmaps(RawImg, ImgHandle, MskHandle, True)
then begin
@ -657,6 +666,8 @@ begin
end;
Image.SetHandles(ImgHandle, MskHandle);
RawImg.FreeData;
{$endif}
end;
@ -823,6 +834,7 @@ var
R: TRect;
ImgData: PRGBAQuad;
msk: THandle;
i, ACount: Integer;
{$endif}
begin
if AImage = nil then Exit;
@ -836,11 +848,16 @@ begin
FMaskList.Insert(AIndex,AMask);
FCount := FImageList.Count;
{$else}
// todo: add support for multiple images
Inc(FCount);
ACount := AImage.Width div Width;
if ACount = 0 then
ACount := 1;
Inc(FCount, ACount);
AllocData(FCount);
if AIndex < FCount - 1
then InternalMove(FCount - 1, AIndex, True);
if AIndex < FCount - ACount then
begin
for i := 0 to ACount - 1 do
InternalMove(FCount - i - 1, AIndex + i, True);
end;
if AMask = nil
then begin
@ -849,12 +866,15 @@ begin
else msk := 0;
end
else msk := AMask.Handle;
R := Rect(0, 0, FWidth, FHeight);
RawImage_FromBitmap(RawImg, AImage.Handle, msk, R);
ImgData := InternalSetImage(AIndex, RawImg);
if HandleAllocated
then TWSCustomImageListClass(WidgetSetClass).Insert(Self, AIndex, ImgData);
for i := 0 to ACount - 1 do
begin
R := Rect(FWidth * i, 0, FWidth * (i + 1), FHeight);
RawImage_FromBitmap(RawImg, AImage.Handle, msk, R);
ImgData := InternalSetImage(AIndex + i, RawImg);
if HandleAllocated
then TWSCustomImageListClass(WidgetSetClass).Insert(Self, AIndex + i, ImgData);
end;
{$endif}
FChanged := true;

6
lcl/interfaces/carbon/carbonwsbuttons.pp
View File

@ -48,7 +48,7 @@ type
protected
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TBitmap); override;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); override;
class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue: TButtonLayout); override;
end;
@ -91,11 +91,11 @@ end;
Sets the bitmap of bevel button in Carbon interface
------------------------------------------------------------------------------}
class procedure TCarbonWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
const AValue: TBitmap);
const AValue: TButtonGlyph);
begin
if not CheckHandle(ABitBtn, Self, 'SetGlyph') then Exit;
TCarbonBitBtn(ABitBtn.Handle).SetGlyph(AValue);
TCarbonBitBtn(ABitBtn.Handle).SetGlyph(AValue.Glyph);
end;
{------------------------------------------------------------------------------

24
lcl/interfaces/gtk/gtkwsbuttons.pp
View File

@ -34,7 +34,7 @@ uses
GLib, Gtk, gdk, Gtk1WSPrivate,
{$ENDIF}
// LCL
Classes, LCLProc, LCLType, LMessages, Controls, Graphics, Buttons,
Classes, LCLProc, LCLType, LMessages, Controls, Graphics, GraphType, Buttons,
// widgetset
WSButtons, WSLCLClasses, WSProc,
// interface
@ -59,7 +59,7 @@ type
class procedure UpdateMargin(const AInfo: PBitBtnWidgetInfo; const ALayout: TButtonLayout; const AMargin: Integer);
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TBitmap); override;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); override;
class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue: TButtonLayout); override;
class procedure SetMargin(const ABitBtn: TCustomBitBtn; const AValue: Integer); override;
class procedure SetSpacing(const ABitBtn: TCustomBitBtn; const AValue: Integer); override;
@ -152,12 +152,15 @@ begin
end;
class procedure TGtkWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
const AValue: TBitmap);
const AValue: TButtonGlyph);
var
WidgetInfo: PWidgetInfo;
BitBtnInfo: PBitBtnWidgetInfo;
GDIObject: PGDIObject;
Mask: PGdkBitmap;
AGlyph: TBitmap;
AIndex: Integer;
AEffect: TGraphicsDrawEffect;
begin
if not WSCheckHandleAllocated(ABitBtn, 'SetGlyph')
then Exit;
@ -165,21 +168,25 @@ begin
WidgetInfo := GetWidgetInfo(Pointer(ABitBtn.Handle));
BitBtnInfo := WidgetInfo^.UserData;
AGlyph := TBitmap.Create;
AValue.GetImageIndexAndEffect(bsUp, AIndex, AEffect);
AValue.Images.GetBitmap(AIndex, AGlyph, AEffect);
// check if an image is needed
if (AValue.Handle = 0)
or (AValue.Width = 0)
or (AValue.Height = 0)
if (AGlyph.Handle = 0)
or (AGlyph.Width = 0)
or (AGlyph.Height = 0)
then begin
if BitBtnInfo^.ImageWidget <> nil
then begin
gtk_container_remove(BitBtnInfo^.TableWidget, BitBtnInfo^.ImageWidget);
BitBtnInfo^.ImageWidget := nil;
end;
AGlyph.Free;
Exit;
end;
GDIObject := PgdiObject(AValue.Handle);
Mask := CreateGdkMaskBitmap(AValue.Handle, AValue.MaskHandle);
GDIObject := PgdiObject(AGlyph.Handle);
Mask := CreateGdkMaskBitmap(AValue.Glyph.Handle, AValue.Glyph.MaskHandle);
// check for image
if BitBtnInfo^.ImageWidget = nil
@ -194,6 +201,7 @@ begin
end;
gdk_pixmap_unref(Mask);
AGlyph.Free;
end;
class procedure TGtkWSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn;

19
lcl/interfaces/qt/qtwsbuttons.pp
View File

@ -37,7 +37,7 @@ uses
{$endif}
qtwidgets, qtobjects,
// LCL
SysUtils, Controls, LCLType, Forms, InterfaceBase, Buttons, LMessages, Graphics,
SysUtils, Controls, LCLType, Forms, InterfaceBase, Buttons, LMessages, Graphics, GraphType,
// Widgetset
WSProc, WSButtons, WSLCLClasses;
@ -49,7 +49,7 @@ type
private
protected
public
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TBitmap); override;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); override;
end;
{ TQtWSSpeedButton }
@ -72,21 +72,30 @@ uses QtWSControls;
Params: None
Returns: Nothing
------------------------------------------------------------------------------}
class procedure TQtWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TBitmap);
class procedure TQtWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph);
var
AIcon: QIconH;
APixmap: QPixmapH;
AGlyph: TBitmap;
AIndex: Integer;
AEffect: TGraphicsDrawEffect;
begin
APixmap := QPixmap_create();
QPixmap_fromImage(APixmap, TQtImage(AValue.Handle).Handle);
AGlyph := TBitmap.Create;
AValue.GetImageIndexAndEffect(bsUp, AIndex, AEffect);
AValue.Images.GetBitmap(AIndex, AGlyph, AEffect);
QPixmap_fromImage(APixmap, TQtImage(AGlyph.Handle).Handle);
try
if APixmap <> nil then
begin
AIcon := QIcon_create(APixmap);
TQtAbstractButton(ABitbtn.Handle).setIcon(AIcon);
TQtAbstractButton(ABitBtn.Handle).setIcon(AIcon);
end;
finally
QPixmap_destroy(APixmap);
AGlyph.Free;
end;
end;

79
lcl/interfaces/win32/win32wsbuttons.pp
View File

@ -33,10 +33,10 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
Windows, Classes, Buttons, Graphics, Controls,
Windows, Classes, Buttons, Graphics, GraphType, Controls,
////////////////////////////////////////////////////
WSProc, WSControls, WSButtons, WSLCLClasses,
Win32WSControls, LCLType, Themes;
Win32WSControls, Win32WSImgList, LCLType, Themes;
type
@ -52,7 +52,7 @@ type
const ALeft, ATop, AWidth, AHeight: integer); override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TBitmap); override;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); override;
class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue: TButtonLayout); override;
class procedure SetMargin(const ABitBtn: TCustomBitBtn; const AValue: Integer); override;
class procedure SetSpacing(const ABitBtn: TCustomBitBtn; const AValue: Integer); override;
@ -74,6 +74,10 @@ implementation
uses
Win32Int, InterfaceBase, Win32Proc;
type
TBitBtnAceess = class(TCustomBitBtn)
end;
{ TWin32WSBitBtn }
const
@ -145,42 +149,34 @@ var
procedure DrawBitmap(AState: TButtonState);
var
MonoDC: HDC;
MonoBmp, OldMonoBmp: HBITMAP;
TextFlags: integer; // flags for caption (enabled or disabled)
numGlyphs, glyphLeft, glyphWidth, glyphHeight: integer;
themesActive, emulateDisabled: boolean;
glyphWidth, glyphHeight: integer;
themesActive: boolean;
OldBitmapHandle: HBITMAP; // Handle of the provious bitmap in hdcNewBitmap
AIndex: Integer;
AEffect: TGraphicsDrawEffect;
begin
emulateDisabled := false;
glyphLeft := 0;
glyphWidth := srcWidth;
glyphHeight := srcHeight;
TextFlags := DST_PREFIXTEXT;
numGlyphs := BitBtn.NumGlyphs;
case AState of
bsDisabled:
begin
if numGlyphs > 1 then
glyphLeft := glyphWidth
else
emulateDisabled := true;
TextFlags := TextFlags or DSS_DISABLED;
end;
bsDown: if numGlyphs > 2 then glyphLeft := 2*glyphWidth;
bsExclusive: if numGlyphs > 3 then glyphLeft := 3*glyphWidth;
end;
if AState = bsDisabled then
TextFlags := TextFlags or DSS_DISABLED;
// fill with background color
OldBitmapHandle := SelectObject(hdcNewBitmap, NewBitmap);
Windows.FillRect(hdcNewBitmap, BitmapRect, BitBtn.Brush.Handle);
if not emulateDisabled then
if AState <> bsDisabled then
begin
if (srcWidth <> 0) and (srcHeight <> 0) then
begin
WidgetSet.MaskBlt(hdcNewBitmap, XDestBitmap, YDestBitmap, glyphWidth,
glyphHeight, BitBtn.Glyph.Canvas.Handle, glyphLeft, 0, BitBtn.Glyph.MaskHandle, glyphLeft, 0);
TBitBtnAceess(BitBtn).FButtonGlyph.GetImageIndexAndEffect(AState, AIndex, AEffect);
TWin32WSCustomImageList.DrawToDC(TBitBtnAceess(BitBtn).FButtonGlyph.Images, AIndex,
hdcNewBitmap, Rect(XDestBitmap, YDestBitmap, glyphWidth, glyphHeight),
TBitBtnAceess(BitBtn).FButtonGlyph.Images.BkColor,
TBitBtnAceess(BitBtn).FButtonGlyph.Images.BlendColor, AEffect,
TBitBtnAceess(BitBtn).FButtonGlyph.Images.DrawingStyle,
TBitBtnAceess(BitBtn).FButtonGlyph.Images.ImageType);
end;
end else
begin
@ -191,18 +187,6 @@ var
if (srcWidth <> 0) and (srcHeight <> 0) then
begin
// Create a Mono DC
MonoBmp := CreateBitmap(glyphWidth, glyphHeight, 1, 1, nil);
MonoDC := CreateCompatibleDC(hdcNewBitmap);
OldMonoBmp := SelectObject(MonoDC, MonoBmp);
// Create the black and white image
with BitBtn.Glyph do
begin
FillRect(MonoDC, Rect(0, 0, glyphWidth, glyphHeight), BitBtn.Brush.Handle);
WidgetSet.MaskBlt(MonoDC, 0, 0, glyphWidth, glyphHeight,
Canvas.Handle, glyphLeft, 0, MaskHandle, glyphLeft, 0);
end;
if themesActive then
begin
// non-themed winapi wants white/other as background/picture-disabled colors
@ -210,13 +194,14 @@ var
SetBkColor(hdcNewBitmap, ColorToRGB(BitBtn.Brush.Color));
SetTextColor(hdcNewBitmap, GetSysColor(COLOR_BTNSHADOW));
end;
// Draw the black and white image
BitBlt(hdcNewBitmap, XDestBitmap, YDestBitmap, glyphWidth, glyphHeight,
MonoDC, 0, 0, SRCCOPY);
TBitBtnAceess(BitBtn).FButtonGlyph.GetImageIndexAndEffect(AState, AIndex, AEffect);
SelectObject(MonoDC, OldMonoBmp);
DeleteDC(MonoDC);
DeleteObject(MonoBmp);
TWin32WSCustomImageList.DrawToDC(TBitBtnAceess(BitBtn).FButtonGlyph.Images, AIndex,
hdcNewBitmap, Rect(XDestBitmap, YDestBitmap, glyphWidth, glyphHeight),
TBitBtnAceess(BitBtn).FButtonGlyph.Images.BkColor,
TBitBtnAceess(BitBtn).FButtonGlyph.Images.BlendColor, AEffect,
TBitBtnAceess(BitBtn).FButtonGlyph.Images.DrawingStyle,
TBitBtnAceess(BitBtn).FButtonGlyph.Images.ImageType);
end;
end;
SetBkMode(hdcNewBitmap, TRANSPARENT);
@ -367,7 +352,9 @@ begin
DrawBitmap(XPBitBtn_ImageIndexToState[I]);
ImageList_AddMasked(ButtonImageList.himl, NewBitmap, ColorToRGB(BitBtn.Brush.Color));
end;
end else begin
end
else
begin
ButtonImageList.himl := 0;
end;
Windows.SendMessage(BitBtnHandle, BCM_SETIMAGELIST, 0, LPARAM(@ButtonImageList));
@ -476,7 +463,7 @@ begin
end;
class procedure TWin32WSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
const AValue: TBitmap);
const AValue: TButtonGlyph);
begin
if not WSCheckHandleAllocated(ABitBtn, 'SetGlyph') then Exit;
DrawBitBtnImage(ABitBtn, ABitBtn.Caption);

39
lcl/interfaces/win32/win32wsimglist.pp
View File

@ -54,6 +54,8 @@ type
class procedure DestroyHandle(AComponent: TComponent); override;
class procedure Draw(AList: TCustomImageList; AIndex: Integer; ACanvas: TCanvas;
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType); override;
class procedure DrawToDC(AList: TCustomImageList; AIndex: Integer; ADC: HDC;
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
class procedure Insert(AList: TCustomImageList; AIndex: Integer; AData: PRGBAQuad); override;
class procedure Move(AList: TCustomImageList; ACurIndex, ANewIndex: Integer); override;
class procedure Replace(AList: TCustomImageList; AIndex: Integer; AData: PRGBAQuad); override;
@ -265,19 +267,26 @@ end;
class procedure TWin32WSCustomImageList.Draw(AList: TCustomImageList; AIndex: Integer;
ACanvas: TCanvas; ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
begin
if not WSCheckHandleAllocated(AList, 'Draw')
then Exit;
DrawToDC(AList, AIndex, ACanvas.Handle, ABounds, ABkColor, ABlendColor, ADrawEffect, AStyle, AImageType);
end;
class procedure TWin32WSCustomImageList.DrawToDC(AList: TCustomImageList;
AIndex: Integer; ADC: HDC; ABounds: TRect; ABkColor, ABlendColor: TColor;
ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle;
AImageType: TImageType);
var
DrawParams: TImageListDrawParams;
RawImg: TRawImage;
ListImg, DeviceImg: TLazIntfImage;
ImgHandle, MskHandle: HBitmap;
ABitmap: TBitmap;
OldBmp, ImgHandle, MskHandle: HBitmap;
ImgDC: HDC;
begin
if not WSCheckHandleAllocated(AList, 'Draw')
then Exit;
if ADrawEffect = gdeNormal then
begin
ImageList_DrawEx(HImageList(AList.Handle), AIndex, ACanvas.Handle, ABounds.Left,
ImageList_DrawEx(HImageList(AList.Handle), AIndex, ADC, ABounds.Left,
ABounds.Top, ABounds.Right, ABounds.Bottom, ColorToImagelistColor(ABkColor),
ColorToImagelistColor(ABlendColor), DRAWINGSTYLEMAP[AStyle] or IMAGETPYEMAP[AImageType]);
end
@ -289,7 +298,7 @@ begin
DrawParams.cbSize := SizeOf(DrawParams);
DrawParams.himlL := HImageList(AList.Handle);
DrawParams.i := AIndex;
DrawParams.hdcDst := ACanvas.Handle;
DrawParams.hdcDst := ADC;
DrawParams.x := ABounds.Left;
DrawParams.y := ABounds.Top;
DrawParams.cx := ABounds.Right;
@ -305,8 +314,7 @@ begin
// use RawImage_PerformEffect to perform drawing effect
AList.GetRawImage(AIndex, RawImg);
RawImg.PerformEffect(ADrawEffect, True);
ABitmap := TBitmap.Create;
if not Widgetset.RawImage_CreateBitmaps(RawImg, ImgHandle, MskHandle, True)
then begin
// bummer, the widgetset doesn't support our 32bit format, try device
@ -319,10 +327,15 @@ begin
DeviceImg.Free;
ListImg.Free;
end;
ABitmap.SetHandles(ImgHandle, MskHandle);
ACanvas.Draw(ABounds.Left, ABounds.Top, ABitmap);
ABitmap.Free;
FreeMem(RawImg.Data);
ImgDC := CreateCompatibleDC(0);
OldBmp := SelectObject(ImgDC, ImgHandle);
WidgetSet.StretchMaskBlt(ADC, ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom,
ImgDC, 0, 0, ABounds.Right, ABounds.Bottom, MskHandle, 0, 0, SRCCOPY);
RawImg.FreeData;
SelectObject(ImgDC, OldBmp);
if ImgHandle<>0 then DeleteObject(ImgHandle);
if MskHandle<>0 then DeleteObject(MskHandle);
DeleteDC(ImgDC);
end;
end;

4
lcl/widgetset/wsbuttons.pp
View File

@ -54,7 +54,7 @@ type
TWSBitBtnClass = class of TWSBitBtn;
TWSBitBtn = class(TWSButton)
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TBitmap); virtual;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); virtual;
class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue: TButtonLayout); virtual;
class procedure SetMargin(const ABitBtn: TCustomBitBtn; const AValue: Integer); virtual;
class procedure SetSpacing(const ABitBtn: TCustomBitBtn; const AValue: Integer); virtual;
@ -74,7 +74,7 @@ implementation
{ TWSCustomBitBtn }
class procedure TWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
const AValue: TBitmap);
const AValue: TButtonGlyph);
begin
end;

2
lcl/widgetset/wsimglist.pp
View File

@ -120,7 +120,7 @@ begin
ABitmap.SetHandles(ImgHandle, MskHandle);
ACanvas.Draw(ABounds.Left, ABounds.Top, ABitmap);
ABitmap.Free;
FreeMem(RawImg.Data);
RawImg.FreeData;
end;
end;