Author Topic: is this complicated ?  (Read 4833 times)

0 Members and 1 Guest are viewing this topic.

Peter

  • Guest
is this complicated ?
« on: December 24, 2010, 05:03:39 AM »
Hi Charles,

some new commands:

createImage()
copyImageRect()
ClearImage()
FreeImage()

look at the demo to see what it means.
Peter

'DEMO'
Code: [Select]
IndexBase 0
Include Once "Win_C.inc"  'Constants
Include Once "Win_D.inc"  'Declarations
Include Once "Win_G.inc"  'Graphics

Function WndProc(byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback
if wMsg = WM_CREATE
'
elseif wMsg = WM_PAINT
'
elseif wMsg = WM_MOUSEMOVE
xMouse = LoWord(lParam)
yMouse = HiWord(lParam)
'
elseif wMsg = WM_DESTROY
PostQuitMessage 0
else
Function = DefWindowProc hWnd,wMsg,wParam,lParam
endif
End Function

/* DECLARATIONS  */

/* VARIABLES  */
Dim hwnd, sx, iHdc,hFont as long
Dim s as string
s = "MERRY CHRISTMAS"
hwnd = SetWindow "OxygenBasic",500,400,WS_DLGFRAME
bHdc = SetBuffer WinWidth, WinHeight
iHdc = CreateImage 1000,400                  
hFont = CreateFont (128,20,0,0,FW_BOLD,0,0,0,0,0,0,0,0,"times")
SelectObject iHdc,hFont
SetBkMode iHdc,1
SetTextcolor iHdc,RGB(0,255,0)
Randomize


/*  MAINLOOP  */
While EscKey() =0
ClearImage iHdc,1000,400                '<-- DContex, ImageWidth, ImageHeight
SetTextcolor iHdc,RGB(255,155,255)
TextOut iHdc,500,100,s,Len(s)
CopyImageRect iHdc,sx,0,500,400,0,0    '<-- DContex, xImage, yImage, ImageWidth, ImageHeight, xBuffer, yBuffer
sx +=1                                  
if sx =980 then sx =0
DoEvents
FlipBuffer
'Sleep 10
Wend
FreeBuffer
FreeImages
ExitProcess 0    

/* FUNCTIONS  */
« Last Edit: January 05, 2013, 05:50:51 PM by peter »

kryton9

  • Guest
Re: is this complicated ?
« Reply #1 on: December 24, 2010, 12:31:47 PM »
I couldn't find the demo in the rar file Peter.

Also, I noticed a User Defined Type of TRGB. Wouldn't it be better to make a class of that type, this way we can have overloaded methods to handle different types, long, float... or can we override even when UDT's?

Edited:Oh I see the demo is the source code above in the previous post   :)
« Last Edit: December 24, 2010, 12:56:26 PM by kryton9 »

Peter

  • Guest
Re: is this complicated ?
« Reply #2 on: December 24, 2010, 12:59:22 PM »
Hi Kryton9,

if you like a class, make your class.
is open source!

Merry Christmas!

Peter

kryton9

  • Guest
Re: is this complicated ?
« Reply #3 on: December 24, 2010, 01:06:06 PM »
Thanks Peter, Merry Christmas to you too. I am enjoying studying your code as well as new oxygen alpha.

Peter

  • Guest
Re: is this complicated ?
« Reply #4 on: December 24, 2010, 03:41:05 PM »

Here is another demo for you!
Code: [Select]
IndexBase 0
Include Once "Win_C.inc"  'Constants
Include Once "Win_D.inc"  'Declarations
Include Once "Win_G.inc"  'Graphics

