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

wince:

Browse Source 
- implement BitBtns
- minor changes

git-svn-id: trunk@13783 -
This commit is contained in:
paul 2008-01-17 10:24:30 +00:00
parent b0f4154cba
commit 8f68c7cbd0
5 changed files with 142 additions and 376 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
lcl/interfaces/wince/wincecallback.inc
View File

@ -291,7 +291,6 @@ Var
DCIndex: integer; DCIndex: integer;
parLeft, parTop: integer; parLeft, parTop: integer;
useDoubleBuffer: boolean; useDoubleBuffer: boolean;
isNotebook: boolean;
isNativeControl: boolean; isNativeControl: boolean;
needParentPaint: boolean; needParentPaint: boolean;
lNotebookFound: boolean; lNotebookFound: boolean;
@ -306,8 +305,6 @@ Var
// create a paint message // create a paint message
GetClassName(Window, @winClassName, 20); GetClassName(Window, @winClassName, 20);
isNotebook := TWinCEWidgetSet(WidgetSet).ThemesActive and
CompareMem(@winClassName, @TabControlClsName, High(TabControlClsName)+1);
isNativeControl := not CompareMem(@winClassName, @ClsName, High(ClsName)+1); isNativeControl := not CompareMem(@winClassName, @ClsName, High(ClsName)+1);
ParentPaintWindow := 0; ParentPaintWindow := 0;
needParentPaint := GetNeedParentPaint(WindowInfo, lWinControl); needParentPaint := GetNeedParentPaint(WindowInfo, lWinControl);
@ -334,8 +331,7 @@ Var
PushEraseBkgndCommand(ecDiscard); PushEraseBkgndCommand(ecDiscard);
// check if double buffering is requested // check if double buffering is requested
useDoubleBuffer := (WParam = 0) and (lWinControl.DoubleBuffered useDoubleBuffer := (WParam = 0) and (lWinControl.DoubleBuffered);
or TWinCEWidgetSet(WidgetSet).ThemesActive);
{$ifdef MSG_DEBUG} {$ifdef MSG_DEBUG}
if useDoubleBuffer and (DoubleBufferDC <> 0) then if useDoubleBuffer and (DoubleBufferDC <> 0) then
begin begin
@ -423,7 +419,7 @@ Var
PaintMsg.PaintStruct := @PS; PaintMsg.PaintStruct := @PS;
if not useDoubleBuffer then if not useDoubleBuffer then
PaintMsg.DC := DC; PaintMsg.DC := DC;
if not needParentPaint and not isNotebook then if not needParentPaint then
begin begin
// send through message to allow message override // send through message to allow message override
//lWinControl.EraseBackground(PaintMsg.DC); //lWinControl.EraseBackground(PaintMsg.DC);
@ -988,7 +984,7 @@ begin
Assert(False, 'Trace:WindowProc - Checking Proc'); Assert(False, 'Trace:WindowProc - Checking Proc');
// Assert(False, Format('Trace:WindowProc - Window Value: $%S-%d; Msg Value: %S; WParam: $%S; LParam: $%S', [IntToHex(Window, 4), Window, WM_To_String(Msg), IntToHex(WParam, 4), IntToHex(LParam, 4)])); // Assert(False, Format('Trace:WindowProc - Window Value: $%S-%d; Msg Value: %S; WParam: $%S; LParam: $%S', [IntToHex(Window, 4), Window, WM_To_String(Msg), IntToHex(WParam, 4), IntToHex(LParam, 4)]));
Case Msg Of case Msg Of
WM_NULL: WM_NULL:
begin begin
CheckSynchronize; CheckSynchronize;
@ -996,7 +992,7 @@ begin
end; end;
WM_ACTIVATE: WM_ACTIVATE:
begin begin
Case Lo(WParam) Of case Lo(WParam) Of
WA_ACTIVE, WA_CLICKACTIVE: WA_ACTIVE, WA_CLICKACTIVE:
begin begin
LMessage.Msg := LM_ACTIVATE LMessage.Msg := LM_ACTIVATE
@ -1004,24 +1000,7 @@ begin
WA_INACTIVE: WA_INACTIVE:
begin begin
LMessage.Msg := LM_DEACTIVATE; LMessage.Msg := LM_DEACTIVATE;
end; // Wince => maybe cast to WM_CLOSE?
end;
end;
WM_ACTIVATEAPP:
begin
if Window = TWinCEWidgetSet(WidgetSet).AppHandle then
begin
if WParam <> 0 then
begin
Windows.SetWindowPos(TWinCEWidgetSet(WidgetSet).AppHandle, HWND_TOP,
0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
end;
// activate/deactivate main window
if (Application <> nil) and (Application.MainForm <> nil) and
Application.MainForm.HandleAllocated then
begin
CallDefaultWindowProc(Application.MainForm.Handle, WM_NCACTIVATE, WParam, 0);
end; end;
end; end;
end; end;
@ -1278,7 +1257,14 @@ begin
end; end;
WinProcess := false; WinProcess := false;
end; end;
end else begin end else
if (lWinControl is TCustomBitBtn) and (PDrawItemStruct(LParam)^.ctlType = ODT_BUTTON) then
begin
DrawBitBtnImage(TCustomBitBtn(lWinControl), PDrawItemStruct(LParam));
WinProcess := False;
end
else
begin
with TLMDrawItems(LMessage) do with TLMDrawItems(LMessage) do
begin begin
Msg := LM_DRAWITEM; Msg := LM_DRAWITEM;
@ -1300,12 +1286,6 @@ begin
If (lWinControl is TCustomFloatSpinEdit) then If (lWinControl is TCustomFloatSpinEdit) then
EnableFloatSpinEditBuddy(Window, WParam<>0); EnableFloatSpinEditBuddy(Window, WParam<>0);
// ugly hack to give bitbtns a nice look
// When no theming active, the internal image needs to be
// recreated when the enabled state is changed
/// if not TWinCEWidgetSet(WidgetSet).ThemesActive
/// and (lWinControl is TCustomBitBtn)
/// then DrawBitBtnImage(TCustomBitBtn(lWinControl), PChar(TCustomBitBtn(lWinControl).Caption));
end; end;
WM_ERASEBKGND: WM_ERASEBKGND:
begin begin

6
lcl/interfaces/wince/winceextra.pp
View File

@ -63,6 +63,10 @@ const
{ missing listview styles} { missing listview styles}
LVS_EX_LABELTIP = $00004000; LVS_EX_LABELTIP = $00004000;
{ missing messages }
WM_HIBERNATE = $03FF;
function DrawState(dc:HDC ; hbr : HBRUSH ; func: DRAWSTATEPROC ; lp:LPARAM; wp:WPARAM;x,y,cx,cy:integer;flags:UINT) : boolean; function DrawState(dc:HDC ; hbr : HBRUSH ; func: DRAWSTATEPROC ; lp:LPARAM; wp:WPARAM;x,y,cx,cy:integer;flags:UINT) : boolean;
@ -235,7 +239,7 @@ begin
case opcode of case opcode of
DST_TEXT, DST_PREFIXTEXT: DST_TEXT, DST_PREFIXTEXT:
begin begin
if not GetTextExtentPoint32(dc, pwidechar(lp), len, @s) if not GetTextExtentPoint32(dc, PWideChar(lp), len, @s)
then Exit; then Exit;
end; end;

5
lcl/interfaces/wince/winceint.pp
View File

@ -92,8 +92,6 @@ type
TWinCEWidgetSet = class(TWidgetSet) TWinCEWidgetSet = class(TWidgetSet)
private private
AppTerminated: Boolean;
// The parent of all windows, represents the button of the taskbar // The parent of all windows, represents the button of the taskbar
// This window is also the owner of the clipboard. // This window is also the owner of the clipboard.
// Assoc. windowproc also acts as handler for popup menus // Assoc. windowproc also acts as handler for popup menus
@ -119,8 +117,6 @@ type
FOnAsyncSocketMsg: TSocketEvent; FOnAsyncSocketMsg: TSocketEvent;
FThemesActive: boolean;
{ event handler helper functions } { event handler helper functions }
procedure HandleProcessEvent(AData: PtrInt; AFlags: dword); procedure HandleProcessEvent(AData: PtrInt; AFlags: dword);
procedure CheckPipeEvents; procedure CheckPipeEvents;
@ -172,7 +168,6 @@ type
property AppHandle: HWND read FAppHandle; property AppHandle: HWND read FAppHandle;
property MessageFont: HFONT read FMessageFont; property MessageFont: HFONT read FMessageFont;
property ThemesActive: boolean read FThemesActive;//just for not removing all those refrences
property OnAsyncSocketMsg: TSocketEvent read FOnAsyncSocketMsg write FOnAsyncSocketMsg; property OnAsyncSocketMsg: TSocketEvent read FOnAsyncSocketMsg write FOnAsyncSocketMsg;
end; end;

431
lcl/interfaces/wince/wincewsbuttons.pp
View File

@ -29,10 +29,12 @@ interface
uses uses
// Libs // Libs
Windows, Windows,
// RTL
SysUtils, Classes,
// LCL // LCL
SysUtils, Controls, LCLType, Forms, graphics, InterfaceBase, Buttons, LMessages,WinCEProc, WinCEWSControls, Controls, Buttons, Graphics, GraphType, LCLType, LCLProc,
// Widgetset // Widgetset
WSButtons, WSLCLClasses; WSButtons, WSLCLClasses, WinCEWSControls, WinCEWSImgList, WinCEProc;
type type
{ TWinCEWSBitBtn } { TWinCEWSBitBtn }
@ -42,13 +44,10 @@ type
protected protected
public public
class function CreateHandle(const AWinControl: TWinControl; class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; //override; const AParams: TCreateParams): HWND; override;
class procedure GetPreferredSize(const AWinControl: TWinControl; class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override; WithThemeSpace: Boolean); override;
class procedure SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: integer); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); override; class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); override;
class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue: TButtonLayout); override; class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue: TButtonLayout); override;
class procedure SetMargin(const ABitBtn: TCustomBitBtn; const AValue: Integer); override; class procedure SetMargin(const ABitBtn: TCustomBitBtn; const AValue: Integer); override;
@ -64,51 +63,27 @@ type
public public
end; end;
procedure DrawBitBtnImage(BitBtn: TCustomBitBtn; ButtonCaption: PWideChar); procedure DrawBitBtnImage(BitBtn: TCustomBitBtn; DrawStruct: PDrawItemStruct);
implementation implementation
uses WinCEInt, WinCEExtra; uses WinCEInt, WinCEExtra;
{ TWinCEWSBitBtn }
const
BUTTON_IMAGELIST_ALIGN_LEFT = 0;
BUTTON_IMAGELIST_ALIGN_RIGHT = 1;
BUTTON_IMAGELIST_ALIGN_TOP = 2;
BUTTON_IMAGELIST_ALIGN_BOTTOM = 3;
BUTTON_IMAGELIST_ALIGN_CENTER = 4;
BCM_FIRST = $1600;
BCM_GETIDEALSIZE = BCM_FIRST + 1;
BCM_SETIMAGELIST = BCM_FIRST + 2;
BCM_GETIMAGELIST = BCM_FIRST + 3;
BCM_SETTEXTMARGIN = BCM_FIRST + 4;
BCM_GETTEXTMARGIN = BCM_FIRST + 5;
{ - you do need to destroy the imagelist yourself.
- you'll need 5 images to support all themed xp button states...
Image 0 = normal
Image 1 = mouse hover
Image 2 = button down
Image 3 = button disabled
Image 4 = button focus
}
XPBitBtn_ImageIndexToState: array[1..6] of TButtonState =
(bsUp, bsExclusive, bsDown, bsDisabled, bsUp, bsUp);
BitBtnEnabledToButtonState: array[boolean] of TButtonState =
(bsDisabled, bsUp);
type type
BUTTON_IMAGELIST = packed record TBitBtnAceess = class(TCustomBitBtn)
himl: Windows.HIMAGELIST;
margin: Windows.RECT;
uAlign: UINT;
end; end;
const
ButtonStateToFrameState: array[TButtonState] of UInt =
(
{ bsUp } DFCS_BUTTONPUSH,
{ bsDisabled } DFCS_BUTTONPUSH or DFCS_INACTIVE,
{ bsDown } DFCS_BUTTONPUSH or DFCS_PUSHED,
{ bsExclusive } DFCS_BUTTONPUSH,
{ bsHot } DFCS_BUTTONPUSH
);
{ TWinCEWSBitBtn }
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Method: DrawBitBtnImage Method: DrawBitBtnImage
@ -118,285 +93,148 @@ type
Updates the button image combining the glyph and caption Updates the button image combining the glyph and caption
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure DrawBitBtnImage(BitBtn: TCustomBitBtn; ButtonCaption: PWideChar); procedure DrawBitBtnImage(BitBtn: TCustomBitBtn; DrawStruct: PDrawItemStruct);
var var
BitmapHandle: HBITMAP; // Handle of the button glyph
BitBtnLayout: TButtonLayout; // Layout of button and glyph BitBtnLayout: TButtonLayout; // Layout of button and glyph
BitBtnHandle: HWND; // Handle to bitbtn window
BitBtnDC: HDC; // Handle to DC of bitbtn window
OldFontHandle: HFONT; // Handle of previous font in hdcNewBitmap OldFontHandle: HFONT; // Handle of previous font in hdcNewBitmap
hdcNewBitmap: HDC; // Device context of the new Bitmap
SrcDC, MaskDC: HDC;
BitmapInfo: BITMAP; // Buffer for bitmap
TextSize: Windows.SIZE; // For computing the length of button caption in pixels TextSize: Windows.SIZE; // For computing the length of button caption in pixels
OldBitmap: HBITMAP; // Handle to the old selected bitmap
NewBitmap: HBITMAP; // Handle of the new bitmap
MaskBmp, OldSrcBmp, OldMaskBmp: HBITMAP;
OldBitmapHandle: HBITMAP; // Handle of the provious bitmap in hdcNewBitmap
XDestBitmap, YDestBitmap: integer; // X,Y coordinate of destination rectangle for bitmap XDestBitmap, YDestBitmap: integer; // X,Y coordinate of destination rectangle for bitmap
XDestText, YDestText: integer; // X,Y coordinates of destination rectangle for caption XDestText, YDestText: integer; // X,Y coordinates of destination rectangle for caption
newWidth, newHeight: integer; // dimensions of new combined bitmap newWidth, newHeight: integer; // dimensions of new combined bitmap
srcWidth: integer; // width of glyph to use, bitmap may have multiple glyphs srcWidth, srcHeight: integer; // width of glyph to use, bitmap may have multiple glyphs
BitmapRect: Windows.RECT; DrawRect: TRect;
ButtonImageList: BUTTON_IMAGELIST; ButtonCaption: PWideChar;
I: integer; ButtonState: TButtonState;
procedure DrawBitmap(AState: TButtonState); procedure DrawBitmap;
var var
MonoDC: HDC;
MonoBmp, OldMonoBmp: HBITMAP;
BkColor: TColorRef;
TextFlags: integer; // flags for caption (enabled or disabled) TextFlags: integer; // flags for caption (enabled or disabled)
numGlyphs, glyphLeft, glyphWidth, glyphHeight: integer; w, h: integer;
themesActive, emulateDisabled: boolean; AIndex: Integer;
AEffect: TGraphicsDrawEffect;
begin begin
emulateDisabled := false;
glyphLeft := 0;
glyphWidth := srcWidth;
glyphHeight := BitmapInfo.bmHeight;
TextFlags := DST_PREFIXTEXT; TextFlags := DST_PREFIXTEXT;
numGlyphs := BitBtn.NumGlyphs; if ButtonState = bsDisabled then
case AState of
bsDisabled:
begin
if numGlyphs > 1 then
glyphLeft := glyphWidth
else
emulateDisabled := true;
TextFlags := TextFlags or DSS_DISABLED; TextFlags := TextFlags or DSS_DISABLED;
end;
bsDown: if numGlyphs > 2 then glyphLeft := 2*glyphWidth;
bsExclusive: if numGlyphs > 3 then glyphLeft := 3*glyphWidth;
end;
// fill with background color // fill with background color
OldBitmapHandle := SelectObject(hdcNewBitmap, NewBitmap);
Windows.FillRect(hdcNewBitmap, BitmapRect, BitBtn.Brush.Handle);
if not emulateDisabled then
begin
if MaskBmp <> 0 then
BitBlt(hdcNewBitmap, XDestBitmap, YDestBitmap, glyphWidth,
glyphHeight, MaskDC, glyphLeft, 0, SRCCOPY);
end else begin
// when not themed, windows wants a white background picture for disabled button image
///themesActive := TWinCEWidgetSet(WidgetSet).ThemesActive;
///if not themesActive then
FillRect(hdcNewBitmap, BitmapRect, GetStockObject(BLACK_BRUSH));
if BitmapHandle <> 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
BkColor := SetBkColor(MaskDC, ColorToRGB(BitBtn.Brush.Color));
BitBlt(MonoDC, 0, 0, glyphWidth, glyphHeight, MaskDC, glyphLeft, 0, SRCCOPY);
SetBkColor(MaskDC, BkColor);
{if themesActive then
begin
// non-themed winapi wants white/other as background/picture-disabled colors
// themed winapi draws bitmap-as, with transparency defined by bitbtn.brush color
BkColor := 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);
SelectObject(MonoDC, OldMonoBmp); if (srcWidth <> 0) and (srcHeight <> 0) then
DeleteDC(MonoDC); begin
DeleteObject(MonoBmp); TBitBtnAceess(BitBtn).FButtonGlyph.GetImageIndexAndEffect(ButtonState, AIndex, AEffect);
w := TBitBtnAceess(BitBtn).FButtonGlyph.Images.Width;
h := TBitBtnAceess(BitBtn).FButtonGlyph.Images.Height;
TWinCEWSCustomImageList.DrawToDC(TBitBtnAceess(BitBtn).FButtonGlyph.Images, AIndex,
DrawStruct^._hDC, Rect(XDestBitmap, YDestBitmap, w, h),
TBitBtnAceess(BitBtn).FButtonGlyph.Images.BkColor,
TBitBtnAceess(BitBtn).FButtonGlyph.Images.BlendColor, AEffect,
TBitBtnAceess(BitBtn).FButtonGlyph.Images.DrawingStyle,
TBitBtnAceess(BitBtn).FButtonGlyph.Images.ImageType);
end; end;
SetBkMode(DrawStruct^._hDC, TRANSPARENT);
if ButtonState = bsDown then
SetTextColor(DrawStruct^._hDC, $FFFFFF)
else
SetTextColor(DrawStruct^._hDC, 0);
DrawState(DrawStruct^._hDC, 0, nil, LPARAM(ButtonCaption), 0, XDestText, YDestText, 0, 0, TextFlags);
end; end;
SetBkMode(hdcNewBitmap, TRANSPARENT);
SetTextColor(hdcNewBitmap, 0);
DrawState(hdcNewBitmap, 0, nil, LPARAM(ButtonCaption), 0, XDestText, YDestText, 0, 0, TextFlags);
SelectObject(hdcNewBitmap, OldBitmapHandle);
end;
var
tmpWideText : PWideChar;
begin begin
DrawRect := DrawStruct^.rcItem;
if DrawStruct^.itemState and ODS_DISABLED <> 0 then
ButtonState := bsDisabled
else
if DrawStruct^.itemState and (ODS_FOCUS or ODS_SELECTED) = (ODS_FOCUS or ODS_SELECTED) then
ButtonState := bsDown
else
if DrawStruct^.itemState and ODS_FOCUS = ODS_FOCUS then
ButtonState := bsHot
else
ButtonState := bsUp;
DrawFrameControl(DrawStruct^._hDC, DrawRect, DFC_BUTTON, ButtonStateToFrameState[ButtonState]);
// DFCS_ADJUSTRECT doesnot work
InflateRect(DrawRect, -4, -4);
ButtonCaption := StringToPWideChar(BitBtn.Caption);
// gather info about bitbtn // gather info about bitbtn
BitBtnHandle := BitBtn.Handle;
if BitBtn.Glyph.Empty then if BitBtn.Glyph.Empty then
begin begin
BitmapHandle := 0;
BitmapInfo.bmWidth := 0;
BitmapInfo.bmHeight := 0;
srcWidth := 0; srcWidth := 0;
end else begin srcHeight := 0;
BitmapHandle := BitBtn.Glyph.Handle; end else
Windows.GetObject(BitmapHandle, sizeof(BitmapInfo), @BitmapInfo); begin
srcWidth := BitmapInfo.bmWidth; srcWidth := TBitBtnAceess(BitBtn).FButtonGlyph.Images.Width;
if BitBtn.NumGlyphs > 1 then srcHeight := TBitBtnAceess(BitBtn).FButtonGlyph.Images.Height;
srcWidth := srcWidth div BitBtn.NumGlyphs;
end; end;
BitBtnLayout := BitBtn.Layout; BitBtnLayout := BitBtn.Layout;
BitBtnDC := GetDC(BitBtnHandle);
hdcNewBitmap := CreateCompatibleDC(BitBtnDC); OldFontHandle := SelectObject(DrawStruct^._hDC, BitBtn.Font.Reference.Handle);
OldFontHandle := SelectObject(hdcNewBitmap, BitBtn.Font.Handle); GetTextExtentPoint32(DrawStruct^._hDC, ButtonCaption, Length(BitBtn.Caption), @TextSize);
tmpWideText := StringToPWideChar(ButtonCaption);
GetTextExtentPoint32(hdcNewBitmap, tmpWideText, Length(ButtonCaption), @TextSize);
FreeMem(tmpWideText);
// calculate size of new bitmap // calculate size of new bitmap
case BitBtnLayout of case BitBtnLayout of
blGlyphLeft, blGlyphRight: blGlyphLeft, blGlyphRight:
begin begin
if BitBtn.Spacing = -1 then YDestBitmap := (DrawRect.Bottom + DrawRect.Top - srcHeight) div 2;
newWidth := BitBtn.Width - 10 YDestText := (DrawRect.Bottom + DrawRect.Top - TextSize.cy) div 2;
else
newWidth := TextSize.cx + srcWidth + BitBtn.Spacing; newWidth := TextSize.cx + srcWidth;
if BitmapHandle <> 0 then
if BitBtn.Spacing <> -1 then
newWidth := newWidth + BitBtn.Spacing;
if srcWidth <> 0 then
inc(newWidth, 2); inc(newWidth, 2);
newHeight := TextSize.cy;
if newHeight < BitmapInfo.bmHeight then
newHeight := BitmapInfo.bmHeight;
YDestBitmap := (newHeight - BitmapInfo.bmHeight) div 2;
YDestText := (newHeight - TextSize.cy) div 2;
case BitBtnLayout of case BitBtnLayout of
blGlyphLeft: blGlyphLeft:
begin begin
XDestBitmap := 0; XDestBitmap := (DrawRect.Right + DrawRect.Left - newWidth) div 2;
XDestText := srcWidth; XDestText := XDestBitmap + srcWidth;
if BitBtn.Spacing = -1 then
inc(XDestText, (newWidth - srcWidth - TextSize.cx) div 2)
else
inc(XDestText, BitBtn.Spacing);
end; end;
blGlyphRight: blGlyphRight:
begin begin
XDestBitmap := newWidth - srcWidth; XDestText := (DrawRect.Right + DrawRect.Left - newWidth) div 2;
XDestText := XDestBitmap - TextSize.cx; XDestBitmap := XDestText + TextSize.cx;
if BitBtn.Spacing = -1 then
dec(XDestText, (newWidth - srcWidth - TextSize.cx) div 2)
else
dec(XDestText, BitBtn.Spacing);
end; end;
end; end;
end; end;
blGlyphTop, blGlyphBottom: blGlyphTop, blGlyphBottom:
begin begin
newWidth := TextSize.cx; XDestBitmap := (DrawRect.Right + DrawRect.Left - srcWidth) shr 1;
if newWidth < srcWidth then XDestText := (DrawRect.Right + DrawRect.Left - TextSize.cx) shr 1;
newWidth := srcWidth;
if BitBtn.Spacing = -1 then newHeight := TextSize.cy + srcHeight;
newHeight := BitBtn.Height - 10
else if BitBtn.Spacing <> -1 then
newHeight := TextSize.cy + BitmapInfo.bmHeight + BitBtn.Spacing; newHeight := newHeight + BitBtn.Spacing;
if BitmapHandle <> 0 then
if srcHeight <> 0 then
inc(newHeight, 2); inc(newHeight, 2);
XDestBitmap := (newWidth - srcWidth) shr 1;
XDestText := (newWidth - TextSize.cx) shr 1;
case BitBtnLayout of case BitBtnLayout of
blGlyphTop: blGlyphTop:
begin begin
YDestBitmap := 0; YDestBitmap := (DrawRect.Top + DrawRect.Bottom - newHeight) div 2;
YDestText := BitmapInfo.bmHeight; YDestText := YDestBitmap + srcHeight;
if BitBtn.Spacing = -1 then
inc(YDestText, (newHeight - BitmapInfo.bmHeight - TextSize.cy) div 2)
else
inc(YDestText, BitBtn.Spacing);
end; end;
blGlyphBottom: blGlyphBottom:
begin begin
YDestBitmap := newHeight - BitmapInfo.bmHeight; YDestText := (DrawRect.Top + DrawRect.Bottom - newHeight) div 2;
YDestText := YDestBitmap - TextSize.cy; YDestBitmap := YDestText + TextSize.cy;
if BitBtn.Spacing = -1 then
dec(YDestText, (newHeight - BitmapInfo.bmHeight - TextSize.cy) div 2)
else
dec(YDestText, BitBtn.Spacing);
end; end;
end; end;
end; end;
end; end;
// create new DrawBitmap;
BitmapRect.left := 0;
BitmapRect.top := 0;
BitmapRect.right := newWidth;
BitmapRect.bottom := newHeight;
if (newWidth = 0) or (newHeight = 0) then
begin
NewBitmap := 0;
MaskDC := 0;
MaskBmp := 0;
end else begin
NewBitmap := CreateCompatibleBitmap(BitBtnDC, newWidth, newHeight);
// prepare masked bitmap
OldBitmapHandle := SelectObject(hdcNewBitmap, NewBitmap);
MaskDC := CreateCompatibleDC(hdcNewBitmap);
if BitBtn.Glyph.MaskHandleAllocated then
begin
// Create a mask DC
MaskBmp := CreateCompatibleBitmap(hdcNewBitmap, BitmapInfo.bmWidth, BitmapInfo.bmHeight);
OldMaskBmp := SelectObject(MaskDC, MaskBmp);
SrcDC := CreateCompatibleDC(hdcNewBitmap);
OldSrcBmp := SelectObject(SrcDC, BitmapHandle);
FillRect(MaskDC, BitmapRect, BitBtn.Brush.Handle);
TWinCEWidgetSet(WidgetSet).MaskBlt(MaskDC, 0, 0, BitmapInfo.bmWidth, BitmapInfo.bmHeight, SrcDC,
0, 0, BitBtn.Glyph.MaskHandle, 0, 0);
end else begin
MaskBmp := BitmapHandle;
OldMaskBmp := SelectObject(MaskDC, MaskBmp);
end;
SelectObject(hdcNewBitmap, OldBitmapHandle);
end;
// destroy previous bitmap, set new bitmap SelectObject(DrawStruct^._hDC, OldFontHandle);
{if TWinCEWidgetSet(WidgetSet).ThemesActive then FreeMem(ButtonCaption);
begin
// winxp draws BM_SETIMAGE bitmap with old style button!
// need to use BCM_SETIMAGELIST
if Windows.SendMessage(BitBtnHandle, BCM_GETIMAGELIST, 0, LPARAM(@ButtonImageList)) <> 0 then
if ButtonImageList.himl <> 0 then
ImageList_Destroy(ButtonImageList.himl);
if NewBitmap <> 0 then
begin
ButtonImageList.himl := ImageList_Create(newWidth, newHeight, ILC_COLORDDB or ILC_MASK, 5, 0);
ButtonImageList.margin.left := 5;
ButtonImageList.margin.right := 5;
ButtonImageList.margin.top := 5;
ButtonImageList.margin.bottom := 5;
ButtonImageList.uAlign := BUTTON_IMAGELIST_ALIGN_CENTER;
// for some reason, if bitmap added to imagelist, need to redrawn, otherwise it's black!?
for I := 1 to 6 do
begin
DrawBitmap(XPBitBtn_ImageIndexToState[I]);
ImageList_AddMasked(ButtonImageList.himl, NewBitmap, ColorToRGB(BitBtn.Brush.Color));
end;
end else begin
ButtonImageList.himl := 0;
end;
Windows.SendMessage(BitBtnHandle, BCM_SETIMAGELIST, 0, LPARAM(@ButtonImageList));
if NewBitmap <> 0 then
DeleteObject(NewBitmap);
end else }begin
OldBitmap := Windows.SendMessage(BitBtnHandle, BM_GETIMAGE, IMAGE_BITMAP, 0);
if NewBitmap <> 0 then
DrawBitmap(BitBtnEnabledToButtonState[BitBtn.Enabled]);
Windows.SendMessage(BitBtnHandle, BM_SETIMAGE, IMAGE_BITMAP, NewBitmap);
if OldBitmap <> 0 then
DeleteObject(OldBitmap);
end;
SelectObject(hdcNewBitmap, OldFontHandle);
DeleteDC(hdcNewBitmap);
ReleaseDC(BitBtnHandle, BitBtnDC);
if BitBtn.Glyph.MaskHandleAllocated then
begin
SelectObject(SrcDC, OldSrcBmp);
DeleteDC(SrcDC);
DeleteObject(MaskBmp);
end;
if MaskDC <> 0 then
begin
SelectObject(MaskDC, OldMaskBmp);
DeleteDC(MaskDC);
end;
BitBtn.Invalidate;
end; end;
@ -411,11 +249,11 @@ begin
with Params do with Params do
begin begin
pClassName := @ButtonClsName; pClassName := @ButtonClsName;
if TCustomBitBtn(AWinControl).Default Then if TCustomBitBtn(AWinControl).Default then
Flags := Flags or BS_DEFPUSHBUTTON Flags := Flags or BS_DEFPUSHBUTTON
else else
Flags := Flags or BS_PUSHBUTTON; Flags := Flags or BS_PUSHBUTTON;
Flags := Flags or BS_BITMAP; Flags := Flags or BS_OWNERDRAW; // Draw bitmap on WM_DRAWITEM
WindowTitle := nil; WindowTitle := nil;
end; end;
// create window // create window
@ -461,78 +299,33 @@ begin
end; end;
end; end;
class procedure TWinCEWSBitBtn.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: integer);
var
pwCaption : PWideChar;
begin
TWinCEWSWinControl.SetBounds(AWinControl, ALeft, ATop, AWidth, AHeight);
if TCustomBitBtn(AWinControl).Spacing = -1 then
begin
pwCaption := StringToPWideChar(AWinControl.Caption);
DrawBitBtnImage(TCustomBitBtn(AWinControl), pwCaption);
FreeMem(pwCaption);
end;
end;
class procedure TWinCEWSBitBtn.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
var
pwCaption : PWideChar;
begin
TWinCEWSWinControl.SetFont(AWinControl, AFont);
pwCaption := StringToPWideChar(AWinControl.Caption);
DrawBitBtnImage(TCustomBitBtn(AWinControl), pwCaption);
FreeMem(pwCaption);
end;
class procedure TWinCEWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn; class procedure TWinCEWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
const AValue: TButtonGlyph); const AValue: TButtonGlyph);
var
pwCaption : PWideChar;
begin begin
pwCaption := StringToPWideChar(ABitBtn.Caption); ABitBtn.invalidate;
DrawBitBtnImage(ABitBtn, pwCaption);
FreeMem(pwCaption);
end; end;
class procedure TWinCEWSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn; class procedure TWinCEWSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn;
const AValue: TButtonLayout); const AValue: TButtonLayout);
var
pwCaption : PWideChar;
begin begin
pwCaption := StringToPWideChar(ABitBtn.Caption); ABitBtn.invalidate;
DrawBitBtnImage(ABitBtn, pwCaption);
FreeMem(pwCaption);
end; end;
class procedure TWinCEWSBitBtn.SetMargin(const ABitBtn: TCustomBitBtn; class procedure TWinCEWSBitBtn.SetMargin(const ABitBtn: TCustomBitBtn;
const AValue: Integer); const AValue: Integer);
var
pwCaption : PWideChar;
begin begin
pwCaption := StringToPWideChar(ABitBtn.Caption); ABitBtn.invalidate;
DrawBitBtnImage(ABitBtn, pwCaption);
FreeMem(pwCaption);
end; end;
class procedure TWinCEWSBitBtn.SetSpacing(const ABitBtn: TCustomBitBtn; class procedure TWinCEWSBitBtn.SetSpacing(const ABitBtn: TCustomBitBtn;
const AValue: Integer); const AValue: Integer);
var
pwCaption : PWideChar;
begin begin
pwCaption := StringToPWideChar(ABitBtn.Caption); ABitBtn.invalidate;
DrawBitBtnImage(ABitBtn, pwCaption);
FreeMem(pwCaption);
end; end;
class procedure TWinCEWSBitBtn.SetText(const AWinControl: TWinControl; const AText: string); class procedure TWinCEWSBitBtn.SetText(const AWinControl: TWinControl; const AText: string);
var
pwCaption : PWideChar;
begin begin
pwCaption := StringToPWideChar(AText); AWinControl.invalidate;
DrawBitBtnImage(TCustomBitBtn(AWinControl), pwCaption);
FreeMem(pwCaption);
end; end;

6
lcl/interfaces/wince/wincewsextctrls.pp
View File

@ -299,12 +299,6 @@ begin
FinishCreateWindow(AWinControl, Params, false); FinishCreateWindow(AWinControl, Params, false);
// return window handle // return window handle
Result := Params.Window; Result := Params.Window;
if TWinCEWidgetSet(WidgetSet).ThemesActive then
with Params.WindowInfo^ do
begin
needParentPaint := true;
isTabPage := true;
end;
end; end;
class procedure TWinCEWSCustomPage.DestroyHandle(const AWinControl: TWinControl); class procedure TWinCEWSCustomPage.DestroyHandle(const AWinControl: TWinControl);