- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear all,
I want to write a fortran dll which can create win32 windows along with menus? Who can tell me what to do?
In normal CVF Win32 application, the main program is as follows:
integer*4 function WinMain( hInstance, hPrevInstance, lpszCmdLine, nCmdShow )
How can I get the parameter of hInstance and lpszCmdLine in a subroutine which will be exported as a dll library?
Thanks!
Sincerely,
Tang, Zhanghong
I want to write a fortran dll which can create win32 windows along with menus? Who can tell me what to do?
In normal CVF Win32 application, the main program is as follows:
integer*4 function WinMain( hInstance, hPrevInstance, lpszCmdLine, nCmdShow )
How can I get the parameter of hInstance and lpszCmdLine in a subroutine which will be exported as a dll library?
Thanks!
Sincerely,
Tang, Zhanghong
Link Copied
14 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Why would you pass lpszCmdLine at all? Command line, if any, should be processed in main application, and the author of WinMain would ceratinly know better what to do with command-line arguments than in your dll.
hInstance is handle of module (.exe, .dll). You can always get handle of .exe that started the process by calling GetModuleHandle(NULL) (btw, it's always 0x400000 in Win32, as this handle is valid only within the process). Getting the handle of the dll itself is trickier -- you can either retrieve it by GetModuleHandle("mydll.dll"C) or by saving hInstDll argument to DllMain. Usually, hInstance is required for APIs working with resources. (I'm not sure why it is required in CreateWindow and what's the difference if you pass hInstance of dll btw. hInstance of .exe).
Of course, you can always pass anything required through argument-list of dll exported functions, e.g. CreateMyWindow().
Jugoslav
hInstance is handle of module (.exe, .dll). You can always get handle of .exe that started the process by calling GetModuleHandle(NULL) (btw, it's always 0x400000 in Win32, as this handle is valid only within the process). Getting the handle of the dll itself is trickier -- you can either retrieve it by GetModuleHandle("mydll.dll"C) or by saving hInstDll argument to DllMain. Usually, hInstance is required for APIs working with resources. (I'm not sure why it is required in CreateWindow and what's the difference if you pass hInstance of dll btw. hInstance of .exe).
Of course, you can always pass anything required through argument-list of dll exported functions, e.g. CreateMyWindow().
Jugoslav
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear Dr. Jugoslav,
Thank you very much for your reply! Here I have attached two projects generated in CVF6.6-maintest and win32dll, in the project of win32dll, I have inserted some resources such as menu and accelerator manually, I don't know if it is valid.
Would you please check the error for me?
Sincerely,
Tang, Zhanghong
Thank you very much for your reply! Here I have attached two projects generated in CVF6.6-maintest and win32dll, in the project of win32dll, I have inserted some resources such as menu and accelerator manually, I don't know if it is valid.
Would you please check the error for me?
Sincerely,
Tang, Zhanghong
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
hInstance is actually address of image of .exe/.dll in current process' address space. It is mostly used with resource-looking functions. Main .exe file is always loaded at 0x400000, and other dll's are loaded elsewhere.
For example, when you
LoadMenu(hInstance, IDC_MENU1)
the function takes the given base address hInstance, looks at image's header in memory at that address, sees that offset to resource section is e.g. 0x123456, and starts looking for binary data of IDC_MENU1 at address (hInstance+0x123456). Thus, you must pass hInstance of the "right" module:
hInstance = GetModuleHandle("win32dll.dll"C)
is what you need in this case, as you're looking for menus etc. within your dll, not within the exe file (you can get .exe's hinstance by GetModuleHandle(NULL), but you'll hardly need it). When I changed that, your sample started working (get rid of hPrevInstance, it's a remnant from Win16 days).
However, there's a crucial design problem. For an application to have usable windows, it needs a message loop (GetMessage thingo) to be able to update their appearance. However, message loop is modal, in the sense that the code exits when the main window is closed (WM_DESTROY->PostQuitMessage exits the do while GetMessage loop). Effectively, your window acts like a modal dialog -- user's exe cannot do anything until win32dll() routine is exited. If it's OK for you -- fine. If it's not, well, you could start playing with CreateThread calls, but that can get tricky...
Jugoslav
For example, when you
LoadMenu(hInstance, IDC_MENU1)
the function takes the given base address hInstance, looks at image's header in memory at that address, sees that offset to resource section is e.g. 0x123456, and starts looking for binary data of IDC_MENU1 at address (hInstance+0x123456). Thus, you must pass hInstance of the "right" module:
hInstance = GetModuleHandle("win32dll.dll"C)
is what you need in this case, as you're looking for menus etc. within your dll, not within the exe file (you can get .exe's hinstance by GetModuleHandle(NULL), but you'll hardly need it). When I changed that, your sample started working (get rid of hPrevInstance, it's a remnant from Win16 days).
However, there's a crucial design problem. For an application to have usable windows, it needs a message loop (GetMessage thingo) to be able to update their appearance. However, message loop is modal, in the sense that the code exits when the main window is closed (WM_DESTROY->PostQuitMessage exits the do while GetMessage loop). Effectively, your window acts like a modal dialog -- user's exe cannot do anything until win32dll() routine is exited. If it's OK for you -- fine. If it's not, well, you could start playing with CreateThread calls, but that can get tricky...
Jugoslav
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thank you very much! I have also found this! When I changed "maintest.exe" to "win32dll.dll", it works!
Another question: when the dll is called several times, it can only work at the first time, after that it still displays "Error initializing application." I have tried to use the subroutine of UnregisterClass, My modified codes is as follows:
! if (hPrevInstance .eq. 0) then
if(.not.UnregisterClass(lpszClassName,hInstance))then
wc%lpszClassName = LOC(lpszClassName)
wc%lpfnWndProc = LOC(MainWndProc)
wc%style = IOR(CS_VREDRAW , CS_HREDRAW)
wc%hInstance = hInstance
wc%hIcon = LoadIcon( hInstance, LOC(lpszIconName))
wc%hCursor = LoadCursor( NULL, IDC_ARROW )
wc%hbrBackground = ( COLOR_WINDOW+1 )
wc%lpszMenuName = NULL
wc%cbClsExtra = 0
wc%cbWndExtra = 0
if (RegisterClass(wc) == 0) goto 99999
end if
In the main program I have called the DLL several times.
Then an interesting thing appear:
The first time it is ok, the second time it is failed, the third time it is ok, ...,
Would you please tell me why? How can I avoid it?
Thanks,
Sincerely,
Tang, Zhanghong
Another question: when the dll is called several times, it can only work at the first time, after that it still displays "Error initializing application." I have tried to use the subroutine of UnregisterClass, My modified codes is as follows:
! if (hPrevInstance .eq. 0) then
if(.not.UnregisterClass(lpszClassName,hInstance))then
wc%lpszClassName = LOC(lpszClassName)
wc%lpfnWndProc = LOC(MainWndProc)
wc%style = IOR(CS_VREDRAW , CS_HREDRAW)
wc%hInstance = hInstance
wc%hIcon = LoadIcon( hInstance, LOC(lpszIconName))
wc%hCursor = LoadCursor( NULL, IDC_ARROW )
wc%hbrBackground = ( COLOR_WINDOW+1 )
wc%lpszMenuName = NULL
wc%cbClsExtra = 0
wc%cbWndExtra = 0
if (RegisterClass(wc) == 0) goto 99999
end if
In the main program I have called the DLL several times.
Then an interesting thing appear:
The first time it is ok, the second time it is failed, the third time it is ok, ...,
Would you please tell me why? How can I avoid it?
Thanks,
Sincerely,
Tang, Zhanghong
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
A common implementation of such stuff is to dedicate a separate dll routine for initialization, from where you call RegisterClass. (for example, Windows common controls require a call to InitCommonControls[Ex] where appropriate dll is loaded and classes are registered).
More simply, do not test return value from RegisterClass. RegisterClass cannot normally fail first time, and if invoked more times, it will return error "already registered", (which you don't care anyway). Or UnregisterClass at the end of dll function (after message loop).
Btw, this is a piece of code I saw on a newsgroup: :-)):
if (!RegisterClass(&wclass))
MessageBox(NULL, "Windows is broken. Use Linux instead. It works.", "Error", MB_OK);
Don't forget to DestroyMenu and DestroyAcceleratorTable at the end of win32dll as well.
Jugoslav
More simply, do not test return value from RegisterClass. RegisterClass cannot normally fail first time, and if invoked more times, it will return error "already registered", (which you don't care anyway). Or UnregisterClass at the end of dll function (after message loop).
Btw, this is a piece of code I saw on a newsgroup: :-)):
if (!RegisterClass(&wclass))
MessageBox(NULL, "Windows is broken. Use Linux instead. It works.", "Error", MB_OK);
Don't forget to DestroyMenu and DestroyAcceleratorTable at the end of win32dll as well.
Jugoslav
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thank you very much! I have successed. I have modified like this:
call InitCommonControls
hInstance = GetModuleHandle("win32dll.dll"C)
...
! if(.not.UnregisterClass(lpszClassName,hInstance))then
wc%lpszClassName = LOC(lpszClassName)
wc%lpfnWndProc = LOC(MainWndProc)
wc%style = IOR(CS_VREDRAW , CS_HREDRAW)
wc%hInstance = hInstance
wc%hIcon = LoadIcon( hInstance, LOC(lpszIconName))
wc%hCursor = LoadCursor( NULL, IDC_ARROW )
wc%hbrBackground = ( COLOR_WINDOW+1 )
wc%lpszMenuName = NULL
wc%cbClsExtra = 0
wc%cbWndExtra = 0
if (RegisterClass(wc) == 0) goto 99999
! end if
...
do while( GetMessage (mesg, NULL, 0, 0) )
if ( TranslateAccelerator (mesg%hwnd, haccel, mesg) == 0) then
lret = TranslateMessage( mesg )
ret = DispatchMessage( mesg )
end if
end do
lret=DestroyMenu(hInstance)
lret=DestroyAcceleratorTable (haccel)
lret=UnregisterClass(lpszClassName,hInstance)
...
I am a fortran beginner, I think you are my best teacher!
Sincerely,
Tang, Zhanghong
call InitCommonControls
hInstance = GetModuleHandle("win32dll.dll"C)
...
! if(.not.UnregisterClass(lpszClassName,hInstance))then
wc%lpszClassName = LOC(lpszClassName)
wc%lpfnWndProc = LOC(MainWndProc)
wc%style = IOR(CS_VREDRAW , CS_HREDRAW)
wc%hInstance = hInstance
wc%hIcon = LoadIcon( hInstance, LOC(lpszIconName))
wc%hCursor = LoadCursor( NULL, IDC_ARROW )
wc%hbrBackground = ( COLOR_WINDOW+1 )
wc%lpszMenuName = NULL
wc%cbClsExtra = 0
wc%cbWndExtra = 0
if (RegisterClass(wc) == 0) goto 99999
! end if
...
do while( GetMessage (mesg, NULL, 0, 0) )
if ( TranslateAccelerator (mesg%hwnd, haccel, mesg) == 0) then
lret = TranslateMessage( mesg )
ret = DispatchMessage( mesg )
end if
end do
lret=DestroyMenu(hInstance)
lret=DestroyAcceleratorTable (haccel)
lret=UnregisterClass(lpszClassName,hInstance)
...
I am a fortran beginner, I think you are my best teacher!
Sincerely,
Tang, Zhanghong
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Heh, I was affraid you will ask that -- it's possible, but it's not so simple. I don't have time now to elaborate -- I'll try to find some tomorrow (remind me if I forget).
Did you work with QuickWin applications? Basically, you're trying to do the same thing as QuickWin -- main PROGRAM statement runs continuously, while windows are created and displayed, and menu callbacks work "synchronously" with main program. In QuickWin, this is achieved using two threads (one for PROGRAM, another, "hidden", for GUI) -- this is what you will have to do too. To be continued...
Jugoslav
Did you work with QuickWin applications? Basically, you're trying to do the same thing as QuickWin -- main PROGRAM statement runs continuously, while windows are created and displayed, and menu callbacks work "synchronously" with main program. In QuickWin, this is achieved using two threads (one for PROGRAM, another, "hidden", for GUI) -- this is what you will have to do too. To be continued...
Jugoslav
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Anyway, thank you very much!
I am very glad that I have found such a good teacher(if you don't mind)!
I am very glad that I have found such a good teacher(if you don't mind)!
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Re multiple windows: I thought about it for a while, and I don't think it's a job for a newbie. It's more a design than coding issue, because threads (which have to be involved) although simple at first sight, require careful coding and understanding. Anyway, here's an outline:
The problem is that a program cannot run two things simultaneously (user's code in the .exe and message loop located in your dll) without having two (or more) threads. So, as a first step:
1) Declare another function in the dll, called e.g. CreateMyWindow, and from there invoke win32dll by calling CreateThread(). Change the prototype of win32dll to proper one (integer function with one argument). Dllexport CreateMyWindow, and remove export for win32dll.
Step 1 leads us to somewhat stupid design of one window per thread. That means that a new thread will be created for each call to CreateMyWindow, and it's a pure waste of system resources. So,
2) Manage the code so that the CreateThread is called only once, to create one GUI thread. So, make an initialization dllexport, called e.g. InitMySystem, like this:
3) MainThreadFunc should run a message loop and create window only on subsequent requests:
4) By now, there's no code to create a window. You cannot call a routine to run in context in another thread (message loop dispatches to windows created only from its thread). What you can do is to use inter-thread communication. The most appropriate method would be to send a custom message to the thread:
On the end of MainThreadFunc (###), perform a cleanup:
Are you really sure you want to try that?
Jugoslav
The problem is that a program cannot run two things simultaneously (user's code in the .exe and message loop located in your dll) without having two (or more) threads. So, as a first step:
1) Declare another function in the dll, called e.g. CreateMyWindow, and from there invoke win32dll by calling CreateThread(). Change the prototype of win32dll to proper one (integer function with one argument). Dllexport CreateMyWindow, and remove export for win32dll.
Step 1 leads us to somewhat stupid design of one window per thread. That means that a new thread will be created for each call to CreateMyWindow, and it's a pure waste of system resources. So,
2) Manage the code so that the CreateThread is called only once, to create one GUI thread. So, make an initialization dllexport, called e.g. InitMySystem, like this:
subroutine InitMySystem() !dec$attributes dllexport:: InitMySystem logical, save:: bAlreadyInitialized = .false. if (.not.bAlreadyInitialized) then RegisterClass(...) ghThread = CreateThread(...MainThreadFunc, LOC(gidThread)) bAlreadyInitialized=.true. end if end subroutine
3) MainThreadFunc should run a message loop and create window only on subsequent requests:
recursive integer function MainThreadFunc(Arg1) !Dec$attributes stdcall:: MainThreadFunc do while (GetMessage...) !@@@ we will need something here TranslateMessage(... end do !### something here also MainThreadFunc = 0
4) By now, there's no code to create a window. You cannot call a routine to run in context in another thread (message loop dispatches to windows created only from its thread). What you can do is to use inter-thread communication. The most appropriate method would be to send a custom message to the thread:
integer, parameter:: WM_CREATEMYWINDOW = WM_APP+1 integer, parameter:: WM_DESTROYALL = WM_APP+2 ! subroutine CreateMyWindow() !dec$attributes dllexport:: CreateMyWindow PostThreadMessage(gidThread, WM_CREATEMYWINDOW, 0, 0) end subroutine CreateMyWindow ! subroutine DestroyAll() !dec$attributes dllexport:: CreateMyWindow PostThreadMessage(gidThread, WM_DESTROYALL, 0, 0) end subroutine DestroyAllNow, at code marked with @@@, handle the two messages above:
if (msg.message == WM_CREATEMYWINDOW) then CreateWindow(...) if (msg.message == WM_DESTROYALL) then exit !Message loop else TranslateMessage DispatchMessage end if
On the end of MainThreadFunc (###), perform a cleanup:
EnumThreadWindows(gidThread, LOC(MyDestroyWindow),0) DestroyMenu() DestroyAccelTable() MainThreadFunc = 0 ! recursive integer function MyDestroy(hWnd, iUnused) DestroyWindow(hWnd) end function MyDestroyAll your functions (especially WndProcs) should be declared RECURSIVE to allow reentrancy. You have to take care how to manage an unknown number of windows in advance. There are certainly more gotchas that I can't see in this overview.
Are you really sure you want to try that?
Jugoslav
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Oh my God! I have to read and think for at least a week! Your idea, your codes and your other things are valuable for me to think a lot! I will try it step by step, I think when I have succeed in it, I will make a great progress in my fortran programing. My wish is that one day I can become an expert like you and answer others' questions fervidly and without any difficulties.
In addition, I have found a subroutine of saving an opengl image to a bitmap file, I have modified it a little, but the result is that the image include the pop-up menus, what should I do?
the subroutine is as follows:
subroutine saveimage(hWnd)
use comdlg32
use dfwin
type(T_OPENFILENAME) ofn
character*512 filename
integer fileinf(12)
integer hWnd
integer hDc
character*(*),parameter :: filter_spec = &
"BMP file"C//"*.bmp"C
character*512 :: file_spec = ""C
integer status,ilen,filesize
type(T_BITMAP) bm
integer(4) hbmComp,ppix,ppiy
ofn%lStructSize = SIZEOF(ofn)
ofn%hwndOwner = hWnd ! For non-console applications,
! set this to the Hwnd of the
! Owner window. For QuickWin
! and Standard Graphics projects,
! use GETHWNDQQ(QWIN$FRAMEWINDOW)
!
ofn%hInstance = hWnd ! For Win32 applications, you
! can set this to the appropriate
! hInstance
!
ofn%lpstrFilter = loc(filter_spec)
ofn%lpstrCustomFilter = NULL
ofn%nMaxCustFilter = 0
ofn%nFilterIndex = 1 ! Specifies initial filter value
ofn%lpstrFile = loc(file_spec)
ofn%nMaxFile = sizeof(file_spec)
ofn%nMaxFileTitle = 0
ofn%lpstrInitialDir = LOC(""C)
ofn%lpstrTitle = loc(""C)
ofn%Flags = OFN_PATHMUSTEXIST
ofn%lpstrDefExt = loc("txt"C)
ofn%lpfnHook = NULL
ofn%lpTemplateName = NULL
hdc = GetDC(hwnd)
call GETBMPINF(hDc, bm, hbmComp,ppix,ppiy)
! Call GetOpenFileName and check status
!
status = GetSaveFileName(ofn)
status = CommDlgExtendedError ()
ilen = INDEX(file_spec,CHAR(0))
filename=file_spec(1:ilen-1)
call SAVEBMI(bm,hbmComp,ppix,ppiy,filename,retcod)
end
subroutine GETBMPINF(hDc, bm, hbmComp,ppix,ppiy)
use dfwina
use dfopngl
integer(4) hDC !handle to device context
type(T_BITMAP) bm
integer(4) vp(4),width,height,hbmComp,hbmold,hdcComp,ppix,ppiy,retint
call fglGetIntegerv_array(GL_VIEWPORT,vp)
width = vp(3)
height = vp(4)
!-- Get pixel information
ppix = GetDeviceCaps(hDC,LOGPIXELSX) !no of pixels/inch, x-dir
ppiy = GetDeviceCaps(hDC,LOGPIXELSY) !no of pixels/inch, y-dir
!-- Create compatible DC and get bitmap
hdcComp = CreateCompatibleDC(hDC)
hbmComp = CreateCompatibleBitmap(hDC,Width,Height)
hbmold = SelectObject(hdcComp,hbmComp)
retint = BitBlt(hdcComp,0,0,width,height,hDC,0,0,SRCCOPY)
retint = GetObject(hbmComp,24,LOC(bm))
end
subroutine SAVEBMI(bm,hbmComp,ppix,ppiy,filename,retcod)
!-------------------------------------------------------------------------------
!
!-- Save bitmapimage in a Windows bitmap file (bmp)
!
!-------------------------------------------------------------------------------
use dfwina
use dfopngl
implicit none
integer bmfu
character*(*) filename !file name for bitmap file
integer(4) retcod !return code:
!= 0, unsupported display, bitmap not saved
!> 0, bitmap saved (file size in bytes returned)
type(T_BITMAPFILEHEADER) bmfh
type(T_BITMAPINFOHEADER) bmih
type(T_BITMAP) bm
integer(4) hbmComp,retint
integer(4) vp(4),width,height,bmsize,ppix,ppiy,rdim,rdimdw,rdimbm
integer(4) ih,iw,jw,kw
integer(1), allocatable :: bmbits(:,:),bmrow(:)
!-- Get dimensions of ViewPort and allocate arrays for bitmap bits
bmfu = 1
call fglGetIntegerv_array(GL_VIEWPORT,vp)
width = vp(3)
height = vp(4)
bmsize = width*height*3
rdim = width*3 !bitmap file always saved as 24 bit bitmap
rdimdw = rdim !row dimension ending on a dword boundary
if (MOD(rdimdw,4) .ne. 0) rdimdw = rdimdw+4-MOD(rdimdw,4)
if (bm%bmBitsPixel .eq. 24) then
rdimbm = rdim !row dimension ending on a word boundary
if (MOD(rdimbm,2) .ne. 0) rdimbm = rdimbm+1
else if (bm%bmBitsPixel .eq. 32) then
rdimbm = width*4
else
retint = MessageBox(NULL,'Display properties not supported, bitmap not saved'C, &
'RosaGL message'C,MB_OK+MB_ICONEXCLAMATION)
retcod = 0
go to 900
end if
allocate(bmbits(rdimbm,height))
retint = GetBitmapBits(hbmComp,rdimbm*height,LOC(bmbits))
!-- Create bitmap file header
bmfh%bfType = 'BM'
bmfh%bfSize = SIZEOF(bmfh)+SIZEOF(bmih)+rdimdw*height
bmfh%bfReserved1 = 0
bmfh%bfReserved2 = 0
bmfh%bfOffBits = SIZEOF(bmfh)+SIZEOF(bmih)
!-- Create bitmap info header
bmih%biSize = SIZEOF(bmih)
bmih%biWidth = width
bmih%biHeight = height
bmih%biPlanes = bm%bmPlanes
bmih%biBitCount = MIN(24,bm%bmBitsPixel)
bmih%biCompression = BI_RGB
bmih%biSizeImage = rdimdw*height
bmih%biXPelsPerMeter = NINT(ppix/0.0254) !(1 inch = 0.0254 m)
bmih%biYPelsPerMeter = NINT(ppiy/0.0254) !(1 inch = 0.0254 m)
bmih%biClrUsed = 0
bmih%biClrImportant = 0
!-- Open file for bitmap
open(unit=bmfu,file=filename,access='sequential',status='unknown',form='binary')
!-- Save bitmap
allocate(bmrow(rdimdw))
bmrow = 0
write(bmfu) bmfh,bmih
do ih=height,1,-1
if (bm%bmBitsPixel .eq. 24) then
bmrow(1:rdimbm) = bmbits(:,ih)
else
jw = 1
kw = 1
do iw=1,width
bmrow(jw:jw+2) = bmbits(kw:kw+2,ih)
jw = jw+3
kw = kw+4
end do
end if
write(bmfu)bmrow
end do
close(unit=bmfu)
deallocate(bmrow)
900 end
In the main program, I called it like this:
...
case (IDM_SAVE)
call saveimage(hWnd)
MainWndProc = 0
return
...
I think I can't go without you:)
In addition, I have found a subroutine of saving an opengl image to a bitmap file, I have modified it a little, but the result is that the image include the pop-up menus, what should I do?
the subroutine is as follows:
subroutine saveimage(hWnd)
use comdlg32
use dfwin
type(T_OPENFILENAME) ofn
character*512 filename
integer fileinf(12)
integer hWnd
integer hDc
character*(*),parameter :: filter_spec = &
"BMP file"C//"*.bmp"C
character*512 :: file_spec = ""C
integer status,ilen,filesize
type(T_BITMAP) bm
integer(4) hbmComp,ppix,ppiy
ofn%lStructSize = SIZEOF(ofn)
ofn%hwndOwner = hWnd ! For non-console applications,
! set this to the Hwnd of the
! Owner window. For QuickWin
! and Standard Graphics projects,
! use GETHWNDQQ(QWIN$FRAMEWINDOW)
!
ofn%hInstance = hWnd ! For Win32 applications, you
! can set this to the appropriate
! hInstance
!
ofn%lpstrFilter = loc(filter_spec)
ofn%lpstrCustomFilter = NULL
ofn%nMaxCustFilter = 0
ofn%nFilterIndex = 1 ! Specifies initial filter value
ofn%lpstrFile = loc(file_spec)
ofn%nMaxFile = sizeof(file_spec)
ofn%nMaxFileTitle = 0
ofn%lpstrInitialDir = LOC(""C)
ofn%lpstrTitle = loc(""C)
ofn%Flags = OFN_PATHMUSTEXIST
ofn%lpstrDefExt = loc("txt"C)
ofn%lpfnHook = NULL
ofn%lpTemplateName = NULL
hdc = GetDC(hwnd)
call GETBMPINF(hDc, bm, hbmComp,ppix,ppiy)
! Call GetOpenFileName and check status
!
status = GetSaveFileName(ofn)
status = CommDlgExtendedError ()
ilen = INDEX(file_spec,CHAR(0))
filename=file_spec(1:ilen-1)
call SAVEBMI(bm,hbmComp,ppix,ppiy,filename,retcod)
end
subroutine GETBMPINF(hDc, bm, hbmComp,ppix,ppiy)
use dfwina
use dfopngl
integer(4) hDC !handle to device context
type(T_BITMAP) bm
integer(4) vp(4),width,height,hbmComp,hbmold,hdcComp,ppix,ppiy,retint
call fglGetIntegerv_array(GL_VIEWPORT,vp)
width = vp(3)
height = vp(4)
!-- Get pixel information
ppix = GetDeviceCaps(hDC,LOGPIXELSX) !no of pixels/inch, x-dir
ppiy = GetDeviceCaps(hDC,LOGPIXELSY) !no of pixels/inch, y-dir
!-- Create compatible DC and get bitmap
hdcComp = CreateCompatibleDC(hDC)
hbmComp = CreateCompatibleBitmap(hDC,Width,Height)
hbmold = SelectObject(hdcComp,hbmComp)
retint = BitBlt(hdcComp,0,0,width,height,hDC,0,0,SRCCOPY)
retint = GetObject(hbmComp,24,LOC(bm))
end
subroutine SAVEBMI(bm,hbmComp,ppix,ppiy,filename,retcod)
!-------------------------------------------------------------------------------
!
!-- Save bitmapimage in a Windows bitmap file (bmp)
!
!-------------------------------------------------------------------------------
use dfwina
use dfopngl
implicit none
integer bmfu
character*(*) filename !file name for bitmap file
integer(4) retcod !return code:
!= 0, unsupported display, bitmap not saved
!> 0, bitmap saved (file size in bytes returned)
type(T_BITMAPFILEHEADER) bmfh
type(T_BITMAPINFOHEADER) bmih
type(T_BITMAP) bm
integer(4) hbmComp,retint
integer(4) vp(4),width,height,bmsize,ppix,ppiy,rdim,rdimdw,rdimbm
integer(4) ih,iw,jw,kw
integer(1), allocatable :: bmbits(:,:),bmrow(:)
!-- Get dimensions of ViewPort and allocate arrays for bitmap bits
bmfu = 1
call fglGetIntegerv_array(GL_VIEWPORT,vp)
width = vp(3)
height = vp(4)
bmsize = width*height*3
rdim = width*3 !bitmap file always saved as 24 bit bitmap
rdimdw = rdim !row dimension ending on a dword boundary
if (MOD(rdimdw,4) .ne. 0) rdimdw = rdimdw+4-MOD(rdimdw,4)
if (bm%bmBitsPixel .eq. 24) then
rdimbm = rdim !row dimension ending on a word boundary
if (MOD(rdimbm,2) .ne. 0) rdimbm = rdimbm+1
else if (bm%bmBitsPixel .eq. 32) then
rdimbm = width*4
else
retint = MessageBox(NULL,'Display properties not supported, bitmap not saved'C, &
'RosaGL message'C,MB_OK+MB_ICONEXCLAMATION)
retcod = 0
go to 900
end if
allocate(bmbits(rdimbm,height))
retint = GetBitmapBits(hbmComp,rdimbm*height,LOC(bmbits))
!-- Create bitmap file header
bmfh%bfType = 'BM'
bmfh%bfSize = SIZEOF(bmfh)+SIZEOF(bmih)+rdimdw*height
bmfh%bfReserved1 = 0
bmfh%bfReserved2 = 0
bmfh%bfOffBits = SIZEOF(bmfh)+SIZEOF(bmih)
!-- Create bitmap info header
bmih%biSize = SIZEOF(bmih)
bmih%biWidth = width
bmih%biHeight = height
bmih%biPlanes = bm%bmPlanes
bmih%biBitCount = MIN(24,bm%bmBitsPixel)
bmih%biCompression = BI_RGB
bmih%biSizeImage = rdimdw*height
bmih%biXPelsPerMeter = NINT(ppix/0.0254) !(1 inch = 0.0254 m)
bmih%biYPelsPerMeter = NINT(ppiy/0.0254) !(1 inch = 0.0254 m)
bmih%biClrUsed = 0
bmih%biClrImportant = 0
!-- Open file for bitmap
open(unit=bmfu,file=filename,access='sequential',status='unknown',form='binary')
!-- Save bitmap
allocate(bmrow(rdimdw))
bmrow = 0
write(bmfu) bmfh,bmih
do ih=height,1,-1
if (bm%bmBitsPixel .eq. 24) then
bmrow(1:rdimbm) = bmbits(:,ih)
else
jw = 1
kw = 1
do iw=1,width
bmrow(jw:jw+2) = bmbits(kw:kw+2,ih)
jw = jw+3
kw = kw+4
end do
end if
write(bmfu)bmrow
end do
close(unit=bmfu)
deallocate(bmrow)
900 end
In the main program, I called it like this:
...
case (IDM_SAVE)
call saveimage(hWnd)
MainWndProc = 0
return
...
I think I can't go without you:)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
By the way, can you tell me why I can't visit your website you offered in your posted article?
http://www.geocities.com/jdujic/fortran/xft/xfthome.htm
http://www.geocities.com/jdujic/fortran/xft/xfthome.htm
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Sorry, I don't know much about OpenGL to tell you the cleaner way. A simple way you used is to simply grab the screen image and dump it to bmp. I think OpenGL does have some routines to convert the OpenGL buffer to a bitmap, but I don't know the details.
Are you from PR China? If yes, I seem to recall that another countrymen of yours complained that there's a government ban on access to Geocities site (it's now part of Yahoo group so I don't think they host pornography and similar stuff, but the ban remained). Sorry, little I can do about it now. I've been contemplating for quite a while about moving the site to a commercial domain, but I can't manage to find the time.
Jugoslav
Are you from PR China? If yes, I seem to recall that another countrymen of yours complained that there's a government ban on access to Geocities site (it's now part of Yahoo group so I don't think they host pornography and similar stuff, but the ban remained). Sorry, little I can do about it now. I've been contemplating for quite a while about moving the site to a commercial domain, but I can't manage to find the time.
Jugoslav
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Oh, I see, thank you anyway. You are always ebullient. I am sorry to bother you so many times. I wish I could do something for you.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I just gone thru ur suggestions and it
seems to me that u have good hand to solve my problem. I created a fortran exe using CONSOLE project. i am executing this exe thru my GUI execution button. once the exe is executed it is popping up a cmd window. I just want to suppress it so that i should not get command window during execution.
hoping to hear u soon
Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page