API Window

[aurelCB]

Hi ...
I find on forum topic how create window with API functions(Fasecero start them).
Very interesting is becose window is showed  like in some other basics ,like ShowModal(etc)
And i try convert this code to Creative Basic.But i can't understand what I do wrong.
I recive error that one of API not founded.
Can someone of you ,put me in the right direction?

thanks advance
Zlatko

Code Select Expand

'Create window with API---------------------
TYPE WNDCLASSEX
DEF cbSize AS INT
DEF style AS INT
DEF lpfnWndProc AS INT
DEF cbClsExtra AS INT
DEF cbWndExtra AS INT
DEF hInstance AS INT
DEF hIcon AS INT
DEF hCursor AS INT
DEF hbrBackground AS INT
DEF lpszMenuName AS POINTER
DEF lpszClassName AS POINTER
DEF hIconSm AS INT
ENDTYPE

TYPE STARTUPINFO
DEF cb AS INT
DEF lpReserved AS POINTER
DEF lpDesktop AS POINTER
DEF lpTitle AS POINTER
DEF dwX AS INT
DEF dwY AS INT
DEF dwXSize AS INT
DEF dwYSize AS INT
DEF dwXCountChars AS INT
DEF dwYCountChars AS INT
DEF dwFillAttribute AS INT
DEF dwFlags AS INT
DEF wShowWindow AS WORD
DEF cbReserved2 AS WORD
DEF lpReserved2 AS INT
DEF hStdInput AS INT
DEF hStdOutput AS INT
DEF hStdError AS INT
ENDTYPE
TYPE MSG
DEF hwnd AS INT
DEF message AS INT
DEF wParam AS INT
DEF lParam AS INT
DEF time AS INT
DEF pt AS POINTER
ENDTYPE

CONST IDC_ARROW = 32512
CONST IDI_APPLICATION = 32512
CONST COLOR_BACKGROUND = 1
CONST CS_DBLCLKS = 0x8
' Window Styles
CONST WS_OVERLAPPED = 0x0
CONST WS_POPUP = 0x80000000
CONST WS_CHILD = 0x40000000
CONST WS_MINIMIZE = 0x20000000
CONST WS_VISIBLE = 0x10000000
CONST WS_DISABLED = 0x8000000
CONST WS_CLIPSIBLINGS = 0x4000000
CONST WS_CLIPCHILDREN = 0x2000000
CONST WS_MAXIMIZE = 0x1000000
CONST WS_CAPTION = 0xC00000                  :'  WS_BORDER | WS_DLGFRAME
CONST WS_BORDER = 0x800000
CONST WS_DLGFRAME = 0x400000
CONST WS_VSCROLL = 0x200000
CONST WS_HSCROLL = 0x100000
CONST WS_SYSMENU = 0x80000
CONST WS_THICKFRAME = 0x40000
CONST WS_GROUP = 0x20000
CONST WS_TABSTOP = 0x10000

CONST WS_MINIMIZEBOX = 0x20000
CONST WS_MAXIMIZEBOX = 0x10000

CONST WS_TILED = WS_OVERLAPPED
CONST WS_ICONIC = WS_MINIMIZE
CONST WS_SIZEBOX = WS_THICKFRAME
CONST WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME | WS_MINIMIZEBOX | WS_MAXIMIZEBOX)
CONST WS_TILEDWINDOW = WS_OVERLAPPED

' Message Function Templates
DECLARE "user32",_GetMessage ALIAS GetMessageA(lpMsg AS MSG,hwnd AS INT,wMsgFilterMin AS INT,wMsgFilterMax AS INT),INT
DECLARE "user32", _TranslateMessage ALIAS TranslateMessage(lpMsg AS MSG),INT
DECLARE "user32",_DispatchMessage ALIAS DispatchMessageA(lpMsg AS MSG),INT
'DECLARE IMPORT, _PeekMessage ALIAS PeekMessageA(lpMsg AS MSG,hwnd AS INT,wMsgFilterMin AS INT,wMsgFilterMax AS INT,wRemoveMsg AS INT),INT
DECLARE "kernel32",_GetCommandLine ALIAS GetCommandLineA(),STRING
DECLARE "kernel32",_GetStartupInfo ALIAS GetStartupInfoA(lpStartupInfo AS STARTUPINFO)

DECLARE "user32",LoadIcon ALIAS "LoadIconA"(hinstance:INT, id:pointer),uint
DECLARE "user32",LoadCursor ALIAS "LoadCursorA"(hinstance:INT, id:pointer),uint
DECLARE "user32",RegisterClassEx ALIAS RegisterClassExA(pcWndClassEx AS WNDCLASSEX),WORD
Declare "user32",CreateWindowExA(dwExStyle:int,lpClassName:string,lpWindowName:string,dwStyle:int,x:int,y:int,nWidth:int,nHeight:int,hWndParent:window,hMenu:int,hInstance:int,lpParam:int),int


' DECLARE THE VARIABLES
DEF pCommandLine:STRING
DEF info:STARTUPINFO
DEF hwnd AS INT :' windows handle
DEF wincl AS WNDCLASSEX :' type for windowclass
DEF messages AS MSG
DEF ClassName as STRING :' class name
DEF pClassName as POINTER :' pointer to class name
ClassName = "MyWindow"
pClassName = ClassName


' INIT THE <WINMAIN> STUFF
def _hinstance as UINT
' here i recive error variable GetCommandLine not define
pCommandLine = _GetCommandLine()

_GetStartupInfo(info)

' INIT THE WNDCLASSEX
wincl.lpszClassName=pClassName :'/* class name */
wincl.hInstance = _hinstance
wincl.lpfnWndProc = &WinProc :'/* windows procedure */
wincl.style = CS_DBLCLKS :'/* Catch double-clicks */
wincl.cbSize = LEN(WNDCLASSEX)
wincl.lpszMenuName = 0 :'/* no menÃÆ'Ã,º */
wincl.cbClsExtra = 0 :'/* No extra bytes after the window class */
wincl.cbWndExtra = 0 :'/* structure or the window instance */
wincl.hbrBackground = COLOR_BACKGROUND
wincl.hIcon=LoadIcon(0, IDI_APPLICATION)
wincl.hIconSm = LoadIcon(0, IDI_APPLICATION)
wincl.hCursor = LoadCursor(0, IDC_ARROW)


' CREATE THE WINDOW
hwnd = CreateWindowExA(0, ClassName , "Caption", WS_OVERLAPPEDWINDOW, 100, 100, 300, 200, HWND_DESKTOP, 0, _hinstance, 0)

' SHOW THE WINDOW
_ShowWindow (hwnd, info.dwFlags)


' MAIN LOOP
WHILE (_GetMessage (messages, 0, 0, 0))
'/* Translate virtual-key messages into character messages */
_TranslateMessage(messages)
'/* Send message to WindowProcedure */
_DispatchMessage(messages)
ENDWHILE
END

' WINDOW PROCEDURE
SUB WinProc(hWnd:INT,uMsg:INT,wParam:INT,lParam:INT),INT
SELECT uMsg
CASE @IDCREATE
'
CASE @IDDESTROY
_PostQuitMessage (0)
' any unhandled message goes here
DEFAULT
RETURN _DefWindowProc(hWnd, uMsg, wParam, lParam)
ENDSELECT
RETURN 0









[aurelCB]

Oh my I forgot :
DefWindowProc ALIAS DefWindowProcA(hwnd AS INT,wMsg AS INT,wParam AS INT,lParam AS INT),INT
I add this api function but same error

Code Select Expand

'Create window with API---------------------
TYPE WNDCLASSEX
DEF cbSize AS INT
DEF style AS INT
DEF lpfnWndProc AS INT
DEF cbClsExtra AS INT
DEF cbWndExtra AS INT
DEF hInstance AS INT
DEF hIcon AS INT
DEF hCursor AS INT
DEF hbrBackground AS INT
DEF lpszMenuName AS POINTER
DEF lpszClassName AS POINTER
DEF hIconSm AS INT
ENDTYPE

TYPE STARTUPINFO
DEF cb AS INT
DEF lpReserved AS POINTER
DEF lpDesktop AS POINTER
DEF lpTitle AS POINTER
DEF dwX AS INT
DEF dwY AS INT
DEF dwXSize AS INT
DEF dwYSize AS INT
DEF dwXCountChars AS INT
DEF dwYCountChars AS INT
DEF dwFillAttribute AS INT
DEF dwFlags AS INT
DEF wShowWindow AS WORD
DEF cbReserved2 AS WORD
DEF lpReserved2 AS INT
DEF hStdInput AS INT
DEF hStdOutput AS INT
DEF hStdError AS INT
ENDTYPE
TYPE POINT
DEF x AS INT
DEF y AS INT
ENDTYPE

TYPE MSG
DEF hwnd AS INT
DEF message AS INT
DEF wParam AS INT
DEF lParam AS INT
DEF time AS INT
DEF pt AS POINT
ENDTYPE

CONST IDC_ARROW = 32512
CONST IDI_APPLICATION = 32512
CONST COLOR_BACKGROUND = 1
CONST CS_DBLCLKS = 0x8
' Window Styles
CONST WS_OVERLAPPED = 0x0
CONST WS_POPUP = 0x80000000
CONST WS_CHILD = 0x40000000
CONST WS_MINIMIZE = 0x20000000
CONST WS_VISIBLE = 0x10000000
CONST WS_DISABLED = 0x8000000
CONST WS_CLIPSIBLINGS = 0x4000000
CONST WS_CLIPCHILDREN = 0x2000000
CONST WS_MAXIMIZE = 0x1000000
CONST WS_CAPTION = 0xC00000                  :'  WS_BORDER | WS_DLGFRAME
CONST WS_BORDER = 0x800000
CONST WS_DLGFRAME = 0x400000
CONST WS_VSCROLL = 0x200000
CONST WS_HSCROLL = 0x100000
CONST WS_SYSMENU = 0x80000
CONST WS_THICKFRAME = 0x40000
CONST WS_GROUP = 0x20000
CONST WS_TABSTOP = 0x10000

CONST WS_MINIMIZEBOX = 0x20000
CONST WS_MAXIMIZEBOX = 0x10000

CONST WS_TILED = WS_OVERLAPPED
CONST WS_ICONIC = WS_MINIMIZE
CONST WS_SIZEBOX = WS_THICKFRAME
CONST WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME | WS_MINIMIZEBOX | WS_MAXIMIZEBOX)
CONST WS_TILEDWINDOW = WS_OVERLAPPED

' Message Function Templates
DECLARE "user32",_GetMessage ALIAS GetMessageA(lpMsg AS MSG,hwnd AS INT,wMsgFilterMin AS INT,wMsgFilterMax AS INT),INT
DECLARE "user32", _TranslateMessage ALIAS TranslateMessage(lpMsg AS MSG),INT
DECLARE "user32",_DispatchMessage ALIAS DispatchMessageA(lpMsg AS MSG),INT
'DECLARE IMPORT, _PeekMessage ALIAS PeekMessageA(lpMsg AS MSG,hwnd AS INT,wMsgFilterMin AS INT,wMsgFilterMax AS INT,wRemoveMsg AS INT),INT
DECLARE "kernel32",_GetCommandLine ALIAS GetCommandLineA(),STRING
DECLARE "kernel32",_GetStartupInfo ALIAS GetStartupInfoA(lpStartupInfo AS STARTUPINFO)
DECLARE "user32",_DefWindowProc ALIAS DefWindowProcA(hwnd AS INT,wMsg AS INT,wParam AS INT,lParam AS INT),INT
DECLARE "user32",LoadIcon ALIAS "LoadIconA"(hinstance:INT, id:pointer),uint
DECLARE "user32",LoadCursor ALIAS "LoadCursorA"(hinstance:INT, id:pointer),uint
DECLARE "user32",RegisterClassEx ALIAS RegisterClassExA(pcWndClassEx AS WNDCLASSEX),WORD
Declare "user32",CreateWindowExA(dwExStyle:int,lpClassName:string,lpWindowName:string,dwStyle:int,x:int,y:int,nWidth:int,nHeight:int,hWndParent:window,hMenu:int,hInstance:int,lpParam:int),int


' DECLARE THE VARIABLES
DEF pCommandLine:STRING
DEF info:STARTUPINFO
DEF hwnd AS INT :' windows handle
DEF wincl AS WNDCLASSEX :' type for windowclass
DEF messages AS MSG
DEF ClassName as STRING :' class name
DEF pClassName as POINTER :' pointer to class name
ClassName = "MyWindow"
pClassName = ClassName


