📄 textmenu.bas
字号:
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 + " ""Text 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 to default", %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 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(255,255,0))
CALL ZI_SetProperty(gCtrl, %ZI_GradientBottom, RGB(0,64,0))
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, bmW, bmH, yOffset, UboundSpriteData, hBitmap AS LONG
LOCAL sLabel AS STRING
LOCAL rc AS RECT
CALL GetClientRect(gCtrl, rc)
hBitmap = ZI_CreateBitmapFromFile("aero256x256.png", bmW, bmH)
CALL ZD_DrawBitmapToCtrl(gCtrl, (rc.nRight - bmW) \ 2, 40, hBitmap, &HFFFFFFFF, %ID_AERO, %ZS_VISIBLE)
CALL ZD_UsePngOpacity(%ID_AERO, %TRUE)
gSpriteArray(1).FontText = "Publisher"
gSpriteArray(2).FontText = "Word"
gSpriteArray(3).FontText = "Outlook"
gSpriteArray(4).FontText = "PowerPoint"
gSpriteArray(5).FontText = "Excel"
UboundSpriteData = UBOUND(gSpriteArray)
yOffset = -116
FOR K = LBOUND(gSpriteArray) TO UboundSpriteData
gSpriteArray(K).FontUseSize = 36
gSpriteArray(K).FontName = "Times New Roman"
gSpriteArray(K).FontUseARGB = ZD_ColorARGB(255, RGB(192,0,0))
gSpriteArray(K).FontUse3D = 0
gSpriteArray(K).hBitmap = ZD_CreateBitmapFromText(gSpriteArray(K).FontText, _
gSpriteArray(K).FontName, _
gSpriteArray(K).FontUseSize, _
gSpriteArray(K).FontUseARGB, _
gSpriteArray(K).FontUse3D, 0)
CALL ZI_GetBitmapSize(gSpriteArray(K).hBitmap, bmW, bmH)
gSpriteArray(K).ID = K
gSpriteArray(K).xPos = (rc.nRight - bmW) \ 2
gSpriteArray(K).yPos = ((rc.nBottom - bmH) \ 2) + yOffset
'yOffset
yOffset = yOffset + 36
CALL ZD_DrawTextBitmapToCtrl(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_SetObjectImageLabel(K, gSpriteArray(K).FontText)
NEXT
ARGB& = ZD_ColorARGB(255, RGB(127,210,94))
MarqueeMsg$ = "Left mouse button down to drag the text, double click to perform selection, right mouse button to edit the text."
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
1, _ ' Optional shadow effect (offset in pixel)
0) ' Optional string format
CALL ZD_GetObjectBound(%ID_OBJECT_TEXT, gnMarqueeWidth, gnMarqueeHeight)
ARGB& = ZD_ColorARGB(255, RGB(255,255,255))
CALL ZD_DrawTextToCtrl(gCtrl, _
"", _ ' The text to be displayed
rc.nRight, _ ' X coordinate
10, _ ' Y coordinate
ARGB&, _ ' ARGB color to use
(FontToUse$), _ ' The True Type Font to use (must be a valid one)
40, _ ' The font size in pixel
%ID_OBJECT_LABEL, _ ' The unique object ID
%ZS_VISIBLE, _ ' Overlay visible at startup
0, _ ' Optional shadow effect (offset in pixel)
0) ' Optional string format
END SUB
SUB DrawMarquee()
LOCAL x, y AS LONG
LOCAL rc AS RECt
CALL GetClientRect(gCtrl, rc)
CALL ZD_GetObjectXY(%ID_OBJECT_TEXT, x, y)
x = x - 2
IF x < -gnMarqueeWidth THEN x = rc.nRight
CALL ZD_SetObjectXY(%ID_OBJECT_TEXT, x, y, %ZD_DRAW_DEFERRED)
END SUB
SUB DrawSprites(BYVAL hWnd AS LONG)
REGISTER K AS LONG
LOCAL Angle AS SINGLE
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -