callback function vrs virtual method in a class

[Aurel]

Uff i try this way,but im not sure exactly what im doing
Compiler says that some elements of win are missing like mWidth but is there ..
here is micro.inc

Code: [Select]

'micro.inc by Aurel
'Last Modified:
'2012.july,29

'myWin variables have a "m" prefix for them
'Parameters/Arguements have an "a" prefix for arguement
#lookahead
Type WNDCLASS
 'cbSize        as long
 Style         as long
 lpfnwndproc   as long
 cbClsextra    as long
 cbWndExtra    as long
 hInstance     as long
 hIcon         as long
' hIconSm       AS long
 hCursor       as long
 hbrBackground as long
 lpszMenuName  as long
 lpszClassName as long
End Type

Type LARGE_INTEGER
lowpart AS INT
highpart AS INT
End Type


Type PointApi
 x as long
 y as long
End Type

Type MSG
 hwnd    as long
 message as long
 wParam  as long
 lParam  as long
 time    as long
 pt      as PointApi
End Type

Type RECT
 Left   as Long
 Top    as Long
 Right  as Long
 Bottom as Long
End Type

% CS_DBLCLKS     = 0x8
% CS_OWNDC       = 32
% SW_SHOW        = 5
% PM_REMOVE      = 1
% PM_NOREMOVE    = 0
% IDI_APPLICATION = 32512
% IDC_ARROW      = 32512

% WM_SETICON     = &H80
% WM_KILLFOCUS = 0x8 
% WM_CREATE      = 1
% WM_DESTROY     = 2
% WM_PAINT       = 15
% WM_QUIT        = 18
% WM_SIZE        = 5
% WM_MOVE        = 3
% WM_CHAR        = 258
% WM_KEYLAST     = &H108
% WM_KEYFIRST    = &H100
% WM_KEYDOWN     = 256
% WM_MOUSEMOVE   = 512
% WM_MBUTTONDOWN = 519
% WM_LBUTTONDOWN = 513
% WM_RBUTTONDOWN = 516
% WM_LBUTTONUP   = 514
% WM_RBUTTONUP   = 517
% WM_MBUTTONUP   = 520
% WM_TIMER       = 275
% WM_WINDOWPOSCHANGED = &H47
% WM_NOTIFY      = 0x004E
% WM_SETFONT = &H30
% WM_COMMAND = 0x111
% BN_CLICKED = 0
% WM_PARENTNOTIFY = 0x210
% WM_SETTEXT  = &HC
% WM_GETTEXT = 0xD

% WS_CLIPSIBLINGS = 0x4000000
% WS_CLIPCHILDREN = 0x2000000
% WS_SYSMENU     = 524288
% WS_THICKFRAME = 0x40000
% WS_CAPTION = 0xC00000
% WS_OVERLAPPED  = 0x0 
% WS_MINMAXSIZE  =
% WS_POPUP       = 0x80000000
% WS_DLGFRAME    = 0x400000
% WS_MAXIMIZE    = &H1000000
% WS_MINIMIZEBOX = &H20000
% WS_MAXIMIZEBOX = 0x10000
% WS_BORDER      = &H800000
% WS_CHILD = 0x40000000
% WS_VISIBLE = 0x10000000
% WS_VSCROLL = 0x200000
% WS_HSCROLL = 0x100000
'minmaxsize-> overlappedwindow
% WS_MINMAXSIZE =(WS_OVERLAPPED Or WS_VISIBLE Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)


Dim kernel32,user32,gdi32,riched32
kernel32 = LoadLibrary "kernel32.dll"
user32   = LoadLibrary "user32.dll"
gdi32    = LoadLibrary "gdi32.dll"
riched32 =  LoadLibrary "riched32.dll"

Bind kernel32
(
  GetCommandLine  GetCommandLineA   
  GetModuleHandle GetModuleHandleA 
  ExitProcess     ExitProcess
  sleep           Sleep
  Beep            Beep   
) 

