can anybody test this "three sdk windows" similar if the winmain() message loops are correct?
'
' 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
.
