📄 eye.bas
字号:
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_OVERLAPPEDWINDOW
CALL SetRect(rc, 0, 0, 668, 532)
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 + " - ""EYE"" OpenGL demo"
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 "START"
CALL CreateWindowEx(0, "BUTTON", "START", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
672 - (7 + 120 + 8), 10, 120, 22, hMain, %ID_START_SHOW, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_START_SHOW), zDefaultFont)
CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_START_SHOW), %ANCHOR_RIGHT)
' Create button "STOP"
CALL CreateWindowEx(0, "BUTTON", "STOP", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
672 - (7 + 120 + 8), 10 + (22 + 5) * 1, 120, 22, hMain, %ID_STOP_SHOW, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_STOP_SHOW), zDefaultFont)
CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_STOP_SHOW), %ANCHOR_RIGHT)
' Create button "LOAD Image"
CALL CreateWindowEx(0, "BUTTON", "LOAD Image", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _
672 - (7 + 120 + 8), 10 + (22 + 5) * 2, 120, 22, hMain, %ID_NEW_IMAGE, zInstance, BYVAL %NULL)
CALL zSetCTLFont(GetDlgItem(hMain, %ID_NEW_IMAGE), zDefaultFont)
CALL ZI_SetAnchorMode(GetDlgItem(hMain, %ID_NEW_IMAGE), %ANCHOR_RIGHT)
' *******************************************************************************
' Alternate methode to create a GDImage OpenGL control
' Note: when GDImage is active the OpenGL $GLImageClassName is already registered
' -------------------------------------------------------------------------------
ClientXsize& = 512: ClientYsize& = 512
UseW& = ClientXsize& ' Use this to preserve the size
UseH& = ClientYsize& ' Use this to preserve the size
Style& = %WS_CHILD OR %WS_VISIBLE 'OR %WS_HSCROLL OR %WS_VSCROLL
StyleEx& = %WS_EX_STATICEDGE
CALL ZI_AdjustWindowRect(StyleEx&, UseW&, UseH&, Style&)
glWnd = CreateWindowEx(StyleEx&, _
$GLImageClassName, _ ' Make it an OpenGL control
"", _ ' Currently not used
Style&, _ ' window style
10, _ ' initial x position
10, _ ' 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
CALL ZI_SetAnchorMode(glWnd, %ANCHOR_HEIGHT_WIDTH) ' Anchor the control (make it a resizable)
' OpenGL section ' ----------------------------------------
' Load any of the supported GDImage graphic format to create a texture
IF ZI_SetGLTextureFromFile("eye.jpg") = 0 THEN ' There is no OpenGL error
ARGBcolor& = ZD_ColorARGB(255, RGB(255,255,255)) ' Use this color for the OpenGL background
CALL ZI_InitGLControl(ARGBcolor&) ' Initialyze the OpenGL parameters
' Use this if you want to create a zoom effect
'CALL ZI_SetGLzoom(glWnd, 100)
END IF
' Show the main window
CALL ShowWindow(hMain, iCmdShow)
CALL SetForegroundWindow(hMain) ' Slightly Higher Priority
CALL SetFocus(hMain) ' Sets Keyboard Focus To The Window
' *******************************************************
' This is a special message loop to render fast animation
' *******************************************************
WHILE Done = %FALSE ' Loop That Runs While done = %FALSE
IF PeekMessage(Msg, %NULL, 0, 0, %PM_REMOVE) THEN ' Is There A Message Waiting?
IF msg.message = %WM_QUIT THEN ' Have We Received A Quit Message?
Done = %TRUE ' If So done = %TRUE
ELSE ' If Not, Deal With Window Messages
'IF TranslateAccelerator(ghWnd, hAccel, Msg) = 0 THEN
CALL TranslateMessage(msg) ' Translate The Message
CALL DispatchMessage(msg) ' Dispatch The Message
'END IF
END IF
ELSE ' If there are no pending messages
IF Active THEN ' Draw The Scene.
IF Animate THEN
CALL DrawTheScene ' Draw the Scene (Don't draw when inactive 1% CPU Use)
IF IsZoomed(hMain) = 0 THEN CALL apisleep(1)
ELSEIF Animate = 0 THEN
CALL apisleep(10)
END IF
ELSE ' When minimized don't hog the CPU.
CALL apiSleep(100)
END IF
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
SUB DrawTheScene() ' See MSDN documentation for the use of the OpenGL API
STATIC xrot AS SINGLE, yrot AS SINGLE, zrot AS SINGLE
' Use this to perform a zoom at first start
'STATIC T???
'fovy& = ZI_GetGLzoom(glWnd)
'IF fovy& > 45 THEN
' IF T??? = 0 THEN T??? = T??? = TimeGetTime() + 200
' IF TimeGetTime() > T??? THEN
' CALL ZI_SetGLzoom(glWnd, fovy& - 1): CALL ZI_ResizeGLWindow(glWnd)
' T??? = TimeGetTime() + 50
' END IF
'END IF
CALL glClear(%GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT)
CALL glLoadIdentity()
CALL glTranslatef(0.0, 0.0, -5.0)
CALL glRotatef(xrot, 1.0, 0.0, 0.0) ' Rotate On The X Axis
CALL glRotatef(yrot, 0.0, 1.0, 0.0) ' Rotate On The Y Axis
CALL glRotatef(zrot, 0.0, 0.0, 1.0) ' Rotate On The Z Axis
CALL glBegin(%GL_QUADS)
' Front Face
CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f(-1.0,-1.0, 1.0) ' Bottom Left Of The Texture And Quad
CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f( 1.0,-1.0, 1.0) ' Bottom Right Of The Texture And Quad
CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f( 1.0, 1.0, 1.0) ' Top Right Of The Texture And Quad
CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f(-1.0, 1.0, 1.0) ' Top Left Of The Texture And Quad
' Back Face
CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f(-1.0,-1.0,-1.0) ' Bottom Right Of The Texture And Quad
CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f(-1.0, 1.0,-1.0) ' Top Right Of The Texture And Quad
CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f( 1.0, 1.0,-1.0) ' Top Left Of The Texture And Quad
CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f( 1.0,-1.0,-1.0) ' Bottom Left Of The Texture And Quad
' Top Face
CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f(-1.0, 1.0,-1.0) ' Top Left Of The Texture And Quad
CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f(-1.0, 1.0, 1.0) ' Bottom Left Of The Texture And Quad
CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f( 1.0, 1.0, 1.0) ' Bottom Right Of The Texture And Quad
CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f( 1.0, 1.0,-1.0) ' Top Right Of The Texture And Quad
' Bottom Face
CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f(-1.0,-1.0,-1.0) ' Top Right Of The Texture And Quad
CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f( 1.0,-1.0,-1.0) ' Top Left Of The Texture And Quad
CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f( 1.0,-1.0, 1.0) ' Bottom Left Of The Texture And Quad
CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f(-1.0,-1.0, 1.0) ' Bottom Right Of The Texture And Quad
' Right face
CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f( 1.0,-1.0,-1.0) ' Bottom Right Of The Texture And Quad
CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f( 1.0, 1.0,-1.0) ' Top Right Of The Texture And Quad
CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f( 1.0, 1.0, 1.0) ' Top Left Of The Texture And Quad
CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f( 1.0,-1.0, 1.0) ' Bottom Left Of The Texture And Quad
' Left Face
CALL glTexCoord2f(0.0, 0.0): CALL glVertex3f(-1.0,-1.0,-1.0) ' Bottom Left Of The Texture And Quad
CALL glTexCoord2f(1.0, 0.0): CALL glVertex3f(-1.0,-1.0, 1.0) ' Bottom Right Of The Texture And Quad
CALL glTexCoord2f(1.0, 1.0): CALL glVertex3f(-1.0, 1.0, 1.0) ' Top Right Of The Texture And Quad
CALL glTexCoord2f(0.0, 1.0): CALL glVertex3f(-1.0, 1.0,-1.0) ' Top Left Of The Texture And Quad
CALL glEnd()
xrot = xrot + 0.3 ' X Axis Rotation
yrot = yrot + 0.2 ' Y Axis Rotation
zrot = zrot + 0.4 ' Z Axis Rotation
CALL ZI_UpdateGLWindow(glWnd) ' Draw the scene
END SUB
FUNCTION WndProc(BYVAL hWin AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
LOCAL ps AS PAINTSTRUCT
LOCAL lp AS POINTAPI
STATIC wasX&, wasY&
SELECT CASE Msg&
CASE %WM_ACTIVATE ' Watch For Window Activate Message
IF HIWRD(wParam) = 0 THEN ' Check Minimization State
Active = 1 ' Program Is Active
ELSE ' Otherwise
Active = 0 ' Program Is No Longer Active
END IF
CASE %WM_SIZE
CALL ZI_ResizeGLWindow(glWnd)
CALL DrawTheScene()
CASE %WM_COMMAND
wP& = LOWRD(wParam&)
SELECT CASE LONG wP&
CASE %ID_START_SHOW
Animate = -1
CASE %ID_STOP_SHOW
Animate = 0
CASE %ID_NEW_IMAGE
FilName$ = ZI_LoadDialog(hWin&)
IF LEN(FilName$) THEN CALL ZI_SetGLTextureFromFile((FilName$))
END SELECT
CASE %WM_PAINT
CALL GradientPaint(hWin&, RGB(228,227,227), RGB(168,167,191))
FUNCTION = 0: EXIT FUNCTION
CASE %WM_DESTROY
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 + -