📄 control.bas
字号:
' Warning each overlay object must have a unique identifier
%ID_TEXT_HELL0 = 1 ' Text overlay
%ID_TEXT_GREAT = 2 ' Text overlay
%ID_TEXT_WATERMARK = 3 ' Text overlay
%ID_RECT_1 = 4 ' Rectangle overlay
' WinXP Theme support declares (if applicable)
DECLARE FUNCTION EnableDialogTheme(BYVAL hDlg AS DWORD, BYVAL dwStyle AS DWORD) AS LONG
DECLARE FUNCTION IsThemeActive() AS LONG
GLOBAL ghRegion AS LONG, ghLayered AS LONG
FUNCTION zDefaultFont() AS LONG
STATIC hDefault&
IF hDefault& = 0 THEN hDefault& = GetStockObject(%ANSI_VAR_FONT)
FUNCTION = hDefault&
END FUNCTION
SUB zSetCTLFont(BYVAL hCTRL&, BYVAL hFont&)
CALL SendMessage(hCTRL&, %WM_SETFONT, hFont&, 0)
END SUB
FUNCTION WinMain (BYVAL hInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
BYVAL lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
LOCAL Msg AS tagMsg
LOCAL wc AS WndClassEx
LOCAL zClass AS ASCIIZ * 80
LOCAL dwExStyle AS DWORD
LOCAL dwStyle AS DWORD
LOCAL rc AS RECT
LOCAL x AS LONG
LOCAL y AS LONG
LOCAL Done AS LONG
LOCAL hMutex AS DWORD
LOCAL hFound AS DWORD
LOCAL hMain AS LONG
LOCAL hBitmap AS LONG
LOCAL hImage AS LONG
LOCAL bmW AS LONG
LOCAL bmH AS LONG
'
LOCAl hWinXP_Lib AS LONG ' Handle to WinXP Theme DLL
LOCAL hWinXP_IsThemeActive AS LONG ' Handle to WinXP's IsThemeActive function
'
zClass = "ZMAIN"
'
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_CLIPSIBLINGS OR %WS_CLIPCHILDREN OR %WS_CAPTION OR _
%WS_SYSMENU ' OR %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX
'
CALL SetRect(rc, 0, 0, 740, 550)
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 control " + ZI_Version
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 "Load Image"
CALL CreateWindowEx(0, "BUTTON", "Load Image", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
740 - (10 + 150 + 6), 10 + 150 + 10, 152, 22, hMain, %ID_NEWIMAGE, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_NEWIMAGE), zDefaultFont)
' Create button "Save Image AS"
CALL CreateWindowEx(0, "BUTTON", "Save Image AS", %WS_CHILD OR %WS_VISIBLE, _
740 - (10 + 150 + 6), 10 + 150 + 10 + (22 + 5)* 1, 152, 22, hMain, %ID_SAVE, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_SAVE), zDefaultFont)
' Create button "Copy to clipboard"
CALL CreateWindowEx(0, "BUTTON", "Copy to clipboard", %WS_CHILD OR %WS_VISIBLE, _
740 - (10 + 150 + 6), 10 + 150 + 10 + (22 + 5)* 2, 152, 22, hMain, %ID_COPY, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_COPY), zDefaultFont)
' Create button "Paste from clipboard"
CALL CreateWindowEx(0, "BUTTON", "Paste from clipboard", %WS_CHILD OR %WS_VISIBLE, _
740 - (10 + 150 + 6), 10 + 150 + 10 + (22 + 5)* 3, 152, 22, hMain, %ID_PASTE, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_PASTE), zDefaultFont)
' Create button "Show/Hide popup region"
CALL CreateWindowEx(0, "BUTTON", "Show/Hide popup region", %WS_CHILD OR %WS_VISIBLE, _
740 - (10 + 150 + 6), 10 + 150 + 10 + (22 + 5)* 4, 152, 22, hMain, %ID_REGION, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_REGION), zDefaultFont)
' Create button "Show/Hide watermark"
CALL CreateWindowEx(0, "BUTTON", "Show/Hide watermark", %WS_CHILD OR %WS_VISIBLE, _
740 - (10 + 150 + 6), 10 + 150 + 10 + (22 + 5)* 5, 152, 22, hMain, %ID_WATERMARK, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_WATERMARK), zDefaultFont)
' Create button "Show/Hide layered window"
CALL CreateWindowEx(0, "BUTTON", "Show/Hide LayeredWindow", %WS_CHILD OR %WS_VISIBLE, _
740 - (10 + 150 + 6), 10 + 150 + 10 + (22 + 5)* 6, 152, 22, hMain, %ID_LAYERED, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_LAYERED), zDefaultFont)
' Create button "Show/Hide 3DIN rectangle"
CALL CreateWindowEx(0, "BUTTON", "Show/Hide 3DIN rectangle", %WS_CHILD OR %WS_VISIBLE, _
740 - (10 + 150 + 6), 10 + 150 + 10 + (22 + 5)* 7, 152, 22, hMain, %ID_RECTANGLE, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_RECTANGLE), zDefaultFont)
' Create button "Animate Text"
CALL CreateWindowEx(0, "BUTTON", "Animate Text", %WS_CHILD OR %WS_VISIBLE, _
740 - (10 + 150 + 6), 10 + 150 + 10 + (22 + 5)* 8, 152, 22, hMain, %ID_ANIMATETEXT, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_ANIMATETEXT), zDefaultFont)
' ******************************************************************************
' Helper function to create A GDImage control (with automatic scrollbar support)
' ------------------------------------------------------------------------------
CALL ZI_CreateWindow(hMain, 10, 10, 740 - (10 + 10 + 150 + 10 + 10), 550 - (10 * 2), %ID_CTRL)
CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientTop, &hFFFFFF)'RGB(0,32,64))
CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientBottom, &hFFFFFF)'RGB(0,128,200))
CALL ZI_SetFromFile(GetDlgItem(hMain, %ID_CTRL), "avalon.jpg")
' ******************************************************************************
' ******************************************************************************
' Alternate methode to create a GDImage control
' ------------------------------------------------------------------------------
Style& = %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER
StyleEx& = 0 ' %WS_EX_STATICEDGE
CALL CreateWindowEx(StyleEx&, _
"ZIMAGECTRL", _ ' GDImage class name
"", _ ' Optional full path name to picture
Style&, _ ' window style
740 - (10 + 150 + 6), _ ' initial x position
10, _ ' initial y position
150, _ ' Calculate Window Width
150, _ ' Calculate Window Height
hMain, _ ' parent window handle
%ID_THUMBCTRL, _ ' ControlID
zInstance, _ ' program instance handle
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -