Oxygen Basic

Programming => Example Code => Topic started by: Frankolinox on November 05, 2013, 08:58:10 AM

Title: two sdk windows similar
Post by: Frankolinox on November 05, 2013, 08:58:10 AM

Code: [Select]

 '
  ' two gui windows for oxygenbasic by frankolinox, 05.nov.2013
  '
  $ filename "t.exe"
  includepath "$/inc/"
  '#include "RTL32.inc"
  '#include "RTL64.inc"
  #include "MinWin.inc"


  #lookahead ' for procedures
  s=error()
  '
  if s then
    print s
    end
  end if


  '=========
  'MAIN CODE
  '=========
  dim as rect crect 'for WndProc and TimerProc
  
  dim cmdline as asciiz ptr, inst as sys
  &cmdline=GetCommandLine
  inst=GetModuleHandle 0
  '
  'WINDOWS START
  '=============
  '
  WinMain inst,0,cmdline,SW_NORMAL
  end


  '--------------------------------------------------------------------
  Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
  '====================================================================

  WndClass wc
  MSG      wm

  WndClass wc2
  MSG      wm2

  sys hwnd, wwd, wht, wtx, wty, tax
  sys hwnd2, wwd2, wht2, wtx2, wty2, tax2,inst2

  wc.style = CS_HREDRAW or CS_VREDRAW
  wc.lpfnWndProc = @WndProc
  wc.cbClsExtra =0
  wc.cbWndExtra =0    
  wc.hInstance =inst
  wc.hIcon=LoadIcon 0, IDI_APPLICATION
  wc.hCursor=LoadCursor 0,IDC_ARROW
  wc.hbrBackground = GetStockObject WHITE_BRUSH
  wc.lpszMenuName =null
  wc.lpszClassName = strptr "Demo"

  RegisterClass (@wc)
 
  Wwd = 320 : Wht = 200
  Tax = GetSystemMetrics SM_CXSCREEN
  Wtx = (Tax - Wwd) /2
  Tax = GetSystemMetrics SM_CYSCREEN
  Wty = (Tax - Wht) /2
 
  hwnd = CreateWindowEx 0,wc.lpszClassName,"OXYGEN BASIC",WS_OVERLAPPEDWINDOW,100+Wtx,100+Wty,Wwd,Wht,0,0,inst,0
  ShowWindow hwnd,SW_SHOW
  UpdateWindow hwnd
  
  '--------------------------- second gui ---------------------------------------------- //

  wc2.style = CS_HREDRAW or CS_VREDRAW
  wc2.lpfnWndProc = @WndProc2
  wc2.cbClsExtra =0
  wc2.cbWndExtra =0    
  wc2.hInstance =inst
  wc2.hIcon=LoadIcon 0, IDI_APPLICATION
  wc2.hCursor=LoadCursor 0,IDC_ARROW
  wc2.hbrBackground = GetStockObject WHITE_BRUSH
  wc2.lpszMenuName =null
  wc2.lpszClassName = strptr "Demo2" 'has to be changed too ;)

  RegisterClass (@wc2)
 
  Wwd2 = 420 : Wht2 = 300
  Tax2 = GetSystemMetrics SM_CXSCREEN
  Wtx2 = (Tax2 - Wwd2) /2
  Tax2 = GetSystemMetrics SM_CYSCREEN
  Wty2 = (Tax2 - Wht2) /2
 
  hwnd2 = CreateWindowEx 0,wc2.lpszClassName,"OXYGEN BASIC2",WS_OVERLAPPEDWINDOW,Wtx2,Wty2,Wwd2,Wht2,0,0,inst2,0
  ShowWindow hwnd2,SW_SHOW
  UpdateWindow hwnd2


  '--------------------------- second gui ends ---------------------------------------------- //
  '
  sys bRet,bRet2
  '
  do while bRet := GetMessage (@wm, 0, 0, 0)
    if bRet = -1 then
      print "error one"
      'show an error message
    else
      TranslateMessage @wm
      DispatchMessage @wm
    end if
  wend

  '
  do while bRet2 := GetMessage (@wm2, 0, 0, 0)
    if bRet2 = -1 then
      print "error two"
      'show an error message
    else
      TranslateMessage @wm2
      DispatchMessage @wm2
    end if
  wend

  End Function

  
  '--------------------------------------------------------------
  function WndProc ( hWnd, wMsg, wParam, lparam ) as sys callback
  '==============================================================

    static as sys hdc
    static as String txt
    static as PaintStruct Paintst
 
    '==========
    select wMsg
    '==========
        
      '--------------
      case WM_CREATE
      '=============

      GetClientRect  hWnd,&cRect

      '--------------  
      case WM_DESTROY
      '===============
          
      PostQuitMessage 0
        
      '------------
      case WM_PAINT
      '============


      'TEXT
      'http://msdn.microsoft.com/en-us/library/dd144821(v=VS.85).aspx

      'DRAWING AND PAINTING
      'http://msdn.microsoft.com/en-us/library/dd162760(v=VS.85).aspx

      GetClientRect  hWnd,&cRect
      hDC=BeginPaint hWnd,&Paintst
      'style
      '0x20 DT_SINGLELINE
      '0x04 DT_VCENTER
      '0x01 DT_CENTER
      '0x25

       SetBkColor   hdc,yellow
       SetTextColor hdc,red
       DrawText hDC,"Hello World!",-1,&cRect,0x25
       EndPaint hWnd,&Paintst
        
      '--------------  
      case WM_KEYDOWN
      '==============

      '============            
      Select wParam
      '============

Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE

      End Select
      

      '--------        
      case else
      '========
          
        function=DefWindowProc hWnd,wMsg,wParam,lParam
        
    end select

  end function ' WndProc

 '--------------------------------------------------------------
  function WndProc2 ( hWnd, wMsg, wParam, lparam ) as sys callback
  '==============================================================

    static as sys hdc
    static as String txt
    static as PaintStruct Paintst
 
    '==========
    select wMsg
    '==========
        
      '--------------
      case WM_CREATE
      '=============

      GetClientRect  hWnd,&cRect

      '--------------  
      case WM_DESTROY
      '===============
          
      PostQuitMessage 0
        
      '------------
      case WM_PAINT
      '============


      'TEXT
      'http://msdn.microsoft.com/en-us/library/dd144821(v=VS.85).aspx

      'DRAWING AND PAINTING
      'http://msdn.microsoft.com/en-us/library/dd162760(v=VS.85).aspx

      GetClientRect  hWnd,&cRect
      hDC=BeginPaint hWnd,&Paintst
      'style
      '0x20 DT_SINGLELINE
      '0x04 DT_VCENTER
      '0x01 DT_CENTER
      '0x25

       SetBkColor   hdc,yellow
       SetTextColor hdc,blue
       DrawText hDC,"Hello Another World!",-1,&cRect,0x25
       EndPaint hWnd,&Paintst
        
      '--------------  
      case WM_KEYDOWN
      '==============

      '============            
      Select wParam
      '============

Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE

      End Select
      

      '--------        
      case else
      '========
          
        function=DefWindowProc hWnd,wMsg,wParam,lParam
        
    end select

  end function ' WndProc

