Hello gummibaer
Note that the interface to CreateWindows is somthing like this:
INTERFACE TO FUNCTION CreateWindow[PASCAL,FAR]
& (LS1,LS2,M,I,J,K,L,HW,HM,H,LS3)
INTEGER*2 CreateWindow,I,J,K,L,HW,HM,H
CHARACTER*(*) LS1 [FAR,REFERENCE]
CHARACTER*(*) LS2 [FAR,REFERENCE]
INTEGER*4 M
CHARACTER*(*) LS3 [FAR,REFERENCE]
END
So you should declare the arguments in that way. Note that the last argument should be a character string NULLSTR, defined as:
CHARACTER*(*) NULLSTR [C]
PARAMETER (NULLSTR=CHAR(0))
In the example below ("99 bottles"), you can see how the function CreateWindow is used. For simple buttons it looks like this:
status = CreateWindow('BUTTON'C,'Text'C,
& WS_CHILD.or.WS_VISIBLE.or.BS_PUSHBUTTON,
& 100,10,90,24,hDlg,IDCANCEL,hIhDlg,NULLSTR)
Good luck in your programming.
c ========================================================
c "99 Bottles for beer" for WinAPI in Fortran
c by GulliPe, 14.11.2006
$DEFINE KERNEL
$DEFINE GDI
$DEFINE USER
$DEFINE CTLMGR
$DEFINE MSG
$DEFINE WINMESSAGES
$DEFINE WINSTYLES
$DEFINE MENUS
$DEFINE ICONS
include 'Windows.FI'
INTERFACE TO FUNCTION MainWndProc(hWnd,message,wParam,lParam)
integer*4 MainWndProc [PASCAL,FAR]
integer*2 hWnd
integer*2 message
integer*2 wParam
integer*4 lParam
END
c ----------------------------------------------------
function WinMain[PASCAL,FAR] (hInstance,hPrevInstance,
* IpCmdLine,nCmdShow)
implicit none
integer*2 WinMain,hInstance,hPrevInstance,nCmdShow
integer*4 IpCmdLine
integer*4 MainWndProc [EXTERN,PASCAL,FAR]
integer*2 hWnd,hInst
integer*4 status
include 'WINDOWS.FD'
common /FortWin_hInst/ hInst
record /MSG/ Wmsg
record /WNDCLASS/ wc
wc.style = NULL
wc.lpfnWndProc = LOCFAR(MainWndProc)
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hInstance
wc.hIcon = LoadIcon_A(NULL,IDI_APPLICATION)
wc.hCursor = LoadCursor_A(NULL,IDC_ARROW)
wc.hbrBackground = GetStockObject(WHITE_BRUSH)
wc.lpszMenuName = LOCFAR(''C)
wc.lpszClassName = LOCFAR('GenericWClass'C)
status = RegisterClass(wc)
hInst = hInstance
hWnd = CreateWindow(
* 'GenericWClass'C,
* '99 bottles of beer'C,
* WS_OVERLAPPEDWINDOW,
* CW_USEDEFAULT,
* CW_USEDEFAULT,
* CW_USEDEFAULT,
* CW_USEDEFAULT,
* NULL,
* NULL,
* hInstance,
* NULLSTR)
status = ShowWindow(hWnd,nCmdShow)
call UpdateWindow(hWnd)
do while (GetMessage(Wmsg,NULL,NULL,NULL).ne.0)
status = TranslateMessage(Wmsg)
status = DispatchMessage(Wmsg)
enddo
WinMain = Wmsg.wParam
return
end
c ----------------------------------------------------
function MainWndProc[PASCAL,FAR] (hWnd,message,wParam,lParam)
implicit none
integer*4 MainWndProc
integer*2 hWnd,message,wParam
integer*4 lParam
integer*2 hInst,hfont,hmenu,lbx1
integer*4 status
integer*2 i
integer*4 lcs
character*2 co,pt,strI,strJ
character*128 str
character str1a*28,str1b*27,str2a*16,str2b*15,str3*32,str4*36
integer*2 IDM_START,IDM_EXIT
parameter (IDM_START=100)
parameter (IDM_EXIT =101)
include 'WINDOWS.FD'
common /FortWin_hInst/ hInst
common /aa00/ lbx1
record /logfont/ lf
select case (message)
case (WM_CREATE)
lf.lfHeight = 16
lf.lfWidth = 0
lf.lfEscapement = 0
lf.lfOrientation = 0
lf.lfWeight = FW_NORMAL
lf.lfItalic = char(0)
lf.lfUnderline = char(0)
lf.lfStrikeOut = char(0)
lf.lfCharSet = ANSI_CHARSET
lf.lfOutPrecision = OUT_DEFAULT_PRECIS
lf.lfClipPrecision = CLIP_DEFAULT_PRECIS
lf.lfQuality = DEFAULT_QUALITY
lf.lfPitchAndFamily = DEFAULT_PITCH
lf.lfFaceName = 'Arial'C
hfont = CreateFontIndirect(lf)
lbx1=CreateWindow('LISTBOX'C,NULLSTR,
* WS_BORDER.or.WS_CHILDWINDOW.or.WS_VISIBLE
* .or.WS_VSCROLL.or.LBS_DISABLENOSCROLL,
* 20,20,600,400,
* hWnd,-1,hInst,NULLSTR)
status = SendMessage(lbx1,WM_SETFONT,hfont,0)
hmenu = CreateMenu()
status = AppendMenu(hmenu,MF_ENABLED,IDM_START,'Start'C)
status = AppendMenu(hmenu,MF_ENABLED,IDM_EXIT,'Exit'C)
status = SetMenu(hWnd,hmenu)
case (WM_COMMAND)
select case (wParam)
case (IDM_START)
co = ', '
pt = '.'//char(0)
str1a = ' bottles of beer on the wall'
str1b = ' bottle of beer on the wall'
str2a = ' bottles of beer'
str2b = ' bottle of beer'
str3 = 'Take one down and pass it around'
str4 = ' no more bottles of beer on the wall'
lcs = LOCFAR(str)
do i = 99,1,-1
write(strI,'(i2)') i
write(strJ,'(i2)') i-1
if(i.gt.1) str = strI//str1a//co//strI//str2a//pt
if(i.eq.1) str = strI//str1b//co//strI//str2b//pt
status = SendMessage(lbx1,LB_INSERTSTRING,-1,lcs)
if(i.gt.2) str = str3//co//strJ//str1a//pt
if(i.eq.2) str = str3//co//strJ//str1b//pt
if(i.eq.1) str = str3//co//str4//pt
status = SendMessage(lbx1,LB_INSERTSTRING,-1,lcs)
str = ''C
status = SendMessage(lbx1,LB_INSERTSTRING,-1,lcs)
enddo
str = 'No more bottles of beer on the wall, '//
* 'no more bottles of beer.'C
status = SendMessage(lbx1,LB_INSERTSTRING,-1,lcs)
str = 'Go to the store and buy some more, '//
* '99 bottles of beer on the wall.'C
status = SendMessage(lbx1,LB_INSERTSTRING,-1,lcs)
MainWndProc = 0
case (IDM_EXIT)
status = DestroyWindow(hWnd)
MainWndProc = 0
case DEFAULT
MainWndProc=DefWindowProc(hWnd,message,wParam,lParam)
end select
case (WM_DESTROY)
call PostQuitMessage(0)
MainWndProc = 0
case DEFAULT
MainWndProc = DefWindowProc(hWnd,message,wParam,lParam)
end select
return
end
c ==========================================================