Bind user32
(
  LoadIcon         LoadIconA       
  LoadCursor       LoadCursorA       
  RegisterClass    RegisterClassA
  RegisterClassEx  RegisterClassExA   
  MessageBox       MessageBoxA       
  SendMessage      SendMessageA
  GetMessage       GetMessageA
  PeekMessage      PeekMessageA
  TranslateMessage TranslateMessage
  DispatchMessage  DispatchMessageA
  PostQuitMessage  PostQuitMessage 
  PostMessage      PostMessageA
  CreateWindowEx   CreateWindowExA   
  ShowWindow       ShowWindow       
  UpdateWindow     UpdateWindow     
  DefWindowProc    DefWindowProcA
  InvalidateRect   InvalidateRect
  ValidateRect     ValidateRect
  GetSystemMetrics GetSystemMetrics
  ReleaseDC        ReleaseDC
  GetDC            GetDC
  BeginPaint        BeginPaint
  EndPaint          EndPaint   
  ShowCursor       ShowCursor
  GetAsyncKeyState GetAsyncKeyState
)
 
Bind gdi32
(
  GetStockObject   GetStockObject
  CreateSolidBrush CreateSolidBrush
  SetBkMode        SetBkMode
  SetBkColor       SetBkColor
) 

declare sub input()

'define Msg,Class & ClassEx //////////////////////////////////
Dim wm as MSG

Dim rc as RECT
Dim wcx as WndClass
'--------------------------------------------------------------------
Type TWINDOW
sys aw
sys ah
string aCaption
sys mWidth 
sys mHeight 
sys mLeft   
sys mTop     
string mCaption
string mClassName
sys mhInstance
sys mStyle
sys mHwnd
sys mIsActive
sys mIsRunning
sys mMsg
End Type

'--------------------------------------------------------------------
TWINDOW win
static  tWindow, win 
   tWindow = @this 
   win = @WindowProc#sys#sys#sys#sys 
'---------------------------------------------------------------------
FUNCTION WindowProc( sys mhwnd, uMsg, wParam, lParam ) as sys callback
   
   ' RETURN DefWindowProc hWnd, uMsg, wParam, lParam
 Return CALL Win(tWindow,mhWnd, uMsg, wParam, lParam )
END FUNCTION
'-------------------------------------------------------------------
Function MakeWindow(
                    sys aw=800,
                    sys ah=600,   
                    string aCaption = "Oxygen Window"
                    )
    win.mWidth     = aw
    win.mHeight    = ah
    win.mLeft      = 0
    win.mTop       = 0
    win.mCaption   = aCaption
    win.mClassName = "OxygenWindow"

   

    win.mhInstance  = GetModuleHandle 0
    '
    WNDCLASS winClass
    winClass.style         = CS_OWNDC | CS_DBLCLKS
    winClass.lpfnWndProc   = &WindowProc
    winClass.cbClsExtra    = 0
    winClass.cbWndExtra    = 0
    winClass.hInstance     = win.mhInstance
    winClass.hIcon         = LoadIcon 0, IDI_APPLICATION
    winClass.hCursor       = LoadCursor 0, IDC_ARROW
    winClass.hbrBackground = 0
    winClass.lpszMenuName  = 0
    winClass.lpszClassName = win.mClassName
    if not RegisterClass(winClass) then
        'error
        MessageBox 0, "RegisterClass", "ERROR", 32
        return 0
    end if
   
    win.mStyle = WS_MINMAXSIZE
   
    'win.mWindowRect <= 0, 0, win.mWidth, win.mHeight
   
    win.mhWnd = CreateWindowEx( 0,
                                win.mClassName,
                                "Oxygen Window", 'win.mCaption,
                                WS_MINMAXSIZE, 'win.mStyle,
                                win.mLeft,
                                win.mTop,
                                win.mWidth ,
                                win.mHeight,
                                0,
                                0,
                                win.mhInstance,
                                0
                              )
    if not win.mhWnd then
        'Error
        MessageBox NULL, "CreateWindowEx:", "ERROR",32
        return 0
    end if

    win.mIsActive  = 1
    win.mIsRunning = 1
   
    ShowWindow win.mhWnd, SW_SHOW
    UpdateWindow win.mhWnd

    return win.mhWnd
