📄 gauge.bas
字号:
'
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_CAPTION OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN 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 + " ""Tachometer"" gauge control"
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 background", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
740 - (10 + 150 + 6), 10, 152, 22, hMain, %ID_NEW_IMAGE, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_NEW_IMAGE), zDefaultFont)
' Create button "Show Bitmap Overlay"
CALL CreateWindowEx(0, "BUTTON", "ANIMATE TACHOMETER", %WS_CHILD OR %WS_VISIBLE, _
740 - (10 + 150 + 6), 10 + (22 + 5)* 1, 152, 44, hMain, %ID_BTN_GAUGE, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_BTN_GAUGE), zDefaultFont)
' Velocity trackbar
Label$ = "Velocity 1..........................20"
CALL zStaticCenter(Label$, 740 - (10 + 150 + 6), 10 + (22 + 4)* 3, 152, 16, hMain, %ID_STATIC)
Style& = %WS_CHILD OR %WS_VISIBLE OR %TBS_BOTH OR %TBS_NOTICKS OR %WS_TABSTOP
hProgress& = CreateWindowEx(0, "msctls_trackbar32", "", Style&, 740 - (10 + 150 + 6), 10 + (22 + 4) * 3 + 16, 152, 16, hMain, %ID_TRACKBAR, zInstance, BYVAL %NULL)
CALL SendMessage(hProgress&, %TBM_SETRANGE, %TRUE, MAKLNG(1,20))
CALL SendMessage(hProgress&, %TBM_SETPAGESIZE, 0, 5)
' Set up default velocity
gVelocity = 4
CALL SendMessage(hProgress&, %TBM_SETPOS, %TRUE, gVelocity)
' Create button "Tiled background"
CALL CreateWindowEx(0, "BUTTON", "Tiled background ON/OFF", %WS_CHILD OR %WS_VISIBLE, _
740 - (10 + 150 + 6), 10 + (22 + 5)* 4 + 8, 152, 22, hMain, %ID_BACKGROUND, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_BACKGROUND), zDefaultFont)
' ******************************************************************************
' Helper function to create A GDImage control (with automatic scrollbar support)
' ------------------------------------------------------------------------------
gCtrl& = ZI_CreateWindow(hMain, 10, 10, 740 - (10 + 10 + 150 + 10 + 10), 550 - (10 * 2), %ID_CTRL)
' Use gradient for background
CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientTop, RGB(0,0,0))
CALL ZI_SetProperty(GetDlgItem(hMain, %ID_CTRL), %ZI_GradientBottom, RGB(64,64,64))
' ------------------------------------------------------------------------------
' Load the Tachometer gauge.
zFullPathname = "tachometer.png"
gTachoHandle = ZI_CreateBitmapFromFile(zFullPathname, imgW&, imgH&)
' Get the size of the GDImage control
CALL GetWindowRect(gCtrl&, rc)
rc.nRight = rc.nRight - rc.nLeft ' Width
rc.nBottom = rc.nBottom - rc.nTop ' Height
x& = MAX&((rc.nRight - imgW&) / 2, 0) ' X location
y& = MAX&((rc.nBottom - imgH&) / 2, 0) ' Y location
BlackARGB& = ZD_ColorARGB(255, 0)
CALL ZD_DrawBitmapToCtrl(gCtrl&, _ ' The GDImage control handle
x&, _ ' The X location
y&, _ ' The Y location
gTachoHandle, _ ' The Tachometer bitmap handle
BlackARGB&, _ ' The Alpha channel to set up translucency (RGB value is ignored)
%ID_BITMAP_TACHO, _ ' The unique object IDentifier
%ZS_HIDDEN) ' The object generic Style
' We load the Tachometer Needle
gUseAngle& = %DEGREE_MIN ' The gauge start angle
zFullPathname = "tachometer_needle.png"
Img& = ZI_CreateImageFromFile( _ ' Create a GDIPLUS image from file
zFullPathname, _ ' The qualified path
imgW&, _ ' Retrieve the image width
imgH&, _ ' Retrieve the image height
%TRUE, _ ' Boolean flag use TRUE to remove ARGBColorToRemove.
ZD_ColorARGB(255, %ZD_TRANSCOLOR)) '// The ARGBColorToRemove
' Render the needle rotation using the global gUseAngle
gTachoAngle = ZI_RenderRotationFromImageToBitmap( _
gTachoHandle, _ ' The GDimage Tachometer bitmap handle
Img&, _ ' The GDIPLUS rendering image handle
gUseAngle&, _ ' The needle angle to use in degree
%NEEDLE_ALPHA_VALUE) ' The needle alpha level (255 = Opaque)
CALL ZD_DrawBitmapToCtrl(gCtrl&, x&, y&, gTachoAngle, BlackARGB&, %ID_BITMAP_ANGLE, %ZS_VISIBLE)
' Delete the GDIPLUS Image Handle
CALL ZI_DeleteImageObject(Img&)
' Draw an ellipse to smooth the contour of the tachometer (antialias)
EllipseColor& = ZD_ColorARGB(255, RGB(32,32,32))
CALL ZD_DrawEllipseToCtrl(gCtrl&, _ ' The GDImage control handle
x& + 1, _ ' TopLeftX coordinate
y& + 2, _ ' TopLeftY coordinate
x& + imgW& - 5, _ ' BottomRightX coordinate
y& + imgH& - 4, _ ' BottomRightY coordinate
EllipseColor&, _ ' The ARGB color to use
5, _ ' Outline width
%ID_ELLIPSE, _ ' The unique object ID
%ZS_VISIBLE, _ ' Overlay visible at startup
%ZD_DRAW_OUTLINE, _ ' Drawing mode
0) ' Optional shadow effect (offset in pixel)
' ******************************************************************************
' Show the main window
CALL ShowWindow(hMain, iCmdShow)
CALL SetForegroundWindow(hMain) ' Slightly Higher Priority
CALL SetFocus(GetDlgItem(hMain, %ID_CTRL)) ' Sets Keyboard Focus To The Window
WHILE GetMessage(Msg, %NULL, 0, 0)
IF IsDialogMessage(hMain, Msg) = %FALSE THEN
CALL TranslateMessage(msg) ' Translate The Message
CALL DispatchMessage(msg) ' Dispatch The Message
END IF
WEND
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
FUNCTION WndProc(BYVAL hWin&, BYVAL Msg&, BYVAL wParam&, BYVAL lParam&) EXPORT AS LONG
LOCAL ps AS PAINTSTRUCT
LOCAL rc AS RECT
STATIC InProgress&
LOCAL zFullPathname AS ASCIIZ * %MAX_PATH
SELECT CASE Msg&
CASE %WM_CTLCOLORSTATIC
CALL SetBkMode(wParam&, %TRANSPARENT)
CASE %WM_HSCROLL
gVelocity = SendMessage(GetDlgItem(hWin&, %ID_TRACKBAR), %TBM_GetPos, 0, 0)
CASE %WM_COMMAND
wP& = LOWRD(wParam&)
SELECT CASE LONG wP&
CASE %ID_NEW_IMAGE
FilName$ = ZI_LoadDialog(hWin&)
CALL ZI_SetFromFile(GetDlgItem(hWin&, %ID_CTRL), (FilName$))
CASE %ID_BTN_GAUGE ' Draw BITMAP Overlay
' If animation still running, then bail out
IF InProgress& = 0 THEN
InProgress& = -1
LOCAL imgW AS LONG, imgH AS LONG, AngleDegree AS LONG
gCtrl& = GetDlgItem(hWin&, %ID_CTRL)
zFullPathname = "tachometer_needle.png"
BlackARGB& = ZD_ColorARGB(255, 0)
CALL ZD_SetObjectVisibility(%ID_BITMAP_TACHO, %True)
CALL ZD_SetObjectVisibility(%ID_BITMAP_ANGLE, %False)
Img& = ZI_CreateImageFromFile(zFullPathname, imgW&, imgH&, %True, ZD_ColorARGB(255, %ZD_TRANSCOLOR))
CALL GetWindowRect(gCtrl&, rc) '// Get the control size
rc.nRight = rc.nRight - rc.nLeft: rc.nBottom = rc.nBottom - rc.nTop
x& = Max&((rc.nRight - imgW&) / 2, 0)
y& = Max&((rc.nBottom - imgH&) / 2, 0)
BailOut& = 0
StepPlus& = gVelocity
StepMinus& = -gVelocity
FOR AngleDegree& = %DEGREE_MIN TO %DEGREE_MAX STEP StepPlus&
CALL ZI_RenderImageRotationToWindow(gCtrl&, Img&, x&, y&, AngleDegree&, %NEEDLE_ALPHA_VALUE)
IF ZD_DoEvents THEN Bailout& = -1: EXIT FOR
NEXT
IF Bailout& = 0 THEN
gUseAngle& = %DEGREE_MAX
CALL ZI_RenderImageRotationToWindow(gCtrl&, Img&, x&, y&, gUseAngle&, %NEEDLE_ALPHA_VALUE)
CALL apiSleep(500)
FOR AngleDegree& = %DEGREE_MAX TO %DEGREE_MIN STEP StepMinus&
CALL ZI_RenderImageRotationToWindow(gCtrl&, Img&, x&, y&, AngleDegree&, %NEEDLE_ALPHA_VALUE)
IF ZD_DoEvents THEN EXIT FOR
NEXT
gUseAngle& = %DEGREE_MIN
CALL ZI_RenderImageRotationToWindow(gCtrl&, Img&, x&, y&, gUseAngle&, %NEEDLE_ALPHA_VALUE)
END IF
CALL ZD_SetObjectVisibility(%ID_BITMAP_TACHO, %False)
gTachoAngle = ZI_RenderRotationFromImageToBitmap(gTachoHandle, Img&, gUseAngle&, %NEEDLE_ALPHA_VALUE)
CALL ZD_DrawBitmapToCtrl(gCtrl&, x&, y&, gTachoAngle, BlackARGB&, %ID_BITMAP_ANGLE, %ZS_VISIBLE)
CALL ZI_UpdateWindow(gCtrl&, %False) ' Refresh display
' Delete the GDIPLUS image Handle
CALL ZI_DeleteImageObject(Img&)
InProgress& = 0
END IF
CASE %ID_BACKGROUND
gCtrl& = GetDlgItem(hWin&, %ID_CTRL)
IF ZI_GetTiledBackground(gCtrl&) THEN
CALL ZI_SetTiledBackground(gCtrl&, 0)
ELSE ' Use a tiled bitmap
zFullPathname = "19a.jpg"
CALL ZI_SetTiledBackground(gCtrl&, ZI_CreateBitmapFromFile(zFullPathname, imgW&, imgH&))
END IF
CALL ZI_UpdateWindow(gCtrl&, %False) ' Refresh display
END SELECT
CASE %WM_PAINT
CALL GradientPaint(hWin&, RGB(228,227,227), RGB(168,167,191))
FUNCTION = 0: EXIT FUNCTION
CASE %WM_DESTROY
IF gTachoHandle THEN CALL DeleteObject(gTachoHandle)
IF gTachoAngle THEN CALL DeleteObject(gTachoAngle)
CALL PostQuitMessage(0)
FUNCTION = 0: EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWin&, Msg&, wParam&, lParam&)
END FUNCTION
SUB GradientPaint(BYVAL hWin&, BYVAL TopRGB&, BYVAL BottomRGB&)
LOCAL ps AS PAINTSTRUCT
LOCAL rc AS RECT
' Tile the background
CALL GetClientRect (hWin&, rc)
hDC& = BeginPaint(hWin&, ps)
CALL ZI_GradientPaintDC(hDC&, 0, 0, rc.nRight, rc.nBottom, TopRGB&, BottomRGB&)
CALL EndPaint(hWin&, ps)
END SUB
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -