OpenGL image to bitmap file

OpenGL image to bitmap file

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)

7 posts / 0 new
Last post
For more complete information about compiler optimizations, see our Optimization Notice.

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

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 
        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 
    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 
!-- Save
    bmrow  = 0 
    write(bmfu) bmfh,bmih 
    do ih=height,1,-1 
      if (bm%bmBitsPixel .eq. 24) then 
          bmrow(1:rdimbm) = bmbits(:,ih) 
          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 

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...


Retired 12/31/2016


Could you add [font size='+0'] [/font] 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.


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


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)
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
900 end

works for me



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).

Keith Richardson

Leave a Comment

Please sign in to add a comment. Not a member? Join today