- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I have a Windows openGL application for display of offshore structures and I want to give users the option to save an image as a bitmap file for use in other applications.
Quickwin offers this option in SAVEIMAGE and SAVEIMAGE_W, but the simple option is not present in a Windows application. Several CVF samples shows how to read a bitmap file, but no examples show how to save a bitmap file.
I would appreciate to se a code example showing the steps to perform to save an openGL image (an other windows images) as a bitmap file.
Regards Soren Fredsgaard
(I tried to post this message on december 29, but it has not appeared on the message board)
Quickwin offers this option in SAVEIMAGE and SAVEIMAGE_W, but the simple option is not present in a Windows application. Several CVF samples shows how to read a bitmap file, but no examples show how to save a bitmap file.
I would appreciate to se a code example showing the steps to perform to save an openGL image (an other windows images) as a bitmap file.
Regards Soren Fredsgaard
(I tried to post this message on december 29, but it has not appeared on the message board)
Link Copied
6 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I have now solved my problem. The attached subroutine SAVEBMI will save a bitmapimage in a bitmap file if the bitmap uses 24 or 32 bit colors. I hope it will be usefull for others.
Regards Soren Fredsgaard
Regards Soren Fredsgaard
subroutine SAVEBMI(hDC,bmfu,bmfnam,retcod)
!-------------------------------------------------------------------------------
!
!-- Save bitmapimage in a Windows bitmap file (bmp)
!
!-------------------------------------------------------------------------------
use dfwina
use dfopngl
implicit none
integer(4) hDC !handle to device context
integer(4) bmfu !file unit for bitmap file
character*(*) bmfnam !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,hbmold,hdcComp,retint
integer(4) vp(4),width,height,ppix,ppiy,bmsize,rdim,rdimdw,rdimbm
integer(4) ih,iw,jw,kw
integer(1), allocatable :: bmbits(:,:),bmrow(:)
!-- Get dimensions of ViewPort and allocate arrays for bitmap bits
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)
!-- 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))
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=bmfnam,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)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I edited your response to add PRE tags so that the source appeared properly. There seems to be source lines missing at the end, though...
Steve
Steve
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Steve,
Could you add [font size='+0'] tags inside the
Feel free to remove this message afterwards to eliminate clutter.
-John
Could you add [font size='+0'] tags inside the
tags? The code will be more readable. Then if we just had the last few lines .... :-)
Feel free to remove this message afterwards to eliminate clutter.
-John
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I'm writing a graphics post-processor at the moment, and I'd love to be able to save bitmaps. I've tried incorporating the above code, but something seems to be missing (apart from the obvious). Was the full version ever posted?? or has anyone got a better way of doing it?
all the best
Steve Brown
all the best
Steve Brown
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
OK
I've worked out the obvious missing piece myself
.....
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)
900 end
works for me
thanks
Steve
I've worked out the obvious missing piece myself
.....
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)
900 end
works for me
thanks
Steve
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Wow...thanks for that code. Works beautifully for my CREATE SCREENSHOT button in my troubleshooting area. I just had to put in my own width and height data (you call your own subroutine in your code for that, I believe).
Thanks!!!
Keith Richardson
Thanks!!!
Keith Richardson
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