📄 iconmenu.bas
字号:
LOCAL hFound AS DWORD
'
LOCAL hWinXP_Lib AS LONG ' Handle to WinXP Theme DLL
LOCAL hWinXP_IsThemeActive AS LONG ' Handle to WinXP's IsThemeActive function
' Setup defalt parameters
grScaleDefault = 0.75
grScaleStep = 0.01
'
zClass = "ZICONMENU"
'
hMutex = CreateMutex(BYVAL %Null, 0, zClass)
IF hMutex THEN
IF GetLastError = %ERROR_ALREADY_EXISTS THEN
DO
hFound = FindWindow(zClass, ""): IF hFound THEN EXIT DO
WHILE PeekMessage(Msg, %NULL, %NULL, %NULL, %PM_REMOVE): WEND
LOOP
IF IsIconic(hFound) THEN CALL ShowWindow(hFound, %SW_RESTORE)
CALL SetForeGroundWindow(hFound)
FUNCTION = 0
EXIT FUNCTION
END IF
END IF
'
IsInitialized& = GetClassInfoEx(zInstance, zClass, wc)
IF IsInitialized& = 0 THEN
wc.cbSize = SIZEOF(wc)
wc.style = %CS_HREDRAW OR %CS_VREDRAW
wc.lpfnWndProc = CODEPTR(WndProc)
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = zInstance
wc.hIcon = LoadIcon(wc.hInstance, "PROGRAM")
wc.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wc.hbrBackground = %NULL ' GetStockObject(%BLACK_BRUSH)
wc.lpszMenuName = %NULL
wc.lpszClassName = VARPTR(zClass)
wc.hIconSm = wc.hIcon
IF RegisterClassEx(wc) THEN IsInitialized& = %TRUE
END IF
'
IF IsInitialized& THEN
'************************************************************************************
' Load the GDImage.dll
IF RegisterGDImageClass() = 0 THEN
FUNCTION = 99: EXIT FUNCTION ' If it fails to register then return ERROR = 99
END IF
'************************************************************************************
' Load the WinXP Theme support (if applicable)
hWinXP_Lib = LoadLibrary("UxTheme.dll")
IF hWinXP_Lib THEN
hWinXP_IsThemeActive = GetProcAddress(hWinXP_Lib, "IsThemeActive")
END IF
'
CALL InitCommonControls
'
' Window Extended Style
dwExStyle = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
' Windows Style
dwStyle = %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU
'
CALL SetRect(rc, 0, 0, 740, 420)
CALL AdjustWindowRectEx(rc, dwStyle, %FALSE, dwExStyle) ' Adjust Window To True Requested Size
'
x = MAX&((GetSystemMetrics(%SM_CXSCREEN) - rc.nRight - rc.nLeft) \ 2, 0)
y = MAX&((GetSystemMetrics(%SM_CYSCREEN) - rc.nBottom - rc.nTop) \ 2, 0)
'
' Create The Window
MyTitle$ = "GDImage " + ZI_Version + " ""Icon Menu"""
hMain = CreateWindowEx(dwExStyle, _ ' Extended Style For The Window
zClass, _ ' Class Name
(MyTitle$), _ ' Window Title
dwStyle OR _ ' Defined Window Style
%WS_CLIPSIBLINGS OR _ ' Required Window Style
%WS_CLIPCHILDREN, _ ' Required Window Style
x, y, _ ' Window Position
rc.nRight - rc.nLeft, _ ' Calculate Window Width
rc.nBottom - rc.nTop, _ ' Calculate Window Height
%NULL, _ ' No Parent Window
%NULL, _ ' No Menu
wc.hInstance, _ ' Instance
BYVAL %NULL) ' Dont Pass Anything To WM_CREATE
'
IF hMain THEN
'
' Apply WinXP Theme support
LOCAL lRes AS LONG, pProc AS DWORD
IF hWinXP_IsThemeActive THEN
CALL DWORD hWinXP_IsThemeActive USING IsThemeActive TO lRes
IF lRes THEN pProc = GetProcAddress(lRes, "EnableThemeDialogTexture")
IF pProc THEN CALL DWORD pProc USING EnableDialogTheme(hMain, &H01 OR &H02 OR &H04 OR &H06)
END IF
'
' Create button "RESET"
CALL CreateWindowEx(0, "BUTTON", "Reset icon location", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
605, 14, 120, 22, hMain, %ID_BTN_RESET, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_BTN_RESET), zDefaultFont)
' Create checkbox "Use fade effect"
CALL CreateWindowEx(0, "Button", "Use scrolling Help", _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _ ' window styles
%BS_AUTOCHECKBOX OR %BS_LEFT OR %BS_VCENTER, _ ' class styles
610, 46, _ ' left, top
120, 22, _ ' width, height
hMain, %ID_BTN_MARQUEE, _ ' handle of parent, control ID
zInstance, BYVAL %NULL) ' handle of instance, creation parameters
CALL zSetCTLFont(GetDlgItem(hMain, %ID_BTN_MARQUEE), zDefaultFont)
' Create checkbox "Use 3D depth"
CALL CreateWindowEx(0, "Button", "Use Wallpaper", _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _ ' window styles
%BS_AUTOCHECKBOX OR %BS_LEFT OR %BS_VCENTER, _ ' class styles
610, 68, _ ' left, top
120, 22, _ ' width, height
hMain, %ID_BTN_WALLPAPER, _ ' handle of parent, control ID
zInstance, BYVAL %NULL) ' handle of instance, creation parameters
CALL zSetCTLFont(GetDlgItem(hMain, %ID_BTN_WALLPAPER), zDefaultFont)
' Create checkbox "Reflection"
CALL CreateWindowEx(0, "Button", "Use Reflection", _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _ ' window styles
%BS_AUTOCHECKBOX OR %BS_LEFT OR %BS_VCENTER, _ ' class styles
610, 90, _ ' left, top
120, 22, _ ' width, height
hMain, %ID_BTN_REFLECTION, _ ' handle of parent, control ID
zInstance, BYVAL %NULL) ' handle of instance, creation parameters
CALL zSetCTLFont(GetDlgItem(hMain, %ID_BTN_REFLECTION), zDefaultFont)
' ******************************************************************************
' Create a GDImage control the SDK way
' We read first the size of the image to create
' window with client rectangle matching exactly
' the image size.
' ------------------------------------------------------------------------------
FullPathName$ = "vistaback.jpg"
CALL ZI_GetImageSizeFromFile((FullPathName$), imgW&, imgH&)
UseW& = imgW& ' Use this to preserve the size of the picture
UseH& = imgH& ' Use this to preserve the size of the picture
Style& = %WS_CHILD OR %WS_VISIBLE 'OR %WS_HSCROLL OR %WS_VSCROLL
StyleEx& = 0'%WS_EX_STATICEDGE
CALL ZI_AdjustWindowRect(StyleEx&, UseW&, UseH&, Style&)
gCtrl = CreateWindowEx(StyleEx&, _
"ZIMAGECTRL", _ ' GDImage class name
"", _ ' Optional full path name to picture
Style&, _ ' window style
0, _ ' initial x position
0, _ ' initial y position
useW&, _ ' Calculate Window Width
useH&, _ ' Calculate Window Height
hMain, _ ' parent window handle
%ID_CTRL, _ ' ControlID
zInstance, _ ' program instance handle
BYVAL 0) ' creation parameters
' We use a callback to monitor the GDImage control messages
' Create a %WM_LBUTTONDOWN event
CALL ZI_EventMessage(CODEPTR(MyCallBack), %WM_LBUTTONDOWN, %TRUE)
' Create a %WM_LBUTTONDBLCLK event
CALL ZI_EventMessage(CODEPTR(MyCallBack), %WM_LBUTTONDBLCLK, %TRUE)
' Create a %WM_RBUTTONDOWN event
CALL ZI_EventMessage(CODEPTR(MyCallBack), %WM_RBUTTONDOWN, %TRUE)
' Create a %WM_KEYDOWN event
CALL ZI_EventMessage(CODEPTR(MyCallBack), %WM_KEYDOWN, %TRUE)
' Create a %WM_MOUSEMOVE event
CALL ZI_EventMessage(CODEPTR(MyCallBack), %WM_MOUSEMOVE, %TRUE)
' Use gradient for background
CALL ZI_SetProperty(gCtrl, %ZI_GradientTop, RGB(27,29,41))
CALL ZI_SetProperty(gCtrl, %ZI_GradientBottom, RGB(27,29,41))
CALL LoadSprites()
gbAnimate = %TRUE
' Show the main window
CALL ShowWindow(hMain, iCmdShow)
CALL SetForegroundWindow(hMain) ' Slightly Higher Priority
CALL SetFocus(gCtrl) ' Sets Keyboard Focus To The Window
CALL SetTimer(hMain, 1, 0, %NULL)
WHILE GetMessage(Msg, %NULL, 0, 0)
CALL TranslateMessage(Msg)
CALL DispatchMessage(Msg)
WEND
CALL KillTimer(hMain, 1)
FUNCTION = msg.wParam
END IF
' UNLOAD the WinXP Theme DLL (if necessary)
IF hWinXP_Lib THEN CALL FreeLibrary(hWinXP_Lib)
END IF
'
IF hMutex THEN CALL CloseHandle(hMutex)
'
END FUNCTION
SUB LoadSprites()
DIM gSpriteArray(1 TO 5) AS gSpriteArrayStruct
LOCAL K, xLeft, yOffset, UboundSpriteData, INT_REFLECTION AS LONG
LOCAL sLabel AS STRING
LOCAL rc AS RECT
gSpriteArray(1).ImageName = "Office Publisher.png"
gSpriteArray(2).ImageName = "Office Word.png"
gSpriteArray(3).ImageName = "Office Outlook.png"
gSpriteArray(4).ImageName = "Office PowerPoint.png"
gSpriteArray(5).ImageName = "Office Excel.png"
CALL GetClientRect(gCtrl, rc)
UboundSpriteData = UBOUND(gSpriteArray)
xLeft = (rc.nRight - ((32 * (UboundSpriteData - 1)) + (64 * UboundSpriteData))) / 2
xLeft = xLeft - ((128 - 64) / 2)
INT_REFLECTION = SendMessage(GetDlgItem(hMain, %ID_BTN_REFLECTION), %BM_GETCHECK, 0, 0)
FOR K = LBOUND(gSpriteArray) TO UboundSpriteData
IF INT_REFLECTION THEN
gSpriteArray(K).hBitmap = ZI_CreateMirrorBitmapFromFile(gSpriteArray(K).ImageName, bmW&, bmH&)
yOffset = 8
ELSE
gSpriteArray(K).hBitmap = ZI_CreateBitmapFromFile(gSpriteArray(K).ImageName, bmW&, bmH&)
yOffset = 0
END IF
gSpriteArray(K).ID = %ID_OBJECT_SPRITE + K
gSpriteArray(K).xPos = xLeft
gSpriteArray(K).yPos = 64
xLeft = xLeft + (64 + 32)
CALL ZD_DrawBitmapToCtrl(gCtrl, gSpriteArray(K).xPos, gSpriteArray(K).yPos, _
gSpriteArray(K).hBitmap, &HFFFFFFFF, gSpriteArray(K).ID, %ZS_VISIBLE)
gSpriteArray(K).scale = grScaleDefault
CALL ZD_SetObjectScale(gSpriteArray(K).ID, gSpriteArray(K).scale)
CALL ZD_UsePngOpacity(%ID_OBJECT_SPRITE + K, %TRUE)
CALL zSplitN(gSpriteArray(K).ImageName, "", sLabel)
CALL ZD_SetObjectImageLabel(%ID_OBJECT_SPRITE + K, Extract$(sLabel, "."))
NEXT
ARGB& = ZD_ColorARGB(128, RGB(255,255,255))
MarqueeMsg$ = "Left mouse button down to drag the icon, double click to perform selection ..."
FontToUse$ = "Times New Roman"
CALL ZD_DrawTextToCtrl(gCtrl, _
(MarqueeMsg$), _ ' The text to be displayed
rc.nRight, _ ' X coordinate
2, _ ' Y coordinate
ARGB&, _ ' ARGB color to use
(FontToUse$), _ ' The True Type Font to use (must be a valid one)
20, _ ' The font size in pixel
%ID_OBJECT_TEXT, _ ' The unique object ID
%ZS_VISIBLE, _ ' Overlay visible at startup
0, _ ' Optional shadow effect (offset in pixel)
0) ' Optional string format
CALL ZD_GetObjectBound(%ID_OBJECT_TEXT, gnMarqueeWidth, gnMarqueeHeight)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -