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

fix xp themes drawing image on bitbtn

Browse Source 
git-svn-id: trunk@5577 -
This commit is contained in:
micha 2004-06-18 19:55:43 +00:00
parent 336d0c8c30
commit 47ee7b1b10
5 changed files with 295 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lcl/interfaces/win32/win32callback.inc
View File

@ -24,6 +24,11 @@
{ callback routines }
{*************************************************************}
{ addition XP messages }
const
WM_THEMECHANGED = $31A;
{ forward declarations }
function ComboBoxEditWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
@ -894,6 +899,11 @@ Begin
LMessage.LParam := LParam;
LMessage.WParam := WParam;
End;
WM_THEMECHANGED:
begin
// winxp theme changed, recheck whether themes are enabled
TWin32WidgetSet(InterfaceObject).UpdateThemesActive;
end;
End;
If WinProcess Then
@ -1242,6 +1252,9 @@ end;
{
$Log$
Revision 1.116 2004/06/18 19:55:43 micha
fix xp themes drawing image on bitbtn
Revision 1.115 2004/06/17 21:33:01 micha
fix scroll message handling for comboboxes

17
lcl/interfaces/win32/win32int.pp
View File

@ -36,7 +36,7 @@ Interface
successful compilation.
}
Uses
Windows, Classes, ComCtrls, Controls, Dialogs, DynHashArray,
Windows, Classes, ComCtrls, Controls, Buttons, Dialogs, DynHashArray,
ExtCtrls, Forms, GraphMath, GraphType, InterfaceBase, LCLIntf, LCLType,
LMessages, StdCtrls, SysUtils, VCLGlobals, Win32Def, Graphics, Menus;
@ -115,6 +115,11 @@ Type
FStatusFont: HFONT;
FMessageFont: HFONT;
FThemesActive: boolean;
FThemeLibrary: HMODULE;
IsThemeActive: function: BOOL; stdcall;
IsAppThemed: function: BOOL; stdcall;
Function GetOwnerHandle(ADialog : TCommonDialog): HWND;
Function GetText(Sender: TComponent; Handle: HWND; var Data: String): Boolean; virtual;
Procedure SetLabel(Sender: TObject; Data: Pointer);
@ -122,6 +127,7 @@ Type
Procedure ResizeChild(Sender: TWinControl; Left, Top, Width, Height: Integer);
Procedure AssignSelf(Window: HWnd; Data: Pointer);
Procedure ReDraw(Child: TObject);
procedure DrawBitBtnImage(BitBtn: TBitBtn; ButtonCaption: PChar);
Procedure SetLimitText(Window: HWND; Limit: Word);
Procedure ShowHide(Sender: TObject);
@ -172,6 +178,7 @@ Type
Function InitHintFont(HintFont: TObject): Boolean; Override;
Function RecreateWnd(Sender: TWinControl): Integer; virtual;
Procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
procedure UpdateThemesActive;
// create and destroy
function CreateComponent(Sender : TObject): THandle; override;
@ -182,6 +189,7 @@ Type
{$I win32lclintfh.inc}
property AppHandle: HWND read FAppHandle;
property ThemesActive: boolean read FThemesActive;
End;
{$I win32listslh.inc}
@ -222,7 +230,7 @@ Uses
Win32WSStdCtrls,
// Win32WSToolwin,
////////////////////////////////////////////////////
Buttons, Calendar, CListBox, Spin, CheckLst, WinExt, LclProc;
Calendar, CListBox, Spin, CheckLst, WinExt, LclProc;
type
{ Linked list of objects for events }
@ -243,7 +251,7 @@ const
BOOL_RESULT: Array[Boolean] Of String = ('False', 'True');
ClsName : array[0..20] of char = 'LazarusForm'#0;
ToolBtnClsName : array[0..20] of char = 'ToolbarButton'#0;
//{$I win32proc.inc}
{$I win32listsl.inc}
{$I win32callback.inc}
@ -264,6 +272,9 @@ End.
{ =============================================================================
$Log$
Revision 1.85 2004/06/18 19:55:43 micha
fix xp themes drawing image on bitbtn
Revision 1.84 2004/06/13 14:32:15 micha
fix cursors to use what's available

251
lcl/interfaces/win32/win32object.inc
View File

@ -39,6 +39,25 @@ Begin
begin
FMetrics.iMenuHeight := GetSystemMetrics(SM_CYMENU);
end;
// see if XP themes are available, first check if correct
// common control library is loaded for themes support
if ((GetFileVersion('comctl32.dll') shr 16) and $FFFF) >= 6 then
begin
FThemeLibrary := LoadLibrary('uxtheme.dll');
if FThemeLibrary <> 0 then
begin
// load functions
Pointer(IsThemeActive) := GetProcAddress(FThemeLibrary, 'IsThemeActive');
Pointer(IsAppThemed) := GetProcAddress(FThemeLibrary, 'IsAppThemed');
end else begin
IsThemeActive := nil;
IsAppThemed := nil;
end;
end;
// init
UpdateThemesActive;
End;
{------------------------------------------------------------------------------
@ -92,7 +111,10 @@ Begin
Windows.UnregisterClass(@ClsName, System.HInstance);
// Windows.UnregisterClass(@ToolBtnClsName, System.HInstance);
Inherited Destroy;
if FThemeLibrary <> 0 then
FreeLibrary(FThemeLibrary);
inherited Destroy;
End;
{------------------------------------------------------------------------------
@ -319,7 +341,7 @@ Begin
Case TControl(Sender).FCompStyle Of
csBitBtn:
IntSendMessage3(LM_IMAGECHANGED, Sender, Nil);
DrawBitBtnImage(TBitBtn(Sender), PChar(Data));
csFileDialog, csOpenFileDialog, csSaveFileDialog, csSelectDirectoryDialog,
csColorDialog, csFontDialog:
Begin
@ -637,8 +659,8 @@ Begin
//TBitBtn
LM_IMAGECHANGED, LM_LAYOUTCHANGED:
Begin
GetClientRect(Handle, SizeRect);
InvalidateRect(Handle, @SizeRect, True);
if Sender is TBitBtn then
DrawBitBtnImage(TBitBtn(Sender), PChar(TBitBtn(Sender).Caption));
End;
{Displays a menu and makes it available for selection. Applications can use this function to display context-sensitive menus,
and will typically supply NULL for the parent_menu_shell, parent_menu_item, func and data parameters.
@ -1328,6 +1350,220 @@ begin
end;
*)
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.UpdateThemesActive
Params: None
Returns: Nothing
Updates the field FThemesActive to save whether xp themes are active
------------------------------------------------------------------------------}
procedure TWin32WidgetSet.UpdateThemesActive;
begin
if (IsThemeActive <> nil) and (IsAppThemed <> nil) then
FThemesActive := IsThemeActive() and IsAppThemed()
else
FThemesActive := false;
end;
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_ImageIndexToEnabled: array[0..4] of Boolean =
(true, true, true, false, true);
type
BUTTON_IMAGELIST = packed record
himl: Windows.HIMAGELIST;
margin: Windows.RECT;
uAlign: UINT;
end;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.DrawBitBtnImage
Params: BitBtn: The TBitBtn to update the image of
ButtonCaption: new button caption
Returns: Nothing
Updates the button image combining the glyph and caption
------------------------------------------------------------------------------}
procedure TWin32WidgetSet.DrawBitBtnImage(BitBtn: TBitBtn; ButtonCaption: PChar);
var
BitmapHandle: HBITMAP; // Handle of the button 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
hdcNewBitmap: HDC; // Device context of the new Bitmap
BitmapInfo: BITMAP; // Buffer for bitmap
TextSize: 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
XDestBitmap, YDestBitmap: integer; // X,Y coordinate of destination rectangle for bitmap
XDestText, YDestText: integer; // X,Y coordinates of destination rectangle for caption
newWidth, newHeight: integer; // dimensions of new combined bitmap
BitmapRect: Windows.RECT;
oldImageList: HIMAGELIST;
ButtonImageList: BUTTON_IMAGELIST;
I: integer;
procedure DrawBitmap(Enabled: boolean);
var
OldBitmapHandle: HBITMAP; // Handle of the provious bitmap in hdcNewBitmap
BitmapFlags: integer; // flags for glyph (enabled or disabled)
TextFlags: integer; // flags for caption (enabled or disabled)
begin
BitmapFlags := DST_BITMAP;
TextFlags := DST_PREFIXTEXT;
if not Enabled then
begin
BitmapFlags := BitmapFlags or DSS_DISABLED;
TextFlags := TextFlags or DSS_DISABLED;
end;
OldBitmapHandle := SelectObject(hdcNewBitmap, NewBitmap);
FillRect(hdcNewBitmap, BitmapRect, BitBtn.Brush.Handle);
SetBkMode(hdcNewBitmap, TRANSPARENT);
if BitmapHandle <> 0 then
DrawState(hdcNewBitmap, 0, nil, BitmapHandle, 0, XDestBitmap, YDestBitmap, 0, 0, BitmapFlags);
DrawState(hdcNewBitmap, 0, nil, LPARAM(ButtonCaption), 0, XDestText, YDestText, 0, 0, TextFlags);
SelectObject(hdcNewBitmap, OldBitmapHandle);
end;
begin
// gather info about bitbtn
BitBtnHandle := BitBtn.Handle;
if BitBtn.Glyph.Empty then
begin
BitmapHandle := 0;
BitmapInfo.bmWidth := 0;
BitmapInfo.bmHeight := 0;
end else begin
BitmapHandle := BitBtn.Glyph.Handle;
Windows.GetObject(BitmapHandle, sizeof(BitmapInfo), @BitmapInfo);
end;
BitBtnLayout := BitBtn.Layout;
BitBtnDC := GetDC(BitBtnHandle);
hdcNewBitmap := CreateCompatibleDC(BitBtnDC);
OldFontHandle := SelectObject(hdcNewBitmap, BitBtn.Font.Handle);
GetTextExtentPoint32(hdcNewBitmap, LPSTR(ButtonCaption), Length(ButtonCaption), TextSize);
// calculate size of new bitmap
case BitBtnLayout of
blGlyphLeft, blGlyphRight:
begin
newWidth := TextSize.cx + BitmapInfo.bmWidth;
if BitmapHandle <> 0 then
inc(newWidth, 2);
newHeight := TextSize.cy;
if newHeight < BitmapInfo.bmHeight then
newHeight := BitmapInfo.bmHeight;
YDestBitmap := (newHeight - BitmapInfo.bmHeight) shr 1;
YDestText := (newHeight - TextSize.cy) shr 1;
end;
blGlyphTop, blGlyphBottom:
begin
newWidth := TextSize.cx;
if newWidth < BitmapInfo.bmWidth then
newWidth := BitmapInfo.bmWidth;
newHeight := TextSize.cy + BitmapInfo.bmHeight;
if BitmapHandle <> 0 then
inc(newHeight, 2);
XDestBitmap := (newWidth - BitmapInfo.bmWidth) shr 1;
XDestText := (newWidth - TextSize.cx) shr 1;
end;
end;
case BitBtnLayout of
blGlyphLeft:
begin
XDestBitmap := 0;
XDestText := newWidth - TextSize.cx;
end;
blGlyphRight:
begin
XDestBitmap := newWidth - BitmapInfo.bmWidth;
XDestText := 0;
end;
blGlyphTop:
begin
YDestBitmap := 0;
YDestText := newHeight - TextSize.cy;
end;
blGlyphBottom: begin
YDestBitmap := newHeight - BitmapInfo.bmHeight;
YDestText := 0;
end;
end;
// create new
if (newWidth = 0) and (newHeight = 0) then
NewBitmap := 0
else
NewBitmap := CreateCompatibleBitmap(BitBtnDC, newWidth, newHeight);
BitmapRect.left := 0;
BitmapRect.top := 0;
BitmapRect.right := newWidth;
BitmapRect.bottom := newHeight;
// destroy previous bitmap, set new bitmap
if FThemesActive then
begin
// winxp draws BM_SETIMAGE bitmap with old style button!
// need to use BCM_SETIMAGELIST
oldImageList := Windows.SendMessage(BitBtnHandle, BCM_GETIMAGELIST, 0, LPARAM(@ButtonImageList));
if oldImageList <> 0 then
oldImageList := ButtonImageList.himl;
if NewBitmap <> 0 then
begin
ButtonImageList.himl := ImageList_Create(newWidth, newHeight, ILC_COLORDDB or ILC_MASK, 5, 0);
ButtonImageList.margin.left := 2;
ButtonImageList.margin.right := 2;
ButtonImageList.margin.top := 2;
ButtonImageList.margin.bottom := 2;
ButtonImageList.uAlign := BUTTON_IMAGELIST_ALIGN_CENTER;
// for some reason, if bitmap added to imagelist, need to redrawn, otherwise it's black!?
for I := 0 to 4 do
begin
DrawBitmap(XPBitBtn_ImageIndexToEnabled[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 oldImageList <> 0 then
ImageList_Destroy(oldImageList);
if NewBitmap <> 0 then
DeleteObject(NewBitmap);
end else begin
OldBitmap := Windows.SendMessage(BitBtnHandle, BM_GETIMAGE, IMAGE_BITMAP, 0);
if NewBitmap <> 0 then
DrawBitmap(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);
end;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.PaintPixmap
Params: Surface - The surface onto which to paint the pixmap
@ -1870,7 +2106,6 @@ Begin
End;
{------------------------------------------------------------------------------
Function: TWin32WidgetSet.CreateComponent
Params: Sender - object for which to create visual representation
@ -1991,9 +2226,8 @@ Begin
Flags := Flags or BS_DEFPUSHBUTTON
else
Flags := Flags or BS_PUSHBUTTON;
Flags := Flags or BS_OWNERDRAW;
Flags := Flags or BS_BITMAP;
WindowTitle := nil;
IntSendMessage3(LM_LOADXPM, Sender, StrCaption);
End;
csButton:
Begin
@ -3060,6 +3294,9 @@ End;
{
$Log$
Revision 1.207 2004/06/18 19:55:43 micha
fix xp themes drawing image on bitbtn
Revision 1.206 2004/06/17 19:54:19 micha
fix bug in drawing groupbox caption when it is a child of another groupbox

21
lcl/interfaces/win32/win32proc.pp
View File

@ -60,6 +60,7 @@ Procedure Win32PosToLCLPos(Sender: TObject; var Left, Top: SmallInt);
procedure UpdateWindowStyle(Handle: HWnd; Style: integer; StyleMask: integer);
function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD;
function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD;
function GetFileVersion(FileName: string): dword;
implementation
@ -824,6 +825,26 @@ begin
end;
end;
function GetFileVersion(FileName: string): dword;
var
buf: pointer;
lenBuf: dword;
fixedInfo: ^VS_FIXEDFILEINFO;
begin
Result := $FFFFFFFF;
lenBuf := GetFileVersionInfoSize(PChar(FileName), lenBuf);
if lenBuf > 0 then
begin
GetMem(buf, lenBuf);
if GetFileVersionInfo(PChar(FileName), 0, lenBuf, buf) then
begin
VerQueryValue(buf, '\', pointer(fixedInfo), lenBuf);
Result := fixedInfo^.dwFileVersionMS;
end;
FreeMem(buf);
end;
end;
{$IFDEF ASSERT_IS_ON}
{$UNDEF ASSERT_IS_ON}
{$C-}

85
lcl/interfaces/win32/win32winapi.inc
View File

@ -193,84 +193,6 @@ var
end;
end;
procedure DrawOwnerButton(Data: PDrawItemStruct);
var Flags:integer; // How the button looks like (pressed or not pressed)
BitmapHandle: HBITMAP; // Handle of the button glyph
OldBitmapHandle: HBITMAP; // Handle of the provious bitmap in hdcNewBitmap
HdcNewBitmap: HDC; // Device context of the new Bitmap
OldFontHandle: HFONT; // Handle of previous font in hdcNewBitmap
BitmapBuf: BITMAP; // Buffer for bitmap
XDestBitmap: integer; // X coordinate of destination rectangle for bitmap
YDestBitmap: integer; // Y coordinate of destination rectangle for bitmap
TextSize: SIZE; // For computing the length of button caption in pixels
NewBitmap: HBITMAP; // Handle of the new bitmap
ButtonCaption: string; // Text written on the button
XDestText: integer; // X coordinate of destination rectangle for caption
YDestText: integer; // Y coordinate of destination rectangle for caption
BitmapFlags: integer; // flags for glyph (enabled or disabled)
TextFlags: integer; // flags for caption (enabled or disabled)
begin
ButtonCaption := TBitBtn(Sender).Caption;
NewBitmap := CreateCompatibleBitmap(Data^._HDC, Data^.rcItem.Right - Data^.rcItem.Left + 1, Data^.rcItem.Bottom - Data^.rcItem.Top + 1);
HdcNewBitmap := CreateCompatibleDC(Data^._HDC);
OldBitmapHandle := SelectObject(hdcNewBitmap, NewBitmap);
OldFontHandle := SelectObject(hdcNewBitmap, TBitBtn(Sender).Font.Handle);
BitmapHandle := TBitBtn(Sender).Glyph.Handle;
Windows.GetObject(BitmapHandle, sizeof(BitmapBuf), @BitmapBuf);
GetTextExtentPoint32(Data^._HDC, LPSTR(ButtonCaption), length(ButtonCaption), TextSize);
case TBitBtn(Sender).Layout of
blGlyphLeft: begin
XDestBitmap := Data^.rcItem.Left + ((Data^.rcItem.Right - Data^.rcItem.Left) - (TextSize.cx + BitmapBuf.bmWidth + 2)) shr 1;
YDestBitmap := Data^.rcItem.Top + ((Data^.rcItem.Bottom - Data^.rcItem.Top) - BitmapBuf.bmHeight) shr 1;
XDestText := XDestBitmap+BitmapBuf.bmWidth + 2;
YDestText := (Data^.rcItem.Bottom - Data^.rcItem.Top - TextSize.cy) shr 1;
end;
blGlyphRight: begin
XDestBitmap := Data^.rcItem.Right - ((Data^.rcItem.Right - Data^.rcItem.Left) - (TextSize.cx + BitmapBuf.bmWidth + 2)) shr 1 - BitmapBuf.bmWidth;
YDestBitmap := Data^.rcItem.Top + ((Data^.rcItem.Bottom - Data^.rcItem.Top) - BitmapBuf.bmHeight) shr 1;
XDestText := XDestBitmap - 2 - TextSize.cx;
YDestText := (Data^.rcItem.Bottom - Data^.rcItem.Top - TextSize.cy) shr 1;
end;
blGlyphTop: begin
XDestBitmap := Data^.rcItem.Left + ((Data^.rcItem.Right - Data^.rcItem.Left) - BitmapBuf.bmWidth) shr 1;
YDestBitmap := Data^.rcItem.Top + ((Data^.rcItem.Bottom - Data^.rcItem.Top) - (TextSize.cy + BitmapBuf.bmHeight + 2)) shr 1;
XDestText := (Data^.rcItem.Right - Data^.rcItem.Left - TextSize.cx) shr 1;
YDestText := YDestBitmap + BitmapBuf.bmHeight + 2;
end;
blGlyphBottom: begin
XDestBitmap := Data^.rcItem.Left + ((Data^.rcItem.Right - Data^.rcItem.Left) - BitmapBuf.bmWidth) shr 1;
YDestBitmap := Data^.rcItem.Bottom - ((Data^.rcItem.Bottom - Data^.rcItem.Top) - (TextSize.cy + BitmapBuf.bmHeight + 2)) shr 1 - BitmapBuf.bmHeight;
XDestText := (Data^.rcItem.Right - Data^.rcItem.Left - TextSize.cx) shr 1;
YDestText := YDestBitmap - 2 - TextSize.cy;
end;
end;
Flags := DFCS_BUTTONPUSH;
BitmapFlags := DST_BITMAP;
TextFlags := DST_PREFIXTEXT;
if (Data^.itemState and ODS_DISABLED) <> 0 then
begin
BitmapFlags := BitmapFlags or DSS_DISABLED;
TextFlags := TextFlags or DSS_DISABLED;
end;
if (Data^.itemState and ODS_SELECTED) <> 0 then
begin
inc(XDestBitmap);
inc(YDestBitmap);
inc(XDestText);
inc(YDestText);
Flags := Flags or DFCS_PUSHED;
end;
DrawFrameControl(HdcNewBitmap, Data^.rcItem, DFC_BUTTON, Flags);
SetBkMode(HdcNewBitmap, TRANSPARENT);
DrawState(HdcNewBitmap, 0, nil, BitmapHandle, 0, XDestBitmap, YDestBitmap, 0, 0, BitmapFlags);
DrawState(HdcNewBitmap, 0, nil, LPARAM(LPSTR(ButtonCaption)), 0, XDestText, YDestText, 0, 0, TextFlags);
SelectObject(HdcNewBitmap, OldBitmapHandle);
SelectObject(HdcNewBitmap, OldFontHandle);
DrawState(Data^._HDC, 0, nil, NewBitmap, 0, 0, 0, 0, 0, DST_BITMAP);
DeleteDC(HdcNewBitmap);
DeleteObject(NewBitmap);
end;
procedure DrawCheckListBoxItem(CheckListBox: TCheckListBox; Data: PDrawItemStruct);
var
Selected: Boolean;
@ -331,10 +253,6 @@ begin
begin
with TLMDrawItems(Message) do
begin
if Sender is TBitBtn then
begin
DrawOwnerButton(DrawItemStruct);
end else
if Sender is TCheckListBox then
begin
// ItemID not UINT(-1)
@ -3065,6 +2983,9 @@ end;
{ =============================================================================
$Log$
Revision 1.119 2004/06/18 19:55:43 micha
fix xp themes drawing image on bitbtn
Revision 1.118 2004/06/17 21:33:01 micha
fix scroll message handling for comboboxes