end function

sub MessageLoop()
    while win.mIsRunning
       ' win.mMenuCommand = NULL
        while PeekMessage    win.mMSG, NULL, 0, 0, PM_REMOVE
            TranslateMessage win.mMSG
            DispatchMessage  win.mMSG
        wend
        input()
    wend
end sub



And test code:

Code: [Select]

#include "micro.inc"

MakeWindow (800, 600, "Simple Window")

MessageLoop()



sub input()
    select &wm
        case 0
            exit sub
     
        case WM_DESTROY
            PostQuitMessage 0
    end select
end sub
Looks like search in the dark....

[Peter]

Hi kent and Aurel,

You mean this here.
Start Test Window.o2bas and tell me, is this Okay?

X

[Aurel]

Hi Peter...
It work but not as properly because processor is constantly on 100%.
I think that your way can be on right track...hmmm
KeyEvent work but nothing else i mean intercepting other messages.
Thank you man  

[kryton9]

I am glad you figured out how to make it run Peter. Thanks.
It does eat up cpu all the time on my netbook also, but runs smoothly.

[Aurel]

Kent...
I hope that you know that is not good using 100% of processor.
Problem is in two loops inside fn MessageLoop().
I have search on net and found Euphoria way with long include file.
BUT because Euphoria is interpreter all functions depend on reading source file
from disk...

Interesting thing is that she use ID for each window,and ID for callback...
Code is a very complicated....

[kryton9]

Aurel, you pointed out about the cpu being eaten up and I did some tests, both on my netbook(weak) and notebook(strong).

I ran code from Peter's demos ufo3. My GLWindow demo and compared it with a visual studio 6 MFC window with message handling.
There is something wrong in oxygen with the windows making and handling messages. Because Peter is using his own win.h and on mine I am using either winmin.inc by Charles and in other tests the includes from VB6 translated.

My netbook runs at around 20% cpu usage with nothing. My notebook at cpu 0% with nothing running.
With MFC program, my notebook cpu was still at 0%. But both my GLWindow and Peters UFO3 take up my notebook cpu to 12%
On my netbook, it varies all the time from 70% to 100%.

Something in the headers or oxygen is definitely effecting cpu usage more than it should.

[Aurel]

Uff after some tweaking i decide to remove PeekMessage and replace them with GetMessage.
Yeah ..look like interpreted stuff...
window.inc

Code: [Select]

'window.inc by Kent Sarikaya
'Last Modified:
'2012.07.27 KS

'myWin variables have a "m" prefix for them
'Parameters/Arguements have an "a" prefix for arguement

include "MinWin.inc"

declare sub OnClose(sys hwnd)

type tWindow
        sys mTop, mLeft, mWidth, mHeight
        string mCaption, mClassName
        sys mMenuCommand
        sys mMouseX, mMouseY, mMouseButton, mKeydown
        sys mChangeSize, mIsActive, mIsRunning

        sys mKeys[256]

        sys  mhInstance, mhDC, mhWnd
        RECT mWindowRect
        MSG  mMSG
        sys  mExStyle, mStyle
end type
dim win as tWindow
 

function WindowProc(sys hwnd, uMsg, wParam, lParam ) as sys callback
    select uMsg
       'onClose------------
        case WM_DESTROY
IF hwnd<>0
          OnClose(hwnd)
END IF
        return 0
       '-----------------   

    end select
'default.............................................
    return DefWindowProc hWnd, uMsg, wParam, lParam
'....................................................
end function