' INIT THE <WINMAIN> STUFF
def _hinstance as UINT
' here i recive error variable GetCommandLine not define
pCommandLine = _GetCommandLine()

_GetStartupInfo(info)

' INIT THE WNDCLASSEX
wincl.lpszClassName=pClassName :'/* class name */
wincl.hInstance = _hinstance
wincl.lpfnWndProc = &WinProc :'/* windows procedure */
wincl.style = CS_DBLCLKS :'/* Catch double-clicks */
wincl.cbSize = LEN(WNDCLASSEX)
wincl.lpszMenuName = 0 :'/* no menÃÆ'Ã,º */
wincl.cbClsExtra = 0 :'/* No extra bytes after the window class */
wincl.cbWndExtra = 0 :'/* structure or the window instance */
wincl.hbrBackground = COLOR_BACKGROUND
wincl.hIcon=LoadIcon(0, IDI_APPLICATION)
wincl.hIconSm = LoadIcon(0, IDI_APPLICATION)
wincl.hCursor = LoadCursor(0, IDC_ARROW)


' CREATE THE WINDOW
hwnd = CreateWindowExA(0, ClassName , "Caption", WS_OVERLAPPEDWINDOW, 100, 100, 300, 200, HWND_DESKTOP, 0, _hinstance, 0)

' SHOW THE WINDOW
_ShowWindow (hwnd, info.dwFlags)


' MAIN LOOP
WHILE (_GetMessage (messages, 0, 0, 0))
'/* Translate virtual-key messages into character messages */
_TranslateMessage(messages)
'/* Send message to WindowProcedure */
_DispatchMessage(messages)
ENDWHILE
END

' WINDOW PROCEDURE
SUB WinProc(hWnd:INT,uMsg:INT,wParam:INT,lParam:INT),INT
SELECT uMsg
CASE @IDCREATE
'
CASE @IDDESTROY
_PostQuitMessage (0)
' any unhandled message goes here
DEFAULT
RETURN _DefWindowProc(hWnd, uMsg, wParam, lParam)
ENDSELECT
RETURN 0









[ZeroDog]

your ALIAS ( _GetCommandLine) seems to be causing the problem.  Use a different alias, possibly without the underscore, or, just dont use an alias at all.

[aurelCB]

Yes I try without alias , in this case I crush Creative Basic?
Hmm I find one example from VB It is very different from this one.
He is without STARTUPINFO.And he use this API calls:

Code Select Expand

' API Declare Statements
Declare "user32",LoadCursor Alias "LoadCursorA"(hInstance As Int, lpCursorName As String) As Int
Declare "user32",LoadIcon Alias "LoadIconA"(hInstance As Int, lpIconName As String) As Int
'UPGRADE_WARNING: Structure WNDCLASSEX may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSExpressCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'

Declare "user32",RegisterClassEx Alias "RegisterClassExA"(ByRef pcWndClassEx As WNDCLASSEX) As Integer
'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSExpressCC.v80/dv_commoner/local/redirect.htm?keyword="FAE78A8D-8978-4FD4-8208-5B7324A8F795"'
Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA"(ByVal dwExStyle As Integer, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hWndParent As Integer, ByVal hMenu As Integer, ByVal hInstance As Integer, ByRef lpParam As Any) As Integer
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Integer, ByVal nCmdShow As Integer) As Integer
Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Integer) As Integer

'UPGRADE_WARNING: Structure MSG may require marshalling attributes to be passed as an argument in this Declare sta
Declare Function GetMessage Lib "user32" Alias "GetMessageA"(ByRef lpMsg As MSG, ByVal hWnd As Integer, ByVal wMsgFilterMin As Integer, ByVal wMsgFilterMax As Integer) As Integer

Declare Function TranslateMessage Lib "user32" (ByRef lpMsg As MSG) As Integer
Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA"(ByRef lpMsg As MSG) As Intege
Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Integer)
Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Integer) As Integer
Declare Function MessageBox Lib "user32" Alias "MessageBoxA"(ByVal hWnd As Integer, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Integer) As Integer
Declare Function SetFocus Lib "user32" (ByVal hWnd As Integer) As Integer
Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA"(ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Declare Function PostMessage Lib "user32" Alias "PostMessageA"(ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer


[Ionic Wind Support Team]

You can't create an API window directly from Creative BASIC, because it is an interpreter.

