*----------------------------------------------------------------------------- * Save a form into a bitmap file. * With thanks to * PAul Maskens, Ted Roche * for their suggestions to improve this program. *----------------------------------------------------------------------------- LParameter toForm, tcFile *-- Create bitmap file Local lnFH If File(tcFile) Erase (tcFile) Endif lnFh =FCreate(tcFile) If lnFH < 1 Return .F. Endif *-- Determine width Local lnWidth lnWidth = toForm.Width+7-((toForm.Width-1)%8) *-- create file header =fwrite(lnFh, 'BM') && 0x00 bfType =fwrite(lnFh, toint(54+lnWidth*toForm.Height*3,4)) && 0x02 bfSize =fwrite(lnFh, chr(0)+chr(0)) && 0x06 reserved =fwrite(lnFh, chr(0)+chr(0)) && 0x08 reserved =fwrite(lnFh, toint(54,4)) && 0x0A bfOffs *-- create bitmap info =fwrite(lnFh, toint(40,4)) && 0x0E biSize =fwrite(lnFh, toInt(lnWidth,4)) && 0x12 biWidth =fwrite(lnFh, toInt(toForm.Height,4)) && 0x16 biHeight =fwrite(lnFh, toInt(1,2)) && 0x1A biPlanes =fwrite(lnFh, toInt(24,2)) && 0x1C biBitCount =fwrite(lnFh, toInt(0,4)) && 0x1E biCompression =fwrite(lnFh, toInt(lnWidth*toForm.Height*3,4)) && 0x22 biSizeImage =fwrite(lnFh, toInt(0,4)) && 0x26 biXPelsPerMetre =fwrite(lnFh, toInt(0,4)) && 0x2A biYPelsPerMetre =fwrite(lnFh, toInt(0,4)) && 0x2E biClrUsed =fwrite(lnFh, toInt(0,4)) && 0x32 biClrImportant *-- save form Local lnXPos, lnYPos, lcString, lnValue, lnLoop For lnYPos = toForm.Height-1 to 0 step -1 wait window Alltrim( str( lnYPos, 3 ) ) NoWait For lnXPos = 0 to lnWidth-1 lnValue = toForm.Point(lnXPos, lnYPos) If lnValue < 0 =FWrite( lnFh, Chr(255)+Chr(255)+Chr(255) ) Else lcString1 = Chr(lnValue%256) lnValue = Int(lnValue /256) lcString2 = Chr(lnValue%256) lnValue = Int(lnValue /256) lcString3 = Chr(lnValue%256) =fwrite( lnFh, lcString3 ) =fwrite( lnFh, lcString2 ) =fwrite( lnFh, lcString1 ) Endif Endfor Endfor *-- close file =fclose(lnFh) Return .T. Function ToInt Parameter tnValue, tnBytes Private cString, nT cString ='' For nT = 1 to tnBytes cString = cString +Chr(tnValue%256) tnValue = Int(tnValue /256) Endfor Return cStringChristof