' Windows Hello World
' with winmain message loop and wndproc
' Revised 22 Jun 2009
' Charles Pegge
basic
type WNDCLASS
;40 bytes
STYLE as long
lpfnwndproc as long
cbClsextra as long
cbWndExtra as long
hInstance as long
hIcon as long
hCursor as long
hbrBackground as long
lpszMenuName as long
lpszClassName as long
end type
type point
x as long
y as long
end type
type MSG
; 28 bytes
hwnd as long
message as long
wParam as long
lParam as long
time as long
pt as point
end type
dim kernel32,user32,GDI32 as long
kernel32=LoadLibrary `kernel32.dll`
user32=LoadLibrary `user32.dll`
GDI32=LoadLibrary `GDI32.dll`
bind kernel32
(
GetCommandLine GetCommandLineA ; @0
GetModuleHandle GetModuleHandleA ; @4
ExitProcess ExitProcess ; @4
)
bind user32
(
LoadIcon LoadIconA ; @8
LoadCursor LoadCursorA ; @8
RegisterClass RegisterClassA ; @4
MessageBox MessageBoxA ; @4
CreateWindowEx CreateWindowExA ; @48
ShowWindow ShowWindow ; @8
UpdateWindow UpdateWindow ; @4
GetMessage GetMessageA ; @16
TranslateMessage TranslateMessage ; @4
DispatchMessage DispatchMessageA ; @4
PostQuitMessage PostQuitMessage ; @4
BeginPaint BeginPaint ; @8
EndPaint EndPaint ; @8
GetClientRect GetClientRect ; @8
DrawText DrawTextA ; @20
PostMessage PostMessageA ; @16
DefWindowProc DefWindowProcA ; @16
)
bind GDI32
(
GetStockObject GetStockObject ; @4
)
declare Function WinMain(byval inst as long ,byval prevInst as long ,byval cmdline as asciiz , byval show as long) as long
declare function WndProc(byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long
'
def SW_NORMAL 1
def SW_SHOWDEFAULT 10
;=====================================
dim byref cmdline as asciiz,inst as long
&cmdline=GetCommandLine
inst=GetModuleHandle 0
'print cmdline `
'` hex inst
WinMain inst,0,cmdline,SW_NORMAL
'
ExitProcess
freelibrary kernel32
freelibrary user32
freelibrary gdi32
terminate
'o2 !10 ; align 16 bytes
;=====================================
% CS_VREDRAW 1
% CS_HREDRAW 2
% IDI_APPLICATION 32512
% IDC_ARROW 32512
% WHITE_BRUSH 0
% MB_ICONERROR 16
def CW_USEDEFAULT 0x80000000
def WS_OVERLAPPEDWINDOW 0x00cf0000
'------------------------------------------------------------
Function WinMain(byval inst as long ,byval prevInst as long,
byval cmdline as asciiz , byval show as long) as long
'===========================================================
'
; window handle
dim a,b,c,hWnd as long
dim wc as WndClass
dim wm as MSG
with wc. '
style=CS_HREDRAW or CS_VREDRAW
lpfnWndProc=&WndProc '#long#long#long#long
cbClsExtra=0
cbWndExtra=0
hInstance=inst
hIcon=LoadIcon 0, IDI_APPLICATION
hCursor=LoadCursor 0,IDC_ARROW
hbrBackground=GetStockObject WHITE_BRUSH '
lpszMenuName=0
#view
lpszClassName=`HelloWin`
#endv
end with
if not RegisterClass &wc
MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
exit function
end if '
hWnd=CreateWindowEx 0,wc.lpszClassName,`Hello Window`,
WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT,CW_USEDEFAULT,640,480,
0,0,inst,0
if not hWnd then
MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
exit function
end if
'
ShowWindow hWnd,show
UpdateWindow hWnd
;
;MESSAGE LOOP
;
do while GetMessage &wm,0,0,0
TranslateMessage &wm
DispatchMessage &wm
'
'select wm.hwnd
'case hwnd
' if wm.message=256 then print `key down` : exit do
'end select
'
wend
;
function=wm.wparam
end function ; end of WinMain
type RECT
; 16 bytes
left as long
top as long
right as long
bottom as long
end type
type rgbacolor
red as byte
green as byte
blue as byte
alpha as byte
end type
type PAINTSTRUCT
; 64 bytes
hDC as long
fErase as long
rcPaint as rect
fRestore as long
fIncUpdate as long
rgb as rgbacolor
Reserved as 32
end type
% WM_CREATE 1
% WM_DESTROY 2
% WM_PAINT 15
% WM_CLOSE 16
% WM_KEYDOWN 256
'-----------------------------------------
function WndProc ( byval hWnd as long,
byval wMsg as long, byval wParam as long,
byval lparam as long ) as long callback
'=========================================
dim cRect as rect
dim Paintst as paintstruct
dim hDC as long
select wMsg
'--------------
case WM_CREATE
'=============
'--------------
case WM_DESTROY
'===============
PostQuitMessage 0
'------------
case WM_PAINT
'============
hDC=BeginPaint hWnd,&Paintst
GetClientRect hWnd,&cRect
; style
; 0x20 DT_SINGLELINE
; 0x04 DT_VCENTER
; 0x01 DT_CENTER
; 0x25
DrawText hDC,`Hello World!`,-1,&cRect,0x25
EndPaint hWnd,&Paintst
'--------------
case WM_KEYDOWN
'==============
if wParam=27 then
PostMessage hWnd,WM_CLOSE,0,0
end if
'--------
case else
'========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
end function ' WndProc
' OPENGL /WINDOWS API Example
' Revised 9 July 2010
' Charles Pegge
#basic
'#file `PortViewer.exe`
/*
Window size wWidth wHeight
Active view:
0 = none
1 = upper left
2 = upper right
3 = lower left
4 = lower right
*/
'SELECT WHICH HEADERS TO USE
'#def TBheaders
'#def JRheaders
#def CHheaders
#ifdef TBheaders
include Win32Api.inc
def included include once `%%APP_INCLUDEPATH%%\thinbasic_%1.inc`
'included gl
'included glext
included glu
included wgl
#endif
#ifdef JRheaders
includepath "gl\"
'include once "opengl32.inc"
include once "gl.inc"
include once "glu.inc"
include once "wglext.inc"
include once "thinbasic_wgl.inc"
includepath ""
#endif
#ifdef CHheaders
#define WINGDIAPI
#define APIENTRY
#define const
typedef word wchar_t
typedef sys ptrdiff_t
includepath ""
library "opengl32.dll"
include once "gl\gl.h"
'include once "gl\glext.h"
library "glu32.dll"
include once "gl\glu.h"
include once "gl\thinbasic_wgl.inc"
library ""
#endif
'////////////////////
type WNDCLASS
;40 bytes
STYLE as long
lpfnwndproc as long
cbClsextra as long
cbWndExtra as long
hInstance as long
hIcon as long
hCursor as long
hbrBackground as long
lpszMenuName as long
lpszClassName as long
end type
type point
x as long
y as long
end type
type MSG
; 28 bytes
hwnd as long
message as long
wParam as long
lParam as long
time as long
pt as point
end type
'
#define SW_NORMAL 1
% SW_SHOWDEFAULT 10
% CS_VREDRAW 1
% CS_HREDRAW 2
% IDI_APPLICATION 32512
% IDC_ARROW 32512
% WHITE_BRUSH 0
% MB_ICONERROR 16
% CW_USEDEFAULT &h80000000
% WS_OVERLAPPEDWINDOW &h00cf0000
type RECT
; 16 bytes
nleft as long
ntop as long
nright as long
nbottom as long
end type
type rgbacolor
red as byte
green as byte
blue as byte
alpha as byte
end type
type PAINTSTRUCT
; 64 bytes
hDC as long
fErase as long
rcPaint as rect
fRestore as long
fIncUpdate as long
rgb as rgbacolor
Reserved as 32
end type
% NULL 0
% FALSE 0
% TRUE -1
% WM_ACTIVATE 0
% WM_CREATE 1
% WM_DESTROY 2
% WM_MOVE 3
% WM_SIZE 5
% WM_SETFOCUS 7
% WM_KILLFOCUS 8
% WM_PAINT 15
% WM_CLOSE 16
% WM_ERASEBKGND 20
%WM_KEYDOWN = &H100
%WM_KEYUP = &H101
%WM_CHAR = &H102
%WM_DEADCHAR = &H103
%WM_SYSKEYDOWN = &H104
%WM_SYSKEYUP = &H105
%WM_SYSCHAR = &H106
%WM_SYSDEADCHAR = &H107
%WM_UNICHAR = &H109
%WM_TIMER = &H113
%WM_HSCROLL = &H114
%WM_VSCROLL = &H115
%WM_MOUSEMOVE = &H200
%WM_LBUTTONDOWN = &H201
%WM_LBUTTONUP = &H202
%WM_LBUTTONDBLCLK = &H203
%WM_RBUTTONDOWN = &H204
%WM_RBUTTONUP = &H205
%WM_RBUTTONDBLCLK = &H206
%WM_MBUTTONDOWN = &H207
%WM_MBUTTONUP = &H208
%WM_MBUTTONDBLCLK = &H209
%WM_MOUSEWHEEL = &H20A
TYPE PIXELFORMATDESCRIPTOR
nSize AS WORD
nVersion AS WORD
dwFlags AS DWORD
iPixelType AS BYTE
cColorBits AS BYTE
cRedBits AS BYTE
cRedShift AS BYTE
cGreenBits AS BYTE
cGreenShift AS BYTE
cBlueBits AS BYTE
cBlueShift AS BYTE
cAlphaBits AS BYTE
cAlphaShift AS BYTE
cAccumBits AS BYTE
cAccumRedBits AS BYTE
cAccumGreenBits AS BYTE
cAccumBlueBits AS BYTE
cAccumAlphaBits AS BYTE
cDepthBits AS BYTE
cStencilBits AS BYTE
cAuxBuffers AS BYTE
iLayerType AS BYTE
bReserved AS BYTE
dwLayerMask AS DWORD
dwVisibleMask AS DWORD
dwDamageMask AS DWORD
END TYPE
' PIXELFORMATDESCRIPTOR flags
%PFD_TYPE_RGBA = 0
%PFD_TYPE_COLORINDEX = 1
%PFD_MAIN_PLANE = 0
%PFD_OVERLAY_PLANE = 1
%PFD_UNDERLAY_PLANE =-1
'
%PFD_DOUBLEBUFFER = &H00000001
%PFD_STEREO = &H00000002
%PFD_DRAW_TO_WINDOW = &H00000004
%PFD_DRAW_TO_BITMAP = &H00000008
%PFD_SUPPORT_GDI = &H00000010
%PFD_SUPPORT_OPENGL = &H00000020
%PFD_GENERIC_FORMAT = &H00000040
%PFD_NEED_PALETTE = &H00000080
%PFD_NEED_SYSTEM_PALETTE = &H00000100
%PFD_SWAP_EXCHANGE = &H00000200
%PFD_SWAP_COPY = &H00000400
%PFD_SWAP_LAYER_BUFFERS = &H00000800
%PFD_GENERIC_ACCELERATED = &H00001000
%PFD_SUPPORT_DIRECTDRAW = &H00002000
' PIXELFORMATDESCRIPTOR flags for use in ChoosePixelFormat only
%PFD_DEPTH_DONTCARE = &H20000000
%PFD_DOUBLEBUFFER_DONTCARE = &H40000000
%PFD_STEREO_DONTCARE = &H80000000
' Font Weights
%FW_DONTCARE = 0
%FW_THIN = 100
%FW_EXTRALIGHT = 200
%FW_LIGHT = 300
%FW_NORMAL = 400
%FW_MEDIUM = 500
%FW_SEMIBOLD = 600
%FW_BOLD = 700
%FW_EXTRABOLD = 800
%FW_HEAVY = 900
%DEFAULT_QUALITY = 0
%DRAFT_QUALITY = 1
%PROOF_QUALITY = 2
%NONANTIALIASED_QUALITY = 3
%ANTIALIASED_QUALITY = 4
%ANSI_CHARSET = 0
%DEFAULT_CHARSET = 1
%SYMBOL_CHARSET = 2
%OUT_TT_PRECIS = 4
%CLIP_DEFAULT_PRECIS = 0
%DEFAULT_PITCH = 0
%FIXED_PITCH = 1
%VARIABLE_PITCH = 2
%MONO_FONT = 8
' Font Families
'
%FF_DONTCARE = 0 ' Don't care or don't know.
%FF_ROMAN = 16 ' Variable stroke width, serifed.
' Times Roman, Century Schoolbook, etc.
%FF_SWISS = 32 ' Variable stroke width, sans-serifed.
' Helvetica, Swiss, etc.
%FF_MODERN = 48 ' Constant stroke width, serifed or sans-serifed.
' Pica, Elite, Courier, etc.
%FF_SCRIPT = 64 ' Cursive, etc.
%FF_DECORATIVE = 80 ' Old English, etc.
%LF_FACESIZE = 32
TYPE LOGFONT
lfHeight AS LONG
lfWidth AS LONG
lfEscapement AS LONG
lfOrientation AS LONG
lfWeight AS LONG
lfItalic AS BYTE
lfUnderline AS BYTE
lfStrikeOut AS BYTE
lfCharSet AS BYTE
lfOutPrecision AS BYTE
lfClipPrecision AS BYTE
lfQuality AS BYTE
lfPitchAndFamily AS BYTE
lfFaceName AS 32
END TYPE
dim kernel32,user32,GDI32 as long
kernel32=LoadLibrary `kernel32.dll`
user32=LoadLibrary `user32.dll`
GDI32=LoadLibrary `GDI32.dll`
bind kernel32
(
GetExitCodeProcess GetExitCodeProcess ; @8
ExitProcess ExitProcess ; @4
GetCommandLine GetCommandLineA ; @0
GetModuleHandle GetModuleHandleA ; @4
QueryPerformanceCounter QueryPerformanceCounter ; @4
)
bind user32
(
LoadIcon LoadIconA ; @8
LoadCursor LoadCursorA ; @8
RegisterClass RegisterClassA ; @4
MessageBox MessageBoxA ; @4
CreateWindowEx CreateWindowExA ; @48
ShowWindow ShowWindow ; @8
UpdateWindow UpdateWindow ; @4
GetMessage GetMessageA ; @16
TranslateMessage TranslateMessage ; @4
DispatchMessage DispatchMessageA ; @4
PostQuitMessage PostQuitMessage ; @4
BeginPaint BeginPaint ; @8
EndPaint EndPaint ; @8
GetClientRect GetClientRect ; @8
DrawText DrawTextA ; @20
PostMessage PostMessageA ; @16
DefWindowProc DefWindowProcA ; @16
FillRect FillRect
GetDC GetDC ; @4
ReleaseDC ReleaseDC
SetTimer SetTimer
KillTimer KillTimer
)
bind GDI32
(
GetStockObject GetStockObject ; @4
CreateSolidBrush CreateSolidBrush ; @4
ChoosePixelFormat ChoosePixelFormat
SetPixelFormat SetPixelFormat
CreateFontIndirect CreateFontIndirectA
SelectObject SelectObject
DeleteObject DeleteObject
SwapBuffers SwapBuffers
)
function hiwrd (byval a as long) as long
shr a,16 : function=a
end function
function lowrd(byval a as long) as long
and a,&hffff : function=a
end function
function min(byval a as long, byval b as long) as long
if a<=b then function=a else function=b
end function
function max(byval a as long, byval b as long) as long
if a>=b then function=a else function=b
end function
function minmax(byval a as long, byval b as long, byval c as long) as long
if b<=a then b=a
if b>=c then b=c
function=b
end function
function rgb(byval r as long, byval g as long, byval b as long) as long
r=minmax 0,r,255
g=minmax 0,g,255
b=minmax 0,b,255
function=r+g*256+b*65536
end function
'////////////////////
dim a
dim gmf(256) AS GLYPHMETRICSFLOAT
dim as quad
'
'TIMING
'
grtic1,grtic2,freq
dim as double
'
'TIMING
'
fps,grlap
dim as long
'
'STATE VARIABLES
'
refresh,bselect,kselect,keyd,cha,ReqShutDown,
bLeft,bMid,bRight,bWheel,
wWidth,wHeight,
'
'GL CONTEXT
'
hDC,hRC,
'
shadows,shadowable,
antialias, multisampling,
nPixelFormat,ReqNewMode,arbMultisampleFormat,
arbMultisampleSupported,
'
'TIMING
'
timerval, doredraw,
'
'POSITIONAL
'
xpos, ypos,
sposx,sposy,mposx,mposy,eposx,eposy,
'
'Rotation around each axis
'
rot_x, rot_y, rot_z,
active_view
'====================================================================
' DrawTorus() - Draw a solid torus (use a display list for the model)
'====================================================================
sub DrawTorus
static as double
twopi = pi()*2,
torus_major = 1.5,
torus_minor = 0.5,
torus_major_res= 32,
torus_minor_res= 32
static as long
torus_list, i,j,k
static as single
a, b, s, t, x, y, z, nx, ny, nz, gscale,tmc,tmd,tme
if not torus_list
'
'Record the Torus plot list
'--------------------------
'
torus_list = glGenLists 1
glNewList( torus_list, GL_COMPILE_AND_EXECUTE )
'
'Draw the torus
'
for i = 0 TO TORUS_MINOR_RES-1
'
glBegin GL_QUAD_STRIP
'
for j = 0 TO TORUS_MAJOR_RES
'
for k = 1 TO 0 STEP -1
'
s = mod( i+k,TORUS_MINOR_RES + 0.5)
t = mod(j,TORUS_MAJOR_RES)
'
'CALCULATE POINT ON SURFACE
'--------------------------
'
tmd=s*twopi/TORUS_MINOR_RES
tme=t*twopi/TORUS_MAJOR_RES
tmc=TORUS_MAJOR+TORUS_MINOR * cos tmd
'
x = tmc * cos tme
y = TORUS_MINOR * sin tmd
z = tmc * sin tme
'
'CALCULATE SURFACE NORMAL
'------------------------
'
a=TORUS_MAJOR * cos tme
nx = x - a
ny = y
a=TORUS_MAJOR * sin tme
nz = z - a
'
'SCALING OF NORMALS
'
gscale = 1 / SQR( nx*nx + ny*ny + nz*nz )
nx*=gscale
ny*=gscale
nz*=gscale
'
glNormal3f nx, ny, nz
glVertex3f x, y, z
'
next
'
next
'
glEnd()
'
next
'
glEndList()
'
else
'
'Playback displaylist
'
glCallList( torus_list )
end if
end sub
''================================================
'' DrawScene() - Draw the scene (a rotating torus)
''================================================
sub DrawScene
static as single,
model_diffuse(4) => (1.0, 0.8, 0.0, 1.0),
model_specular(4) => (0.0, 0.0, 1.0, 1.0),
model_shininess=0.1
glPushMatrix
'Rotate the object
glRotatef rot_x*0.5, 1.0, 0.0, 0.0
glRotatef rot_y*0.5, 0.0, 1.0, 0.0
glRotatef rot_z*0.5, 0.0, 0.0, 1.0
'Set model color (used for orthogonal views, lighting disabled)
'
glColor4fv model_diffuse
'Set model material (used for perspective view, lighting enabled)
'
glMaterialfv GL_FRONT, GL_DIFFUSE, model_diffuse
glMaterialfv GL_FRONT, GL_SPECULAR, model_specular
glMaterialf GL_FRONT, GL_SHININESS, model_shininess
'
DrawTorus
glPopMatrix
end sub
'============================================================
' DrawBorder() - Draw a 2D border (used for orthogonal views)
'============================================================
sub DrawBorder( byval gscale as single, st as long )
dim as single x,y
glPushMatrix
'Setup modelview matrix (flat XY view)
'
glLoadIdentity
gluLookAt,
0.0, 0.0, 1.0,
0.0, 0.0, 0.0,
0.0, 1.0, 0.0
'We don't want to update the Z-buffer
'
glDepthMask GL_FALSE
'Set color
'---------
glDisable GL_LIGHTING
glColor3f 0.7, 0.7, 0.4
glBegin GL_LINES
dim h as long
'h=gsteps*0.5
h=st*0.5
x = gscale * h
y = gscale * h
'Horizontal lines
'----------------
glVertex3f -x, -y, 0.0
glVertex3f x, -y, 0.0
glVertex3f -x, y, 0.0
glVertex3f x, y, 0.0
'Vertical lines
glVertex3f -x, -y, 0.0
glVertex3f -x, y, 0.0
glVertex3f x, -y, 0.0
glVertex3f x, y, 0.0
glEnd
'Enable Z-buffer writing again
'
glDepthMask GL_TRUE
glPopMatrix
end sub
'========================================================
' DrawGrid() - Draw a 2D grid (used for orthogonal views)
'========================================================
sub DrawGrid( BYVAL gscale AS SINGLE, BYVAL gsteps AS INTEGER )
dim as long i
dim as single x,y
glPushMatrix
'Set background color
'
glClearColor 0.15, 0.15, 0.3, 0.0
glClear GL_COLOR_BUFFER_BIT
'Setup modelview matrix (flat XY view)
'
glLoadIdentity
gluLookAt,
0.0, 0.0, 1.0,
0.0, 0.0, 0.0,
0.0, 1.0, 0.0
'
'We don't want to update the Z-buffer
'
glDepthMask GL_FALSE
'Set grid color
glDisable GL_LIGHTING
glColor3f 0.0, 0.5, 0.5
glBegin GL_LINES
dim g,h as long
g=gsteps+0
h=g*0.5
'' Horizontal lines
x = gscale * h
y = (-gscale) * h
'
for i = 0 to g
glVertex3f -x, y, 0.0
glVertex3f x, y, 0.0
y+=gscale
next
'' Vertical lines
x = -gscale * h
y = gscale * h
'
for i = 0 to g
glVertex3f x, -y, 0.0
glVertex3f x, y, 0.0
x+=gscale
next
glEnd
'Enable Z-buffer writing again
'
glDepthMask GL_TRUE
glPopMatrix
end sub
;===============
; DrawAllViews( )
;===============
sub DrawAllViews( )
dim bb
static as single,
light_position(4) => (0.0, 8.0, 8.0, 1.0),
light_diffuse (4) => (0.5, 0.5, 0.5, 1.0),
light_specular(4) => (0.5, 0.5, 0.5, 1.0),
light_ambient (4) => (0.5, 0.5, 0.5, 1.0)
static as double aspect
;
;Calculate aspect of window
;
if ( wheight > 0 )
aspect = wwidth / wheight
else
aspect = 1.0
end if
'
glClearColor 0.1, 0, 0.5, 0
glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
'
glEnable GL_SCISSOR_TEST
;
glEnable GL_DEPTH_TEST
glDepthFunc GL_LEQUAL
;======================
;** ORTHOGONAL VIEWS **
;======================
;For orthogonal views, use wireframe rendering
;---------------------------------------------
glPolygonMode GL_FRONT_AND_BACK, GL_LINE
;Enable line anti-aliasing
;
glEnable GL_LINE_SMOOTH
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA
;Setup orthogonal projection matrix
glMatrixMode GL_PROJECTION
glLoadIdentity
dim as long a
glOrtho -3*aspect, 3.0*aspect, -3.0, 3.0, 1.0, 50
dim w,h as long
w=wwidth : h=wheight
sar w : sar h
glMatrixMode GL_MODELVIEW
glLoadIdentity
;Upper left view (TOP VIEW)
;--------------------------
;
glViewport 0,h,w,h
glScissor 0,h,w,h
DrawGrid 0.4,12
if active_view=1 then DrawBorder 0.45,12
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt,
0.0, 10.0, 0.1, 'Eye-position (above)
0.0, 0.0, 0.0, 'View-point
0.0, 1.0, 0.0 'Up-vector
DrawScene
;Lower left view (FRONT VIEW)
;----------------------------
;
glViewport 0,0,w,h
glScissor 0,0,w,h
;glMatrixMode GL_MODELVIEW
;
DrawGrid 0.4, 12
if active_view=3 then DrawBorder 0.45,12
glLoadIdentity
gluLookAt,
0.0, 0.0, 10.0, 'Eye-position (in front of)
0.0, 0.0, 0.0, 'View-point
0.0, 1.0, 0.0 'Up-vector
DrawScene
;Lower right view (SIDE VIEW)
;----------------------------
;
glViewport w,0,w,h
glScissor w,0,w,h
DrawGrid 0.4, 12
if active_view=4 then DrawBorder 0.45,12
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt,
10.0, 0.0, 0.0, 'Eye-position (to the right)
0.0, 0.0, 0.0, 'View-point
0.0, 1.0, 0.0 'Up-vector
DrawScene
;Disable line anti-aliasing
;
glDisable GL_LINE_SMOOTH
glDisable GL_BLEND
;======================
;** PERSPECTIVE VIEW **
;======================
;For perspective view, use solid rendering
;
glPolygonMode GL_FRONT_AND_BACK, GL_FILL
;Enable face culling (faster rendering)
;
glEnable GL_CULL_FACE
glCullFace GL_BACK
glFrontFace GL_CW
;Setup perspective projection matrix
;
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 65.0, aspect, 1.0, 50.0
;Upper right view (PERSPECTIVE VIEW
'
glViewport w, h, w, h
glScissor w, h, w, h
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt,
3.0, 1.5, 3.0, 'Eye-position
0.0, 0.0, 0.0, 'View-point
0.0, 1.0, 0.0 'Up-vector
'
'Configure and enable light source 1
'
glLightfv GL_LIGHT1, GL_POSITION, light_position
glLightfv GL_LIGHT1, GL_AMBIENT, light_ambient
glLightfv GL_LIGHT1, GL_DIFFUSE, light_diffuse
glLightfv GL_LIGHT1, GL_SPECULAR, light_specular
glEnable GL_LIGHT1
glEnable GL_LIGHTING
DrawScene
glDisable GL_LIGHTING
glDisable GL_CULL_FACE
glDisable GL_DEPTH_TEST
glDisable GL_SCISSOR_TEST
end sub
'dim keys(256) as long
'dim mapref(16) as long
'dim cameraProjectionMatrix(16) as single
dim as double,
modelview(16),
projection(16)
sub do_the_next_frame(BYVAL hWnd AS long ) ' construct each frame
'
static as long signal = 0
' timing
QueryPerformanceCounter &grtic2
grlap=(grtic2-grtic1)*1e6/freq
' fps=0.99*fps+10000/grlap ' moving average frames per sec
' screen refresh
' if bselect+kselect+refresh=0 then grtic1=grtic2: GOTO xdo_frame ' no need to update frame
refresh=0
'glClear(GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT)
'=============
DrawAllViews()
'=============
glFinish ' wait until all operations complete
SwapBuffers HDC
'IF firstframe=0 THEN SetWindowPos hWnd,HWND_TOP,100,100,500,500,0: firstframe=1
grtic1=grtic2
'
xdo_frame:
end sub '
'include mwinproc.inc
'////////////////////
'---------------------------------------------------------------------------------------------------------------------
function WndProc (byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long callback
'=====================================================================================================================
STATIC cxClient AS LONG
STATIC cyClient AS LONG
LOCAL hdc AS LONG
dim viewport(4) AS LONG
dim as long a,b,c,i,j
dim as long x,y,z
if wmsg=wm_paint then refresh=1
'==========
select wMsg
'==========
'
'---------------
case WM_ACTIVATE
'===============
if HIwrd(wParam) then exit function
'--------------
case WM_DESTROY
'==============
goto termination
'------------
case WM_TIMER
'============
if wParam=1
do_the_next_frame (hWnd)
if ReqShutDown then goto termination
end if
'---------------
case WM_KEYDOWN
'==============
wParam=wParam AND 255
'keys(wParam) = 1: keyd=wParam: kselect=wParam
if wParam=27 then ReqShutDown=1 : goto termination
'---------------
case WM_DESTROY
'===============
goto termination1
'----------------
case WM_MOUSEMOVE
'================
bselect=bselect OR 1
mPosX = LOwrd(lParam)
mPosY = HIwrd(lParam)
'
if bleft=1
'
x=mPosX : y=mPosY
'
'Depending on which view was selected, rotate around different axes
'
'=================
select active_view
'=================
'-----
case 1
'=====
'
rot_x = rot_x + y - ypos
rot_z = rot_z + x - xpos
'
'-----
case 3
'=====
rot_x = rot_x + y - ypos
rot_y = rot_y + x - xpos
'
'-----
case 4
'=====
'
rot_y = rot_y + x - xpos
rot_z = rot_z + y - ypos
'
'--------
case else
'========
'
'Do nothing for perspective view, or if no view is selected
'
'=========
end select
'=========
'
'Remember mouse position
'
xpos = x
ypos = y
'
end if
'----------------
case WM_LBUTTONUP
'================
bLeft = 0:ePosX=mPosX:ePosY=mPosy
'
'Deselect any previously selected view
'
active_view = 0
'----------------
case WM_MBUTTONUP
'================
bMid = 0:ePosX=mPosX:ePosY=mPosy
'----------------
case WM_RBUTTONUP
'================
bRight = 0:ePosX=mPosX:ePosY=mPosy
'------------------
case WM_LBUTTONDOWN
'==================
bLeft = 1:sPosX=mPosX:sPosY=mPosy
bSelect = bselect OR 2
xpos = LOwrd(lParam)
ypos = HIwrd(lParam)
'
' Detect which of the four views was clicked
'
active_view = 1
if ( xpos >= wwidth\2 )
active_view+=1
end if
if ( ypos >= wheight\2 )
active_view = active_view + 2
end if
doredraw = TRUE
'------------------
case WM_MBUTTONDOWN
'==================
bMid = 1 : sPosX=mPosX:sPosY=mPosy
bSelect = bselect OR 2
'------------------
case WM_RBUTTONDOWN
'==================
bRight = 1:sPosX=mPosX:sPosY=mPosY
bSelect = bselect OR 2
'-----------------
case WM_MOUSEWHEEL
'=================
bWheel = HIwrd(wParam)
bselect=1
'------------
case %WM_SIZE
'============
wWidth = lowrd lParam
wHeight = hiwrd lParam
'
'Set the viewport to new dimensions
'
if wHeight > 0 and wWidth > 0
glViewport 0, 0, wWidth, wHeight
viewport(1)=>0,0,wWidth,wHeight
'
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45, wWidth/wHeight, 1.0, 100
glMatrixMode GL_MODELVIEW
glGetDoublev GL_MODELVIEW_MATRIX, modelview
glGetDoublev GL_PROJECTION_MATRIX, projection
end if
'------------------
case %WM_ERASEBKGND
'==================
function = 1
'--------
case else
'========
function=DefWindowProc hWnd,wMsg,wParam,lParam
'=========
end select
'=========
;
exit function
;
termination:
'
if ReqShutDown<0 THEN exit function ' dont terminate
'
termination1:
'
KillTimer hWnd,1
'CLOSE
glDeleteLists 1000, 255 ' font
wglMakeCurrent hDC, NULL
wglDeleteContext hRC
ReleaseDC hWnd,hDC
PostQuitMessage 0
end function ' WndProc
'////////////////////
'--------------------
sub initialise_OpenGL
(
BYVAL hWnd AS LONG,
BYVAL hDC AS LONG,
BYVAL hRC AS LONG
)
'====================
'BuildFont
dim glFont as LOGFONT
dim glFontHandle as long
'
glFont.lfHeight = 1 'Height Of Font
glFont.lfWeight = FW_BOLD 'Font Weight
glFont.lfCharSet = ANSI_CHARSET 'Character Set Identifier
glFont.lfOutPrecision = OUT_TT_PRECIS 'Output Precision
glFont.lfClipPrecision = CLIP_DEFAULT_PRECIS 'Clipping Precision
glFont.lfQuality = ANTIALIASED_QUALITY 'Output Quality
glFont.lfPitchAndFamily = FF_DONTCARE OR DEFAULT_PITCH 'Family And Pitch
copy0 &glFont.lfFaceName, `Arial` '`Comic Sans MS` 'Font Name
'
glFontHandle = CreateFontIndirect(&glFont)
glFontHandle = SelectObject(hDC, glFontHandle)
'
'wglUseFontOutlines hDC, 0, 255, 1000, 0.0, 0.2, WGL_FONT_POLYGONS, ?gmf)
'
DeleteObject(glFontHandle)
end sub
'-------------------------
Function WinMain,
byval inst as long,
byval prevInst as long,
byval cmdline as long,
byval show as long
as long
'=========================
; window handle
dim a,b,c,hWnd as long
dim wc as WndClass
dim wm as MSG
with wc. '
style=CS_HREDRAW or CS_VREDRAW
lpfnWndProc=&WndProc
cbClsExtra=0
cbWndExtra=0
hInstance=inst
hIcon=LoadIcon 0, IDI_APPLICATION
hCursor=LoadCursor 0,IDC_ARROW
hbrBackground=GetStockObject WHITE_BRUSH '
lpszMenuName=0
lpszClassName=`Opengl`
end with
if not RegisterClass &wc
MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
exit function
end if '
hWnd=CreateWindowEx 0,wc.lpszClassName,`4 Port Viewer Demo`,
WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT,CW_USEDEFAULT,480,480,
0,0,inst,0
if not hWnd
MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
exit function
end if
hDC = GetDC(hWnd)
'setup pixel format
dim pfd AS PIXELFORMATDESCRIPTOR
'
pfd.nSize = SIZEOF PIXELFORMATDESCRIPTOR 'Size of UDT structure
pfd.nVersion = 1 'Version. Always set to 1.
pfd.dwFlags = PFD_DRAW_TO_WINDOW OR _ 'Support Window
PFD_SUPPORT_OPENGL OR _ 'Support OpenGL
PFD_DOUBLEBUFFER 'Support Double Buffering
pfd.iPixelType = PFD_TYPE_RGBA 'Red, Green, Blue, & Alpha Mode
pfd.cColorBits = 32 '32-Bit Color Mode
pfd.cRedBits = NULL 'Ignore Color and Shift Bits...
pfd.cRedShift = NULL '...
pfd.cGreenBits = NULL '...
pfd.cGreenShift = NULL '...
pfd.cBlueBits = NULL '...
pfd.cBlueShift = NULL '...
pfd.cAlphaBits = NULL 'No Alpha Buffer
pfd.cAlphaShift = NULL 'Ignore Shift Bit.
pfd.cAccumBits = NULL 'No Accumulation Buffer
pfd.cAccumRedBits = NULL 'Ignore Accumulation Bits...
pfd.cAccumGreenBits = NULL '...
pfd.cAccumBlueBits = NULL '...
pfd.cAccumAlphaBits = NULL '... Good Cereal! ;)
pfd.cDepthBits = 16 ' bits z-buffer depth 8 16 24
pfd.cStencilBits = 1 'Stencil Buffer
pfd.cAuxBuffers = NULL 'No Auxiliary Buffer
pfd.iLayerType = PFD_MAIN_PLANE 'Main Drawing Plane
pfd.bReserved = NULL 'Reserved
pfd.dwLayerMask = NULL 'Ignore Layer Masks...
pfd.dwVisibleMask = NULL '...
pfd.dwDamageMask = NULL '...
nPixelFormat = ChoosePixelFormat(hDC, &pfd) ' First without multisampling
SetPixelFormat(hDC, nPixelFormat, &pfd)
hRC = wglCreateContext (hDC)
wglMakeCurrent hDC, hRC
ReqNewMode=0 ' done
'initialise_OpenGL(hWnd,hDC,hRC)
ShowWindow hWnd,show
UpdateWindow hWnd
;
timerval=16 ' a bit less than 1/60 sec
SetTimer hWnd,1,timerval,NULL
;
;MESSAGE LOOP
;
while GetMessage &wm,0,0,0
TranslateMessage &wm
DispatchMessage &wm
wend
;
function=wm.wparam
end function ; end of WinMain
a=true
dim cmdline,inst as long
cmdline=GetCommandLine
inst=GetModuleHandle 0
'
WinMain (inst,0,cmdline,SW_NORMAL)
'
freelibrary kernel32
freelibrary user32
freelibrary gdi32
terminate
'----------------------------------------
'Polyhedral GreenHouse
'========================================
'16:18 03/02/2010
basic
/*
ROOF PANEL
/\ apex
/ \
/ \
-------------- truncation
/ \
/ main \
/ \
..............
\ / /\
\ tail / / \
\ / / \
\ / / \
\ / / head \
\ / / \
\/ / \
------------------------
| main | shoulder
| |
SIDE PANEL | |
| |
| |
| |
| |
| |
| |
--------------
*/
'===============
class greenhouse
'===============
protected double
a,b,n,r,
w1,w2,h1,h2,rd,sht,
fr,ta,ra,rm,rtb,sh,s1,s2,v1,sc,ma,
sina,cosa,tana,sinb,cosb,tanb,
rptw,rptm,rtam,rsdm,rptr,sdtm,sdbm,sdsm,
ts1,ts2,ts3,ts4,ts5,tr1,tr2,tr3,tr4,tr5,tl,nfx,
fa,ssa,rsa,tsa,
mv,rv,
wi1,th1
protected string
srA,srB,srC
'=================
class strut 'INNER
'=================
/*
-------------------------------------
/ /|
------------------------------------- |
| | |
| | |
| | |
| | |
| | |
| |/
-------------------------------------
*/
protected double
length,width,thickness,mitre1,bevel1,mitre2,bevel2,
cx,cy,cz,
x1,x2,x3,x4,x5,x6,x7,x8,
y1,y2,y3,y4,y5,y6,y7,y8,
z1,z2,z3,z4,z5,z6,z7,z8
'
protected string srA
'----------------------------------------------------------------------------------------
method input(double le, double wi, double th, double m1, double m2, double b1, double b2)
'========================================================================================
'
'FIX COORDINATES OF STRUT
'------------------------
'
length=le : width=wi : thickness=th : mitre1=m1 : mitre2=m2 : bevel1=b1 : bevel2=b2
'
x1=0 : x2=le : x3=le-wi*tan(m2) : x4=wi*tan(m1) : x5=x1 : x6=x2 : x7=x3 : x8=x4
y1=0 : y2=0 : y3=wi : y4=wi : y5=y1+th*tan(b1) : y6=y5 : y7=y3-th*tan(b2) : y8=y7
z1=0 : z2=0 : z3=0 : z4=0 : z5=th : z6=th : z7=th : z8=th
'
cx=x1+le*.5 :cy=0 : cz=0
end method
'
'-----------------
method calculate()
'=================
'FACES (anticlockwise index)
'1 front 1 2 3 4
'2 back 6 5 8 7
'3 outer 5 6 2 1
'4 inner 4 3 7 8
'5 left 5 1 4 8
'6 right 2 6 7 3
'VOLUME (face index)
'3 outer
'1 front
'4 inner
'2 back
'5 left (end)
'6 right (end)
end method
'--------------
method report()
'==============
tab=chr 9
function vals(double d) as string = left(str(d),5) chr(9)
srA= `
Panel Frame Strut Measurements:
Coordinates
X` tab `Y` tab `Z` tab `POINT
--------------------------------------
` vals(x1) vals(y1) vals(z1) `p1
` vals(x2) vals(y2) vals(z2) `p2
` vals(x3) vals(y3) vals(z3) `p3
` vals(x4) vals(y4) vals(z4) `p4
` vals(x5) vals(y5) vals(z5) `p5
` vals(x6) vals(y6) vals(z6) `p6
` vals(x7) vals(y7) vals(z7) `p7
` vals(x8) vals(y8) vals(z8) `p8
--------------------------------------
`
print srA
end method
end class
'--------------------------------------------------------------------------------------------
method input(double scale, double radius, double SideHeight, double sides, double RoofSlope )
'============================================================================================
'INPUTS
sc=scale 'SCALE
rd=radius 'FACE RADIUS
sht=sideheight 'HEIGHT TO START OF ROOF EXLCUDING TAIL
n=sides 'NUMBER OF SIDES
a=pi/n 'MAIN ANGLE
b=rad(RoofSlope) 'ROOF PANEL SLOPE
rptw=0.2*sc 'ROOF PANEL TRUNCATION WIDTH
wi1=.05*sc 'FRAME BATTEN WIDTH
th1=.025*sc 'FRAME BATTEN THICKNESS
end method
'-----------------
method calculate()
'=================
'TRIGO PROPORTIONS
cosa=cos a
sina=sin a
tana=tan a
sinb=sin b
cosb=cos b
tanb=tan b
'MAIN CALCS
'----------
r=sc*rd/cos(a) 'CORNER RADIUS
fr=r*cosa 'FACE RADIUS
w1=r*sina 'SIDE PANEL W1
w2=w1*cosa 'ROOF PANEL W2
h1=w1*sina/cosb 'ROOF PANEL TAIL
h2=r*cosa/cosb 'ROOF PANEL MAIN
v1=h1*sinb 'SIDE PANEL PEAK
ta=atn(h1/w2) 'TAIL ANGLE
ma=asin( tana/sin(ta) )*.5 'TAIL BEVEL
ra=asin(sina*cosa*cosb) 'ROOF ANGLE
rptr=h2-rptw/tan(ra) 'ROOF PANEL TRUNCATED
rm=atn(tana*sinb*cos(ra) ) 'ROOF PANEL SIDE BEVEL
rtb=b/2 'ROOF PANEL TOP BEVEL
sh=sc*sht-v1 'SIDE PANEL SHOULDER HEIGHT
rptm=atn(h2/w2)*.5 'ROOF PANEL TOP MITRE
rtam=ta 'ROOF PANEL TAIL MITRE
rsdm=.5*(pi-atn(h2/w2)-ta) 'ROOF PANEL SIDE MITRE
sdtm=atn(v1/w1) 'SIDE PANEL TIP MITRE
sdbm=pi*.25 'SIDE PANEL BASE MITRE
sdsm=pi*.25-sdtm*.5 'SIDE PANEL SHOULDER MITRE
'SIDE BEVEL a
'DERIVED MEASUREMENTS
'--------------------
double vv,tt
vv=rptw
tt=1/tana
fa=n*w1*w1*tt 'FLOOR AREA (POLYGONS)
ssa=n*(w1*sc*sht*2-v1*w1) 'SIDE SURFACE AREA
rsa=n*(w2+rptw)*rptr+
n*w2*h1
'ROOF SURFACE AREA
tsa=n*rptw*rptw/tana 'ROOF TOP OPENING AREA
mv=fa*sc*sht 'APPROX VOLUME EXCLUDING ROOF SPACE
rv=n*tt*w2*w2*w2*tt*tanb/3-
n*tt*vv*vv*vv*tt*tanb/3
'APPROX ROOF VOLUME (EXCLUDING APEX)
'DIFFERENCE OF CONES
'FRAME LENGTHS:
'--------------
'side frame
ts1=w1*2 'BASE
ts2=sh 'RIGHT SIDE
ts3=sqrt(w1*w1+v1*v1) 'TOP RIGHT
ts4=ts3 'TOP LEFT
ts5=ts2 'LEFT SIDE
'roof panel
tr1=h1/sin(ta) 'LEFT BASE
tr2=tr1 'RIGHT BASE
tr3=rptr/cos(ra) 'RIGHT SIDE
tr4=rptw*2 'TOP
tr5=tr3 'LEFT SIDE
'TOTAL FRAME MEMBER LENGTH
tl=ts1 ts2 ts3 ts4 ts5 tr1 tr2 tr3 tr4 tr5
'CREATE STRUTS FOR THE FRAME
'---------------------------
'
strut p1str1,p1str2,p1str3,p1str4,p1str5
strut p2str1,p2str2,p2str3,p2str4,p2str5
'
'GOING ANTICLOCKWISE
'
'PARAMS: length,width,thickness,LeftMitre,RightMitre,OuterBevel,InnerBevel
/*
/\
/ \
/ \
| |
| |
| |
| |
______
*/
p1str1.input ts1,wi1,th1,sdbm,sdbm,0,0 'BASE
p1str2.input ts2,wi1,th1,sdbm,sdsm,a, 0 'RIGHT SIDE
p1str3.input ts3,wi1,th1,sdsm,sdtm,ma,0 'TOP RIGHT
p1str4.input ts4,wi1,th1,sdtm,sdsm,ma,0 'TOP LEFT
p1str5.input ts5,wi1,th1,sdsm,sdbm,a ,0 'LEFT SIDE
p1str1.report
/*
----
/ \
/ \
\ /
\ /
\ /
\/
*/
p2str1.input tr1,wi1,th1,rsdm,rtam,ma,0 'LEFT BASE
p2str2.input tr2,wi1,th1,rtam,rsdm,ma,0 'RIGHT BASE
p2str3.input tr3,wi1,th1,rsdm,rptm,rm,0 'RIGHT SIDE
p2str4.input tr4,wi1,th1,rptm,rptm,rtb,0 'TOP SIDE
p2str5.input tr5,wi1,th1,rptm,rsdm,rm,0 'LEFT SIDE
'FIXINGS:
'--------
'JOINT fixings + MEMBER fixings
'
nfx= 3*10 + 6*8
end method
'OUTPUT
'--------------
method report()
'==============
function degs(double d) as string= left(str(deg(d)),5) chr(9)
function vals(double d) as string = left(str(d),5) chr(9)
srA= `
Polyhedral GreenHouse Measurements:
` vals(this.sc) `scaling
` vals(r) `Corner radius
` vals(fr) `Face radius
` vals(n) `number of sides
` degs(b) `roof slope
--------------------------------------
` vals(w2) `roof panel half width
` vals(h1) `roof panel tail
` vals(h2) `roof panel main
` vals(rptw) `roof panel truncation width
` vals(rptr) `roof panel truncated
--------------------------------------
` degs(ta) `roof tail angle
` degs(ra) `roof panel apex angle
--------------------------------------
` degs(rptm) `roof panel top mitre
` degs(rsdm) `roof panel side mitre
` degs(rtam) `roof panel tail mitre
` degs(rtb) `roof panel top bevels (top opening)
` degs(rm) `roof panel side bevels
` degs(ma) `roof panel tail bevels
--------------------------------------
` vals(w1) `side panel half width
` vals(sh) `side panel shoulder
` vals(v1) `side panel head
` degs(sdtm) `side panel tip mitre
` degs(sdbm) `side panel base mitre
` degs(sdsm) `side panel shoulder mitre
` degs(a ) `side panel side bevels
` degs(ma) `side panel apex bevels
`
srB= `
Polyhedral GreenHouse:
Areas:
` vals(fa) `floor area
` vals(ssa) `side panels area
` vals(rsa) `roof panels area
` vals(tsa) `roof opening area
Volumes:
` vals(mv) `main volume
` vals(rv) `roof volume
--------------------------------------
Side Frame members:
` vals(ts1) `ts1
` vals(ts2) `ts2
` vals(ts3) `ts3
` vals(ts4) `ts4
` vals(ts5) `ts5
--------------------------------------
Roof Frame members:
` vals(tr1) `tr1
` vals(tr2) `tr2
` vals(tr3) `tr3
` vals(tr4) `tr4
` vals(tr5) `tr5
--------------------------------------
` vals(tl) `total per segment
` vals(n ) `segments
` vals(tl*n) `total length
` vals(nfx*n) `total fixings
`
print srA
print srB
end method
end class
'----
'MAIN
'====
'params are all Double
greenhouse g
g.input 1,1,2,6,45 '(Scale, Radius, SideHeight, Sides, RoofSlope )
g.calculate
g.report
Hi John,
We got a bit stuck last time because ScriptBasic expects extension modules to be written in C to map into ScriptBasic variables. As I recall this is what prompted me to embark upon C header reading capability. My workload is rather high at present but I will certainly add it to my list and revisit what we did about 18 months ago.
Charles
dim as byte b(600)=>(1,0,255,255,0,0,0,0,0,0,0,0,64,8,202,16,9,0,10,0,10,0,104,1,132,0,0,0,0,0,82,0,67,0,68,0,76,0,71,0,
50,0,83,0,76,0,76,0,0,0,10,0,144,1,0,0,84,0,97,0,104,0,111,0,109,0,97,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,1,80,240,0,99,0,57,0,15,0,233,3,0,0,255,255,128,0,68,0,105,0,115,0,109,0,105,0,115,0,115,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,7,0,0,80,6,0,3,0,83,1,27,0,234,3,0,0,255,255,128,0,82,0,67,0,32,0,70,0,105,0,108,0,
101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,18,0,80,15,0,12,0,44,1,12,0,235,3,0,0,255,255,130,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,1,80,68,1,12,0,15,0,12,0,236,3,0,0,255,255,128,0,46,0,46,0,46,0,46,0,46,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,80,63,0,99,0,57,0,15,0,237,3,0,0,255,255,128,0,67,0,114,0,101,0,97,0,
116,0,101,0,32,0,67,0,111,0,100,0,101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7,0,0,80,6,0,39,0,83,1,39,0,
238,3,0,0,255,255,128,0,83,0,101,0,108,0,101,0,99,0,116,0,32,0,67,0,111,0,100,0,101,0,32,0,67,0,114,0,101,0,97,0,
116,0,105,0,111,0,110,0,32,0,84,0,121,0,112,0,101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,0,3,80,27,0,54,0,
69,0,12,0,239,3,0,0,255,255,128,0,70,0,117,0,108,0,108,0,32,0,83,0,76,0,76,0,32,0,77,0,111,0,100,0,117,0,108,0,
101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,0,1,80,120,0,54,0,87,0,15,0,240,3,0,0,255,255,128,0,83,0,76,0,
76,0,32,0,65,0,83,0,77,0,68,0,65,0,84,0,65,0,32,0,84,0,111,0,32,0,70,0,105,0,108,0,101,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,9,0,1,80,231,0,54,0,105,0,15,0,241,3,0,0,255,255,128,0,83,0,76,0,76,0,32,0,65,0,83,0,
77,0,68,0,65,0,84,0,65,0,32,0,84,0,111,0,32,0,67,0,108,0,105,0,112,0,66,0,111,0,97,0,114,0,100,0,0,0,0,0)
OXYGEN UPDATES LOG
03:39 12/09/2010 Resources may now be attached to compiled files. (rsrc is las section in file)
03:39 12/09/2010 File paths containing spaces supported.
04:45 12/09/2010 tools updated: cco2 co2 eo2
#basic
dim as byte b(600)=>(1,0,255,255,0,0,0,0,0,0,0,0,64,8,202,16,9,0,10,0,10,0,104,1,132,0,0,0,0,0,82,0,67,0,68,0,76,0,71,0,
50,0,83,0,76,0,76,0,0,0,10,0,144,1,0,0,84,0,97,0,104,0,111,0,109,0,97,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,1,80,240,0,99,0,57,0,15,0,233,3,0,0,255,255,128,0,68,0,105,0,115,0,109,0,105,0,115,0,115,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,7,0,0,80,6,0,3,0,83,1,27,0,234,3,0,0,255,255,128,0,82,0,67,0,32,0,70,0,105,0,108,0,
101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,18,0,80,15,0,12,0,44,1,12,0,235,3,0,0,255,255,130,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,1,80,68,1,12,0,15,0,12,0,236,3,0,0,255,255,128,0,46,0,46,0,46,0,46,0,46,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,80,63,0,99,0,57,0,15,0,237,3,0,0,255,255,128,0,67,0,114,0,101,0,97,0,
116,0,101,0,32,0,67,0,111,0,100,0,101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7,0,0,80,6,0,39,0,83,1,39,0,
238,3,0,0,255,255,128,0,83,0,101,0,108,0,101,0,99,0,116,0,32,0,67,0,111,0,100,0,101,0,32,0,67,0,114,0,101,0,97,0,
116,0,105,0,111,0,110,0,32,0,84,0,121,0,112,0,101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,0,3,80,27,0,54,0,
69,0,12,0,239,3,0,0,255,255,128,0,70,0,117,0,108,0,108,0,32,0,83,0,76,0,76,0,32,0,77,0,111,0,100,0,117,0,108,0,
101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,0,1,80,120,0,54,0,87,0,15,0,240,3,0,0,255,255,128,0,83,0,76,0,
76,0,32,0,65,0,83,0,77,0,68,0,65,0,84,0,65,0,32,0,84,0,111,0,32,0,70,0,105,0,108,0,101,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,9,0,1,80,231,0,54,0,105,0,15,0,241,3,0,0,255,255,128,0,83,0,76,0,76,0,32,0,65,0,83,0,
77,0,68,0,65,0,84,0,65,0,32,0,84,0,111,0,32,0,67,0,108,0,105,0,112,0,66,0,111,0,97,0,114,0,100,0,0,0,0,0)
print b(3)
terminate
I had one problematic posting. could you try downloading again to get the latest version and see if this works.
#basic
dim as byte dlgtpl(104)=>(1,0,255,255,0,0,0,0,0,0,0,0,0,8,207,16,1,0,10,0,10,0,150,0,100,0,0,0,0,0,73,0,68,0,68,0,95,0,68,0,
76,0,71,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,80,48,0,66,0,51,0,15,0,233,3,0,0,66,0,85,0,84,0,84,0,
79,0,78,0,0,0,73,0,68,0,67,0,95,0,66,0,84,0,78,0,0,0,0,0)
type MSG
; 28 bytes
hwnd as long
message as long
wParam as long
lParam as long
time as long
pt as point
end type
dim kernel32,user32,GDI32 as long
kernel32=LoadLibrary `kernel32.dll`
user32=LoadLibrary `user32.dll`
GDI32=LoadLibrary `GDI32.dll`
bind kernel32
(
GetCommandLine GetCommandLineA ; @0
GetModuleHandle GetModuleHandleA ; @4
ExitProcess ExitProcess ; @4
)
bind user32
(
LoadIcon LoadIconA ; @8
LoadCursor LoadCursorA ; @8
RegisterClass RegisterClassA ; @4
MessageBox MessageBoxA ; @4
CreateWindowEx CreateWindowExA ; @48
ShowWindow ShowWindow ; @8
UpdateWindow UpdateWindow ; @4
GetMessage GetMessageA ; @16
TranslateMessage TranslateMessage ; @4
DispatchMessage DispatchMessageA ; @4
PostQuitMessage PostQuitMessage ; @4
BeginPaint BeginPaint ; @8
EndPaint EndPaint ; @8
GetClientRect GetClientRect ; @8
DrawText DrawTextA ; @20
PostMessage PostMessageA ; @16
DefWindowProc DefWindowProcA ; @16
DialogBoxParam DialogBoxParamA ;@20
DialogBoxIndirectParam DialogBoxIndirectParamA ;@20
EndDialog EndDialogA ;@8
)
bind GDI32
(
GetStockObject GetStockObject ; @4
)
% WM_DESTROY 2
% WM_CLOSE 16
% WM_SYSCOMMAND = 0x0112
% SC_CLOSE = 0xF060
% WM_COMMAND = 0x0111
% CS_VREDRAW 1
% CS_HREDRAW 2
% IDI_APPLICATION 32512
% IDC_ARROW 32512
% WHITE_BRUSH 0
% MB_ICONERROR 16
declare Function WinMain(byval inst as long ,byval prevInst as long ,byval cmdline as asciiz , byval show as long) as long
declare function WndProc(byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long
'
def SW_NORMAL 1
def SW_SHOWDEFAULT 10
;=====================================
dim byref cmdline as asciiz,inst as long
&cmdline=GetCommandLine
inst=GetModuleHandle 0
'print cmdline `
'` hex inst
WinMain inst,0,cmdline,SW_NORMAL
'
freelibrary kernel32
freelibrary user32
freelibrary gdi32
terminate
Function WinMain(byval inst as long ,byval prevInst as long,byval cmdline as asciiz , byval show as long) as long
Dim RetVal as long
RetVal = DialogBoxIndirectParam(inst,&dlgtpl,0,&WndProc,0)
if RetVal == -1 then
MessageBox 0,`No Resource` ,`Information`,MB_ICONERROR
exit function
end if
function=RetVal
End Function
'==============================================================================
Function WndProc (byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long ) as long callback
select wMsg
case WM_DESTROY
PostQuitMessage 0
'case WM_CLOSE
' EndDialog(hWnd,0)
case WM_SYSCOMMAND
if (wParam AND 0xFFF0) == SC_CLOSE then
EndDialog(hWnd,0)
end if
case WM_COMMAND
end select
End Function
s=error() : if s then print s : goto endprog
#basic
dim as byte dlgtpl(104)=>(1,0,255,255,0,0,0,0,0,0,0,0,0,8,207,16,1,0,10,0,10,0,150,0,100,0,0,0,0,0,73,0,68,0,68,0,95,0,68,0,
76,0,71,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,80,48,0,66,0,51,0,15,0,233,3,0,0,66,0,85,0,84,0,84,0,
79,0,78,0,0,0,73,0,68,0,67,0,95,0,66,0,84,0,78,0,0,0,0,0)
type MSG
; 28 bytes
hwnd as long
message as long
wParam as long
lParam as long
time as long
pt as point
end type
dim kernel32,user32,GDI32 as long
kernel32=LoadLibrary `kernel32.dll`
user32=LoadLibrary `user32.dll`
GDI32=LoadLibrary `GDI32.dll`
bind kernel32
(
GetCommandLine GetCommandLineA ; @0
GetModuleHandle GetModuleHandleA ; @4
ExitProcess ExitProcess ; @4
)
bind user32
(
LoadIcon LoadIconA ; @8
LoadCursor LoadCursorA ; @8
RegisterClass RegisterClassA ; @4
MessageBox MessageBoxA ; @4
CreateWindowEx CreateWindowExA ; @48
ShowWindow ShowWindow ; @8
UpdateWindow UpdateWindow ; @4
GetMessage GetMessageA ; @16
TranslateMessage TranslateMessage ; @4
DispatchMessage DispatchMessageA ; @4
PostQuitMessage PostQuitMessage ; @4
BeginPaint BeginPaint ; @8
EndPaint EndPaint ; @8
GetClientRect GetClientRect ; @8
DrawText DrawTextA ; @20
PostMessage PostMessageA ; @16
DefWindowProc DefWindowProcA ; @16
DialogBoxParam DialogBoxParamA ;@20
DialogBoxIndirectParam DialogBoxIndirectParamA ;@20
EndDialog EndDialog ;@8
)
bind GDI32
(
GetStockObject GetStockObject ; @4
)
s=error() : if s then print s : goto endprog
% WM_DESTROY 2
% WM_CLOSE 16
% WM_SYSCOMMAND = 0x0112
% SC_CLOSE = 0xF060
% WM_COMMAND = 0x0111
% CS_VREDRAW 1
% CS_HREDRAW 2
% IDI_APPLICATION 32512
% IDC_ARROW 32512
% WHITE_BRUSH 0
% MB_ICONERROR 16
declare Function WinMain(byval inst as long ,byval prevInst as long ,byval cmdline as asciiz , byval show as long) as long
declare function WndProc(byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long
'
def SW_NORMAL 1
def SW_SHOWDEFAULT 10
;=====================================
dim byref cmdline as asciiz,inst as long
&cmdline=GetCommandLine
inst=GetModuleHandle 0
'print cmdline `
'` hex inst
WinMain inst,0,cmdline,SW_NORMAL
'
freelibrary kernel32
freelibrary user32
freelibrary gdi32
terminate
Function WinMain(byval inst as long ,byval prevInst as long,byval cmdline as asciiz , byval show as long) as long
Dim RetVal as long
RetVal = DialogBoxIndirectParam(inst,&dlgtpl,0,&WndProc,0)
if RetVal == -1 then
MessageBox 0,`No Resource` ,`Information`,MB_ICONERROR
exit function
end if
function=RetVal
End Function
'==============================================================================
Function WndProc (byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long ) as long callback
select wMsg
case WM_DESTROY
PostQuitMessage 0
'case WM_CLOSE
' EndDialog(hWnd,0)
case WM_SYSCOMMAND
if (wParam AND 0xFFF0) == SC_CLOSE then
EndDialog(hWnd,0)
end if
case WM_COMMAND
end select
End Function
endprog:
Antivirus | Version | Last Update | Result |
---|---|---|---|
AhnLab-V3 | 2010.09.15.00 | 2010.09.14 | - |
AntiVir | 8.2.4.52 | 2010.09.14 | TR/Crypt.XPACK.Gen2 |
Antiy-AVL | 2.0.3.7 | 2010.09.15 | - |
Authentium | 5.2.0.5 | 2010.09.15 | - |
Avast | 4.8.1351.0 | 2010.09.14 | - |
Avast5 | 5.0.594.0 | 2010.09.14 | - |
AVG | 9.0.0.851 | 2010.09.14 | - |
BitDefender | 7.2 | 2010.09.15 | - |
CAT-QuickHeal | 11.00 | 2010.09.15 | - |
ClamAV | 0.96.2.0-git | 2010.09.15 | - |
Comodo | 6081 | 2010.09.15 | - |
DrWeb | 5.0.2.03300 | 2010.09.15 | - |
Emsisoft | 5.0.0.37 | 2010.09.15 | Trojan.Crypt!IK |
eSafe | 7.0.17.0 | 2010.09.14 | - |
eTrust-Vet | 36.1.7855 | 2010.09.14 | - |
F-Prot | 4.6.1.107 | 2010.09.14 | - |
F-Secure | 9.0.15370.0 | 2010.09.15 | - |
Fortinet | 4.1.143.0 | 2010.09.13 | - |
GData | 21 | 2010.09.15 | - |
Ikarus | T3.1.1.88.0 | 2010.09.15 | Trojan.Crypt |
Jiangmin | 13.0.900 | 2010.09.15 | - |
K7AntiVirus | 9.63.2512 | 2010.09.14 | - |
Kaspersky | 7.0.0.125 | 2010.09.15 | Email-Worm.Win32.Warezov.gxp |
McAfee | 5.400.0.1158 | 2010.09.15 | - |
McAfee-GW-Edition | 2010.1B | 2010.09.14 | - |
Microsoft | 1.6103 | 2010.09.15 | - |
NOD32 | 5451 | 2010.09.14 | - |
Norman | 6.06.06 | 2010.09.14 | - |
nProtect | 2010-09-14.01 | 2010.09.14 | - |
Panda | 10.0.2.7 | 2010.09.14 | - |
PCTools | 7.0.3.5 | 2010.09.15 | - |
Prevx | 3.0 | 2010.09.15 | - |
Rising | 22.65.02.01 | 2010.09.15 | - |
Sophos | 4.57.0 | 2010.09.15 | - |
Sunbelt | 6877 | 2010.09.15 | - |
SUPERAntiSpyware | 4.40.0.1006 | 2010.09.15 | - |
Symantec | 20101.1.1.7 | 2010.09.15 | - |
TheHacker | 6.7.0.0.018 | 2010.09.15 | - |
TrendMicro | 9.120.0.1004 | 2010.09.15 | - |
TrendMicro-HouseCall | 9.120.0.1004 | 2010.09.15 | - |
VBA32 | 3.12.14.0 | 2010.09.14 | - |
ViRobot | 2010.8.25.4006 | 2010.09.15 | - |
VirusBuster | 12.65.6.0 | 2010.09.14 | - |
I went to the SourceForge site to download the 03 release and Kaspersky and Virus Total complained.
I could include the source code in the zip. It only adds an extra 200k. What do you think?
But Oxygen.dll compiles with FreeBasic ...
... If your releasing the source to O2 and it's self compiling, maybe distributing the code that way would make things easier. If you include an easy to use build script with the release, I can't see how that will slow anyone down.
I would like to take a peek at your work (source) just out of curiosity.
But, if the Antivirus Software will recognize a certain pattern as a virus, then it doesn't matter if you download it inside a zip file or compile it yourself; the Antivirus Software will delete it as soon the compiler is done writing it to disk (happened to me with tcc compiled programs).
Hello,
Sorry, it was a false detection. It will be fixed in the next update.
Thank you for your help.
-------------------------------------------
Regards, Ivan Kargapoltsev.
Virus analyst , Kaspersky Lab.
I submitted eo2.exe co2.exe and cco2.exe and got this response from Dr Kaspersky: