I saw in El_Choni TailBite-Program a additional icon. With icon it is possible to "stick" the window on top.
My rountines based on El_Choni's routines, but i change a lot.
The code shows, how to add a additional costom icon.
http://caosandkin.bei.t-online.de/pureb ... rIcons.zip
TitleBarIcons
At last somebody notices the d*mn button in the titlebar XD (it took me some time to get it working properly). However, I haven't been able to attach a tooltip to it yet.
@GPI, nice work. Maybe you're able to attach a tooltip to it?
BTW, my code, like yours, uses a bitmap to draw the icon, but maybe this looks awful in XP, I don't know. Would there be a way to draw the icon with the colours used by the user?
EDIT: now I see that's what your code does, I'll use that trick if you don't mind
@GPI, nice work. Maybe you're able to attach a tooltip to it?
BTW, my code, like yours, uses a bitmap to draw the icon, but maybe this looks awful in XP, I don't know. Would there be a way to draw the icon with the colours used by the user?
EDIT: now I see that's what your code does, I'll use that trick if you don't mind

El_Choni
Not easy, because the button is a fake...El_Choni wrote:@GPI, nice work. Maybe you're able to attach a tooltip to it?
And i don't see any possibility to get a message, when the mouse-cursor moves out of the icon...
No problem: But maybe you should store the created bitmaps (you should check, if the icon-size has changed and recreate the icons if necassary.)EDIT: now I see that's what your code does, I'll use that trick if you don't mind
I think, we are talking about two different things...El_Choni wrote:But that's what my code does... What it doesn't check is icon colours and shape, like yours.GPI wrote:No problem: But maybe you should store the created bitmaps (you should check, if the icon-size has changed and recreate the icons if necassary.)
Look in the prepare-Icons-Segment of my code.
I create a window with some Toggle-Button-Gadget and set diffrent "styles" (normal, pushed, disabled, disabled-pushed). With this icons i create my Icon for the Titlebar. And thats my trick to create XP-Styled Icons on a XP-Sytem with style on. Also when the user change the colors of the buttons, my routines can handle this.
Btw: I think, that a tooltip is impossible. I can set, that a tooltip popup on a rect (and not on a gadget), but this rect must be in the client area. The titlebar is not the client area...
When i can get a id to the no client area.
Found something funny: It is possible to give the tooltip-rect negativ values (i think, this is a bug and should not work; but it work under win98se and winXP prof).
The program need the pictures of the zip.
Code: Select all
Global XPStyle
#TitleButton_ChangeState=#WM_User
Structure Box
x.l
y.l
w.l
h.l
EndStructure
Structure TitleButton
WindowID.l
Flags.l
State.l
OldWndProc.l
Icon1.l
Icon2.l
Icon3.l
Icon4.l
ActivState.l
CurrentIcon.l
ToolTip.l
EndStructure
;XIncludeFile "test.pb.declare"
;Autogenerated -- start of section automatically generated from Test.pb
; with jaPBe 1.4.2.28
Declare UpdateIconToolTipRect(WindowID,ToolTip)
Declare CreateIconButtonToolTip(WindowID, text$); - Create a (Balloon) Toolkit
Declare CreateIcon(GadgetNb,ImageNb,StampNb,WindowID)
Declare SetPixelProzent(hDC,x,y,pro)
Declare TitleButtonCallback(WindowID, Message, wParam, lParam)
Declare TestInButton(WindowID,*pt.POINT)
Declare SetTitleButtonState(WindowID,State)
Declare GetTitleButtonState(WindowID)
Declare RemoveTitleButton(WindowID)
Declare AddTitleButton(WindowID,Icon1,Icon2,Icon3,Icon4,Flags,ToolTip$)
Declare Redraw_TitleBarIcon(WindowID)
Declare GetMetrics(WindowID,*box.Box)
Declare GetBitmapHeight(hBitmap)
Declare GetBitmapWidth(hBitmap)
Procedure GetBitmapWidth(hBitmap)
BmpInfo.BITMAP
If hBitmap = 0 : ProcedureReturn 0 : EndIf
If GetObjectType_(hBitmap) <> #OBJ_BITMAP : ProcedureReturn 0 : EndIf
If GetObject_(hBitmap, SizeOf(BITMAP), BmpInfo) = 0 : ProcedureReturn 0 : EndIf
ProcedureReturn BmpInfo\bmWidth
EndProcedure
Procedure GetBitmapHeight(hBitmap)
BmpInfo.BITMAP
If hBitmap = 0 : ProcedureReturn 0 : EndIf
If GetObjectType_(hBitmap) <> #OBJ_BITMAP : ProcedureReturn 0 : EndIf
If GetObject_(hBitmap, SizeOf(BITMAP), BmpInfo) = 0 : ProcedureReturn 0 : EndIf
ProcedureReturn BmpInfo\bmHeight
EndProcedure
Procedure GetMetrics(WindowID,*box.Box)
getclientrect_(WindowID,rect.RECT)
WindowWidth= rect\right
CaptionHeight = GetSystemMetrics_(#SM_CYCAPTION)
*box\w = GetSystemMetrics_(#SM_CXSIZE)-2
*box\h = GetSystemMetrics_(#SM_CYSIZE)-4
*box\x = WindowWidth-(*box\w*4)-GetSystemMetrics_(#SM_CXDLGFRAME)-GetSystemMetrics_(#SM_CXBORDER)
*box\y = ((CaptionHeight-*box\h)/2)+GetSystemMetrics_(#SM_CYDLGFRAME)
EndProcedure
NewList TitleButtons.TitleButton()
Procedure Redraw_TitleBarIcon(WindowID)
GetMetrics(WindowID,Box.Box)
hRegion = CreateRectRgn_(Box\x, Box\y, Box\x+Box\w, Box\y+Box\h)
SendMessage_(WindowID, #WM_NCPAINT, hRegion, 0)
DeleteObject_(hRegion)
EndProcedure
Procedure AddTitleButton(WindowID,Icon1,Icon2,Icon3,Icon4,Flags,ToolTip$)
AddElement(TitleButtons())
TitleButtons()\WindowID=WindowID
TitleButtons()\OldWndProc=GetWindowLong_(WindowID,#GWL_WNDPROC)
TitleButtons()\Flags=Flags
TitleButtons()\Icon1=Icon1
TitleButtons()\Icon2=Icon2
TitleButtons()\Icon3=Icon3
TitleButtons()\Icon4=Icon4
TitleButtons()\CurrentIcon=Icon1
SetWindowLong_(WindowID,#gwl_UserData,@TitleButtons())
SetWindowLong_(WindowID,#GWL_WNDPROC,@TitleButtonCallback())
Redraw_TitleBarIcon(WindowID)
TitleButtons()\ToolTip=CreateIconButtonToolTip(WindowID,ToolTip$)
EndProcedure
Procedure RemoveTitleButton(WindowID)
result=#False
ResetList(TitleButtons())
While NextElement(TitleButtons())
If TitleButtons()\WindowID=WindowID
SetWindowLong_(WindowID,#GWL_WNDPROC,TitleButtons()\OldWndProc)
SetWindowLong_(WindowID,#gwl_UserData,0)
DeleteElement(TitleButtons())
result=#True
Break
EndIf
Wend
ProcedureReturn result
EndProcedure
Procedure GetTitleButtonState(WindowID)
*TitleButton.TitleButton=GetWindowLong_(WindowID,#gwl_UserData)
If *TitleButton
ProcedureReturn *TitleButton\State
Else
ProcedureReturn -1
EndIf
EndProcedure
Procedure SetTitleButtonState(WindowID,State)
*TitleButton.TitleButton=GetWindowLong_(WindowID,#gwl_UserData)
If *TitleButton
*TitleButton\State=State
If *TitleButton\State=#False
If *TitleButton\ActivState
*TitleButton\CurrentIcon=*TitleButton\Icon1
Else
*TitleButton\CurrentIcon=*TitleButton\Icon3
EndIf
Else
If *TitleButton\ActivState
*TitleButton\CurrentIcon=*TitleButton\Icon2
Else
*TitleButton\CurrentIcon=*TitleButton\Icon4
EndIf
EndIf
Redraw_TitleBarIcon(WindowID)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure TestInButton(WindowID,*pt.POINT)
ScreenToClient_(WindowID, *pt)
GetMetrics(WindowID,Box.Box)
xCur = *pt\x+GetSystemMetrics_(#SM_CXDLGFRAME)
yCur = *pt\y+GetSystemMetrics_(#SM_CYCAPTION)+GetSystemMetrics_(#SM_CYDLGFRAME)
If xCur>Box\x And xCur<(Box\x+Box\w) And yCur>Box\y And yCur<(Box\y+Box\h)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure TitleButtonCallback(WindowID, Message, wParam, lParam)
*TitleButton.TitleButton=GetWindowLong_(WindowID,#gwl_UserData)
Select Message
Case #WM_NCACTIVATE
result = CallWindowProc_(*TitleButton\OldWndProc, WindowID, Message, wParam, lParam)
*TitleButton\ActivState=wParam
If *TitleButton\State=#False
If *TitleButton\ActivState
*TitleButton\CurrentIcon=*TitleButton\Icon1
Else
*TitleButton\CurrentIcon=*TitleButton\Icon3
EndIf
Else
If *TitleButton\ActivState
*TitleButton\CurrentIcon=*TitleButton\Icon2
Else
*TitleButton\CurrentIcon=*TitleButton\Icon4
EndIf
EndIf
Redraw_TitleBarIcon(WindowID)
Case #WM_NCPAINT
result = CallWindowProc_(*TitleButton\OldWndProc, WindowID, Message, wParam, lParam)
UpdateIconToolTipRect(*TitleButton\WindowID,*TitleButton\ToolTip)
GetMetrics(WindowID,Box.Box)
hDC = GetWindowDC_(WindowID)
hDCImage=CreateCompatibleDC_(hDC)
OldObject=SelectObject_(hDCImage,*TitleButton\CurrentIcon)
SetStretchBltMode_(hDC, #COLORONCOLOR)
If XPStyle
c1=GetPixel_(hDC,Box\x,Box\y)
c2=GetPixel_(hDC,Box\x+Box\w-1,Box\y)
c3=GetPixel_(hDC,Box\x+Box\w-1,Box\y+Box\h-1)
c4=GetPixel_(hDC,Box\x,Box\y+Box\h-1)
EndIf
StretchBlt_(hDC, Box\x, Box\y, Box\w,Box\h, hDCImage, 0, 0,GetBitmapWidth(*TitleButton\CurrentIcon),GetBitmapHeight(*TitleButton\CurrentIcon), #SRCCOPY)
If XPStyle
SetPixel_(hDC,Box\x,Box\y,c1)
SetPixel_(hDC,Box\x+Box\w-1,Box\y,c2)
SetPixel_(hDC,Box\x+Box\w-1,Box\y+Box\h-1,c3)
SetPixel_(hDC,Box\x,Box\y+Box\h-1,c4)
EndIf
SelectObject_(hDCImage,OldObject)
DeleteDC_(hDCImage)
ReleaseDC_(WindowID, hDC)
Case #wm_NCLBUTTONDBLCLK
If wParam=#HTCAPTION
pt.POINT
pt\x = lParam&$FFFF
pt\y = lParam>>16
If TestInButton(WindowID,pt)
SendMessage_(WindowID,#WM_NCLBUTTONDOWN,wParam,lParam)
EndIf
Else
result = CallWindowProc_(*TitleButton\OldWndProc, WindowID, Message, wParam, lParam)
EndIf
Case #WM_NCLBUTTONDOWN
If wParam=#HTCAPTION
pt.POINT
pt\x = lParam&$FFFF
pt\y = lParam>>16
If TestInButton(WindowID,pt)
*TitleButton\Flags&#PB_Button_Toggle
If *TitleButton\Flags&#PB_Button_Toggle;{Toogle
If *TitleButton\State
If *TitleButton\ActivState
*TitleButton\CurrentIcon=*TitleButton\Icon1
Else
*TitleButton\CurrentIcon=*TitleButton\Icon3
EndIf
*TitleButton\State=#False
Else
If *TitleButton\ActivState
*TitleButton\CurrentIcon=*TitleButton\Icon2
Else
*TitleButton\CurrentIcon=*TitleButton\Icon4
EndIf
*TitleButton\State=#True
EndIf
Redraw_TitleBarIcon(WindowID)
PostMessage_(WindowID,#TitleButton_ChangeState,*TitleButton\State,0)
;}
Else;{Button
While getasynckeystate_(#VK_LBUTTON)&$FF00
GetCursorPos_(pt)
If TestInButton(WindowID,pt)
If *TitleButton\State=#False
If *TitleButton\ActivState
*TitleButton\CurrentIcon=*TitleButton\Icon2
Else
*TitleButton\CurrentIcon=*TitleButton\Icon4
EndIf
*TitleButton\State=#True
Redraw_TitleBarIcon(WindowID)
EndIf
Else
If *TitleButton\State=#True
If *TitleButton\ActivState
*TitleButton\CurrentIcon=*TitleButton\Icon1
Else
*TitleButton\CurrentIcon=*TitleButton\Icon3
EndIf
*TitleButton\State=#False
Redraw_TitleBarIcon(WindowID)
EndIf
EndIf
Delay(1)
Wend
If *TitleButton\State=#True
If *TitleButton\ActivState
*TitleButton\CurrentIcon=*TitleButton\Icon1
Else
*TitleButton\CurrentIcon=*TitleButton\Icon3
EndIf
*TitleButton\State=#False
Redraw_TitleBarIcon(WindowID)
PostMessage_(WindowID,#TitleButton_ChangeState,#True,0)
EndIf
;}
EndIf
If *TitleButton\ActivState=#False
result = CallWindowProc_(*TitleButton\OldWndProc, WindowID, Message, wParam, lParam)
EndIf
Else
result = CallWindowProc_(*TitleButton\OldWndProc, WindowID, Message, wParam, lParam)
EndIf
Else
result = CallWindowProc_(*TitleButton\OldWndProc, WindowID, Message, wParam, lParam)
EndIf
Default
result = CallWindowProc_(*TitleButton\OldWndProc, WindowID, Message, wParam, lParam)
EndSelect
ProcedureReturn result
EndProcedure
Procedure SetPixelProzent(hDC,x,y,pro)
col=GetPixel_(hDC,x,y)
r=Red(col)*pro/100:If r>255:r=255:EndIf
g=Green(col)*pro/100:If g>255:g=255:EndIf
b=Blue(col)*pro/100:If b>255:b=255:EndIf
SetPixel_(hDC,x,y,RGB(r,g,b))
EndProcedure
Procedure CreateIcon(GadgetNb,ImageNb,StampNb,WindowID)
GetMetrics(WindowID,Box.Box)
i1=CreateImage(ImageNb,Box\w,Box\h)
hDC = GetWindowDC_(GadgetID(GadgetNb))
hDCImage= CreateCompatibleDC_(hDC)
OldObject=SelectObject_(hDCImage,i1)
BitBlt_(hDCImage, 0,0, Box\w,Box\h, hDC, XPStyle, XPStyle, #SRCCOPY)
Ex=GetSystemMetrics_(#SM_CXEDGE)
Ey=GetSystemMetrics_(#SM_CyEDGE)
inW=Box\w-Ex*2-2
inH=Box\h-Ey*2-2
UseImage(StampNb)
outW=ImageWidth()
outH=ImageHeight()
StartDrawing(ImageOutput())
back=Point(0,0)
For x=0 To inW
xx=x*outW/(inW+1)
x2=(x+1)*outW/(inW+1)
If x2>xx:x2-1:EndIf
For y=0 To inH
yy=y*outH/(inH+1)
y2=(y+1)*outH/(inH+1)
If y2>yy:y2-1:EndIf
r=0:g=0:b=0:c=0
For dx=xx To x2
For dy=yy To y2
a=Point(dx,dy)
r+Red(a):g+Green(a):b+Blue(a)
c+1
Next
Next
If c>0
r/c:If r>255:r=255:EndIf
g/c:If g>255:g=255:EndIf
b/c:If b>255:b=255:EndIf
a=RGB(r,g,b)
Else
a=$FF00FF
EndIf
If a<>back
a=Red(a)*100/255
If XPStyle
a+30
EndIf
If a>100
a=100
EndIf
SetPixelProzent(hDCImage,Ex+x+1,Ex+y+1,a)
EndIf
Next
Next
StopDrawing()
SelectObject_(hDCImage,OldObject)
DeleteDC_(hDCImage)
ReleaseDC_(GadgetID(GadgetNb), hDC)
ProcedureReturn i1
EndProcedure
Procedure CreateIconButtonToolTip(WindowID, text$); - Create a (Balloon) Toolkit
Flag=#WS_POPUP | #TTS_NOPREFIX|#TTS_ALWAYSTIP
ToolTip=CreateWindowEx_(0,"ToolTips_Class32","",Flag,0,0,0,0,WindowID,0,GetModuleHandle_(0),0)
SendMessage_(ToolTip,#TTM_SETTIPTEXTCOLOR,GetSysColor_(#COLOR_INFOTEXT),0)
SendMessage_(ToolTip,#TTM_SETTIPBKCOLOR,GetSysColor_(#COLOR_INFOBK),0)
SendMessage_(ToolTip,#TTM_SETMAXTIPWIDTH,0,GetSystemMetrics_(#SM_CXFULLSCREEN))
Balloon.TOOLINFO\cbSize=SizeOf(TOOLINFO)
Balloon\uFlags= #TTF_SUBCLASS
Balloon\hwnd=WindowID
Balloon\uId=WindowID
getwindowrect_(WindowID,rect.RECT)
pt.POINT\x=0
pt.POINT\y=0
clienttoscreen_(WindowID,pt)
titlehight=pt\y-rect\top
leftoffset=GetSystemMetrics_(#SM_CXDLGFRAME)
GetMetrics(WindowID,Box.Box)
Balloon\rect\left=Box\x-leftoffset
Balloon\rect\top=Box\y-titlehight
Balloon\rect\right=Box\x+Box\w-leftoffset
Balloon\rect\bottom=Box\y+Box\h-titlehight
Balloon\lpszText=@text$
SendMessage_(ToolTip, #TTM_ADDTOOL, 0, Balloon)
ProcedureReturn ToolTip
EndProcedure
Procedure UpdateIconToolTipRect(WindowID,ToolTip)
If ToolTip
getwindowrect_(WindowID,rect.RECT)
pt.POINT\x=0
pt.POINT\y=0
clienttoscreen_(WindowID,pt)
titlehight=pt\y-rect\top
leftoffset=GetSystemMetrics_(#SM_CXDLGFRAME)
GetMetrics(WindowID,Box.Box)
Balloon.TOOLINFO\cbSize=SizeOf(TOOLINFO)
Balloon\uFlags= #TTF_SUBCLASS
Balloon\hwnd=WindowID
Balloon\uId=WindowID
Balloon\rect\left=Box\x-leftoffset
Balloon\rect\top=Box\y-titlehight
Balloon\rect\right=Box\x+Box\w-leftoffset
Balloon\rect\bottom=Box\y+Box\h-titlehight
SendMessage_(ToolTip, #TTM_NEWTOOLRECT, 0, Balloon)
EndIf
EndProcedure
;{Prepare icons
If OpenWindow(0,0,0,100,100,#PB_Window_ScreenCentered,"IconCreation!")
If CreateGadgetList(WindowID())
GetMetrics(WindowID(),Box.Box)
LoadImage(4,"ontop0.bmp");:ResizeImage(4,Box\w-GetSystemMetrics_(#SM_CXEDGE)*2,Box\h-GetSystemMetrics_(#SM_CyEDGE)*2)
LoadImage(5,"ontop1.bmp");:ResizeImage(5,Box\w-GetSystemMetrics_(#SM_CXEDGE)*2,Box\h-GetSystemMetrics_(#SM_CyEDGE)*2)
ButtonGadget(0, 0,0 ,Box\w,Box\h," ",#PB_Button_Toggle)
ButtonGadget(1,Box\w,0 ,Box\w,Box\h," ",#PB_Button_Toggle)
ButtonGadget(2, 0,Box\h,Box\w,Box\h," ",#PB_Button_Toggle)
ButtonGadget(3,Box\w,Box\h,Box\w,Box\h," ",#PB_Button_Toggle)
SetGadgetState(1,#True)
SetGadgetState(3,#True)
DisableGadget(2,#True)
DisableGadget(3,#True)
SendMessage_(GadgetID(0),#BM_SETIMAGE,#image_bitmap,i1)
SendMessage_(GadgetID(1),#BM_SETIMAGE,#image_icon,i2)
SendMessage_(GadgetID(3),#BM_SETIMAGE,#image_icon,i1)
SendMessage_(GadgetID(4),#BM_SETIMAGE,#image_icon,i2)
While WindowEvent():Wend
;{XP-Style?
hDC=GetWindowDC_(GadgetID(2))
c1=GetPixel_(hDC,0,0)
c2=GetPixel_(hDC,Box\w-1,0)
c3=GetPixel_(hDC,Box\w-1,Box\h-1)
c4=GetPixel_(hDC,0,Box\h-1)
If c1=c2 And c1=c3 And c1=c4
XPStyle=#True
ResizeGadget(0, 0,0 ,Box\w+2,Box\h+2)
ResizeGadget(1,Box\w+2,0 ,Box\w+2,Box\h+2)
ResizeGadget(2, 0,Box\h+2,Box\w+2,Box\h+2)
ResizeGadget(3,Box\w+2,Box\h+2,Box\w+2,Box\h+2)
While WindowEvent():Wend
Else
XPStyle=#False
EndIf
;}
Icon1=CreateIcon(0,0,4,WindowID())
Icon2=CreateIcon(1,1,5,WindowID())
Icon3=CreateIcon(2,2,4,WindowID())
Icon4=CreateIcon(3,3,5,WindowID())
;Repeat:WaitWindowEvent():ForEver
CloseWindow(0)
EndIf
EndIf
;}
If OpenWindow(1,0,0,200,200,#PB_Window_ScreenCentered|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget|#PB_Window_SystemMenu|#PB_Window_SizeGadget,"Test 1")
AddTitleButton(WindowID(1),Icon1,Icon2,Icon3,Icon4,0,"Buttontest")
If OpenWindow(2,WindowX()+200,WindowY(),200,200,#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget|#PB_Window_SystemMenu,"Test 2")
AddTitleButton(WindowID(2),Icon1,Icon2,Icon3,Icon4,#PB_Button_Toggle,"ToggleTest")
If CreateGadgetList(WindowID())
ButtonImageGadget(0,0,0,100,50,UseImage(4))
ButtonImageGadget(1,0,50,100,50,UseImage(5))
ButtonGadget(2,0,100,100,20,"Test",#PB_Button_Toggle)
EndIf
Repeat
event=WaitWindowEvent()
If event=#TitleButton_ChangeState
MessageRequester("Hallo","Window 'Test "+Str(EventWindowID())+"'"+Chr(10)+"ButtonState:"+Str(EventwParam()))
EndIf
Until event=#PB_Event_CloseWindow
EndIf
EndIf
No external images needed now. Still no tooltips in this one, I'll try to add them looking at your code:
EDIT: now it does exactly what I needed, thanks to you
I've added it to TailBite.
Our codes are different: your code is useful to add title buttons in any app, mine is only an example of using one titlebar button. Yours could maybe make it into an userlib.
BTW, I know you must have some reason for this, but I don't know which: why do you create a memory context in every WM_NCPAINT? Can't you reuse always the same, as in my code below or in the original code?
EDIT: now it does exactly what I needed, thanks to you

Our codes are different: your code is useful to add title buttons in any app, mine is only an example of using one titlebar button. Yours could maybe make it into an userlib.
BTW, I know you must have some reason for this, but I don't know which: why do you create a memory context in every WM_NCPAINT? Can't you reuse always the same, as in my code below or in the original code?
Code: Select all
Global OldWndProc, mDC, WindowWidth, xPos, yPos, BtnWidth, BtnHeight
Global OrBtnWidth, OrBtnHeight, BtnDown, BGColour, FGColour, hToolTip, tp.TOOLINFO
Procedure UpdateTP()
tp\cbSize = SizeOf(TOOLINFO)
tp\uFlags = #TTF_SUBCLASS
tp\hwnd = WindowID()
tp\uId = WindowID()
tp\rect\left = xPos-GetSystemMetrics_(#SM_CXDLGFRAME)-GetSystemMetrics_(#SM_CXBORDER)
tp\rect\top = yPos-GetSystemMetrics_(#SM_CYCAPTION)-GetSystemMetrics_(#SM_CYDLGFRAME)-GetSystemMetrics_(#SM_CYBORDER)
tp\rect\right = xPos+BtnWidth
tp\rect\bottom = tp\rect\top+BtnHeight
tp\lpszText = @"Stay on top"
EndProcedure
Procedure UpdateMetrics()
WindowWidth = WindowWidth()
CaptionHeight = GetSystemMetrics_(#SM_CYCAPTION)
BtnWidth = GetSystemMetrics_(#SM_CXSIZE)-2
BtnHeight = GetSystemMetrics_(#SM_CYSIZE)-4
xPos = WindowWidth-(BtnWidth*4)-GetSystemMetrics_(#SM_CXDLGFRAME)-GetSystemMetrics_(#SM_CXBORDER)
yPos = ((CaptionHeight-BtnHeight)/2)+GetSystemMetrics_(#SM_CYDLGFRAME)+GetSystemMetrics_(#SM_CXBORDER)
BGColour = GetSysColor_(#COLOR_3DFACE)
FGColour = GetSysColor_(#COLOR_BTNTEXT)
hDC = GetDC_(WindowID())
*Icon = AllocateMemory(0, 1760)
For z=#OBM_REDUCED To #OBM_REDUCE Step #OBM_REDUCE-#OBM_REDUCED
If z-#OBM_REDUCED:*OnTops = ?OnTop0:Else:*OnTops = ?OnTop1:EndIf
hSysBitmap = LoadBitmap_(0, z)
If z-#OBM_REDUCED
CreateImage(1, 22, 24)
StartDrawing(ImageOutput())
DrawImage(hSysBitmap, 0, 0, 22, 24)
StopDrawing()
ImageID = GrabImage(1, z-#OBM_REDUCED, 0, 2, 22, 20)
Else
ImageID = CreateImage(z-#OBM_REDUCED, 22, 20)
StartDrawing(ImageOutput())
DrawImage(hSysBitmap, 0, 0, 22, 20)
StopDrawing()
EndIf
DeleteObject_(hSysBitmap)
bmih.BITMAPINFOHEADER
bmih\biSize = SizeOf(BITMAPINFOHEADER)
bmih\biWidth = 22
bmih\biHeight = -20
bmih\biPlanes = 1
bmih\biBitCount = 32
bmih\biCompression = #BI_RGB
If GetDIBits_(hDC, ImageID, 0, 20, *Icon, @bmih, 0)
For i=0 To 15
*PixelPlace.LONG = *Icon+((i+2)*(88))+12
For j=0 To 1
ThisByte = PeekB(*OnTops+(i*2)+j)&$FF
For p=0 To 7
ThisByte<<1
If ThisByte>=%100000000
*PixelPlace\l = ((FGColour&$FF)<<16)|(FGColour&$FF00)|((FGColour&$FF0000)>>16)
Else
*PixelPlace\l = ((BGColour&$FF)<<16)|(BGColour&$FF00)|((BGColour&$FF0000)>>16)
EndIf
*PixelPlace+4
ThisByte&$FF
Next p
Next j
Next i
EndIf
SetDIBits_(hDC, ImageID, 0, 20, *Icon, @bmih, 0)
Next z
FreeMemory(0)
ReleaseDC_(WindowID(), hDC)
If BtnDown
SelectObject_(mDC, UseImage(0))
Else
SelectObject_(mDC, UseImage(#OBM_REDUCE-#OBM_REDUCED))
EndIf
If hToolTip
UpdateTP()
SendMessage_(hToolTip, #TTM_NEWTOOLRECT, 0, @tp)
EndIf
EndProcedure
Procedure CreateIconButtonToolTip(hWnd)
UpdateMetrics()
hToolTip = CreateWindowEx_(0, "ToolTips_Class32", "", #WS_POPUP|#TTS_NOPREFIX|#TTS_ALWAYSTIP, 0, 0, 0, 0, hWnd, 0, GetModuleHandle_(0), 0)
If hToolTip
UpdateTP()
SendMessage_(hToolTip, #TTM_ADDTOOL, 0, @tp)
EndIf
ProcedureReturn hToolTip
EndProcedure
Procedure TestInButton(hWnd, *pt.POINT)
ScreenToClient_(hWnd, *pt)
UpdateMetrics()
xCur = *pt\x+GetSystemMetrics_(#SM_CXDLGFRAME)
yCur = *pt\y+GetSystemMetrics_(#SM_CYCAPTION)+GetSystemMetrics_(#SM_CYDLGFRAME)
If xCur>xPos And xCur<(xPos+BtnWidth) And yCur>yPos And yCur<(yPos+BtnHeight)
ProcedureReturn #TRUE
Else
ProcedureReturn #FALSE
EndIf
EndProcedure
Procedure PaintButton(hWnd)
hDC = GetWindowDC_(hWnd)
SetStretchBltMode_(hDC, #HALFTONE)
StretchBlt_(hDC, xPos, yPos, BtnWidth, BtnHeight, mDC, 0, 0, OrBtnWidth, OrBtnHeight, #SRCCOPY)
ReleaseDC_(hWnd, hDC)
EndProcedure
Procedure WndProc(hWnd, uMsg, wParam, lParam)
Select uMsg
Case #WM_NCACTIVATE
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
UpdateMetrics()
PaintButton(hWnd)
Case #WM_NCPAINT
UpdateMetrics()
hRegion = CreateRectRgn_(xPos, yPos, xPos+BtnWidth, yPos+BtnHeight)
CombineRgn_(wParam, wParam, hRegion, #RGN_DIFF)
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
DeleteObject_(hRegion)
PaintButton(hWnd)
Case #WM_NCLBUTTONDBLCLK
If wParam=#HTCAPTION
pt.POINT
pt\x = lParam&$FFFF
pt\y = lParam>>16
If TestInButton(hWnd, pt)
SendMessage_(hWnd, #WM_NCLBUTTONDOWN, wParam, lParam)
Else
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
EndIf
Else
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
EndIf
Case #WM_NCLBUTTONDOWN
If wParam=#HTCAPTION
pt.POINT
pt\x = lParam&$ffff
pt\y = lParam>>16
ScreenToClient_(hWnd, @pt)
UpdateMetrics()
xCur = pt\x+GetSystemMetrics_(#SM_CXDLGFRAME)
yCur = pt\y+GetSystemMetrics_(#SM_CYCAPTION)+GetSystemMetrics_(#SM_CYDLGFRAME)
If xCur>xPos And xCur<(xPos+BtnWidth) And yCur>yPos And yCur<(yPos+BtnHeight)
If BtnDown
SetWindowPos_(hWnd, #HWND_NOTOPMOST, 0, 0, 0, 0, #SWP_NOMOVE|#SWP_NOSIZE)
SelectObject_(mDC, UseImage(#OBM_REDUCE-#OBM_REDUCED))
BtnDown = 0
Else
SetWindowPos_(hWnd, #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE|#SWP_NOSIZE)
SelectObject_(mDC, UseImage(0))
BtnDown = 1
EndIf
PaintButton(hWnd)
Else
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
EndIf
Else
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
EndIf
Default
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
EndSelect
ProcedureReturn result
EndProcedure
If OpenWindow(0, 0, 0, 320, 256, #PB_Window_SystemMenu|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget|#PB_Window_ScreenCentered, "Title button")
WindowID = WindowID()
OrBtnWidth = 22
OrBtnHeight = 20
hDC = GetDC_(WindowID)
mDC = CreateCompatibleDC_(hDC)
CreateImage(0, 22, 20)
mOldOblect = SelectObject_(mDC, ImageID())
ReleaseDC_(WindowID, hDC)
UpdateMetrics()
OldWndProc = SetWindowLong_(WindowID, #GWL_WNDPROC, @WndProc())
CreateIconButtonToolTip(WindowID)
PaintButton(WindowID)
Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow
DeleteObject_(mOldOblect)
DeleteDC_(mDC)
EndIf
End
DataSection
OnTop0:
Data.b %00000000,%00000000
Data.b %00000000,%00000000
Data.b %00000000,%00000000
Data.b %00000011,%00000000
Data.b %00000010,%10000110
Data.b %00000010,%01111010
Data.b %00000010,%01001010
Data.b %11111110,%01001010
Data.b %11111110,%11111010
Data.b %00000011,%11111110
Data.b %00000011,%11111110
Data.b %00000011,%10000110
Data.b %00000011,%00000000
Data.b %00000000,%00000000
Data.b %00000000,%00000000
Data.b %00000000,%00000000
OnTop1:
Data.b %00000000,%00000000
Data.b %00000000,%00000000
Data.b %00000000,%11110000
Data.b %00000011,%00001000
Data.b %00001110,%00001100
Data.b %00001010,%00001100
Data.b %00010010,%00011100
Data.b %00010011,%00111100
Data.b %00011011,%11111000
Data.b %00011111,%11111000
Data.b %00001111,%11111000
Data.b %00001111,%11110000
Data.b %00011001,%11100000
Data.b %00000000,%00000000
Data.b %00000000,%00000000
Data.b %00000000,%00000000
EndDataSection
El_Choni
When you use SelectObject_() on a bitmap, this bitmap is locked and can't be used with any other hDC. But my routines should work with many diffrent windows and with the same images at the same time.El_Choni wrote:BTW, I know you must have some reason for this, but I don't know which: why do you create a memory context in every WM_NCPAINT? Can't you reuse always the same, as in my code below or in the original code?
Translated Code to PB 4.0:
Code: Select all
Global OldWndProc, mDC, WindowWidth, xPos, yPos, BtnWidth, BtnHeight
Global OrBtnWidth, OrBtnHeight, BtnDown, BGColour, FGColour, hToolTip, tp.TOOLINFO
Procedure UpdateTP()
tp\cbSize = SizeOf(TOOLINFO)
tp\uFlags = #TTF_SUBCLASS
tp\hwnd = WindowID(0)
tp\uId = WindowID(0)
tp\rect\left = xPos-GetSystemMetrics_(#SM_CXDLGFRAME)-GetSystemMetrics_(#SM_CXBORDER)
tp\rect\top = yPos-GetSystemMetrics_(#SM_CYCAPTION)-GetSystemMetrics_(#SM_CYDLGFRAME)-GetSystemMetrics_(#SM_CYBORDER)
tp\rect\right = xPos+BtnWidth
tp\rect\bottom = tp\rect\top+BtnHeight
tp\lpszText = @"Stay on top"
EndProcedure
Procedure UpdateMetrics()
WindowWidth = WindowWidth(0)
CaptionHeight = GetSystemMetrics_(#SM_CYCAPTION)
BtnWidth = GetSystemMetrics_(#SM_CXSIZE)-2
BtnHeight = GetSystemMetrics_(#SM_CYSIZE)-4
xPos = WindowWidth-(BtnWidth*4)-GetSystemMetrics_(#SM_CXDLGFRAME)-GetSystemMetrics_(#SM_CXBORDER)
yPos = ((CaptionHeight-BtnHeight)/2)+GetSystemMetrics_(#SM_CYDLGFRAME)+GetSystemMetrics_(#SM_CXBORDER)
BGColour = GetSysColor_(#COLOR_3DFACE)
FGColour = GetSysColor_(#COLOR_BTNTEXT)
hDC = GetDC_(WindowID(0))
*Icon = AllocateMemory(1760)
For z=#OBM_REDUCED To #OBM_REDUCE Step #OBM_REDUCE-#OBM_REDUCED
If z-#OBM_REDUCED:*OnTops = ?OnTop0:Else:*OnTops = ?OnTop1:EndIf
hSysBitmap = LoadBitmap_(0, z)
If z-#OBM_REDUCED
CreateImage(1, 22, 24)
StartDrawing(ImageOutput(1))
DrawImage(hSysBitmap, 0, 0, 22, 24)
StopDrawing()
ImageID = GrabImage(1, z-#OBM_REDUCED, 0, 2, 22, 20)
Else
ImageID = CreateImage(z-#OBM_REDUCED, 22, 20)
StartDrawing(ImageOutput(z-#OBM_REDUCED))
DrawImage(hSysBitmap, 0, 0, 22, 20)
StopDrawing()
EndIf
DeleteObject_(hSysBitmap)
bmih.BITMAPINFOHEADER
bmih\biSize = SizeOf(BITMAPINFOHEADER)
bmih\biWidth = 22
bmih\biHeight = -20
bmih\biPlanes = 1
bmih\biBitCount = 32
bmih\biCompression = #BI_RGB
If GetDIBits_(hDC, ImageID, 0, 20, *Icon, @bmih, 0)
For i=0 To 15
*PixelPlace.LONG = *Icon+((i+2)*(88))+12
For j=0 To 1
ThisByte = PeekB(*OnTops+(i*2)+j)&$FF
For p=0 To 7
ThisByte<<1
If ThisByte>=%100000000
*PixelPlace\l = ((FGColour&$FF)<<16)|(FGColour&$FF00)|((FGColour&$FF0000)>>16)
Else
*PixelPlace\l = ((BGColour&$FF)<<16)|(BGColour&$FF00)|((BGColour&$FF0000)>>16)
EndIf
*PixelPlace+4
ThisByte&$FF
Next p
Next j
Next i
EndIf
SetDIBits_(hDC, ImageID, 0, 20, *Icon, @bmih, 0)
Next z
FreeMemory(*Icon)
ReleaseDC_(WindowID(0), hDC)
If BtnDown
SelectObject_(mDC, ImageID(0))
Else
SelectObject_(mDC, ImageID(#OBM_REDUCE-#OBM_REDUCED))
EndIf
If hToolTip
UpdateTP()
SendMessage_(hToolTip, #TTM_NEWTOOLRECT, 0, @tp)
EndIf
EndProcedure
Procedure CreateIconButtonToolTip(hWnd)
UpdateMetrics()
hToolTip = CreateWindowEx_(0, "ToolTips_Class32", "", #WS_POPUP|#TTS_NOPREFIX|#TTS_ALWAYSTIP, 0, 0, 0, 0, hWnd, 0, GetModuleHandle_(0), 0)
If hToolTip
UpdateTP()
SendMessage_(hToolTip, #TTM_ADDTOOL, 0, @tp)
EndIf
ProcedureReturn hToolTip
EndProcedure
Procedure TestInButton(hWnd, *pt.POINT)
ScreenToClient_(hWnd, *pt)
UpdateMetrics()
xCur = *pt\x+GetSystemMetrics_(#SM_CXDLGFRAME)
yCur = *pt\y+GetSystemMetrics_(#SM_CYCAPTION)+GetSystemMetrics_(#SM_CYDLGFRAME)
If xCur>xPos And xCur<(xPos+BtnWidth) And yCur>yPos And yCur<(yPos+BtnHeight)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure PaintButton(hWnd)
hDC = GetWindowDC_(hWnd)
SetStretchBltMode_(hDC, #HALFTONE)
StretchBlt_(hDC, xPos, yPos, BtnWidth, BtnHeight, mDC, 0, 0, OrBtnWidth, OrBtnHeight, #SRCCOPY)
ReleaseDC_(hWnd, hDC)
EndProcedure
Procedure WndProc(hWnd, uMsg, wParam, lParam)
Select uMsg
Case #WM_NCACTIVATE
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
UpdateMetrics()
PaintButton(hWnd)
Case #WM_NCPAINT
UpdateMetrics()
hRegion = CreateRectRgn_(xPos, yPos, xPos+BtnWidth, yPos+BtnHeight)
CombineRgn_(wParam, wParam, hRegion, #RGN_DIFF)
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
DeleteObject_(hRegion)
PaintButton(hWnd)
Case #WM_NCLBUTTONDBLCLK
If wParam=#HTCAPTION
pt.POINT
pt\x = lParam&$FFFF
pt\y = lParam>>16
If TestInButton(hWnd, pt)
SendMessage_(hWnd, #WM_NCLBUTTONDOWN, wParam, lParam)
Else
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
EndIf
Else
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
EndIf
Case #WM_NCLBUTTONDOWN
If wParam=#HTCAPTION
pt.POINT
pt\x = lParam&$ffff
pt\y = lParam>>16
ScreenToClient_(hWnd, @pt)
UpdateMetrics()
xCur = pt\x+GetSystemMetrics_(#SM_CXDLGFRAME)
yCur = pt\y+GetSystemMetrics_(#SM_CYCAPTION)+GetSystemMetrics_(#SM_CYDLGFRAME)
If xCur>xPos And xCur<(xPos+BtnWidth) And yCur>yPos And yCur<(yPos+BtnHeight)
If BtnDown
SetWindowPos_(hWnd, #HWND_NOTOPMOST, 0, 0, 0, 0, #SWP_NOMOVE|#SWP_NOSIZE)
SelectObject_(mDC, ImageID(#OBM_REDUCE-#OBM_REDUCED))
BtnDown = 0
Else
SetWindowPos_(hWnd, #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE|#SWP_NOSIZE)
SelectObject_(mDC, ImageID(0))
BtnDown = 1
EndIf
PaintButton(hWnd)
Else
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
EndIf
Else
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
EndIf
Default
result = CallWindowProc_(OldWndProc, hWnd, uMsg, wParam, lParam)
EndSelect
ProcedureReturn result
EndProcedure
If OpenWindow(0, 0, 0, 320, 256, "Title button", #PB_Window_SystemMenu|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget|#PB_Window_ScreenCentered)
WindowID = WindowID(0)
OrBtnWidth = 22
OrBtnHeight = 20
hDC = GetDC_(WindowID)
mDC = CreateCompatibleDC_(hDC)
CreateImage(0, 22, 20)
mOldOblect = SelectObject_(mDC, ImageID(0))
ReleaseDC_(WindowID, hDC)
UpdateMetrics()
OldWndProc = SetWindowLong_(WindowID, #GWL_WNDPROC, @WndProc())
CreateIconButtonToolTip(WindowID)
PaintButton(WindowID)
Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow
DeleteObject_(mOldOblect)
DeleteDC_(mDC)
EndIf
End
DataSection
OnTop0:
Data.b %00000000,%00000000
Data.b %00000000,%00000000
Data.b %00000000,%00000000
Data.b %00000011,%00000000
Data.b %00000010,%10000110
Data.b %00000010,%01111010
Data.b %00000010,%01001010
Data.b %11111110,%01001010
Data.b %11111110,%11111010
Data.b %00000011,%11111110
Data.b %00000011,%11111110
Data.b %00000011,%10000110
Data.b %00000011,%00000000
Data.b %00000000,%00000000
Data.b %00000000,%00000000
Data.b %00000000,%00000000
OnTop1:
Data.b %00000000,%00000000
Data.b %00000000,%00000000
Data.b %00000000,%11110000
Data.b %00000011,%00001000
Data.b %00001110,%00001100
Data.b %00001010,%00001100
Data.b %00010010,%00011100
Data.b %00010011,%00111100
Data.b %00011011,%11111000
Data.b %00011111,%11111000
Data.b %00001111,%11111000
Data.b %00001111,%11110000
Data.b %00011001,%11100000
Data.b %00000000,%00000000
Data.b %00000000,%00000000
Data.b %00000000,%00000000
EndDataSection
Apart from that Mrs Lincoln, how was the show?