.

Title: Re: two sdk windows similar
Post by: Aurel on November 05, 2013, 09:58:26 AM

frank
I don't get it why you create two windows with duplicate callbacks which in fact
share same window procedure...what is the point in all this ???
there is no need for that at all...

Title: Re: two sdk windows similar
Post by: kryton9 on November 05, 2013, 01:50:04 PM

Well for example in a game:
The one windows could be the main game action screen.
The second window a map of the world you are in and your location.

Title: Re: two sdk windows similar
Post by: Charles Pegge on November 05, 2013, 03:01:40 PM

I have never seen that before Frank. Intriguing idea, 2 main windows operating at the same time.

You only need one loop to service both windows at the same time, but to get them to quit independently, a little extra logic is required:

  sys bRet,bRet2,xit
  '
  do
    bRet = GetMessage (@wm, 0, 0, 0)
    if not bRet
     xit++
      if xit=2 then exit do
    elseif bRet = -1
      print "message loop error"
    else
      TranslateMessage @wm
      DispatchMessage @wm
    end if
  end do

Title: Re: two sdk windows similar
Post by: Frankolinox on November 07, 2013, 03:55:18 AM

more to come with my idea and a project next weeks and month if there's time enough..

one example could be to use "drag'n'drop" feature for folder's, material, maps (game as kent said), images or even appliacation (depending or not from the main window where you're working) and so on from one sdk window to another and much more. :)

