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