Function WndProc(byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback
if wMsg = WM_CREATE
'
elseif wMsg = WM_PAINT
'
elseif wMsg = WM_MOUSEMOVE
xMouse = LoWord(lParam)
yMouse = HiWord(lParam)
InValidateRect hwnd,0,0
'
elseif wMsg = WM_DESTROY
PostQuitMessage 0
else
Function = DefWindowProc hWnd,wMsg,wParam,lParam
endif
End Function

/* DECLARATIONS  */

/* VARIABLES  */
Dim hwnd, sa, sx, iHdc, hFont as long
Dim s as string
s = "HAPPY NEW YEAR"
hwnd = SetWindow "OxygenBasic o24",500,400,WS_DLGFRAME
bHdc = SetBuffer WinWidth, WinHeight
iHdc = CreateImage 1000,400                   
hFont = CreateFont (160,22,0,0,FW_BOLD,0,0,0,0,0,0,0,0,"times")
SelectObject iHdc,hFont
SetBkMode iHdc,1
SetTextcolor iHdc,RGB(0,255,0)
Randomize
SetTextcolor iHdc,RGB(255,155,55)
TextOut iHdc,500,100,s,Len(s)

/*  MAINLOOP  */
While EscKey() =0
ClearBuffer()               
CopyImageRect iHdc,sx,0,500,400,0,0   
For sa=1 To 50
Circle,bHdc,Rand(1,499),Rand(1,399),Rand(8,48),Rand(Rgb(64,64,64),Rgb(255,255,255))
Next
sx +=2                                   
if sx >=990 then sx =0
DoEvents
FlipBuffer()
'Sleep 10
Wend
FreeBuffer()
FreeImages()
ExitProcess 0     

/* FUNCTIONS  */

kryton9

  • Guest
Re: is this complicated ?
« Reply #5 on: December 25, 2010, 12:47:34 AM »
Another nice one, thanks.

Charles Pegge

  • Guest
Re: is this complicated ?
« Reply #6 on: December 25, 2010, 02:43:08 AM »

Thanks Peter,

I will explore the possibilities of even simpler code :)

(I have a little time before serious feasting begins!)

Charles

Charles Pegge

  • Guest
Re: is this complicated ?
« Reply #7 on: December 25, 2010, 04:41:07 AM »

Hiding the windows infrastructure:

Win_F.inc
Code: [Select]
IndexBase 0
Include Once "Win_C.inc"  'Constants
Include Once "Win_D.inc"  'Declarations
Include Once "Win_G.inc"  'Graphics

