Hello,
this is another nice demo derived from other examples. I used it to look for some issues, especially memory leaks.
The app creates drawings that can be adapted to your own patterns, e.g. samples for wallpaper, T-shirts, wrapping paper etc. or for a kind of Rorschach test. Each drawing is unique and will never come back. Some drawings are really interesting. I have only used one of the many GDI functions provided. I assume that something like a Mondrian or Picasso style would be possible with a little more effort and a little more functions.
Roland
tinyart.o2bas
$ filename "TinyArt.exe"
'uses rtl32
'uses rtl64
uses dialogs
indexbase 0
% PS_NULL 5
'% ALTERNATE 1
'% WINDING 2
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
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
% IDM_EXIT 1120
enum idm_colors(IDM_WHITE=1141, IDM_BLACK, IDM_BLUE, IDM_RED, IDM_GREEN, IDM_YELLOW,
IDM_MAGENTA, IDM_CYAN, IDM_GRAY)
def CSB CreateSolidBrush
sys bk_colors = {CSB WHITE, CSB BLACK, CSB BLUE, CSB RED, CSB GREEN, CSB YELLOW,
CSB MAGENTA, CSB CYAN, CSB LTGRAY}
enum idm_polygons(IDM_POLY1=1161, IDM_POLY2, IDM_POLY3, IDM_POLY4, IDM_POLY5)
% IDM_PLAY 1200
% IDM_HELP 1260
% IDM_ABOUT 1270
% ID_TIMER 3000
sys hMenu
sys hAccel
int maxPolygons=3
int toggle_play
int vMin=4, vMax=20 'vertices
POINT points[24], points1[24], points2[24], points3[24], points4[24]
declare sub initMenu(sys hDlg)
declare sub drawPattern(sys hDlg, int max)
declare sub showHelp()
string cr=chr(13,10)
==============================================
'MAIN CODE
=============================================
function DlgProc(sys hDlg, uint uMsg, sys wParam, lParam) as int callback
static PAINTSTRUCT ps
static sys hDlgBrush
int x
select case uMsg
case WM_INITDIALOG
initMenu(hDlg)
//initialize the background brush
hDlgBrush = bk_colors[0] 'WHITE
ShowWindow(hDlg, SW_NORMAL)
case WM_COMMAND
select case loword(wParam)
case IDCANCEL, IDM_EXIT
SendMessage(hDlg, WM_CLOSE, 0, 0)
case IDM_WHITE to IDM_GRAY
for x = IDM_WHITE to IDM_GRAY
if x = loword(wParam) then
CheckMenuItem(hMenu, x, MF_BYCOMMAND or MF_CHECKED)
int idx = x-IDM_WHITE
hDlgBrush = bk_colors[idx]
else
CheckMenuItem(hMenu, x, MF_BYCOMMAND or MF_UNCHECKED)
end if
next x
case IDM_POLY1 to IDM_POLY5
for x = IDM_POLY1 to IDM_POLY5
if x = loword(wParam) then
CheckMenuItem(hMenu, x, MF_CHECKED)
maxPolygons = x-IDM_POLY1 + 1
else
CheckMenuItem(hMenu, x, MF_UNCHECKED)
end if
next x
case IDM_PLAY
toggle_play = not toggle_play
if toggle_play then
ModifyMenu(hMenu, IDM_PLAY, MF_BYCOMMAND, IDM_PLAY, "Stop Tour!")
SetTimer(hDlg, ID_TIMER, 1000, NULL)
else
ModifyMenu(hMenu, IDM_PLAY, MF_BYCOMMAND, IDM_PLAY, "Start Tour!")
KillTimer(hDlg, ID_TIMER)
end if
DrawMenuBar(hDlg)
case IDM_HELP
showHelp()
case IDM_ABOUT
mbox "Simple Graphics Demo" + cr + "using OxygenBasic"
end select
case WM_LBUTTONDOWN
InvalidateRect(hDlg, 0, true)
case WM_SIZE
InvalidateRect(hDlg, 0, true)
case WM_TIMER
InvalidateRect(hDlg, 0, true)
case WM_KEYUP
if wParam = 13 then ' Enter
InvalidateRect(hDlg, 0, true)
end if
case WM_CTLCOLORDLG
return hDlgBrush
case WM_PAINT
BeginPaint(hDlg, &ps)
InvalidateRect(hDlg,Null, true)
EndPaint(hDlg, &ps)
drawPattern(hDlg, maxPolygons)
case WM_CLOSE
KillTimer(hDlg, ID_TIMER)
for x = IDM_WHITE to IDM_GRAY
int ix = x-IDM_WHITE
if DeleteObject(bk_colors[ix]) = 0 then
mbox "Cannot DeleteObject bk_color[" ix "]"
end if
next x
DestroyWindow(hDlg)
case WM_DESTROY
int idx
DestroyAcceleratorTable(hAccel)
PostQuitMessage(null)
end select
return 0
end function
sub winmain()
sys hDlg, bRet
MSG Msg
Dialog( 0, 0, 300, 240, "My little Art Gallery",
WS_OVERLAPPEDWINDOW or DS_CENTER )
hDlg = CreateModelessDialog( null, @DlgProc, 0)
while bRet := GetMessage(&Msg, NULL, 0, 0)
if bRet = -1 then
'show an error message
mbox "Error in Message Loop"
end
else
if TranslateAccelerator( hDlg, hAccel, @Msg ) = 0 then
if not IsDialogMessage(hDlg, &Msg) then
TranslateMessage(&Msg)
DispatchMessage(&Msg)
end if
end if
end if
wend
end sub
winmain()
========================================================
sub initMenu(sys hDlg)
indexbase 1
MENU(hMenu)
BEGIN
POPUP "&File"
BEGIN
MENUITEM "E&xit" tab "Alt+F4", IDM_EXIT
ENDMenu
POPUP "&Options"
BEGIN
POPUP "BackGround Color"
BEGIN
MENUITEM "White", IDM_WHITE, CHECKED
MENUITEM "Black", IDM_BLACK
MENUITEM "Blue", IDM_BLUE
MENUITEM "Red", IDM_RED
MENUITEM "Green", IDM_GREEN
MENUITEM "Yellow", IDM_YELLOW
MENUITEM "Magenta", IDM_MAGENTA
MENUITEM "Cyan", IDM_CYAN
MENUITEM "Gray", IDM_GRAY
ENDMenu
POPUP "Number of Polygons"
BEGIN
MENUITEM "1 polygon", IDM_POLY1
MENUITEM "2 polygons", IDM_POLY2
MENUITEM "3 polygons", IDM_POLY3, CHECKED
MENUITEM "4 polygons", IDM_POLY4
MENUITEM "5 polygons", IDM_POLY5
ENDMenu
ENDMenu
POPUP "&Help"
BEGIN
MENUITEM "Instructions" tab "F1", IDM_HELP
MENUITEM "SEPARATOR"
MENUITEM "Ab&out",IDM_ABOUT
ENDMenu
MENUITEM "&Start Tour!", IDM_PLAY
ENDMenu
if SetMenu(hDlg, hMenu) = 0 then
mbox "SetMenu hMenu failed!"
end if
'Accelerators
indexbase 0
ACCEL accl[1] = {
{FVIRTKEY, asc("S"), IDM_PLAY},
{FVIRTKEY, VK_F1, IDM_HELP}
}
hAccel = CreateAcceleratorTable(@accl, 2)
end sub
sub makePolygon(sys hDlg, int m)
static sys brush_color, hPen, hDC
RECT pRect
int i
int c = rand(vMax) + vMin
GetClientRect(hDlg, &pRect)
int h = pRect.bottom
int w = pRect.right
if m then h \= 2 : w \= 2
c--
for i = 0 to c
if m then
points1[i].x = rand(w) : points2[i].x = points1[i].x + w : points3[i].x = points1[i].x + w : points4[i].x = points1[i].x
points1[i].y = rand(h) : points2[i].y = points1[i].y + h : points3[i].y = points1[i].y : points4[i].y = points1[i].y + h
else
points[i].x = rand(w)
points[i].y = rand(h)
end if
next
brush_color=CreateSolidBrush(RGB(rand(255), rand(255), rand(255)))
hPen = CreatePen(PS_NULL,0,0) 'invisible
hDC = GetDC(hDlg)
SelectObject(hDC, brush_color)
SelectObject(hDC,hPen)
if m then
SetPolyFillMode (hDC, rand(1)+1) 'ALTERNATE, WINDING
Polygon(hDC, points1[],c)
SetPolyFillMode (hDC, rand(1)+1)
Polygon(hDC, points2[],c)
SetPolyFillMode (hDC, rand(1)+1)
Polygon(hDC, points3[],c)
SetPolyFillMode (hDC, rand(1)+1)
Polygon(hDC, points4[],c)
else
SetPolyFillMode (hDC, rand(1)+1) 'ALTERNATE, WINDING
Polygon(hDC, points[],c)
end if
if ReleaseDC(hDlg, hDC) = 0 then mbox "Cannot ReleaseDC hDC"
if DeleteObject(brush_color) = 0 then mbox "Cannot DeleteObject brush_color"
if DeleteObject(hPen) = 0 then mbox "Cannot DeleteObject hPen"
end sub
sub drawPattern(sys hDlg, int max)
int x
int multiple = rand(1)
for x = 1 to max
makePolygon(hDlg, multiple)
next
ValidateRect(hDlg, NULL)
end sub
sub showHelp()
string s = quote """
Options for navigating:
=======================
File
Exit, Alt-F4 or Escape key: ends the program
Options
Background Color: change background color for next drawing
Number of Polygons: 1 to 5 polygons can be selected
Start/Stop Tour! or "S" key:
Creates continuous new drawings
Clicking with Left Mouse Button or pressing Enter:
Creates a new drawing
Resizing Window:
Creates new drawing.
"""
mbox s
end sub