function MakeWindow(sys aWidth, aHeight, string aCaption) as sys
    win.mWidth     = aWidth
    win.mHeight    = aHeight
    win.mLeft      = 0
    win.mTop       = 0
    win.mCaption   = 0 'aCaption
    win.mClassName = strptr "OxygenWindow"

    win.mWindowRect.left   = win.mLeft
    win.mWindowRect.right  = win.mWidth
    win.mWindowRect.top    = win.mTop
    win.mWindowRect.bottom = win.mHeight

    win.mhInstance  = GetModuleHandle 0
    '
    WNDCLASS winClass
    winClass.style = CS_HREDRAW | CS_VREDRAW
    winClass.lpfnWndProc   = @WindowProc
    winClass.cbClsExtra    = 0
    winClass.cbWndExtra    = 0
    winClass.hInstance     = win.mhInstance
    winClass.hIcon         = LoadIcon 0, IDI_WINLOGO
    winClass.hCursor       = LoadCursor 0, IDC_ARROW
    winClass.hbrBackground = GetStockObject WHITE_BRUSH 'NULL
    winClass.lpszMenuName  = 0
    winClass.lpszClassName = StrPtr "win"
   
    RegisterClass &winClass

    win.mStyle = WS_OVERLAPPED | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME | WS_MINIMIZEBOX | WS_MAXIMIZEBOX
    win.mWindowRect <= 0, 0, win.mWidth, win.mHeight
    win.mhWnd = CreateWindowEx 0,"win"," Peter",WS_OVERLAPPEDWINDOW,0,0,640,480,0,0,win.mhInstance,0
   
    win.mIsActive  = 1
    win.mIsRunning = 1
   
    ShowWindow win.mhWnd, SW_SHOW
    UpdateWindow win.mhWnd
    return win.mhWnd
end function

sub MessageLoop()
    MSG wm
   'while win.mIsRunning
        'win.mMenuCommand = 0
if @wm >  0
'input()
        while GetMessage(&wm, 0, 0, 0)<>0           
    TranslateMessage &wm
            DispatchMessage  &wm       
        wend
     
    end if
end sub

function GetWidth() as sys
    return win.mWidth
end function


function GetHeight() as sys
    return win.mHeight
end function


function KeyEvent() as sys 'read once and clear
    return win.mKeydown
    win.mKeydown = 0      '<-- That is nonsens here!
end function


function MenuDown( WORD ID ) as sys
    if win.mMenuCommand = ID then return 1
end function


function KeyDown( sys ucKey ) as sys
    if win.mKeys[ucKey] then return 1
end function


function KeyUp( sys ucKey ) as sys
    if win.mKeys[ucKey] = 0 then return 1
end function


function MouseDown( sys button ) as sys
    if win.mMouseButton and button then return 1
end function


function MouseUp( sys button ) as sys
    if ( win.mMouseButton xor -1 ) and button then return 1
end function


And here is test...

Code: [Select]

'test window.o2bas
'by Kent Sarikaya 2012 July
'modifyed by Peter Wirlauber
'and modifyed by Aurel

include "window.inc"
! Beep Lib "kernel32.dll" (sys dwFreq, dwDuration) As sys
sys win
win = MakeWindow 800, 600, "Test OnClose()"

MessageLoop()

SUB OnClose(win)
Beep 1200,100
print "Thanks..."   
Return PostQuitMessage 0
END SUB

[Aurel]

Kent
I am not sure that something is wrong with oxygen inside but can be(problem with wndsclassex ).
But from my expirience with awinh.inc most thing work as espected ( i mean in a C-way).
When you test upper code you will see that work ok.
By the way Peter way is excellent for GDI examples and games but not very well for GUI stuff.
Strange thing is in GL examples who are not work very well on mine computers .
Another point i have found somwhere on GDI - C examples .
Messsage loop is written in a different way ,i must found where i put all this examples 

Hmm i will try incorprate some of this into awinh.inc or in micro.inc
just to look how respond.

 