I've not tested my idea yet, but there should be interaction between this two (you can create four, five windows more if you like) sdk windows in future.

frank

Title: Re: three sdk windows similar test
Post by: Frankolinox on November 18, 2013, 01:29:14 AM

can anybody test this "three sdk windows" similar if the winmain() message loops are correct?

Code: [Select]

  '
  ' three gui windows for oxygenbasic by frankolinox, 16.nov.2013
  '
  $ filename "testGuis.exe"
  includepath "$/inc/"
  '#include "RTL32.inc"
  '#include "RTL64.inc"
  #include "MinWin.inc"


  #lookahead ' for procedures
  s=error()
  '
  if s then
    print s
    end
  end if

  % WM_DROPFILES  0x0233
 
  Dim String myDroppedFiles(10)

  extern lib "shell32.dll" 
  Declare DragQueryFile Alias "DragQueryFileA" ( _
          sys wHandle, NumFiles, NameBuffer,BufferLen ) As sys
  Declare DragFinish Alias "DragFinish" (sys wHandle)
  Declare DragAcceptFiles Alias "DragAcceptFiles" (sys hWnd, fAccept )
  end extern


  '=========
  'MAIN CODE
  '=========
  dim as rect crect 'for WndProc and TimerProc
 
  dim cmdline as asciiz ptr, inst as sys
  &cmdline=GetCommandLine
  inst=GetModuleHandle 0
  '
  'WINDOWS START
  '=============
  '
  WinMain inst,0,cmdline,SW_NORMAL
  end


  '--------------------------------------------------------------------
  Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
  '====================================================================

  WndClass wc
  MSG      wm

  WndClass wc2
  MSG      wm2

  WndClass wc3
  MSG      wm3

  sys hwnd, wwd, wht, wtx, wty, tax
  sys hwnd2, wwd2, wht2, wtx2, wty2, tax2,inst2
  sys hwnd3, wwd3, wht3, wtx3, wty3, tax3,inst3

  wc.style = CS_HREDRAW or CS_VREDRAW
  wc.lpfnWndProc = @WndProc
  wc.cbClsExtra =0
  wc.cbWndExtra =0   
  wc.hInstance =inst
  wc.hIcon=LoadIcon 0, IDI_APPLICATION
  wc.hCursor=LoadCursor 0,IDC_ARROW
  wc.hbrBackground = GetStockObject WHITE_BRUSH
  wc.lpszMenuName =null
  wc.lpszClassName = strptr "Demo"

  RegisterClass (@wc)
 
  Wwd = 420 : Wht = 300
  Tax = GetSystemMetrics SM_CXSCREEN
  Wtx = (Tax - Wwd) /2
  Tax = GetSystemMetrics SM_CYSCREEN
  Wty = (Tax - Wht) /2
 
  hwnd = CreateWindowEx 0,wc.lpszClassName,"OXYGEN BASIC",WS_OVERLAPPEDWINDOW,180+Wtx,50+Wty,Wwd,Wht,0,0,inst,0
  ShowWindow hwnd,SW_SHOW
  UpdateWindow hwnd
 
  '--------------------------- second gui ---------------------------------------------- //

  wc2.style = CS_HREDRAW or CS_VREDRAW
  wc2.lpfnWndProc = @WndProc2
  wc2.cbClsExtra =0
  wc2.cbWndExtra =0   
  wc2.hInstance =inst2
  wc2.hIcon=LoadIcon 0, IDI_APPLICATION
  wc2.hCursor=LoadCursor 0,IDC_ARROW
  wc2.hbrBackground = GetStockObject WHITE_BRUSH
  wc2.lpszMenuName =null
  wc2.lpszClassName = strptr "Demo2" 'has to be changed too ;)

  RegisterClass (@wc2)
 
  Wwd2 = 420 : Wht2 = 300
  Tax2 = GetSystemMetrics SM_CXSCREEN
  Wtx2 = (Tax2 - Wwd2) /2
  Tax2 = GetSystemMetrics SM_CYSCREEN
  Wty2 = (Tax2 - Wht2) /2
 
  hwnd2 = CreateWindowEx 0,wc2.lpszClassName,"OXYGEN BASIC2",WS_OVERLAPPEDWINDOW,Wtx2,Wty2,Wwd2,Wht2,0,0,inst2,0
  ShowWindow hwnd2,SW_SHOW
  UpdateWindow hwnd2

  DragAcceptFiles(hwnd2, TRUE)

  '--------------------------- second gui ends ---------------------------------------------- //
  '
  '--------------------------- third gui begins ------------------------------------------ //

  wc3.style = CS_HREDRAW or CS_VREDRAW
  wc3.lpfnWndProc = @WndProc3
  wc3.cbClsExtra =0
  wc3.cbWndExtra =0   
  wc3.hInstance =inst3
  wc3.hIcon=LoadIcon 0, IDI_APPLICATION
  wc3.hCursor=LoadCursor 0,IDC_ARROW
  wc3.hbrBackground = GetStockObject WHITE_BRUSH
  wc3.lpszMenuName =null
  wc3.lpszClassName = strptr ("Demo3") 'has to be changed too ;)

  RegisterClass (@wc3)
 
  Wwd3 = 460 : Wht3 = 360
  Tax3 = GetSystemMetrics SM_CXSCREEN
  Wtx3 = (Tax3 - Wwd3) /2
  Tax3 = GetSystemMetrics SM_CYSCREEN
  Wty3 = (Tax3 - Wht3) /2
 
  hwnd3 = CreateWindowEx 0,wc3.lpszClassName,"Batman1",WS_OVERLAPPEDWINDOW,50+Wtx3,150+Wty3,Wwd3,Wht3,0,0,inst3,0
  ShowWindow hwnd3,SW_SHOW
  UpdateWindow hwnd3
 
 '---------------------------- third gui ends -------------------------------------- //
 
  sys bRet,bRet2,bRet3,xit
  '
  '
  do
    bRet = GetMessage (@wm, 0, 0, 0)
    if not bRet
     xit++
      if xit=3 then exit do
    elseif bRet = -1
      print "message loop error"
    else
      TranslateMessage @wm
      DispatchMessage @wm
    end if
  end do

  '
  do while bRet2 := GetMessage (@wm2, 0, 0, 0)
    if bRet2 = -1 then
      print "error two"
      'show an error message
    else
      TranslateMessage @wm2
      DispatchMessage @wm2
    end if
  wend

  do while bRet3 := GetMessage (@wm3, 0, 0, 0)
    if bRet3 = -1 then
      print "error three"
      'show an error message
    else
      TranslateMessage(@wm3)
      DispatchMessage(@wm3)
    end if
  wend
 
  End Function

 
  Function GetDropFiles(sys hDropParam) As String
  ===============================================
  string sDropFiles, sFiles
  sys i,e
  e=DragQueryFile(hDropParam, -1, null, 0)-1
  '
  for i = 0 To e
    le=DragQueryFile(hDropParam, i, null, 1)
    sfile=space le             
    DragQueryFile(hDropParam, i, StrPtr sFile, le+1)
    If Ucase(mid(sFile, -4)) = ".LNK"
    else
      sDropFiles+= sFile + chr(13,10)
    end if
  next i   
  return sDropFiles
  End Function

  '--------------------------------------------------------------
  function WndProc ( hWnd, wMsg, wParam, lparam ) as sys callback
  '==============================================================

    static as sys hdc
    static as String txt
    static as PaintStruct Paintst
 
    '==========
    select wMsg
    '==========
       
      '--------------
      case WM_CREATE
      '=============

      GetClientRect  hWnd,&cRect
    '--------------
    Case WM_DROPFILES
    =================
    '
    pDrop = wparam
    sFiles = GetDropFiles(pDrop)
    print sFiles
    DragFinish(wparam)

      '-------------- 
      case WM_DESTROY
      '===============
         
      PostQuitMessage 0
      DragAcceptFiles(hwnd, TRUE) 
     
      '------------
      case WM_PAINT
      '============

      GetClientRect  hWnd,&cRect
      hDC=BeginPaint hWnd,&Paintst
      'style
      '0x20 DT_SINGLELINE
      '0x04 DT_VCENTER
      '0x01 DT_CENTER
      '0x25

       SetBkColor   hdc,yellow
       SetTextColor hdc,red
       'DrawText hDC,"Hello World!",-1,&cRect,0x25
       DrawText hDC,"Drop Files Here",-1,&cRect,0x25
       EndPaint hWnd,&Paintst
       
      '--------------   
      case WM_KEYDOWN
      '==============

      '============           
      Select wParam
      '============

Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE

      End Select     

      '--------       
      case else
      '========
         
        function=DefWindowProc hWnd,wMsg,wParam,lParam
       
    end select
  end function

 '--------------------------------------------------------------
  function WndProc2 ( hWnd, wMsg, wParam, lparam ) as sys callback
  '==============================================================

    static as sys hdc
    static as String txt
    static as PaintStruct Paintst
 
    '==========
    select wMsg
    '==========
       
      '--------------
      case WM_CREATE
      '=============

      GetClientRect  hWnd,&cRect

      '-------------- 
      case WM_DESTROY
      '===============
         
      PostQuitMessage 0
       
      '------------
      case WM_PAINT
      '============


      'TEXT
      'http://msdn.microsoft.com/en-us/library/dd144821(v=VS.85).aspx

      'DRAWING AND PAINTING
      'http://msdn.microsoft.com/en-us/library/dd162760(v=VS.85).aspx

      GetClientRect  hWnd,&cRect
      hDC=BeginPaint hWnd,&Paintst
      'style
      '0x20 DT_SINGLELINE
      '0x04 DT_VCENTER
      '0x01 DT_CENTER
      '0x25

       SetBkColor   hdc,yellow
       SetTextColor hdc,blue
       DrawText hDC,"Hello Another World!",-1,&cRect,0x25
       EndPaint hWnd,&Paintst
       
      '--------------   
      case WM_KEYDOWN
      '==============

      '============           
      Select wParam
      '============

Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE

      End Select
     

      '--------       
      case else
      '========
         
        function=DefWindowProc hWnd,wMsg,wParam,lParam
       
    end select

  end function

  '--------------------------------------------------------------
  function WndProc3 ( hWnd, wMsg, wParam, lparam ) as sys callback
  '==============================================================

    static as sys hdc
    static as String txt
    static as PaintStruct Paintst
 
    '==========
    select wMsg
    '==========
       
      '--------------
      case WM_CREATE
      '=============

      GetClientRect  hWnd,&cRect

      '-------------- 
      case WM_DESTROY
      '===============
         
      PostQuitMessage 0
       
      '------------
      case WM_PAINT
      '============
      GetClientRect  hWnd,&cRect
      hDC=BeginPaint hWnd,&Paintst
      'style
      '0x20 DT_SINGLELINE
      '0x04 DT_VCENTER
      '0x01 DT_CENTER
      '0x25

       SetBkColor   hdc,yellow
       SetTextColor hdc,red
       DrawText hDC,"Hello Batmans World!",-1,&cRect,0x25
       EndPaint hWnd,&Paintst
       
      '--------------   
      case WM_KEYDOWN
      '==============

      '============           
      Select wParam
      '============

Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE

      End Select

      '--------       
      case else
      '========
         
        function=DefWindowProc(hWnd,wMsg,wParam,lParam)
       
    end select

  end function

Thanks in advance, best regards, frank

.

Title: Re: two sdk windows similar
Post by: Frankolinox on November 21, 2013, 08:49:37 AM

no answer does that means, a) you don't know it or b) it's ok my three sdk window oxygen example? or c) no fun to answer ?;)

Title: Re: two sdk windows similar
Post by: Charles Pegge on November 21, 2013, 12:39:08 PM

Try removing the second and third message loops.

Title: Re: two sdk windows similar
Post by: Aurel on November 21, 2013, 01:36:31 PM

sorry Frank...
this is not good solution as i said before :-\