Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Convert Icon to Bitmap
Message
Information générale
Forum:
Visual FoxPro
Catégorie:
Fonctions Windows API
Versions des environnements
Visual FoxPro:
VFP 8 SP1
Divers
Thread ID:
01046527
Message ID:
01046800
Vues:
30
>My office is in Central VFP <lol>. Normally I am working in the office but also/sometimes like to do things from home. I used to completely work from home but if You want to work together with people it's nicer to have them not walking through Your sleeping room. Also I found it hard to separate business- from private-life.
>
>But having the freedom of choice is a phantastic option. I really like what I do and so I am never "Off duty". Even when I'm running (I am running longer distances 2-5 times/week) I am working - actually that is the time when I have the best ideas.

I also like a job like this, because I can do more research at home. Oh, don't run too far from home. I'm afraid you need to take a cab to get back <lol>

BTW, here is the code for creating the bitmap:
#Define c0             chr(0)
#Define w0             c0+c0
#Define dw0            w0+w0

#Define BMPINFO_Size   40
#Define RGBQUAD_Size   4

ls_BitmapInfo = CreateBmpInfoStruct( lh_Bitmap )
CreateBitmapFile( tc_Filename, ln_Height, ls_BitmapInfo, lh_Bitmap, lh_DestDC )

***************

Procedure CreateBmpInfoStruct( th_Bitmap )

Local ls_Bitmap, ls_BitmapInfo
Local ln_Width, ln_Height, ln_Planes, ln_BPP, ln_ColorBits, ln_ImgSize

   ls_Bitmap = replicate( c0, BITMAP_Size )
   If (API_GetObject( th_Bitmap, BITMAP_Size, @ls_Bitmap ) != 0)
      ln_Width = Buff2Num( ls_Bitmap, (DWORD_Size*1)+1, .T. )
      ln_Height = Buff2Num( ls_Bitmap, (DWORD_Size*2)+1, .T. )
      ln_Planes = Buff2Num( ls_Bitmap, (DWORD_Size*4)+1 )
      ln_BPP = Buff2Num( ls_Bitmap, (DWORD_Size*4)+3 )
      ln_ColorBits = ln_Planes * ln_BPP

      ** Convert the color format to a count of bits.
      If (ln_ColorBits > 1)
         Do case
            Case (ln_ColorBits <= 4)
               ln_ColorBits = 4

            Case (ln_ColorBits <= 8)
               ln_ColorBits = 8

            Case (ln_ColorBits <= 16)
               ln_ColorBits = 16

            Case (ln_ColorBits <= 24)
               ln_ColorBits = 24

            Otherwise
               ln_ColorBits = 32
         EndCase
      endif

      ** Create BITMAPINFO structure. (This structure
      ** contains a BITMAPINFOHEADER structure and an array of RGBQUAD
      ** data structures.)
      ln_ImgSize = (BitAnd( ((ln_Width * ln_ColorBits) + 31), BitNot( 31 )) / 8) * ln_Height
      ls_BitmapInfo = DWord( BMPINFO_Size ) + ;
         DWord( ln_Width ) + DWord( ln_Height ) + Word( ln_Planes ) + Word( ln_BPP ) + ;
         dw0 + DWord( ln_ImgSize ) + qw0
      If (ln_ColorBits < 24)
         ls_BitmapInfo = ls_BitmapInfo + DWord( BitLShift( ln_ColorBits, 1 )) + dw0
      else
         ls_BitmapInfo = ls_BitmapInfo + dw0 + dw0
      endif

      If (ln_ColorBits != 24)
         ls_BitmapInfo = ls_BitmapInfo + replicate( c0, RGBQUAD_Size * BitLShift( ln_ColorBits, 1 ))
      endif
   endif

   Return ls_BitmapInfo
EndProc

***************

Procedure CreateBitmapFile
LParameters tc_Filename, tn_Height, tc_BitmapInfo, th_Bitmap, th_DC

Local ln_BISize, ln_BPP, ln_ColorBits, ln_ImgSize
Local lc_Bits, lc_BmpHeader, lc_Safety, ls_BI

   Declare Integer GetDIBits in GDI32 ;
      Long hDC, Long hBmp, ;
      Long uStartScan, Long nScanLines, ;
      String @lpvBits,  String @lpBI, Long uUsage

   ls_BI = tc_BitmapInfo
   ln_ImgSize = Buff2Num( ls_BI, 21, .T. )
   lc_Bits = replicate( c0, ln_ImgSize )

   If (GetDIBits( th_DC, th_Bitmap, 0, tn_Height, @lc_Bits, @ls_BI, 0 ) != 0)
      ln_BPP = Buff2Num( ls_BI, 15, .F. )
      ln_ColorBits = Buff2Num( ls_BI, 33, .T. ) * RGBQUAD_Size
      ln_BISize = Buff2Num( ls_BI, 1, .T. ) + ln_ImgSize + ln_ColorBits
      lc_BmpHeader = 'BM' + DWord(14 + ln_BISize ) + w0 + w0 + ;
         DWord( 54 + ln_ColorBits )

      lc_Safety = set( 'Safety' )
      Set safety off
      StrToFile( lc_BmpHeader + left( ls_BI, BMPINFO_Size ) + lc_Bits, tc_Filename )
      Set safety &lc_Safety
   else
      nErr = GetLastError()
      ? FormatErrMsg( nErr )
   endif
EndProc
HTH
Herman
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform