This is a nice little aquarium app which I found in the BCX forum. I simplified the code a little bit,I left out some features, and it is still a very nice aquarium app. At least I really like this program and I am happy that it could be ported to Oxygenbasic.
In the zip file there are the necessary files and a 64-bit executable.
' A very nice Aquarium demo, ported to OxygenBasic (simplified)
' MrBcx's Blitting Example
'==============================================================
' BCX Aquarium by Kevin Diggins 2023-09-06 MIT License
'==============================================================
'Double Click for FullScreen Switching and vice versa
#compact
$ filename "Aquarium.exe"
'uses rtl32
'uses rtl64
uses corewin
declare function TransparentBlt Lib "msimg32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As sys, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Long
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
def MAKEINTRESOURCE "#%1"
% COLOR_WINDOW 5
% IMAGE_ICON 1
% LR_LOADFROMFILE 0x0010
% WM_SETICON 0x80
% ICON_BIG 1
% HORZRES 8
% VERTRES 10
% SM_CXBORDER 5
% SM_CYBORDER 6
% HWND_TOPMOST -1
% SWP_NOZORDER 4
% IMAGE_BITMAP 0
% BI_RGB 0
% DIB_RGB_COLORS 0
% SRCCOPY 0xCC0020
% LR_LOADTRANSPARENT 32
% LR_LOADMAP3DCOLORS 4096
type BITMAP
long bmType
long bmWidth
long bmHeight
long bmWidthBytes
word bmPlanes
word bmBitsPixel
sys bmBits
end type
type RGBQUAD
byte rgbBlue
byte rgbGreen
byte rgbRed
byte rgbReserved
end type
type BITMAPINFOHEADER
dword biSize
long biWidth
long biHeight
word biPlanes
word biBitCount
dword biCompression
dword biSizeImage
long biXPelsPerMeter
long biYPelsPerMeter
dword biClrUsed
dword biClrImportant
end type
type BITMAPINFO
BITMAPINFOHEADER bmiHeader
RGBQUAD bmiColors[1]
end type
BITMAPINFO BUFFER_BMP
function rand(int max) as int
uint number
int err = rand_s(&number) : if err != 0 then mbox "rand_s function failed"
return mod(number, max+1)
end function
function rnd() as double
uint number
int err = rand_s(&number) : if err != 0 then mbox "rand_s function failed"
return mod(number, 10000+1) / 10000
end function
function rnd2(int min, int max)
int range = max - min
return rand(range) + min
end function
sub ToggleFullScreen(sys hwnd)
static bool FullScreen=False
static int oldx, oldy, oldwidth, oldheight
RECT rc
FullScreen = not FullScreen
if FullScreen then
GetWindowRect( hwnd, @rc )
oldx=rc.left : oldy=rc.top
oldwidth=rc.right-oldx : oldheight=rc.bottom-oldy
int cx, cy
sys hdc = GetDC(null)
cx = GetDeviceCaps(hdc,HORZRES) + GetSystemMetrics(SM_CXBORDER)
cy = GetDeviceCaps(hdc,VERTRES) + GetSystemMetrics(SM_CYBORDER)
ReleaseDC(null,hdc)
SetWindowLongPtr(hwnd,GWL_STYLE,
GetWindowLongPtr(hwnd, GWL_STYLE) and
(not (WS_CAPTION or WS_THICKFRAME or WS_BORDER or WS_SYSMENU)))
' Put window on top and expand it to fill screen
SetWindowPos(hwnd, convert sys HWND_TOPMOST,
-(GetSystemMetrics(SM_CXBORDER)+1),
-(GetSystemMetrics(SM_CYBORDER)+1),
cx+1, cy+1, SWP_NOZORDER);
else
SetWindowLongPtr(hwnd,GWL_STYLE,
GetWindowLongPtr(hwnd, GWL_STYLE) or WS_CAPTION or WS_THICKFRAME or WS_BORDER or WS_SYSMENU)
MoveWindow( hwnd, oldx, oldy, oldwidth, oldheight, true )
end if
end sub
'=======================
'MAIN CODE
'=======================
dim nCmdline as asciiz ptr, hInstance as sys
&nCmdline = GetCommandLine
hInstance = GetModuleHandle(0)
'========================================'
string g_szClassName = "OxyAquarium"
sys hwnd
'==============================================================
' It is okay to change the value of these values
'==============================================================
int MAXX = 1024 ' These govern screen and backbuffer sizes
int MAXY = 720 ' These are inital values - they are dynamic.
def FISH1 3
def FISH2 3
def FISH3 3
def FISH4 3
def FISH5 3
'==============================================================
'==============================================================
% FISHW = 120 ' All of the Fish bitmaps are 120 W x 80 H
'==============================================================
dim as single X1[FISH1], Y1[FISH1], Velo1[FISH1] ' velocitys: Pos values move right, Neg move left.
dim as single X2[FISH2], Y2[FISH2], Velo2[FISH2]
dim as single X3[FISH3], Y3[FISH3], Velo3[FISH3]
dim as single X4[FISH4], Y4[FISH4], Velo4[FISH4]
dim as single X5[FISH5], Y5[FISH5], Velo5[FISH5]
sys hBkGnd, Fish_1, Fish_2, Fish_3, Fish_4, Fish_5
sub ErrMsg(string item)
mbox " Could not load " item ".bmp! " + cr +
" ---------- Stop! ---------- "
ExitProcess(0)
end sub
function FuzzyEqual(SoftValue as double, HardValue as double, Low as double, High as double) as int
dim as double LowerBound = SoftValue - Low
dim as double UpperBound = SoftValue + High
if HardValue >= LowerBound and HardValue <= UpperBound then
function = true
else
function = false
end if
end function
function LoadBMP(string F, int ii=0, int t=0) as sys
if t then t = LR_LOADTRANSPARENT or LR_LOADMAP3DCOLORS
if ii then
return LoadImage(GetModuleHandle(0), MAKEINTRESOURCE(ii),IMAGE_BITMAP,0,0,t)
end if
return LoadImage(null,F,IMAGE_BITMAP,0,0,LR_LOADFROMFILE or t)
end function
sub Setup()
hBkGnd = LoadBMP("Aquarium.bmp")
Fish_1 = LoadBMP("Fish_1.bmp")
Fish_2 = LoadBMP("Fish_2.bmp")
Fish_3 = LoadBMP("Fish_3.bmp")
Fish_4 = LoadBMP("Fish_4.bmp")
Fish_5 = LoadBMP("Fish_5.bmp")
if hBkGnd = null then ErrMsg("Aquarium")
if Fish_1 = null then ErrMsg("Fish_1")
if Fish_2 = null then ErrMsg("Fish_2")
if Fish_3 = null then ErrMsg("Fish_3")
if Fish_4 = null then ErrMsg("Fish_4")
if Fish_5 = null then ErrMsg("Fish_5")
'======================================================================
' Randomly place our fish on the screen at startup
' First, work out the Y-axis locations
'======================================================================
int i
for i = 1 to FISH1
Y1[i] = RND2(100, MAXY)
if FuzzyEqual(Y1[i], Y1[i+1], 20, 20) then Y1[i] += 160
if FuzzyEqual(Y1[i], Y1[i-1], 20, 20) then Y1[i] -= 160
Y1[i] = Y1[i] + (2 * SIN((X1[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH2
Y2[i] = RND2(100, MAXY)
if FuzzyEqual(Y2[i], Y2[i+1], 20, 20) then Y2[i] += 160
if FuzzyEqual(Y2[i], Y2[i-1], 20, 20) then Y2[i] -= 160
Y2[i] = Y2[i] + (2 * COS((X2[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH3
Y3[i] = RND2(100, MAXY)
if FuzzyEqual(Y3[i], Y3[i+1], 20, 20) then Y3[i] += 160
if FuzzyEqual(Y3[i], Y3[i-1], 20, 20) then Y3[i] -= 160
Y3[i] = Y3[i] + (2 * SIN((X3[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH4
Y1[i] = RND2(100, MAXY)
if FuzzyEqual(Y4[i], Y4[i+1], 20, 20) then Y1[i] += 160
if FuzzyEqual(Y4[i], Y4[i-1], 20, 20) then Y1[i] -= 160
Y4[i] = Y4[i] + (2 * COS((X4[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH5
Y5[i] = RND2(100, MAXY)
if FuzzyEqual(Y5[i], Y5[i+1], 20, 20) then Y5[i] += 160
if FuzzyEqual(Y5[i], Y5[i-1], 20, 20) then Y5[i] -= 160
Y5[i] = Y5[i] + (2 * SIN((X5[i] / MAXX) * 2 * pi))
next
'======================================================================
' Now, work out the X-axis starting locations
'======================================================================
for i = 1 to FISH1 ' Setup Fish_1's position & Velocity
X1[i] = -FISHW*2 ' Fish 1 moves RIGHT to LEFT
Velo1[i] = -RND2(3, 7) ' <- Change speed here
if Velo1[i] = Velo1[i-1] then Velo1[i] += i + 2
next
for i = 1 to FISH2 ' Setup Fish_2's position & Velocity
X2[i] = MAXX * RND ' Fish 2 moves LEFT to RIGHT
Velo2[i] = RND2(4, 8) ' <- Change speed here
if Velo2[i] = Velo2[i-1] then Velo2[i] += i + 4
next
for i = 1 to FISH3 ' Setup Fish_3's position & Velocity' Fish 4 moves RIGHT to LEFT
X3[i] = MAXX * RND ' Fish 3 moves LEFT to RIGHT
Velo3[i] = RND2(3, 7) ' <- Change speed here
if Velo3[i] = Velo3[i-1] then Velo3[i] += i + 2
next
for i = 1 to FISH4 ' Setup Fish_4's position & Velocity
X4[i] = -FISHW*2 ' Fish 4 moves RIGHT to LEFT
Velo4[i] = RND2(3, 7) ' <- Change speed here
if Velo4[i] = Velo4[i-1] then Velo4[i] += i + 2
next
for i = 1 to FISH5 ' Setup Fish_3's position & Velocity' Fish 4 moves RIGHT to LEFT
X5[i] = MAXX * RND ' Fish 3 moves LEFT to RIGHT
Velo5[i] = RND2(3, 7) ' <- Change speed here
if Velo5[i] = Velo5[i-1] then Velo5[i] += i + 2
next
end sub
sub DoEvents()
MSG Msg
while (PeekMessage(&Msg, null, 0, 0, PM_REMOVE))
TranslateMessage(&Msg)
DispatchMessage(&Msg)
end while
end sub
sys PREV_BMP
sys BUFFER
int BUFFER_BMWIDTH
int BUFFER_BMHEIGHT
sub BUFFER_START (int x, int y)
if PREV_BMP then
DeleteObject(SelectObject(BUFFER,PREV_BMP))
PREV_BMP = null
end if
if BUFFER then DeleteDC(BUFFER)
BUFFER = CreateCompatibleDC(0)
BUFFER_BMWIDTH = x
BUFFER_BMHEIGHT = y
BUFFER_BMP.bmiHeader.biSize = sizeof(BITMAPINFOHEADER)
BUFFER_BMP.bmiHeader.biWidth = BUFFER_BMWIDTH;
BUFFER_BMP.bmiHeader.biHeight = -BUFFER_BMHEIGHT
BUFFER_BMP.bmiHeader.biPlanes = 1
BUFFER_BMP.bmiHeader.biBitCount = 32
BUFFER_BMP.bmiHeader.biCompression = BI_RGB
PREV_BMP = SelectObject(BUFFER,CreateDIBSection(0, &BUFFER_BMP, DIB_RGB_COLORS,0,0,0))
end sub
sub BUFFER_STOP (sys hwnd)
sys Local_HDC = GetDC(hwnd)
BitBlt(Local_HDC,0,0,BUFFER_BMWIDTH,BUFFER_BMHEIGHT,BUFFER,0,0,SRCCOPY)
ReleaseDC(hwnd,Local_HDC)
DeleteObject(SelectObject(BUFFER,PREV_BMP))
end sub
function IsOdd(Number AS INTEGER) as int
function = Number AND 1
end function
sub Blit_Stretch (sys hBmp, sys DrawHDC)
sys hdcDest = CreateCompatibleDC(null)
sys hOldBitmap = SelectObject(hdcDest, hBmp)
BITMAP bmpInfo
GetObject(hBmp,sizeof(BITMAP), &bmpInfo)
int bmpWidth = bmpInfo.bmWidth
int bmpHeight = bmpInfo.bmHeight
StretchBlt(DrawHDC,0,0,MAXX,MAXY,hdcDest,0,0,bmpWidth,bmpHeight,SRCCOPY)
SelectObject(hdcDest, hOldBitmap)
DeleteDC(hdcDest)
end sub
sub Blit_Sprite (sys hBmp, int Left, int Top, ulong rgbMask, sys DrawHDC)
sys hdcDest=0
sys hOldBitmap=0
BITMAP bmpInfo={}
if not hBmp or not DrawHDC then return
hdcDest = CreateCompatibleDC(null)
hOldBitmap = SelectObject(hdcDest,hBmp)
GetObject(hBmp, sizeof(BITMAP), &bmpInfo)
TransparentBlt(DrawHDC, Left, Top, bmpInfo.bmWidth, bmpInfo.bmHeight,
hdcDest, 0, 0, bmpInfo.bmWidth, bmpInfo.bmHeight, rgbMask)
SelectObject(hdcDest,hOldBitmap)
DeleteDC(hdcDest)
end sub
sub Drawit()
int i
Setup()
DO
DOEVENTS
BUFFER_START(MAXX, MAXY)
BLIT_STRETCH(hBkGnd, BUFFER)
'================================================================================
for i = 1 TO FISH1 ' Fish 1 moves RIGHT to LEFT
Y1[i] = Y1[i] + (2 * SIN((X1[i] / MAXX) * 2 * PI))
next
for i = 1 TO FISH1 ' Update Fish_1 position and velocity (swim right to left)
X1[i] = X1[i] + Velo1[i]
if IsOdd (i) AND X1[i] < MAXX/2 then Velo1[i] += -RND() * 0.3 ' Going for a bit of behavior
if X1[i] < -FISHW then
X1[i] = MAXX + FISHW ' Start Fish_1 from the right edge with an offset
Velo1[i] = -(RND2(3, 7)) ' Reset Fish_1's horizontal velocity (negative for left)
Y1[i] = RND2(100, MAXY-200)
end if
if Velo1[i] < 0 then
BLIT_SPRITE(Fish_1, X1[i], Y1[i], RGB(255, 0, 255), BUFFER)
end if
next
'================================================================================
for i = 1 TO FISH2 ' Fish 2 moves LEFT to RIGHT
Y2[i] = Y2[i] + (2 * COS((X2[i] / MAXX) * 2 * PI))
next
for i = 1 TO FISH2 ' Update Fish_2 position and velocity (swim left to right)
X2[i] = X2[i] + Velo2[i]
if NOT IsOdd (i) AND X2[i] < MAXX/2 then Velo2[i] += RND() * 0.4 ' Going for a bit of behavior
if X2[i] + (-FISHW) > MAXX then
X2[i] = -FISHW ' Start Fish_2 from the left edge with an offset
Velo2[i] = RND2(4, 8) ' Reset Fish_2's horizontal velocity (positive for right)
Y2[i] = RND2(100, MAXY-200)
end if
if Velo2[i] > 0 then BLIT_SPRITE(Fish_2, X2[i], Y2[i], RGB(255, 0, 255), BUFFER)
next
'================================================================================
for i = 1 TO FISH3 ' Fish 3 moves LEFT to RIGHT
Y3[i] = Y3[i] + (2 * SIN((X3[i] / MAXX) * 2 * PI))
next
for i = 1 TO FISH3 ' Update Fish_3 position and velocity (swim left to right)
X3[i] = X3[i] + Velo3[i]
if NOT IsOdd (i) AND X3[i] > MAXX/2 then Velo3[i] += RND() * 0.3 ' Going for a bit of behavior
if X3[i] + (-FISHW) > MAXX then
X3[i] = -FISHW ' Start Fish_2 from the left edge with an offset
Velo3[i] = RND2(3, 7) ' Reset Fish_2's horizontal velocity (positive for right)
Y3[i] = RND2(100, MAXY-200)
end if
if Velo3[i] > 0 then BLIT_SPRITE(Fish_3, X3[i], Y3[i], RGB(255, 0, 255), BUFFER)
next
'================================================================================
for i = 1 TO FISH4 ' Fish 4 moves RIGHT to LEFT
Y4[i] = Y4[i] + (2 * COS((X4[i] / MAXX) * 2 * PI))
next
for i = 1 TO FISH4 ' Update Fish_4 position and velocity (swim right to left)
X4[i] = X4[i] + Velo4[i]
if IsOdd (i) AND X4[i] < MAXX/2 then Velo4[i] += -RND() * 0.4 ' Going for a bit of behavior
if X4[i] < -FISHW then
X4[i] = MAXX + FISHW ' Start Fish_1 from the right edge with an offset
Velo4[i] = -(RND2(3, 7)) ' Reset Fish_1's horizontal velocity (negative for left)
Y4[i] = RND2(100, MAXY-200)
end if
if Velo4[i] < 0 then BLIT_SPRITE(Fish_4, X4[i], Y4[i], RGB(255, 0, 255), BUFFER)
next
'================================================================================
for i = 1 TO FISH5 ' Fish 5 moves LEFT to RIGHT
Y5[i] = Y5[i] + (2 * SIN((X5[i] / MAXX) * 2 * PI))
next
for i = 1 TO FISH5 ' Update Fish_3 position and velocity (swim left to right)
X5[i] = X5[i] + Velo5[i]
if NOT IsOdd (i) AND X5[i] > MAXX/2 then Velo5[i] += RND() * 0.3 ' Going for a bit of behavior
if X5[i] + (-FISHW) > MAXX then
X5[i] = -FISHW ' Start Fish_2 from the left edge with an offset
Velo5[i] = RND2(3, 7) ' Reset Fish_2's horizontal velocity (positive for right)
Y5[i] = RND2(100, MAXY-200)
end if
if Velo5[i] > 0 then BLIT_SPRITE(Fish_5, X5[i], Y5[i], RGB(255, 0, 255), BUFFER)
next
BUFFER_STOP(hwnd)
SLEEP(60)
loop
end sub
function WinMain(sys nCmdShow) as sys
WNDCLASSEX wc
MSG Msg
sys hDC = GetDC(hwnd)
int screenwidth = GetDeviceCaps(hDC, HORZRES)
int screenheight = GetDeviceCaps(hDC, VERTRES)
int topleft = (screenwidth-MAXX) / 2
int toptop = (screenheight-MAXY) / 2
wc.cbSize = sizeof(WNDCLASSEX)
wc.style = CS_HREDRAW or CS_VREDRAW or CS_OWNDC or CS_DBLCLKS
wc.lpfnWndProc = @WndProc
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hInstance
wc.hIcon = null
wc.hCursor = LoadCursor(null, IDC_ARROW)
wc.hbrBackground = COLOR_WINDOW+1
wc.lpszMenuName = null
wc.lpszClassName = strptr(g_szClassName)
wc.hIconSm = null
if not RegisterClassEx(&wc) then
MessageBox(null, "Window Registration Failed!", "Error!",
MB_ICONEXCLAMATION or MB_OK)
return 0
end if
hwnd = CreateWindowEx(
WS_EX_CLIENTEDGE,
g_szClassName,
"A very nice Aquarium - Double Click for FullScreen Switching and vice versa ",
WS_OVERLAPPEDWINDOW,
topleft, toptop,
MAXX, MAXY,
null, null, hInstance, null)
if hwnd = null then
MessageBox(null, "Window Creation Failed!", "Error!",
MB_ICONEXCLAMATION or MB_OK)
return 0
end if
ShowWindow(hwnd, nCmdShow)
UpdateWindow(hwnd)
drawit()
sys bRet
do while (bRet := GetMessage(&Msg, null, 0, 0))
if bRet = -1 then
'show an error message
mbox "Error in Message Loop"
end
else
TranslateMessage(&Msg)
DispatchMessage(&Msg)
end if
wend
return Msg.wParam
end function
function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
select uMsg
case WM_CREATE
sys hIcon = LoadImage(hInstance, "fish.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)
SendMessage(hwnd, WM_SETICON, ICON_BIG, hIcon)
case WM_LBUTTONDBLCLK
ToggleFullScreen(hwnd)
case WM_SIZE
MAXX = loword(lParam)
MAXY = hiword(lParam)
case WM_KEYDOWN
if loword(wParam) = 27 then
SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
end if
case WM_CLOSE
DestroyWindow(hwnd)
case WM_DESTROY
PostQuitMessage(0)
ExitProcess(0)
case else
return DefWindowProc(hwnd, uMsg, wParam, lParam)
end select
return 0
end function
'WINDOWS START
'=============
'
WinMain(SW_NORMAL)
Thanks Roland, that is an excellent example, though a bit too large to include in the demos. Perhaps I could post it separately on GitHub.
Hi Charles,
it is not necessary to include this app in the demos. It is just a small project using Oxygenbasic which I would like to divide into 3 parts. The second part is to use a . res file for creating an executable.
I modified aquarium.o2bas a little and added the routine for bubble simulation. It now behaves like the original demo. The app can be designed variably by using different fish bmps (120 x 80) or aquarium backgrounds (1024*720) which give a different nice appearance.
This is the expanded source code for aquarium.o2bas:
' A very nice Aquarium demo, ported to OxygenBasic (simplified)
' MrBcx's Blitting Example
'==============================================================
' BCX Aquarium by Kevin Diggins 2023-09-06 MIT License
'==============================================================
'Double Click for FullScreen Switching and vice versa
#compact
$ filename "Aquarium.exe"
'uses rtl32
'uses rtl64
uses corewin
declare function TransparentBlt Lib "msimg32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As sys, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Long
macro rgb(r,g,b) {r+(g<<8)+(b<<16)}
def MAKEINTRESOURCE "#%1"
% COLOR_WINDOW 5
% IMAGE_ICON 1
% LR_LOADFROMFILE 0x0010
% WM_SETICON 0x80
% ICON_BIG 1
% HORZRES 8
% VERTRES 10
% SM_CXBORDER 5
% SM_CYBORDER 6
% HWND_TOPMOST -1
% SWP_NOZORDER 4
% IMAGE_BITMAP 0
% BI_RGB 0
% DIB_RGB_COLORS 0
% SRCCOPY 0xCC0020
% LR_LOADTRANSPARENT 32
% LR_LOADMAP3DCOLORS 4096
type BITMAP
long bmType
long bmWidth
long bmHeight
long bmWidthBytes
word bmPlanes
word bmBitsPixel
sys bmBits
end type
type RGBQUAD
byte rgbBlue
byte rgbGreen
byte rgbRed
byte rgbReserved
end type
type BITMAPINFOHEADER
dword biSize
long biWidth
long biHeight
word biPlanes
word biBitCount
dword biCompression
dword biSizeImage
long biXPelsPerMeter
long biYPelsPerMeter
dword biClrUsed
dword biClrImportant
end type
type BITMAPINFO
BITMAPINFOHEADER bmiHeader
RGBQUAD bmiColors[1]
end type
BITMAPINFO BUFFER_BMP
function rand(int max) as int
uint number
int err = rand_s(&number) : if err != 0 then mbox "rand_s function failed"
return mod(number, max+1)
end function
function rnd() as double
uint number
int err = rand_s(&number) : if err != 0 then mbox "rand_s function failed"
return mod(number, 10000+1) / 10000
end function
function rnd2(int min, int max)
int range = max - min
return rand(range) + min
end function
function timer() as float
return GetTickCount() * 0.001
end function
sub ToggleFullScreen(sys hwnd)
static bool FullScreen = false
static int oldx, oldy, oldwidth, oldheight
RECT rc
FullScreen = not FullScreen
if FullScreen then
GetWindowRect(hwnd, @rc )
oldx = rc.left : oldy = rc.top
oldwidth = rc.right-oldx : oldheight = rc.bottom-oldy
int cx, cy
sys hdc = GetDC(null)
cx = GetDeviceCaps(hdc,HORZRES) + GetSystemMetrics(SM_CXBORDER)
cy = GetDeviceCaps(hdc,VERTRES) + GetSystemMetrics(SM_CYBORDER)
ReleaseDC(null,hdc)
SetWindowLongPtr(hwnd,GWL_STYLE,
GetWindowLongPtr(hwnd, GWL_STYLE) and
(not (WS_CAPTION or WS_THICKFRAME or WS_BORDER or WS_SYSMENU)))
' Put window on top and expand it to fill screen
SetWindowPos(hwnd, convert sys HWND_TOPMOST,
-(GetSystemMetrics(SM_CXBORDER)+1),
-(GetSystemMetrics(SM_CYBORDER)+1),
cx+1, cy+1, SWP_NOZORDER)
else
SetWindowLongPtr(hwnd,GWL_STYLE,
GetWindowLongPtr(hwnd, GWL_STYLE) or WS_CAPTION or WS_THICKFRAME or WS_BORDER or WS_SYSMENU)
MoveWindow(hwnd, oldx, oldy, oldwidth, oldheight, true )
end if
end sub
'=======================
'MAIN CODE
'=======================
dim nCmdline as asciiz ptr, hInstance as sys
&nCmdline = GetCommandLine
hInstance = GetModuleHandle(0)
'========================================'
string szClassName = "OxyAquarium"
sys hwnd
'==============================================================
' It is okay to change the value of these values
'==============================================================
int MAXX = 1024 ' These govern screen and backbuffer sizes
int MAXY = 720 ' These are inital values - they are dynamic.
def FISH1 3
def FISH2 3
def FISH3 3
def FISH4 3
def FISH5 3
'==============================================================
'==============================================================
% FISHW = 120 ' All of the Fish bitmaps are 120 W x 80 H
'==============================================================
dim as single X1[FISH1], Y1[FISH1], Velo1[FISH1] ' velocitys: Pos values move right, Neg move left.
dim as single X2[FISH2], Y2[FISH2], Velo2[FISH2]
dim as single X3[FISH3], Y3[FISH3], Velo3[FISH3]
dim as single X4[FISH4], Y4[FISH4], Velo4[FISH4]
dim as single X5[FISH5], Y5[FISH5], Velo5[FISH5]
sys hBkGnd, Fish_1, Fish_2, Fish_3, Fish_4, Fish_5
sub ErrMsg(string item)
mbox " Could not load " item ".bmp! " + cr +
" ---------- Stop! ---------- "
ExitProcess(0)
end sub
function FuzzyEqual(SoftValue as double, HardValue as double, Low as double, High as double) as int
dim as double LowerBound = SoftValue - Low
dim as double UpperBound = SoftValue + High
if HardValue >= LowerBound and HardValue <= UpperBound then
function = true
else
function = false
end if
end function
function LoadBMP(string F, int ii = 0, int t = 0) as sys
if t then t = LR_LOADTRANSPARENT or LR_LOADMAP3DCOLORS
if ii then
return LoadImage(GetModuleHandle(0), MAKEINTRESOURCE(ii),IMAGE_BITMAP,0,0,t)
end if
return LoadImage(null,F,IMAGE_BITMAP,0,0,LR_LOADFROMFILE or t)
end function
sub Setup()
hBkGnd = LoadBMP("Aquarium.bmp")
Fish_1 = LoadBMP("Fish_1.bmp")
Fish_2 = LoadBMP("Fish_2.bmp")
Fish_3 = LoadBMP("Fish_3.bmp")
Fish_4 = LoadBMP("Fish_4.bmp")
Fish_5 = LoadBMP("Fish_5.bmp")
if hBkGnd = null then ErrMsg("Aquarium")
if Fish_1 = null then ErrMsg("Fish_1")
if Fish_2 = null then ErrMsg("Fish_2")
if Fish_3 = null then ErrMsg("Fish_3")
if Fish_4 = null then ErrMsg("Fish_4")
if Fish_5 = null then ErrMsg("Fish_5")
'======================================================================
' Randomly place our fish on the screen at startup
' First, work out the Y-axis locations
'======================================================================
int i
for i = 1 to FISH1
Y1[i] = rnd2(100, MAXY)
if FuzzyEqual(Y1[i], Y1[i+1], 20, 20) then Y1[i] += 160
if FuzzyEqual(Y1[i], Y1[i-1], 20, 20) then Y1[i] -= 160
Y1[i] = Y1[i] + (2 * sin((X1[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH2
Y2[i] = rnd2(100, MAXY)
if FuzzyEqual(Y2[i], Y2[i+1], 20, 20) then Y2[i] += 160
if FuzzyEqual(Y2[i], Y2[i-1], 20, 20) then Y2[i] -= 160
Y2[i] = Y2[i] + (2 * cos((X2[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH3
Y3[i] = rnd2(100, MAXY)
if FuzzyEqual(Y3[i], Y3[i+1], 20, 20) then Y3[i] += 160
if FuzzyEqual(Y3[i], Y3[i-1], 20, 20) then Y3[i] -= 160
Y3[i] = Y3[i] + (2 * sin((X3[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH4
Y1[i] = rnd2(100, MAXY)
if FuzzyEqual(Y4[i], Y4[i+1], 20, 20) then Y1[i] += 160
if FuzzyEqual(Y4[i], Y4[i-1], 20, 20) then Y1[i] -= 160
Y4[i] = Y4[i] + (2 * cos((X4[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH5
Y5[i] = rnd2(100, MAXY)
if FuzzyEqual(Y5[i], Y5[i+1], 20, 20) then Y5[i] += 160
if FuzzyEqual(Y5[i], Y5[i-1], 20, 20) then Y5[i] -= 160
Y5[i] = Y5[i] + (2 * sin((X5[i] / MAXX) * 2 * pi))
next
'======================================================================
' Now, work out the X-axis starting locations
'======================================================================
for i = 1 to FISH1 ' Setup Fish_1's position & Velocity
X1[i] = -FISHW*2 ' Fish 1 moves RIGHT to LEFT
Velo1[i] = -rnd2(3, 7) ' <- Change speed here
if Velo1[i] = Velo1[i-1] then Velo1[i] += i + 2
next
for i = 1 to FISH2 ' Setup Fish_2's position & Velocity
X2[i] = MAXX * rnd ' Fish 2 moves LEFT to RIGHT
Velo2[i] = rnd2(4, 8) ' <- Change speed here
if Velo2[i] = Velo2[i-1] then Velo2[i] += i + 4
next
for i = 1 to FISH3 ' Setup Fish_3's position & Velocity' Fish 4 moves RIGHT to LEFT
X3[i] = MAXX * rnd ' Fish 3 moves LEFT to RIGHT
Velo3[i] = rnd2(3, 7) ' <- Change speed here
if Velo3[i] = Velo3[i-1] then Velo3[i] += i + 2
next
for i = 1 to FISH4 ' Setup Fish_4's position & Velocity
X4[i] = -FISHW*2 ' Fish 4 moves RIGHT to LEFT
Velo4[i] = rnd2(3, 7) ' <- Change speed here
if Velo4[i] = Velo4[i-1] then Velo4[i] += i + 2
next
for i = 1 to FISH5 ' Setup Fish_3's position & Velocity' Fish 4 moves RIGHT to LEFT
X5[i] = MAXX * rnd ' Fish 3 moves LEFT to RIGHT
Velo5[i] = rnd2(3, 7) ' <- Change speed here
if Velo5[i] = Velo5[i-1] then Velo5[i] += i + 2
next
end sub
sub doevents()
MSG Msg
while PeekMessage(&Msg, null, 0, 0, PM_REMOVE)
TranslateMessage(&Msg)
DispatchMessage(&Msg)
end while
end sub
sys PREV_BMP
sys BUFFER
int BUFFER_BMWIDTH
int BUFFER_BMHEIGHT
sub BUFFER_Start(int x, int y)
if PREV_BMP then
DeleteObject(SelectObject(BUFFER,PREV_BMP))
PREV_BMP = null
end if
if BUFFER then DeleteDC(BUFFER)
BUFFER = CreateCompatibleDC(0)
BUFFER_BMWIDTH = x
BUFFER_BMHEIGHT = y
BUFFER_BMP.bmiHeader.biSize = sizeof(BITMAPINFOHEADER)
BUFFER_BMP.bmiHeader.biWidth = BUFFER_BMWIDTH
BUFFER_BMP.bmiHeader.biHeight = -BUFFER_BMHEIGHT
BUFFER_BMP.bmiHeader.biPlanes = 1
BUFFER_BMP.bmiHeader.biBitCount = 32
BUFFER_BMP.bmiHeader.biCompression = BI_RGB
PREV_BMP = SelectObject(BUFFER,CreateDIBSection(0, &BUFFER_BMP, DIB_RGB_COLORS,0,0,0))
end sub
sub BUFFER_Stop(sys hwnd)
sys Local_HDC = GetDC(hwnd)
BitBlt(Local_HDC,0,0,BUFFER_BMWIDTH,BUFFER_BMHEIGHT,BUFFER,0,0,SRCCOPY)
ReleaseDC(hwnd,Local_HDC)
DeleteObject(SelectObject(BUFFER,PREV_BMP))
end sub
function IsOdd(Number as int) as int
function = Number and 1
end function
sub Blit_Stretch(sys hBmp, sys DrawHDC)
sys hdcDest = CreateCompatibleDC(null)
sys hOldBitmap = SelectObject(hdcDest, hBmp)
BITMAP bmpInfo
GetObject(hBmp,sizeof(BITMAP), &bmpInfo)
int bmpWidth = bmpInfo.bmWidth
int bmpHeight = bmpInfo.bmHeight
StretchBlt(DrawHDC,0,0,MAXX,MAXY,hdcDest,0,0,bmpWidth,bmpHeight,SRCCOPY)
SelectObject(hdcDest, hOldBitmap)
DeleteDC(hdcDest)
end sub
sub Blit_Sprite(sys hBmp, int Left, int Top, ulong rgbMask, sys DrawHDC)
sys hdcDest = 0
sys hOldBitmap = 0
BITMAP bmpInfo = {}
if not hBmp or not DrawHDC then return
hdcDest = CreateCompatibleDC(null)
hOldBitmap = SelectObject(hdcDest,hBmp)
GetObject(hBmp, sizeof(BITMAP), &bmpInfo)
TransparentBlt(DrawHDC, Left, Top, bmpInfo.bmWidth, bmpInfo.bmHeight,
hdcDest, 0, 0, bmpInfo.bmWidth, bmpInfo.bmHeight, rgbMask)
SelectObject(hdcDest,hOldBitmap)
DeleteDC(hdcDest)
end sub
int Pensize = 1
int Penstyle = 0
function Circle(sys hWnd, int X, int Y, int R, int Pen, int Fill = 0, sys DrawHDC = 0)
int RetCode
if Pensize < 1 then Pensize = 1
if not DrawHDC then DrawHDC = GetDC(hWnd)
sys hNewPen = CreatePen(Penstyle,Pensize,Pen)
sys hOldPen = SelectObject(DrawHDC,hNewPen)
sys hOldBrush
sys hNewBrush
if Fill then
hNewBrush = CreateSolidBrush(Pen)
hOldBrush = SelectObject(DrawHDC,hNewBrush)
else
hNewBrush = GetStockObject(NULL_BRUSH)
hOldBrush = SelectObject(DrawHDC,hNewBrush)
end if
RetCode = Ellipse(DrawHDC,X-R,Y+R,X+R,Y-R)
DeleteObject(SelectObject(DrawHDC,hOldPen))
DeleteObject(SelectObject(DrawHDC,hOldBrush))
if hWnd then ReleaseDC(hWnd,DrawHDC)
return RetCode
end function
sub DrawBubble(int RPX,int RPY,int Radius)
Circle(0,RPX,RPY,Radius,rgb(128,140,160),0,BUFFER)
end sub
sub Drawit()
int i
Setup()
do
doevents
BUFFER_Start(MAXX, MAXY)
Blit_Stretch(hBkGnd, BUFFER)
'================================================================================
for i = 1 to FISH1 ' Fish 1 moves RIGHT to LEFT
Y1[i] = Y1[i] + (2 * sin((X1[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH1 ' Update Fish_1 position and velocity (swim right to left)
X1[i] = X1[i] + Velo1[i]
if IsOdd (i) and X1[i] < MAXX/2 then Velo1[i] += -rnd() * 0.3 ' Going for a bit of behavior
if X1[i] < -FISHW then
X1[i] = MAXX + FISHW ' Start Fish_1 from the right edge with an offset
Velo1[i] = -(rnd2(3, 7)) ' Reset Fish_1's horizontal velocity (negative for left)
Y1[i] = rnd2(100, MAXY-200)
end if
if Velo1[i] < 0 then
Blit_Sprite(Fish_1, X1[i], Y1[i], rgb(255, 0, 255), BUFFER)
end if
next
'================================================================================
for i = 1 to FISH2 ' Fish 2 moves LEFT to RIGHT
Y2[i] = Y2[i] + (2 * cos((X2[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH2 ' Update Fish_2 position and velocity (swim left to right)
X2[i] = X2[i] + Velo2[i]
if not IsOdd (i) and X2[i] < MAXX/2 then Velo2[i] += rnd() * 0.4 ' Going for a bit of behavior
if X2[i] + (-FISHW) > MAXX then
X2[i] = -FISHW ' Start Fish_2 from the left edge with an offset
Velo2[i] = rnd2(4, 8) ' Reset Fish_2's horizontal velocity (positive for right)
Y2[i] = rnd2(100, MAXY-200)
end if
if Velo2[i] > 0 then Blit_Sprite(Fish_2, X2[i], Y2[i], rgb(255, 0, 255), BUFFER)
next
'================================================================================
for i = 1 to FISH3 ' Fish 3 moves LEFT to RIGHT
Y3[i] = Y3[i] + (2 * sin((X3[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH3 ' Update Fish_3 position and velocity (swim left to right)
X3[i] = X3[i] + Velo3[i]
if not IsOdd (i) and X3[i] > MAXX/2 then Velo3[i] += rnd() * 0.3 ' Going for a bit of behavior
if X3[i] + (-FISHW) > MAXX then
X3[i] = -FISHW ' Start Fish_2 from the left edge with an offset
Velo3[i] = rnd2(3, 7) ' Reset Fish_2's horizontal velocity (positive for right)
Y3[i] = rnd2(100, MAXY-200)
end if
if Velo3[i] > 0 then Blit_Sprite(Fish_3, X3[i], Y3[i], rgb(255, 0, 255), BUFFER)
next
'================================================================================
for i = 1 to FISH4 ' Fish 4 moves RIGHT to LEFT
Y4[i] = Y4[i] + (2 * cos((X4[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH4 ' Update Fish_4 position and velocity (swim right to left)
X4[i] = X4[i] + Velo4[i]
if IsOdd (i) and X4[i] < MAXX/2 then Velo4[i] += -rnd() * 0.4 ' Going for a bit of behavior
if X4[i] < -FISHW then
X4[i] = MAXX + FISHW ' Start Fish_1 from the right edge with an offset
Velo4[i] = -(rnd2(3, 7)) ' Reset Fish_1's horizontal velocity (negative for left)
Y4[i] = rnd2(100, MAXY-200)
end if
if Velo4[i] < 0 then Blit_Sprite(Fish_4, X4[i], Y4[i], rgb(255, 0, 255), BUFFER)
next
'================================================================================
for i = 1 to FISH5 ' Fish 5 moves LEFT to RIGHT
Y5[i] = Y5[i] + (2 * sin((X5[i] / MAXX) * 2 * pi))
next
for i = 1 to FISH5 ' Update Fish_3 position and velocity (swim left to right)
X5[i] = X5[i] + Velo5[i]
if not IsOdd (i) and X5[i] > MAXX/2 then Velo5[i] += rnd() * 0.3 ' Going for a bit of behavior
if X5[i] + (-FISHW) > MAXX then
X5[i] = -FISHW ' Start Fish_2 from the left edge with an offset
Velo5[i] = rnd2(3, 7) ' Reset Fish_2's horizontal velocity (positive for right)
Y5[i] = rnd2(100, MAXY-200)
end if
if Velo5[i] > 0 then Blit_Sprite(Fish_5, X5[i], Y5[i], rgb(255, 0, 255), BUFFER)
next
'================================================================================
' Bubble Simulation Loop
'================================================================================
single impedence = 0.04
dim static sngStart as single
sngStart = timer()
for i = 1 to 100
dim BubbleX as int
dim BubbleY as int
dim BubbleRadius as int
BubbleX = rnd2(MAXX-100, MAXX) ' Adjust WindowWidth with your aquarium's width
BubbleY = rnd2(10, MAXY) ' Fixed height of the aquarium window
BubbleRadius = rnd2(1, 11) ' Adjust the range for bubble size
DrawBubble(BubbleX, BubbleY, BubbleRadius)
DrawBubble(BubbleX-1, BubbleY, BubbleRadius)
DrawBubble(BubbleX+1, BubbleY, BubbleRadius)
while timer() < (sngStart + IMPEDENCE) and timer() >= sngStart ' Slow the bubbles a bit
wend
next
BUFFER_Stop(hwnd)
SLEEP(60)
loop
end sub
function WinMain(sys nCmdShow) as sys
WNDCLASSEX wc
MSG Msg
sys hDC = GetDC(hwnd)
int screenwidth = GetDeviceCaps(hDC, HORZRES)
int screenheight = GetDeviceCaps(hDC, VERTRES)
int topleft = (screenwidth-MAXX) / 2
int toptop = (screenheight-MAXY) / 2
wc.cbSize = sizeof(WNDCLASSEX)
wc.style = CS_HREDRAW or CS_VREDRAW or CS_OWNDC or CS_DBLCLKS
wc.lpfnWndProc = @WndProc
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hInstance
wc.hIcon = null
wc.hCursor = LoadCursor(null, IDC_ARROW)
wc.hbrBackground = COLOR_WINDOW+1
wc.lpszMenuName = null
wc.lpszClassName = strptr(szClassName)
wc.hIconSm = null
if not RegisterClassEx(&wc) then
MessageBox(null, "Window Registration Failed!", "Error!",
MB_ICONEXCLAMATION or MB_OK)
return 0
end if
hwnd = CreateWindowEx(
WS_EX_CLIENTEDGE,
szClassName,
"A very nice Aquarium - Double Click for FullScreen Switching and vice versa ",
WS_OVERLAPPEDWINDOW,
topleft, toptop,
MAXX, MAXY,
null, null, hInstance, null)
if hwnd = null then
MessageBox(null, "Window Creation Failed!", "Error!",
MB_ICONEXCLAMATION or MB_OK)
return 0
end if
ShowWindow(hwnd, nCmdShow)
UpdateWindow(hwnd)
Drawit()
sys bRet
do while (bRet := GetMessage(&Msg, null, 0, 0))
if bRet = -1 then
'show an error message
mbox "Error in Message Loop"
end
else
TranslateMessage(&Msg)
DispatchMessage(&Msg)
end if
wend
return Msg.wParam
end function
function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
select uMsg
case WM_CREATE
sys hIcon = LoadImage(hInstance, "fish.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)
SendMessage(hwnd, WM_SETICON, ICON_BIG, hIcon)
case WM_LBUTTONDBLCLK
ToggleFullScreen(hwnd)
case WM_SIZE
MAXX = loword(lParam)
MAXY = hiword(lParam)
case WM_KEYDOWN
if loword(wParam) = 27 then
SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
end if
case WM_CLOSE
DestroyWindow(hwnd)
case WM_DESTROY
PostQuitMessage(0)
ExitProcess(0)
case else
return DefWindowProc(hwnd, uMsg, wParam, lParam)
end select
return 0
end function
'WINDOWS START
'=============
'
WinMain(SW_NORMAL)