Code:
#PBFORMS CREATED V1.50
#COMPILE EXE
#DIM ALL
'------------------------------------------------------------------------------
' 3D Matrix Rotation by Wayne Hill - PB/Win 7.0
'------------------------------------------------------------------------------
' ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
%USEMACROS = 1
#IF NOT %DEF( %WINAPI )
#INCLUDE "WIN32API.INC"
#ENDIF
#IF NOT %DEF( %COMMCTRL_INC )
#INCLUDE "COMMCTRL.INC"
#ENDIF
#INCLUDE "PBForms.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%frm_dialog = 101
%cmd_draw = 102
%IDC_MSCTLS_TRACKBAR32_1 = 104
%IDC_MSCTLS_TRACKBAR32_2 = 105
%IDC_MSCTLS_TRACKBAR32_3 = 106
%IDC_LABEL1 = 107
%IDC_LABEL2 = 108
%IDC_LABEL3 = 109
%IDC_LABEL4 = 110
%IDC_LABEL5 = 111
%IDC_LABEL6 = 112
%IDC_MSCTLS_TRACKBAR32_4 = 113
%IDC_LABEL7 = 114
%IDC_LABEL8 = 115
%IDC_BUTTON1 = 116
%IDC_BUTTON2 = 117
%IDC_BUTTON3 = 118
%IDC_BUTTON4 = 119
%IDC_BUTTON5 = 120
%IDC_LABEL9 = 121
%IDC_LABEL10 = 122
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------
#INCLUDE "CCDraw.INC" 'CCDraw include file - See Below
'------------------------------------------------------------------------------
' ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION Showfrm_dialogProc( )
DECLARE FUNCTION Showfrm_dialog( BYVAL hParent AS DWORD ) AS LONG
DECLARE SUB SetTrackBars( hWnd AS LONG, X AS LONG, Y AS LONG, Z AS LONG )
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN( )
PBFormsInitComCtls( %ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR %ICC_INTERNET_CLASSES )
Showfrm_dialog %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION Showfrm_dialogProc( )
LOCAL hTrackX AS DWORD
LOCAL hTrackY AS DWORD
LOCAL hTrackZ AS DWORD
LOCAL hScale AS DWORD
LOCAL hZoom AS LONG
LOCAL rc AS RECT
SELECT CASE AS LONG CBMSG
CASE %WM_SIZE 'resize control if parent is resized
IF CBWPARAM <> %SIZE_MINIMIZED THEN
GETWINDOWRECT ghCCD, rc ' get control's coordinates on screen
MAPWINDOWPOINTS 0, CBHNDL, rc, 2 ' map result to dialog
SETWINDOWPOS ghCCD, 0, 0, 0, LOWRD( CBLPARAM ) - rc.nleft - 10, _ ' width
HIWRD( CBLPARAM ) - rc.nTop - 10, _ ' height
%SWP_NOMOVE OR %SWP_NOZORDER
INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD ' Redraw Window
END IF
CASE %WM_HSCROLL
CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_1 TO hTrackX
CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_2 TO hTrackY
CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_3 TO hTrackZ
CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_4 TO hScale
gXROT = SENDMESSAGE( hTrackX, %TBM_GETPOS, 0, 0 )
CONTROL SET TEXT CBHNDL, %IDC_LABEL1, STR$( gXROT )
gYROT = SENDMESSAGE( hTrackY, %TBM_GETPOS, 0, 0 )
CONTROL SET TEXT CBHNDL, %IDC_LABEL2, STR$( gYROT )
gZROT = SENDMESSAGE( hTrackZ, %TBM_GETPOS, 0, 0 )
CONTROL SET TEXT CBHNDL, %IDC_LABEL3, STR$( gZROT )
gMScale = SENDMESSAGE( hScale, %TBM_GETPOS, 0, 0 )
CONTROL SET TEXT CBHNDL, %IDC_LABEL8, STR$( gMScale ) + "%"
INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD ' Redraw Window
CASE %WM_INITDIALOG
CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_1 TO hTrackX
SENDMESSAGE hTrackX, %TBM_SETRANGE, %TRUE, MAKLNG( 0, 360 * 2 ) ' Set min. & max. positions
SENDMESSAGE hTrackX, %TBM_SETPOS, %TRUE, 360 ' Set current position
CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_2 TO hTrackY
SENDMESSAGE hTrackY, %TBM_SETRANGE, %TRUE, MAKLNG( 0, 360 * 2 ) ' Set min. & max. positions
SENDMESSAGE hTrackY, %TBM_SETPOS, %TRUE, 360 ' Set current position
CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_3 TO hTrackZ
SENDMESSAGE hTrackZ, %TBM_SETRANGE, %TRUE, MAKLNG( 0, 360 * 2 ) ' Set min. & max. positions
SENDMESSAGE hTrackZ, %TBM_SETPOS, %TRUE, 360 ' Set current position
CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_4 TO hScale
SENDMESSAGE hScale, %TBM_SETRANGE, %TRUE, MAKLNG( 1, 1500 ) ' Set min. & max. positions
SENDMESSAGE hScale, %TBM_SETPOS, %TRUE, 100 ' Set current position
gMScale = 100
INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD ' Redraw Window
CASE %WM_LBUTTONDOWN, %WM_LBUTTONDBLCLK 'start selrect draw
gMouseDownInParent = 1
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %CMD_draw
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
DIALOG END CBHNDL
END IF
CASE %IDC_BUTTON1
IF CBCTLMSG = %BN_CLICKED THEN
gXRot = 360 : gYRot = 360 : gZRot = 360
SetTrackBars( CBHNDL, 360, 360, 360 )
END IF
CASE %IDC_BUTTON2
IF CBCTLMSG = %BN_CLICKED THEN
gXRot = 270 : gYRot = 360 : gZRot = 360
SetTrackBars( CBHNDL, 270, 360, 360 )
END IF
CASE %IDC_BUTTON3
IF CBCTLMSG = %BN_CLICKED THEN
gXRot = 270 : gYRot = 360 : gZRot = 270
SetTrackBars( CBHNDL, 270, 360, 270 )
END IF
CASE %IDC_BUTTON4
IF CBCTLMSG = %BN_CLICKED THEN
gXRot = 310 : gYRot = 360 : gZRot = 225
SetTrackBars( CBHNDL, 310, 360, 225 )
END IF
CASE %IDC_BUTTON5
IF CBCTLMSG = %BN_CLICKED THEN
CONTROL HANDLE CBHNDL, %IDC_BUTTON5 TO hZoom
IF SENDMESSAGE( hZoom, %BM_GETCHECK, 0, 0 ) = %BST_CHECKED THEN
gZoomStatus = 1 'On
ELSE
gZoomStatus = 0 'Off
END IF
END IF
END SELECT
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION Showfrm_dialog( BYVAL hParent AS DWORD ) AS LONG
LOCAL lRslt AS LONG
#PBFORMS BEGIN DIALOG %frm_dialog->->
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "3D Matrix Rotation", 153, 51, 414, 357, %WS_POPUP _
OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
%WS_MAXIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_WINDOWEDGE _
OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD BUTTON, hDlg, %cmd_draw, "Exit", 355, 10, 44, 16
CONTROL ADD "msctls_trackbar32", hDlg, %IDC_MSCTLS_TRACKBAR32_1, _
"msctls_trackbar32_1", 25, 5, 305, 15, %WS_CHILD OR %WS_VISIBLE OR _
%TBS_HORZ OR %TBS_BOTTOM
CONTROL ADD "msctls_trackbar32", hDlg, %IDC_MSCTLS_TRACKBAR32_2, _
"msctls_trackbar32_2", 25, 20, 305, 15, %WS_CHILD OR %WS_VISIBLE OR _
%TBS_HORZ OR %TBS_BOTTOM
CONTROL ADD "msctls_trackbar32", hDlg, %IDC_MSCTLS_TRACKBAR32_3, _
"msctls_trackbar32_3", 25, 35, 305, 15, %WS_CHILD OR %WS_VISIBLE OR _
%TBS_HORZ OR %TBS_BOTTOM
CONTROL ADD "msctls_trackbar32", hDlg, %IDC_MSCTLS_TRACKBAR32_4, _
"msctls_trackbar32_4", 25, 50, 305, 15, %WS_CHILD OR %WS_VISIBLE OR _
%TBS_HORZ OR %TBS_BOTTOM
CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "360", 330, 5, 20, 10
CONTROL ADD LABEL, hDlg, %IDC_LABEL2, "360", 330, 20, 20, 10
CONTROL ADD LABEL, hDlg, %IDC_LABEL3, "360", 330, 35, 20, 10
CONTROL ADD LABEL, hDlg, %IDC_LABEL4, "X", 5, 5, 15, 10
CONTROL ADD LABEL, hDlg, %IDC_LABEL5, "Y", 5, 20, 15, 10
CONTROL ADD LABEL, hDlg, %IDC_LABEL6, "Z", 5, 35, 15, 10
CONTROL ADD LABEL, hDlg, %IDC_LABEL7, "Scale", 5, 50, 20, 10
CONTROL ADD LABEL, hDlg, %IDC_LABEL8, "100%", 330, 50, 30, 10
CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "XY", 10, 70, 20, 15
CONTROL ADD BUTTON, hDlg, %IDC_BUTTON2, "XZ", 35, 70, 20, 15
CONTROL ADD BUTTON, hDlg, %IDC_BUTTON3, "YZ", 60, 70, 20, 15
CONTROL ADD BUTTON, hDlg, %IDC_BUTTON4, "ISO", 85, 70, 20, 15
CONTROL ADD BUTTON, hDlg, %IDC_BUTTON5, "Zoom", 110, 70, 30, 15, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_TEXT OR _
%BS_DEFPUSHBUTTON OR %BS_PUSHLIKE OR %BS_AUTOCHECKBOX OR %BS_CENTER _
OR %BS_VCENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
DIALOG SEND hDlg, %DM_SETDEFID, %IDC_BUTTON5, 0
CONTROL ADD LABEL, hDlg, %IDC_LABEL9, "Label9", 155, 70, 55, 10
CONTROL ADD LABEL, hDlg, %IDC_LABEL10, "Label10", 215, 70, 50, 10
#PBFORMS END DIALOG
ghCCD = CreateCcd( hDlg, %ID_CCD, 10, 90, 80, 60, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP _
, %WS_EX_CLIENTEDGE )
DIALOG SHOW MODAL hDlg, CALL Showfrm_dialogProc TO lRslt
#PBFORMS BEGIN CLEANUP %frm_dialog
#PBFORMS END CLEANUP
FUNCTION = lRslt
END FUNCTION
SUB SetTrackBars( hWnd AS LONG, X AS LONG, Y AS LONG, Z AS LONG )
LOCAL hTrackX AS DWORD
LOCAL hTrackY AS DWORD
LOCAL hTrackZ AS DWORD
LOCAL hScale AS DWORD
CONTROL HANDLE hWnd, %IDC_MSCTLS_TRACKBAR32_1 TO hTrackX
CONTROL HANDLE hWnd, %IDC_MSCTLS_TRACKBAR32_2 TO hTrackY
CONTROL HANDLE hWnd, %IDC_MSCTLS_TRACKBAR32_3 TO hTrackZ
CONTROL HANDLE hWnd, %IDC_MSCTLS_TRACKBAR32_4 TO hScale
SENDMESSAGE hTrackX, %TBM_SETPOS, %TRUE, X
SENDMESSAGE hTrackY, %TBM_SETPOS, %TRUE, Y
SENDMESSAGE hTrackZ, %TBM_SETPOS, %TRUE, Z
SENDMESSAGE hScale, %TBM_SETPOS, %TRUE, 100
gMscale = 100
gFirstTime = %TRUE
CONTROL SET TEXT hWnd, %IDC_LABEL1, STR$( gXROT )
CONTROL SET TEXT hWnd, %IDC_LABEL2, STR$( gYROT )
CONTROL SET TEXT hWnd, %IDC_LABEL3, STR$( gZROT )
CONTROL SET TEXT hWnd, %IDC_LABEL8, STR$( gMscale )
INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD ' Redraw Window
END SUB
'
'
'
'
'
'--------------------------------------------------------------
' CCDraw.INC, PB/Win 7.0 Custom Control Draw, by Wayne Hill.
'--------------------------------------------------------------
GLOBAL gXROT AS DOUBLE
GLOBAL gYROT AS DOUBLE
GLOBAL gZROT AS DOUBLE
GLOBAL ghCCD AS LONG
GLOBAL gMScale AS LONG
GLOBAL gxGridZero AS LONG
GLOBAL gyGridZero AS LONG
GLOBAL gZoomStatus AS LONG
GLOBAL gPt AS POINTAPI, gRc AS RECT
GLOBAL gPrevPt AS POINTAPI
GLOBAL gMouseDownInParent AS LONG
GLOBAL gxOffset AS LONG, gYoffset AS LONG
GLOBAL gFirstTime AS LONG
'Equates
%ID_CCD = 150
DECLARE SUB Matrix( hWnd AS DWORD, X AS DOUBLE, Y AS DOUBLE, Z AS DOUBLE, Xpoint AS LONG, Xpoint AS LONG )
DECLARE FUNCTION CreateCCD( BYVAL hWnd AS LONG, BYVAL CtrlId AS LONG, _
BYVAL vLeft AS LONG, BYVAL vTop AS LONG, _
BYVAL vWidth AS LONG, BYVAL vHeight AS LONG, _
BYVAL wStyle AS LONG, BYVAL wStyleEx AS LONG ) AS LONG
DECLARE FUNCTION ctlWndProc( BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG ) AS LONG
DECLARE FUNCTION ccdPaint( BYVAL hWnd AS LONG, BYVAL wParam AS LONG ) AS LONG
DECLARE SUB DRAWCIRCLE( MemDC AS DWORD, hPen AS DWORD, fromX AS LONG, fromY AS LONG, ToX AS LONG, ToY AS LONG, radius AS LONG )
DECLARE SUB DRAWLINE( MemDC AS DWORD, hPen AS DWORD, fromX AS LONG, fromY AS LONG, ToX AS LONG, ToY AS LONG )
DECLARE SUB selRectBegin( BYVAL hWnd AS DWORD )
DECLARE SUB selRectDraw( BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG )
DECLARE SUB selRectEnd( BYVAL hWnd AS DWORD )
SUB Matrix( hWnd AS DWORD, X AS DOUBLE, Y AS DOUBLE, Z AS DOUBLE, Xpoint AS LONG, Ypoint AS LONG )
LOCAL XSIN AS DOUBLE, YSIN AS DOUBLE, ZSIN AS DOUBLE
LOCAL XCOS AS DOUBLE, YCOS AS DOUBLE, ZCOS AS DOUBLE
LOCAL RMX1 AS DOUBLE, RMX2 AS DOUBLE, RMY1 AS DOUBLE
LOCAL RMY2 AS DOUBLE, RMZ1 AS DOUBLE, RMZ2 AS DOUBLE
LOCAL D2R AS DOUBLE
LOCAL wRect AS RECT
D2R = 0.0174532925199433
XSIN = SIN( gXROT * D2R ) : YSIN = SIN( gYROT * D2R ) : ZSIN = SIN( gZROT * D2R )
XCOS = COS( gXROT * D2R ) : YCOS = COS( gYROT * D2R ) : ZCOS = COS( gZROT * D2R )
RMX1 = YCOS * ZCOS
RMY1 = - ZSIN * YCOS
RMZ1 = YSIN
RMX2 = ZCOS * - YSIN * - XSIN + ZSIN * XCOS
RMY2 = - ZSIN * - YSIN * - XSIN + ZCOS * XCOS
RMZ2 = YCOS * - XSIN
Xpoint = (( X * RMX1 ) + ( Y * RMY1 ) + ( Z * RMZ1 )) * gMScale
Ypoint = (( X * RMX2 ) + ( Y * RMY2 ) + ( Z * RMZ2 )) * gMScale
IF SGN( Ypoint ) THEN Ypoint = - Ypoint ' Mirror -X for Dialog inverse
GETCLIENTRECT hWnd, wRect
gxOffset = ( wRect.nRight / 2 ) + gxGridZero
gyOffset = ( wRect.nBottom / 2 ) + gyGridZero
Xpoint = Xpoint + gxOffset
Ypoint = Ypoint + gyOffset
END SUB
' Create control
FUNCTION CreateCCD( BYVAL hWnd AS LONG, BYVAL CtrlId AS LONG, _
BYVAL vLeft AS LONG, BYVAL vTop AS LONG, _
BYVAL vWidth AS LONG, BYVAL vHeight AS LONG, _
BYVAL wStyle AS LONG, BYVAL wStyleEx AS LONG ) AS LONG
LOCAL hCcd AS LONG
LOCAL wc AS WNDCLASSEX
LOCAL szClassName AS ASCIIZ * 20
szClassName = "CCDRAW"
IF GETCLASSINFOEX( GETMODULEHANDLE( BYVAL %NULL ), szClassName, wc ) = 0 THEN
wc.cbSize = SIZEOF( wc )
wc.style = %CS_DBLCLKS OR %CS_CLASSDC
wc.lpfnWndProc = CODEPTR( ctlWndProc )
wc.cbWndExtra = 4
wc.hInstance = GETMODULEHANDLE( BYVAL %NULL )
wc.hCursor = LOADCURSOR ( %NULL, BYVAL %IDC_CROSS )
wc.lpszClassName = VARPTR( szClassName )
REGISTERCLASSEX wc 'register new class
IF ERR THEN EXIT FUNCTION 'something bad
END IF
CONTROL ADD "CCDRAW", hWnd, CtrlId, "", vLeft, vTop, vWidth, vHeight, wStyle, wStyleEx
CONTROL HANDLE hWnd, CtrlId TO hCcd
gFirstTime = %TRUE
FUNCTION = hCcd 'return the handle
END FUNCTION
' Main Message Handling
FUNCTION ctlWndProc( BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG ) AS LONG
DIM HoldPos AS POINTAPI
LOCAL hDC AS LONG
SELECT CASE wMsg
CASE %WM_LBUTTONDOWN, %WM_LBUTTONDBLCLK 'start selrect draw
selRectBegin hWnd
gMouseDownInParent = 0
CASE %WM_MOUSEMOVE
IF gMouseDownInParent THEN EXIT FUNCTION
GETCURSORPOS HoldPos
SCREENTOCLIENT hWnd, HoldPos
CONTROL SET TEXT GETPARENT( hWnd ), %IDC_LABEL9, STR$( HoldPos.x )
CONTROL SET TEXT GETPARENT( hWnd ), %IDC_LABEL10, STR$( HoldPos.y )
IF ( wParam AND %MK_LBUTTON ) THEN 'if mouse button is down while moved, draw rect
selRectDraw hWnd, LOWRD( lParam ), HIWRD( lParam )
INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD ' Redraw Window
END IF
CASE %WM_LBUTTONUP 'mouse button released - end draw
selRectEnd hWnd
gMouseDownInParent = 0
CASE %WM_ERASEBKGND : FUNCTION = 1 ' Don't erase background
CASE %WM_PAINT : FUNCTION = ccdPaint( hWnd, wParam )
CASE %WM_DESTROY
hDc = GETDC( hWnd )
DELETEDC( hDC )
CASE ELSE : FUNCTION = DEFWINDOWPROC( hWnd, wMsg, wParam, lParam ) 'default message processing
END SELECT
END FUNCTION
' WM_PAINT message handler
FUNCTION ccdPaint( BYVAL hWnd AS LONG, BYVAL wParam AS LONG ) AS LONG
LOCAL wRect AS RECT
LOCAL hBrush AS LONG
LOCAL YellowPen AS DWORD
LOCAL RedPen AS DWORD
LOCAL BluePen AS DWORD
LOCAL GreenPen AS DWORD
LOCAL BrownPen AS DWORD
LOCAL GridLine AS DWORD
'Create Pens
RedPen = CREATEPEN( %PS_SOLID, 10, RGB( 255, 0, 0 ))
YellowPen = CREATEPEN( %PS_SOLID, 10, RGB( 255, 255, 0 ))
GreenPen = CREATEPEN( %PS_SOLID, 10, RGB( 150, 255, 100 ))
BluePen = CREATEPEN( %PS_SOLID, 10, RGB( 0, 0, 255 ))
BrownPen = CREATEPEN( %PS_SOLID, 10, RGB( 150, 100, 50 ))
GridLine = CREATEPEN( %PS_DOT, 0, RGB( 0, 0, 0 ))
LOCAL hDC AS LONG
DIM mpx AS LONG
DIM mpy AS LONG
DIM mpx2 AS LONG
DIM mpy2 AS LONG
DIM Axes AS DOUBLE
DIM Cage AS DOUBLE
DIM Helix AS DOUBLE
DIM I AS LONG
DIM X AS DOUBLE, Y AS DOUBLE, Z AS DOUBLE
'''''''''''''''''''''''''''''
LOCAL hDCmem AS LONG
LOCAL hbmMem AS LONG
LOCAL hbmOld AS LONG
LOCAL hPen AS LONG
Local PS As PAINTSTRUCT
CALL GETCLIENTRECT( hWnd, wRect )
hDc = BeginPaint hWnd, PS
hDCmem = CREATECOMPATIBLEDC( hdc ) ' Create off-screen DC
hbmMem = CREATECOMPATIBLEBITMAP( hdc, wRect.nRight, wRect.nBottom )
hbmOld = SELECTOBJECT( hDCmem, hbmMem )
FILLRECT hDCmem, wRect, GETSTOCKOBJECT( %WHITE_BRUSH ) 'Paint Background
SETBKMODE hDCmem, %TRANSPARENT
Helix = .875
' Draw Quad Helix
FOR i = 0 TO 360 STEP 10
X = COS( I * ( 3.14159 / 180 )) * ( Helix )
Y = SIN( I * ( 3.14159 / 180 )) * ( Helix )
Z = ( Helix * 2 ) * ( i / 360 ) - Helix
Matrix( hWnd, X, Y, Z, mpx, mpy )
CALL DRAWCIRCLE( hDCmem, RedPen, mpx, mpy, mpx, mpy, 3 )
X = COS(( I + 90 ) * ( 3.14159 / 180 )) * ( Helix )
Y = SIN(( I + 90 ) * ( 3.14159 / 180 )) * ( Helix )
Matrix( hWnd, X, Y, Z, mpx, mpy )
CALL DRAWCIRCLE( hDCmem, BluePen, mpx, mpy, mpx, mpy, 3 )
X = COS(( I + 180 ) * ( 3.14159 / 180 )) * ( Helix )
Y = SIN(( I + 180 ) * ( 3.14159 / 180 )) * ( Helix )
Matrix( hWnd, X, Y, Z, mpx, mpy )
CALL DRAWCIRCLE( hDCmem, GreenPen, mpx, mpy, mpx, mpy, 3 )
X = COS(( I + 270 ) * ( 3.14159 / 180 )) * ( Helix )
Y = SIN(( I + 270 ) * ( 3.14159 / 180 )) * ( Helix )
Matrix( hWnd, X, Y, Z, mpx, mpy )
CALL DRAWCIRCLE( hDCmem, YellowPen, mpx, mpy, mpx, mpy, 3 )
NEXT I
Cage = 1.0
' Draw cage
Matrix( hWnd, Cage, Cage, Cage, mpx, mpy )
Matrix( hWnd, - Cage, Cage, Cage, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
Matrix( hWnd, - Cage, - Cage, Cage, mpx, mpy )
CALL DRAWLINE( hDCmem, GridLine, mpx2, mpy2, mpx, mpy )
Matrix( hWnd, Cage, - Cage, Cage, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
Matrix( hWnd, Cage, Cage, Cage, mpx, mpy )
CALL DRAWLINE( hDCmem, GridLine, mpx2, mpy2, mpx, mpy )
Matrix( hWnd, Cage, Cage, - Cage, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
Matrix( hWnd, - Cage, Cage, - Cage, mpx, mpy )
CALL DRAWLINE( hDCmem, GridLine, mpx2, mpy2, mpx, mpy )
Matrix( hWnd, - Cage, - Cage, - Cage, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
Matrix( hWnd, Cage, - Cage, - Cage, mpx, mpy )
CALL DRAWLINE( hDCmem, GridLine, mpx2, mpy2, mpx, mpy )
Matrix( hWnd, Cage, - Cage, Cage, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
Matrix( hWnd, Cage, - Cage, - Cage, mpx, mpy )
Matrix( hWnd, Cage, Cage, - Cage, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
Matrix( hWnd, - Cage, Cage, - Cage, mpx, mpy )
Matrix( hWnd, - Cage, Cage, Cage, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
Matrix( hWnd, - Cage, - Cage, - Cage, mpx, mpy )
Matrix( hWnd, - Cage, - Cage, Cage, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
' Draw Axes
Axes = 1.25
Matrix( hWnd, - Axes, 0, 0, mpx, mpy )
Matrix( hWnd, Axes, 0, 0, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 ) ' X Axis
TEXTOUT hDCmem, mpx2, mpy2, "X", LEN( "X" )
Matrix( hWnd, 0, Axes, 0, mpx, mpy )
TEXTOUT hDCmem, mpx, mpy, "Y", LEN( "Y" )
Matrix( hWnd, 0, - Axes, 0, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 ) ' Y Axis
Matrix( hWnd, 0, 0, Axes, mpx, mpy )
TEXTOUT hDCmem, mpx, mpy, "Z", LEN( "Z" )
Matrix( hWnd, 0, 0, - Axes, mpx2, mpy2 )
CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 ) ' Z Axis
IF gZoomStatus THEN ' Paint Zoom Window as needed
hBrush = SELECTOBJECT( hDCmem, GETSTOCKOBJECT( %NULL_BRUSH )) 'for hollow rect
hPen = SELECTOBJECT( hDCmem, CREATEPEN( %PS_SOLID, 2, GETSYSCOLOR ( %COLOR_3DSHADOW ))) 'create pen
RECTANGLE hDCmem, gRc.nLeft, gRc.nTop, gRc.nRight + 1, gRc.nBottom + 1 'draw rect
DELETEOBJECT SELECTOBJECT( hDCmem, hPen ) 'Destroy hPen
DELETEOBJECT SELECTOBJECT( hDCmem, hBrush ) 'Destroy hBrush
END IF
' Copy Off-screen DC to Screen DC
BITBLT( hDC, wRect.nLeft, _
wRect.nTop, wRect.nRight - wRect.nLeft, _
wRect.nBottom - wRect.nTop, _
hDCmem, 0, 0, %SRCCOPY )
SELECTOBJECT( hDCmem, hbmOld )
DELETEOBJECT hbmMem
DELETEDC( hDCmem )
EndPaint hWnd, PS
'Destroy Pens
DELETEOBJECT RedPen
DELETEOBJECT YellowPen
DELETEOBJECT GreenPen
DELETEOBJECT BluePen
DELETEOBJECT BrownPen
DELETEOBJECT GridLine
END FUNCTION
SUB DRAWCIRCLE( MemDC AS DWORD, hPen AS DWORD, fromX AS LONG, fromY AS LONG, ToX AS LONG, ToY AS LONG, radius AS LONG )
SELECTOBJECT( MemDC, hPen ) 'Get Virtual Pen ready
ELLIPSE MemDC, fromX - radius, fromY - radius, ToX + radius, ToY + radius
END SUB
SUB DRAWLINE( MemDC AS DWORD, hPen AS DWORD, fromX AS LONG, fromY AS LONG, ToX AS LONG, ToY AS LONG )
DIM PrevPos AS POINTAPI
SELECTOBJECT( MemDC, hPen ) 'Get Virtual Pen ready
MOVETOEX MemDC, fromX, fromY, PrevPos 'Move Virtual Pen
LINETO MemDC, ToX, ToY 'Draw on Virual DC
MOVETOEX MemDC, PrevPos.x, PrevPos.y, PrevPos 'Return to previous postion
END SUB
SUB selRectBegin( BYVAL hWnd AS DWORD )
LOCAL rc AS RECT
SELECT CASE gZoomStatus
CASE 0
SETCAPTURE hWnd ' set capture to desired window
GETCLIENTRECT hWnd, rc ' get client size
MAPWINDOWPOINTS hWnd, 0, rc, 2 ' map client coordiantes to screen
CLIPCURSOR rc ' clip cursor to client coordinates
GETCURSORPOS gPt ' get cursor pos on screen
SCREENTOCLIENT hWnd, gPt ' convert to client coordinates
gPrevPt.x = gPt.x 'INI Mouse Point X-Y
gPrevPt.y = gPt.y
CASE 1
SETCAPTURE hWnd ' set capture to desired window
GETCLIENTRECT hWnd, rc ' get client size
MAPWINDOWPOINTS hWnd, 0, rc, 2 ' map client coordiantes to screen
CLIPCURSOR rc ' clip cursor to client coordinates
GETCURSORPOS gPt ' get cursor pos on screen
SCREENTOCLIENT hWnd, gPt ' convert to client coordinates
END SELECT
INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD ' Redraw Window
END SUB
SUB selRectDraw( BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG )
SELECT CASE gZoomStatus
CASE 0
GETCURSORPOS gPt ' get cursor pos on screen
SCREENTOCLIENT hWnd, gPt
gxGridZero = gxGridZero + ( gPt.X - gPrevPt.x )
gyGridZero = gyGridZero + ( gPt.Y - gPrevPt.Y ) '
gPrevPt.x = gPt.x ' Store Mouse Position X + Y
gPrevPt.y = gPt.y
CASE 1
' must make sure rect coordinates are correct,
' so right side always is larger than left, etc.
IF ( gPt.x < = x ) AND ( gPt.y > = y ) THEN
SETRECT gRc, gPt.x, y, x, gPt.y
ELSEIF ( gPt.x > x ) AND ( gPt.y > y ) THEN
SETRECT gRc, x, y, gPt.x, gPt.y
ELSEIF ( gPt.x > = x ) AND ( gPt.y < = y ) THEN
SETRECT gRc, x, gPt.y, gPt.x, y
ELSE
SETRECT gRc, gPt.x, gPt.y, x, y
END IF
IF gRc.nLeft = gRc.nRight THEN INCR gRc.nRight '<- ensure we never get a "null rect"
IF gRc.nTop = gRc.nBottom THEN INCR gRc.nBottom
' Let Virtual DC do rectangle draw
END SELECT
END SUB
SUB selRectEnd( BYVAL hWnd AS DWORD )
LOCAL rc AS RECT
DIM CenterBox AS POINTAPI
DIM CenterScreen AS POINTAPI
LOCAL xs AS DOUBLE, ys AS DOUBLE
LOCAL hScale AS LONG
LOCAL NewScale AS LONG
SELECT CASE gZoomStatus
CASE 0
RELEASECAPTURE
CLIPCURSOR BYVAL %NULL
CASE 1
RELEASECAPTURE
CLIPCURSOR BYVAL %NULL
GETCURSORPOS gPt ' get cursor pos on screen
SCREENTOCLIENT hWnd, gPt
GETCLIENTRECT hWnd, rc
CenterScreen.x = Rc.nRight / 2
CenterScreen.y = Rc.nBottom / 2
CenterBox.x = ( gRc.nRight + gRc.nLeft ) / 2
CenterBox.y = ( gRc.nBottom + gRc.nTop ) / 2
' Scale Drawing by ratio of ZoomBox to Screen size
xs = rc.nRight \ ( gRc.nRight - gRc.nLeft )
ys = rc.nBottom \ ( gRc.nBottom - gRc.nTop )
NewScale = MAX( xs, ys )
' Calculate the difference from GridZero
' and center of screen then offset scale by difference.
gxOffset = ( CenterScreen.x - CenterBox.x )
gYoffset = ( CenterScreen.y - CenterBox.y )
gxGridZero = gxGridZero + ( gxOffset * xs )
gyGridZero = gyGridZero + ( gYoffset * ys )
gMscale = gMscale * NewScale
CONTROL HANDLE GETPARENT( hWnd ), %IDC_MSCTLS_TRACKBAR32_4 TO hScale
SENDMESSAGE hScale, %TBM_SETPOS, %TRUE, gMscale
CONTROL SET CHECK GETPARENT( hWnd ), %IDC_BUTTON5, 0
gZoomStatus = 0
CONTROL SET TEXT GETPARENT( hWnd ), %IDC_LABEL8, STR$( gMscale )
gRc.nLeft = 0
gRc.nTop = 0
gRc.nRight = 0
gRc.nBottom = 0
INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD ' Redraw Window
END SELECT
END SUB