Function WndProc(byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback
if wMsg = WM_CREATE
'
elseif wMsg = WM_PAINT
'
elseif wMsg = WM_MOUSEMOVE
xMouse = LoWord(lParam)
yMouse = HiWord(lParam)
InValidateRect hwnd,0,0
'
elseif wMsg = WM_DESTROY
PostQuitMessage 0
else
Function = DefWindowProc hWnd,wMsg,wParam,lParam
endif
End Function


'============

create 'invoke macro

'============



/*  MAINLOOP  */

While EscKey() =0

ClearBuffer()               

'=========

run 'invoke macro

'=========

DoEvents
FlipBuffer()
Sleep 5
Wend
FreeBuffer()
FreeImages()
ExitProcess 0     



Demo
Code: [Select]

'=========
def create
'=========

/* DECLARATIONS  */

/* VARIABLES  */

Dim hwnd, sa, sx, iHdc, hFont as long
Dim s as string
s = "HAPPY NEW YEAR"
hwnd = SetWindow "OxygenBasic o24",500,400,WS_DLGFRAME
bHdc = SetBuffer WinWidth, WinHeight
iHdc = CreateImage 1000,400                   
hFont = CreateFont (160,22,0,0,FW_BOLD,0,0,0,0,0,0,0,0,"times")
SelectObject iHdc,hFont
SetBkMode iHdc,1
SetTextcolor iHdc,RGB(0,255,0)
Randomize
SetTextcolor iHdc,RGB(255,155,55)
TextOut iHdc,500,100,s,Len(s)

type vector4i sys a,b,c,d
vector4i circ[50]
For sa=0 to 49
  circ[sa].a=Rand(1,499)
  circ[sa].b=Rand(1,399)
  circ[sa].c=Rand(8,48)
  circ [sa].d=Rand(Rgb(64,64,64),Rgb(255,255,255))
Next

/* FUNCTIONS  */

end def 'create


'======
def run
'======

CopyImageRect iHdc,sx,0,500,400,0,0   
sx +=2 : if sx >=990 then sx =0
'
For sa=0 To 49
  Circle,bHdc,circ[sa].a,circ[sa].b,circ[sa].c,circ[sa].d
  c=circ[sa].c
  if c>=48 then circ[sa].a=Rand(1,499) : circ[sa].b=Rand(1,399) : c=8
  circ[sa].c=c+1 
Next

end def

include "Win_F.inc"


Peter

  • Guest
Re: is this complicated ?
« Reply #8 on: December 25, 2010, 06:43:36 AM »
thanks Charles,

Def is great!

Question:  (vector4i circ[50]) is (circ[50] as vector4i ?)
                
what type has sys ?
and what are variables without any type?

Sleep under 10 msec has no effect!
what we need is a command like LimitFrame().  QueryPerformanceCounter would be good for it!

Peter

and here something for the users  brains.

Code: [Select]
IndexBase 0

Include Once "Win_C.inc"  
Include Once "Win_D.inc"  
Include Once "Win_G.inc"  

Function WndProc(byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback
if wMsg = WM_CREATE
'
elseif wMsg = WM_PAINT
'
elseif wMsg = WM_MOUSEMOVE
xMouse = LoWord(lParam)
yMouse = HiWord(lParam)
InValidateRect hwnd,0,0
'
elseif wMsg = WM_DESTROY
PostQuitMessage 0
else
Function = DefWindowProc hWnd,wMsg,wParam,lParam
endif
End Function

Declare Function LoadPicture(byval pfile as string) as long
Declare Function DrawToImage(byval PicHdc As Long, byval x1 As Long, byval y1 As Long, byval w as long, byval h as long)
Declare Function FreePicture()

Dim jc,bHdc,iHdc,dir,pHnd(10),pHdc(10) as long
Dim s1,s2,s3,s4,s5,s6,s7,s8 as long

SetWindow "HappyShow 2010",320,264,WS_DLGFRAME
bHdc = SetBuffer WinWidth,WinHeight
iHdc = CreateImage 2560,264

s1 = LoadPicture "pics/christball320x240.bmp"
s2 = LoadPicture "pics/snowman320x240.bmp"
s3 = LoadPicture "pics/wintersnow320x240.bmp"
s4 = LoadPicture "pics/christmas320x240.bmp"
s5 = LoadPicture "pics/tannen320x240.bmp"
s6 = LoadPicture "pics/newtree320x240.bmp"
s7 = LoadPicture "pics/morewinter320x240.bmp"
s8 = LoadPicture "pics/happy320x240.bmp"

DrawToImage s1,0,0,320,240
DrawToImage s2,320,0,320,240
DrawToImage s3,640,0,320,240
DrawToImage s4,960,0,320,240
DrawToImage s5,1280,0,320,240
DrawToImage s6,1600,0,320,240
DrawToImage s7,1920,0,320,240
DrawToImage s8,2240,0,320,240

While EscKey() =0
CopyImageRect iHdc,jc,0,320,240,0,0
if dir =0
jc = jc +2
if jc >=2240 Then dir =1
elseif dir =1
jc = jc -2
if jc <=0 Then dir =0
endif
DoEvents
FlipBuffer
Sleep 10
Wend
FreeBuffer
FreeImages
FreePicture
ExitProcess 0

Function LoadPicture(byval pfile as string) as long
static co as long
co += 1
pHnd(co) = LoadImage(0, pfile, 0, 0, 0, 16)
pHdc(co) = CreateCompatibleDC(hdc)
SelectObject pHdc(co), pHnd(co)              
Function = pHdc(co)
End Function

Function FreePicture()
For c=1 To 8
DeleteObject pHnd(c): DeleteDC pHdc(c)
Next
End Function

Function DrawToImage(byval PicHdc As Long,byval x1 As Long, byval y1 As Long, byval w as long, byval h as long)
BitBlt iHdc, x1, y1, w, h, PicHdc, 0, 0, &hCC0020
End Function
 

[attachment deleted by admin]
« Last Edit: December 25, 2010, 01:11:05 PM by peter »

Charles Pegge

  • Guest
Re: is this complicated ?
« Reply #9 on: December 25, 2010, 12:06:22 PM »

Thanks Peter,

when the type of a variable is unspecified it defaults to sys

sys is long for 32 bit systems and will be quad for 64 bit systems.

type vector4i sys a,b,c,d
is very naughty but useful for simple structures  8)

These are all equivalent:

vector4i circ[50]
dim vector4i circ[50]
dim as vector4i circ[50]
dim circ[50] as vector4i
dim byval circ[50] as vector4i
var vector4i circ[50]

Round brackets are also allowed except for the first one. (c syntax)

Sleep <10 gives the CPU core the opportunity to do tasks between loops even though it is below the resolution of the windows message timer.


Charles

Peter

  • Guest
Re: is this complicated ?
« Reply #10 on: December 25, 2010, 12:59:22 PM »
thank you for your explanation Charles.

I like square brackets  much more than round brackets.

And here:
I found this at Aurel Basic. I have modified it a bit.
to be honest,  something more !

This isn't declared yet   '% WS_MINIMIZEBOX = &H20000'
Write it in the source code or remove it.
Peter

Code: [Select]
IndexBase 0
Include Once "Win_C.inc"  'Constants
Include Once "Win_D.inc"  'Declarations
Include Once "Win_G.inc"  'Graphics

Function WndProc(byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback
if wMsg = WM_CREATE
'
elseif wMsg = WM_PAINT
'
elseif wMsg = WM_MOUSEMOVE
xMouse = LoWord(lParam)
yMouse = HiWord(lParam)
'
elseif wMsg = WM_DESTROY
PostQuitMessage 0
else
Function = DefWindowProc hWnd,wMsg,wParam,lParam
endif
End Function

Dim pi, v, v3, v4, x, y, x2, y2, x3, y3, x4, y4, x5, y5, n, p as single
Dim s, bHdc, hFont as long
pi = 3.14159

SetWindow "Rotate...", 640, 500, WS_MINIMIZEBOX | WS_OVERLAPPED  
bHdc = SetBuffer 640,500
hFont = CreateFont (32,20,0,0,FW_BOLD,0,0,0,0,0,0,0,0,"times")
SelectObject bHdc,hFont
SetBkMode bHdc,1

While (WinExit =0) & (EscKey()=0)
ClearBuffer()
SetTextColor bHdc,Rgb(200, 240, 0)
TextOut bHdc,90,0,"YOU NEEDN'T WAIT!",17
For v =0 To 7
v = v + 0.008
if v = 6.28 Then v=0
v3 = v3 + .003
v4 = v4 + .01
if v3 >= 6.28 Then v3 = 0.003
if v4 >= 6.28 Then v4 = 0.01

x =  Cos(v3) * 180 + (Cos(v) * -20 + 320)
y =  Sin(v3) * 180 + (Sin(v) * -20 + 240)
x2 = Cos(v3) * 180 + (Cos(v) *  20 + 320)
y2 = Sin(v3) * 180 + (Sin(v) *  20 + 240)
x3 = Cos(v3) * 180 + (Cos(v) *   0 + 320)
y3 = Sin(v3) * 180 + (Sin(v) *   0 + 240)

x4 = Cos(v)  * 20  + 320
y4 = Sin(v)  * 20  + 240
x5 = Cos(v4) * 80  + 320
y5 = Sin(v4) * 80  + 240

Circle bHdc, x3, y3, 20, Rgb(100, 200, 255)
Circle bHdc, x4, y4, 40, Rgb(22,  220, 100)
Circle bHdc, x5, y5, 10, Rgb(255, 120,  50)
Next
DoEvents
FlipBuffer
Sleep 24
Wend
Beep 440,400
FreeBuffer()
ExitProcess 0

« Last Edit: December 25, 2010, 01:26:14 PM by peter »

Aurel

  • Guest
Re: is this complicated ?
« Reply #11 on: August 21, 2012, 02:25:42 AM »
I would like to ask about Macro.
What is the main advantage of using MACRO ?
Is it posible to use macro to hide WndProc ?

Charles Pegge

  • Guest
Re: is this complicated ?
« Reply #12 on: August 21, 2012, 03:16:35 AM »
Hi Aurel,

I use short macros in projectsA/openglGUI/viewer.o2bas to hide most of the program, including wndproc, and to expose selected parts of the program. This is a seriously complex piece of programming. It is my most sensitive  'canary' for OxygenBasic. :) I did a fair amount of work on this system a few days ago, and this is how the top level appears now:

Code: OxygenBasic
  1.  
  2.  
  3.   ' GL Example using Glo2/openglview sourcelibrary
  4.  '
  5.  ' 10 Sept 2010
  6.  ' 14 Sept 2011
  7.  ' 07 May  2012
  8.  ' 14 Aug  2012
  9.  '
  10.  ' Charles Pegge
  11.  
  12.  
  13.   '==============
  14.  'SPECIFICATIONS
  15.  '==============
  16.  
  17.  
  18.   $ WindowTitle  "OxygenBasic Opengl Viewer Demo"
  19.   $ WindowSize   800,800
  20.  
  21.  
  22.   'Controls
  23.  '--------
  24.  
  25.   $ NavigationKeys
  26.   $ FunctionKeys
  27.   $ GraphicalControls
  28.  
  29.   'sources for editbox
  30.  
  31.   $ textfile1 "portviewer2Man.txt"
  32.  
  33.  
  34.   'color / images / textures
  35.  '-------------------------
  36.  
  37.   $ BackColor 0.3,0,.1,0
  38.   $ GDIplus
  39.   '$ BackImage "../../examples/images/dawn1815.jpg"
  40.  
  41.  
  42.   'standard lighting
  43.  '-----------------
  44.  
  45.   $ LightPosition 0.0, 8.0, 8.0, 1.0
  46.   $ LightAmbient  1.0, 1.0, 1.0, 1.0
  47.   $ LightDiffuse  1.0, 1.0, 1.0, 1.0
  48.   $ LightSpecular 1.0, 1.0, 1.0, 1.0
  49.  
  50.  
  51.   'standard material
  52.  '-----------------
  53.  
  54.   $ MaterialAmbient   .15, .15, 0.2, 1.0
  55.   $ MaterialDiffuse   0.7, 0.7, 0.6, 1.0
  56.   $ MaterialSpecular  0.0, 0.0, 0.1, 1.0
  57.   $ MaterialShininess 0
  58.  
  59.   $ Geometries   include "geometries.inc"
  60.   $ DrawingLists include "DrawingLists.inc"
  61.   $ scenes       include "scenes.inc"
  62.   $ StartScene   7
  63.  
  64.   $ fontA "Arial",FW_SEMIBOLD
  65.   $ fontB "Lucida Console",FW_BOLD
  66.   '$ fontC "Times",FW_NORMAL
  67.  
  68.  
  69.  
  70.   'COMPILING TO OXYGEN-DEPENDENT EXECUTABLE
  71.  '----------------------------------------
  72.  
  73.   '#file "Viewer.exe"
  74.  
  75.   'COMPILING TO INDEPENDENT EXECUTABLE
  76.  
  77.   $ FileName "Viewer.exe"
  78.   'include "..\..\inc\RTL64.inc" 'to compile 64bit
  79.  'include "..\..\inc\RTL32.inc" 'to compile 32bit
  80.  
  81.  
  82.  
  83.   '===========
  84.  'MAIN SOURCE
  85.  '===========
  86.  
  87.   include "OpenglView.inc"
  88.  

The intention is to bring together in one place, all the parts of the system which are of interest to the user, without making the system inefficient or bloated.


Charles
« Last Edit: August 21, 2012, 03:22:17 AM by Charles Pegge »

Aurel

  • Guest
Re: is this complicated ?
« Reply #13 on: August 21, 2012, 03:34:51 AM »
Hi Charles

I agree with you that this is a complex piece of programming.
In first place i ask because i need to know what is a main difference between macro
and function.
I refer to this simple example given by Peter:
Code: [Select]
Macro Rebirth
   Stars[i].yStar = Rand(1, yRes - 2)
   Stars[i].speed = Rand(1, 20) * 0.1 + 1
End Macro

And then is used inside standard Function.
Is macro some sort of static function with global scope ?
THen i see that macro can have parameters.
I was wondering is there a way to define or declare variable as function(pointer)
which can be called globaly?

I will try to do some more test that i have better perception what is what,,ufff...

Aurel

Charles Pegge

  • Guest
Re: is this complicated ?
« Reply #14 on: August 21, 2012, 05:25:05 AM »
You can often substitute macros for functions and vice-versa. The scoping rules are different however. The macro will see all the variables in the environment from where it is invoked, including locals and statics. Macros will always be faster than functions, but the more complex ones will use more code when they are used several times.

Macros work only by symbol substitution. Code is expanded and inserted to replace the invoking expression. There are no calls involved. They go back to the earliest days of computing when computers used valves :)

Hiword and Loword are very good candidates for macros:


macro loword(a)
a and 0xffff
end macro

macro hiword(a)
a>>16
end macro


Charles