[kryton9]

For code that draws or renders, I see that we need to put that into the ON_IDLE section. I think that is what is eating up cpu.

[Aurel]

Hmm problematic thing in this way is that because in test code
subroutine event must be written ,if is event not written linker tell
function not defined...

[kryton9]

Ok this version is lean, mean and clean and setup to handle anything you want Aurel.

X

[Aurel]

Ok this version is lean, mean and clean and setup to handle anything you want Aurel.

Hey..is this some kind of joke
Nothing is captured here ,infact it is almost same method (C-way) which i already use Kent.
Did you forget awinh.inc.
insde is :

Code: [Select]

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_SIZE
GetSize(win,x,y,w,h)
MoveWindow(richedit1,160,80,(w-rw/2)+64,(h-56)-32 ,1)
MoveWindow(edit1,160,54,(w-rw/2)+64,23 ,1)
'-------------------------------------------------------------
CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message

Select controlID
  CASE b0ID
If notifycode=0  
SendMessage richedit1,WM_SETTEXT,0,""
End If
  CASE b1ID
If notifycode=0  
doOpen()
End If
  CASE b2ID
    If notifycode=0
UpdateWindow(win)
   SetControlText()
End If
 CASE b3ID
If notifycode=0
LoadFromFile()
End If
 CASE b4ID
If notifycode=0
GetLineCount()
End If
 CASE b5ID
If notifycode=0
GetCSize()
End If




End Select
'-----------------------------------------------------
END SELECT



So ...where is this improvement...oh..my.
Only thing which you cover is message loop,right?
This is not solution at all.
Peter comes closer with his example but have problem with declered sub which must be
added if is added in message selection.

I don't know why Charles don't respond yet with his OOP example  

[Charles Pegge]

There is Kent's GlWindow example. This is fully OOPified and uses callbacks  for rendering and keyboard functions. As you can see, the architecture is not trivial.

projectsB/glWindow

If you want simplicity, I would stay with the standard wndproc.

Charles

[Aurel]

Yes Charles i know for that GLWindow example and i understand that architecture
is not trivial.
I don't want to force OOP over standard things.
I want simplicity of course but must there be way to simplify things like in other compilers,right?
If all this methods fail i will give up defenately from all this mumbo-jumbo.
Just another example from GUI-oop zip from fb:

Code: [Select]

function TForm.WindowProc(hDlg as hwnd,Msg as uint,wParam as wparam,lParam as lparam) as integer
    dim as TWinControl ptr WinControl = iif(CreationData, CreationData, GetWinControl(hDlg))
    dim as TMessage message = type(hDlg,Msg,wParam,lParam,0,WinControl)
    if WinControl then
       WinControl->ProcessMessage(message)
       cast(TForm ptr,WinControl)->ProcessMessage(message)
       return message.result
    end if
    return message.result
end function

function TForm.ClientWindowProc(hDlg as hwnd,Msg as uint,wParam as wparam,lParam as lparam) as integer
    dim as TWinControl ptr WinControl = iif(CreationData, CreationData, GetWinControl(hDlg))
    dim as TMessage message = type(hDlg,Msg,wParam,lParam,0,WinControl)
    if WinControl then
       WinControl->ProcessMessage(message)
       dim as WndClassEx wc
       wc.cbSize = sizeof(wc)
       if GetClassInfoEx(0,"MDIClIENT",@wc) then
          message.result = CallWindowProc(wc.lpfnWndProc,message.Handle,message.Msg,message.wParam,message.lParam)
       end if
       return message.result
    end if
    return message.result
end function


[Charles Pegge]

Looking at that sort of code gives me a migraine. Can you tell me what it is supposed to do, 

The main purpose of OOP is to bring order, simplicity and clarity to a program. When you have a number of similar but independent components in a program then OOP is a very good solution.

I would generally start out with straight procedural coding then bunch things into classes only to make the code shorter or simpler.

Charles