Creative BASIC subroutines don't have addresses, so you can't properly fill in the WNDCLASSEX structure, which expects the address of a wndproc subroutine (lpfnWndProc).   If you wish to experiment with such code then you will have to use Emergence BASIC or Aurora.

Paul.

[aurelCB]

Oh my I just try
Thanks Paul...

[aurelCB]

Hi...
I find one weird example on FB forum.
Not work quiet well but work.

Code Select Expand

'Window FB MSG
'#Include "windows.bi"


CONST WS_OVERLAPPEDWINDOW = 0x00CF0000
CONST WS_VISIBLE = 0x10000000
CONST WS_CHILD = 0x40000000
CONST SW_SHOWNORMAL = 1
CONST WM_DESTROY = 0x2
CONST WM_CLOSE = 0x10
CONST WM_SETFONT = 0x30
const DEFAULT_GUI_FONT = 17
'CONST HWND_DESKTOP = 0

Type POINT
  def x as INT
  def y as INT
Endtype

TYPE MSG
DEF hwnd AS INT
DEF message AS INT
DEF wParam AS INT
DEF lParam AS INT
DEF time AS INT
DEF pt AS POINT
ENDTYPE

DECLARE "user32",CreateWindowExA(dwExStyle AS INT,lpClassName AS STRING,lpWindowName AS STRING,dwStyle AS INT,x AS INT,y AS INT,nWidth AS INT,nHeight AS INT,hWndParent AS INT,hMenu AS INT,hInstance AS INT,lpParam AS INT),INT
DECLARE "user32",GetMessageA(lpMsg AS MSG,hwnd AS INT,wMsgFilterMin AS INT,wMsgFilterMax AS INT),INT
DECLARE "user32",TranslateMessage(lpMsg AS MSG),INT
DECLARE "user32",DispatchMessageA(lpMsg AS MSG),INT
DECLARE "user32", PostQuitMessage(nExitCode AS INT)
DECLARE "user32",ShowWindow(hwnd AS INT,nCmdShow AS INT),INT
DECLARE "user32",UpdateWindow(hwnd AS INT),INT
declare "gdi32",GetStockObject(nIndex AS INT),INT

DEF wmsg:MSG   :' Message variable (stores massages)
Dim hwnd:INT    :' Window variable
DEF btn1:INT    : 'Button variable
'pmsg = wmsg.message
const button1_ID = 2124
' Create window
hWnd = CreateWindowExA( 0, "#32769", "Hello", WS_OVERLAPPEDWINDOW|WS_VISIBLE, 100, 100, 400, 300, 0, 0, 0, 0 )
'btn1 = CreateWindowExA( 0, "BUTTON", "Click Me!", WS_VISIBLE|WS_CHILD, 20, 20, 70, 30, hWnd, 0, 0, 0 )
Button1 = CreateWindowExA(0, "Button","Button",1342242816, 95, 47, 89, 27,hwnd,button1_ID,0 ,0)
'Messagebox 0,"Window is : "+str$(hwnd),"ON"
SENDMESSAGE (hwnd,WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT),0,100)



  Select wmsg
Case @idcontrol
IF @controlid = 2124
'dont work
Messagebox 0,"Button Cliked!,"ON"
ENdIF
 
  EndSelect

'Endwhile

[Ionic Wind Support Team]

Aurel,
Again you are running into the same issue.  There is no where for the OS to send messages meant for your window.  There isn't a workaround, and nothing you can do about it, Creative subroutines don't have a physical address in memory. There is no way to give the OS an address of a subroutine to call when a message needs to be processed.

You can open a window using the API as you have noticed, but all of the messages are just going to the default window handler buried deep in the GDI.  Which doesn't do anything with control and menu notification messages, so it would be pointless to do so.  You could try and intercept the messages by writing your own message processing loop but you would be circumventing the way the OS works.

You must open the window using the Creative BASIC WINDOW command and supply your handler subroutine.  Then if you want you can create controls using the API remembering to offset the control ID properly.

I hope this is clear to you, because I do want you to understand why it doesn't work.

Paul.

[aurelCB]

Yes Paul you are 100% right.
I will give up from this pointless experiment.

Zlatko

[Haim]

Aurel
Why limit yoursel only to CBasic?
I suggest you also try Ebasic, which is not an interpreted language but a true compiler and it supports function pointers.
Haim