PIE GRAPHICS WITH PURE VFP CODE

Did you know that it is possible to draw pie style graphics in vfp without the need of any active-x or api call ? With pure VFP code ? draw a circle with foxpro
To draw any circle, there are two main parameters : 1 point with the coordinates of the center of the circle (x,y) and the radius. having this, it is very simple to calculate the coordinates of any point in the circumference border.
Even if you already use gdi+ or any active-x to draw graphics, I think it's imteresting to know how a circle is built, and how to calculate the positions of each point.

For this purpose, I'll need to make you remember the concepts of sine and cosine : 

In any right angled triangle, for any angle:

sine of the angle = length of the opposite side / length of the hypotenuse
cosine of the angle = length of the adjacent side / length of the hypotenuse

hypotenuse of a right angled triangle is the longest side, which is the one opposite the right angle. The adjacent side is the side which is between the angle in question and the right angle. The opposite side is opposite the angle in question.

So, imagine a right angled triangle inside a circumference, like in the picture below.

sine of angle = opposite side (height or y) / hypotenuse (radius) !!!

height = sine of angle * radius

 

 

cosine of angle = adjacent side (width or x) / hypotenuse (radius) !!!

width = cosine of angle * radius

 

Now we can create a loop starting from angle 0 (zero) and finishing at angle 360 degrees. At each step we can calculate the position of every point of the circle !

Then it becomes quite simple to draw the graphic. for that purpose, I'll use the line object, drawing lines from the center of the circle till the point x,y just calculated. and that's all !!!

There's one problem with the line object in VFP. To draw a line, we need to use the properties top, left, width, height and lineslant (specifies which way a line slants, from upper left to lower right or lower left to upper right), instead of simply passing the two points, x1y1 and x2y2. so, as you can see in the code below, depending on the angle and the resulting position in the quadrant (quarter of the circumference of a circle), I needed to make some extra code to deal with this. Pay attention to the "do case" command below.

Procedure DrawPie

LPARAMETERS tnCenterX, tnCenterY, tnRadius, tnStart, tnEnd, tnColor

LOCAL lnLineWidth, N, x, Y, lcObj, lnPointLeft, lnPointTop, lcSlant
m.lnLineWidth = 3

FOR m.N = m.tnStart TO m.tnEnd STEP (1 * m.lnLineWidth)
    m.x = COS(DTOR(m.N)) * m.tnRadius
    m.Y = SIN(DTOR(m.N)) * m.tnRadius

    m.lcObj = "line" + TRANSFORM(m.N * 100)
    THISFORM.container1.ADDOBJECT(m.lcObj,"line")

    DO CASE
        CASE m.N >= 0 AND m.N < 90 && 1st quadrant
            m.lnPointLeft = m.tnCenterX
            m.lnPointTop = m.tnCenterY – m.Y
            m.lcSlant = "/"

        CASE m.N >= 90 AND m.N < 180 && 2nd quadrant
            m.lnPointLeft = m.tnCenterX + m.x
            m.lnPointTop = m.tnCenterY – m.Y
            m.lcSlant = "\"

        CASE m.N >= 180 AND m.N < 270 && 3rd quadrant
            m.lnPointLeft = m.tnCenterX + m.x
            m.lnPointTop = m.tnCenterY
            m.lcSlant = "/"

        CASE m.N >= 270 AND m.N <= 360 && 4th quadrant
            m.lnPointLeft = m.tnCenterX
            m.lnPointTop = m.tnCenterY
            m.lcSlant = "\"
    ENDCASE

    WITH THISFORM.container1.&lcObj.
        .LINESLANT = m.lcSlant
        .BORDERCOLOR = m.tnColor
        .BORDERWIDTH = m.lnLineWidth
        .WIDTH = ABS(m.x)
        .HEIGHT = ABS(m.Y)
        .LEFT = m.lnPointLeft
        .TOP = m.lnPointTop
        .VISIBLE = .T.
    ENDWITH

ENDFOR
RETURN

You may find this procedure slow, specially if you run it in slow machines, but it works ! the biggest problem is that it adds many objects in a form, in the case of a loop with step 1, at least 360 lines !
If we draw a line with borderwidth = 1, in some cases, the calculated points will create some holes between the lines. a wider border will resolve this problem. the bigger the step in the loop (from 0 to 360 degrees), the faster the procedure will run, and less objects will be added.
Run the form piegraphics.scx from the attached file, change the cursor, radius, step, and linewidth values, and check all procedures to better understand this post.

What next ?

Of course, in one of my next posts I'll deal with pie style graphics using Gdi+ – Google for the keyword FOXCHARTS, for a great surprise made in pyure VFP9 code.
Some of the subjects discussed here will help us to create more interesting graphics.

BAR GRAPHICS WITHOUT COMPLICATIONS

I always see people asking how to create graphics without active-x controls.

In my opinion, the most simple way to do it is to use labels. labels are versatile, we can change their backcolor, caption, width, height. These four properties are all we need to create a simple graphic, like in this picture below.



The graphic is drawn in a container. we can set the label color to the bar color, in its caption we can store the values, its height is proportional to the value, and the width depends on the division between the container's width and the wuantity of bars.

The bars auto adjust themselves according to the data received, and the dimensions of the container.

Everything is done in a single method. in the form example, I've put this code in the refresh method of the container. a cursor is needed to store the data, where the first field, field(1) receives the values and the second field field(2) receives the caption. The name of the cursor is stored in the tag property of the container. and that's all !

Some extra code was added to allow the resizement of the form.

Put this code in the load event of the form :

 

create cursor sales (amount n(8,2), cname c(6))

insert into sales values (250,"jan")
insert into sales values (128,"feb")
insert into sales values ( 90,"mar")
insert into sales values (330,"apr")
insert into sales values (190,"may")
insert into sales values (250,"jun")
insert into sales values ( 50,"jul")
insert into sales values ( 80,"aug")
insert into sales values ( 50,"sep")
insert into sales values ( 19,"oct")
insert into sales values (160,"nov")
insert into sales values (199,"dec")

 

and this in the refresh event:

 

*!* create array with 12 colors to be used

dimension lacolors(12)
lacolors(1) = rgb(255,128,128) && red
lacolors(2) = rgb(0,255,0) && green
lacolors(3) = rgb(128,128,255) && blue
lacolors(4) = rgb(255,0,255) && pink
lacolors(5) = rgb(0,255,255) && cyan
lacolors(6) = rgb(255,255,0) && yellow
lacolors(7) = rgb(160,160,210) && blue2
lacolors(8) = rgb(255,160,30) && orange
lacolors(9) = rgb(200,140,140) &&
lacolors(10) = rgb(96,196,96) && green2
lacolors(11) = rgb(255,200,200) && rose
lacolors(12) = rgb(200,200,200) && grey

lnblack = rgb(28,28,28) && black
lnwhite = rgb(255,255,255) && white
lctable = this.tag

select "&lctable"

*!* calculate the width of each bar
lnlargura = int(this.width / reccount())
lnaltura = this.height

lcfldvalor = this.tag + "." + field(1)

if fcount() > 1
   lcfldlegenda = this.tag + "." + field(2)
else
   lcfldlegenda = ""
endif
calculate max(evaluate(lcfldvalor)) to lnmax

 

*!* add the labels that will be the bars and the captions
scan
   n = recno()
   lcobj = "label" + transform(n)
   lcleg = "lname" + transform(n)
   *!* check if object already exists to avoid errors
   if type("this."+lcobj) <> "o"
      this.addobject(lcobj,"label")
      this.addobject(lcleg,"label")
   endif

   with this.&lcobj.
      .backstyle = 1 && opaque
      .backcolor = lacolors(iif(n>12,n-12,n))
      .width = lnlargura
      lnvalor = evaluate(lcfldvalor)
      lnbarra = ( lnvalor / lnmax) * (this.height - 1 - 17)
      .height = lnbarra
      .left = ((n-1) * lnlargura) + 2
      .top = lnaltura - this.&lcobj..height – 17
      .tag = transform(lnvalor)
      .caption = transform(lnvalor)
      .fontsize = 8
      .fontbold = .t.
      .alignment = 2
      .visible = .t.
   endwith

   with this.&lcleg.
      .backstyle = 1 && opaque
      .backcolor = lnwhite
      .forecolor = lnblack
      .width = lnlargura – 2
      if not empty(lcfldlegenda)
         .caption = alltrim(evaluate(lcfldlegenda))
      endif
      .left = ((n-1) * lnlargura) + 3
      .top = this.height – 17
      .height = 17
      .fontsize = 8
      .alignment = 2
      .visible = .t.
   endwith

endscan

this.width = ((n) * lnlargura) + 3

 

You may use this technique to create bar graphics at the horizontal, with very slight adaptations in the code.
In the attached file, bargraphics.zip, you'll find bargraphics.scx/sct from this example, and also 3 more files, callbar.prg that calls barras.scx/sct that create a modal form with bargraphics that can be resized.

CAPTURE SCREEN PORTIONS

This short but powerful example makes use of many API calls, for memory access and data conversion to the clipboard. Does not require any ocx and works with vfp from version 5 to 9. The author created it because many people have been looking for tools to capture images from webcams and other image accessories linked to the programs. This sample shows again that we can do many cool things with visual foxpro. Have a look at what he's done with a simple form !
This is one of my preferred codes from my colleague from the brazilian forum http://www.vfpbrasil.com.br/ , Gelson L. Bremm, from Florianopolis - Brazil, who gave me the authorization to publish here. I think it's really worth to share with the rest of the community.

 Download the source code below 

*!* IMAGECAPTURE.PRG
*!* Author : Gelson L. Bremm (Florianopolis - Brazil)
*!* Description : Captures portions of image
PUBLIC oCapturaImg
oCapturaImg = CREATEOBJECT("ImageCapture")
oCapturaImg.Show()

DEFINE CLASS ImageCapture AS Form
  Height = 147
  Width = 115
  Desktop = .T.
  ShowWindow = 2
  DoCreate = .T.
  ShowTips = .T.
  AutoCenter = .T.
  Caption = "Capture"
  HalfHeightCaption = .T.
  MaxButton = .F.
  MinButton = .F.
  MinHeight = 80
  AlwaysOnTop = .T.
  Name = "CAPTURE"

  ADD OBJECT Command1 AS myCmdButton

  PROCEDURE Init
    WITH THIS
      .DeclareFunctions()
      .Resize()
    ENDWITH
  ENDPROC

  PROCEDURE SetTransparent
    LOCAL lnControlBottom, lnControlRight, lnControlLeft, lnControlTop, lnBorderWidth, ;
      lnTitleHeight, lnFormHeight, lnFormWidth, lnInnerRgn, lnOuterRgn, lnCombinedRgn, ;
      lnControlRgn, lnControl, lnRgnDiff, lnRgnOr, llTrue

    lnRgnDiff = 4
    lnRgnOr = 2
    llTrue = -1

    WITH THIS
      lnBorderWidth = SYSMETRIC(3)
      lnTitleHeight = SYSMETRIC(9)-SYSMETRIC(4)
      lnFormWidth = .Width + (lnBorderWidth * 2)
      lnFormHeight = .Height + lnTitleHeight + lnBorderWidth
      lnOuterRgn = CreateRectRgn(0, 0, lnFormWidth, lnFormHeight)
      lnInnerRgn = CreateRectRgn(lnBorderWidth, lnTitleHeight, ;
        lnFormWidth - lnBorderWidth, lnFormHeight - lnBorderWidth)
      lnCombinedRgn = CreateRectRgn(0, 0, 0, 0)
      CombineRgn(lnCombinedRgn, lnOuterRgn, lnInnerRgn, lnRgnDiff)
      FOR EACH Control in .Controls
        lnControlLeft = Control.Left + lnBorderWidth
        lnControlTop = Control.Top + lnTitleHeight
        lnControlRight = Control.Width + lnControlLeft
        lnControlBottom = Control.Height + lnControlTop
        lnControlRgn = CreateRectRgn(lnControlLeft, lnControlTop, lnControlRight, lnControlBottom)
        CombineRgn(lnCombinedRgn, lnCombinedRgn, lnControlRgn, lnRgnOr)
      ENDFOR
      SetWindowRgn(.HWnd , lnCombinedRgn, llTrue)
    ENDWITH
  ENDPROC

  PROCEDURE num2dword
    LPARAMETERS lnValue

    #DEFINE m0 256
    #DEFINE m1 65536
    #DEFINE m2 16777216

    LOCAL b0, b1, b2, b3

    b3 = INT(lnValue/m2)
    b2 = INT((lnValue - b3*m2)/m1)
    b1 = INT((lnValue - b3*m2 - b2*m1)/m0)
    b0 = MOD(lnValue, m0)

    RETURN(CHR(b0)+CHR(b1)+CHR(b2)+CHR(b3))
  ENDPROC

  PROCEDURE declarefunctions
    DECLARE INTEGER CombineRgn in "gdi32" integer hDestRgn, integer hRgn1, integer hRgn2, integer nMode
    DECLARE INTEGER CreateRectRgn in "gdi32" integer X1, integer Y1, integer X2, integer Y2
    DECLARE INTEGER SetWindowRgn in "user32" integer hwnd, integer hRgn, integer nRedraw

    DECLARE INTEGER SelectObject IN gdi32 integer hdc, integer hObject
    DECLARE INTEGER ReleaseDC IN user32 INTEGER hwnd, INTEGER hdc
    DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc
    DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
    DECLARE INTEGER DeleteDC IN gdi32 INTEGER hdc
    DECLARE INTEGER CloseClipboard IN user32
    DECLARE INTEGER GetFocus IN user32
    DECLARE INTEGER EmptyClipboard IN user32
    DECLARE INTEGER GetWindowDC IN user32 INTEGER hwnd
    DECLARE INTEGER OpenClipboard IN user32 INTEGER hwnd
    DECLARE INTEGER SetClipboardData IN user32 INTEGER wFormat, INTEGER hMem
    DECLARE INTEGER CreateCompatibleBitmap IN gdi32;
      INTEGER hdc, INTEGER nWidth, INTEGER nHeight
    DECLARE INTEGER BitBlt IN gdi32;
      INTEGER hDestDC, INTEGER x, INTEGER y,;
      INTEGER nWidth, INTEGER nHeight, INTEGER hSrcDC,;
      INTEGER xSrc, INTEGER ySrc, INTEGER dwRop

    DECLARE INTEGER GetActiveWindow IN user32
    DECLARE INTEGER GetClipboardData IN user32 INTEGER uFormat
    DECLARE INTEGER GlobalAlloc IN kernel32 INTEGER wFlags, INTEGER dwBytes
    DECLARE INTEGER GlobalFree IN kernel32 INTEGER hMem

    DECLARE INTEGER GetObject IN gdi32 AS GetObjectA;
      INTEGER hgdiobj, INTEGER cbBuffer, STRING @lpvObject

    DECLARE INTEGER GetObjectType IN gdi32 INTEGER h

    DECLARE RtlZeroMemory IN kernel32 As ZeroMemory;
      INTEGER dest, INTEGER numBytes

    DECLARE INTEGER GetDIBits IN gdi32;
      INTEGER hdc, INTEGER hbmp, INTEGER uStartScan,;
      INTEGER cScanLines, INTEGER lpvBits, STRING @lpbi,;
      INTEGER uUsage

    DECLARE INTEGER CreateFile IN kernel32;
      STRING lpFileName, INTEGER dwDesiredAccess,;
      INTEGER dwShareMode, INTEGER lpSecurityAttr,;
      INTEGER dwCreationDisp, INTEGER dwFlagsAndAttrs,;
      INTEGER hTemplateFile

    DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject

    DECLARE Sleep IN kernel32 INTEGER dwMilliseconds
  ENDPROC

  PROCEDURE CopyToClipBoard
    WITH THIS
      .Caption = "Capturing"
      .Command1.Left = .Width+.Command1.Width
      .Cls()
      .SetTransparent()
      =Sleep(100)

      #DEFINE CF_BITMAP 2
      #DEFINE SRCCOPY 13369376

      lnLeft = SYSMETRIC(3)
      lnTop = SYSMETRIC(4)+(SYSMETRIC(20)-SYSMETRIC(11))
      lnRight = 0
      lnBottom = 0
      lnWidth = .Width
      lnHeight = .Height-1

      *hwnd = GetFocus()
      hdc = GetWindowDC(.HWnd)
      hVdc = CreateCompatibleDC(hdc)
      hBitmap = CreateCompatibleBitmap(hdc, lnWidth, lnHeight)

      = SelectObject(hVdc, hBitmap)
      = BitBlt(hVdc, 0, 0, lnWidth, lnHeight, hdc, lnLeft, lnTop, SRCCOPY)
      = OpenClipboard(.HWnd)
      = EmptyClipboard()
      = SetClipboardData(CF_BITMAP, hBitmap)
      = CloseClipboard()
      = DeleteObject(hBitmap)
      = DeleteDC(hVdc)
      = ReleaseDC(.HWnd, hdc)

      .Command1.Left = VAL(.Command1.Tag)
      .SetTransparent()
      .Caption = "Capture"
    ENDWITH
  ENDPROC

  PROCEDURE CopyToFile
    #DEFINE CF_BITMAP 2
    #DEFINE SRCCOPY 13369376
    #DEFINE OBJ_BITMAP 7
    #DEFINE DIB_RGB_COLORS 0
    #DEFINE BFHDR_SIZE 14
    #DEFINE BHDR_SIZE 40
    #DEFINE GENERIC_WRITE 1073741824
    #DEFINE FILE_SHARE_WRITE 2
    #DEFINE CREATE_ALWAYS 2
    #DEFINE FILE_ATTRIBUTE_NORMAL 128
    #DEFINE INVALID_HANDLE_VALUE -1
    #DEFINE BITMAP_STRU_SIZE 24
    #DEFINE BI_RGB 0
    #DEFINE RGBQUAD_SIZE 4
    #DEFINE BHDR_SIZE 40
    #DEFINE GMEM_FIXED 0

    LOCAL cDefault, cNameFile, hClipBmp
    LOCAL pnWidth, pnHeight, pnBitsSize, pnRgbQuadSize, pnBytesPerScan
    LOCAL hFile, lnFileSize, lnOffBits, lcBFileHdr
    LOCAL lnBitsPerPixel, lcBIHdr, lcRgbQuad
    LOCAL lpBitsArray, lcBInfo
    LOCAL hdc, hMemDC, lcBuffer

    cDefault = FULLPATH(SYS(5))
    cNameFile = GETPICT("BMP")
    SET DEFAULT TO (cDefault)
    IF EMPTY(cNameFile)
      RETURN
    ENDIF

    IF FILE(cNameFile)
      IF MESSAGEBOX("There is already a file named '"+PROPER(JUSTFNAME(cNameFile))+;
          "'"+CHR(13)+"Overwrite the existing file ?",36+256,"Confirm overwrite") = 7
        RETURN
      ENDIF
    ENDIF
    ERASE (cNameFile)

    WITH THIS
      .CopyToClipBoard()

      = OpenClipboard (0)
      hClipBmp = GetClipboardData (CF_BITMAP)
      = CloseClipboard()

      IF hClipBmp = 0 Or GetObjectType(hClipBmp) # OBJ_BITMAP
        =MESSAGEBOX("There is no image in the clipboard.",48,"Error creating file")
        RETURN
      ENDIF

      STORE 0 TO pnWidth, pnHeight, pnBytesPerScan, pnBitsSize, pnRgbQuadSize
      lcBuffer = REPLI(CHR(0), BITMAP_STRU_SIZE)
      IF GetObjectA (hClipBmp, BITMAP_STRU_SIZE, @lcBuffer) # 0
        pnWidth = ASC(SUBSTR(lcBuffer, 5,1)) + ;
          ASC(SUBSTR(lcBuffer, 6,1)) * 256 +;
          ASC(SUBSTR(lcBuffer, 7,1)) * 65536 +;
          ASC(SUBSTR(lcBuffer, 8,1)) * 16777216

        pnHeight = ASC(SUBSTR(lcBuffer, 9,1)) + ;
          ASC(SUBSTR(lcBuffer, 10,1)) * 256 +;
          ASC(SUBSTR(lcBuffer, 11,1)) * 65536 +;
          ASC(SUBSTR(lcBuffer, 12,1)) * 16777216
      ENDIF

      lnBitsPerPixel = 24
      pnBytesPerScan = INT((pnWidth * lnBitsPerPixel)/8)
      IF MOD(pnBytesPerScan, 4) # 0
        pnBytesPerScan = pnBytesPerScan + 4 - MOD(pnBytesPerScan, 4)
      ENDIF

      lcBIHdr = .num2dword(BHDR_SIZE) + .num2dword(pnWidth) +;
        .num2dword(pnHeight) + (CHR(MOD(1,256))+CHR(INT(1/256))) + (CHR(MOD(lnBitsPerPixel,256))+;
        CHR(INT(lnBitsPerPixel/256))) + .num2dword(BI_RGB) + REPLI(CHR(0), 20)

      IF lnBitsPerPixel <= 8
        pnRgbQuadSize = (2^lnBitsPerPixel) * RGBQUAD_SIZE
        lcRgbQuad = REPLI(CHR(0), pnRgbQuadSize)
      ELSE
        lcRgbQuad = ""
      ENDIF
      lcBInfo = lcBIHdr + lcRgbQuad
      pnBitsSize = pnHeight * pnBytesPerScan
      lpBitsArray = GlobalAlloc (GMEM_FIXED, pnBitsSize)
      = ZeroMemory (lpBitsArray, pnBitsSize)

      *hwnd = GetActiveWindow()
      hdc = GetWindowDC(.HWnd)
      hMemDC = CreateCompatibleDC (hdc)
      = ReleaseDC (.HWnd, hdc)
      = GetDIBits (hMemDC, hClipBmp, 0, pnHeight, lpBitsArray, @lcBInfo, DIB_RGB_COLORS)

      lnFileSize = BFHDR_SIZE + BHDR_SIZE + pnRgbQuadSize + pnBitsSize
      lnOffBits = BFHDR_SIZE + BHDR_SIZE + pnRgbQuadSize
      lcBFileHdr = "BM" + .num2dword(lnFileSize) + .num2dword(0) + .num2dword(lnOffBits)

      hFile = CreateFile(cNameFile, GENERIC_WRITE, FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)

      IF hFile # INVALID_HANDLE_VALUE
        DECLARE INTEGER WriteFile IN kernel32;
          INTEGER hFile, STRING @lpBuffer, INTEGER nBt2Write,;
          INTEGER @lpBtWritten, INTEGER lpOverlapped
        = WriteFile (hFile, @lcBFileHdr, Len(lcBFileHdr), 0, 0)
        = WriteFile (hFile, @lcBInfo, Len(lcBInfo), 0, 0)

        DECLARE INTEGER WriteFile IN kernel32;
          INTEGER hFile, INTEGER lpBuffer, INTEGER nBt2Write,;
          INTEGER @lpBtWritten, INTEGER lpOverlapped
        = WriteFile (hFile, lpBitsArray, pnBitsSize, 0, 0)
        = CloseHandle (hFile)
      ELSE
        = MESSAGEBOX("Error creating file: " + cNameFile, "Internal Error")
      ENDIF

      = GlobalFree(lpBitsArray)
      = DeleteDC (hMemDC)
      = DeleteObject (hClipBmp)
    ENDWITH
  ENDPROC

  PROCEDURE Resize
    WITH THIS
      .Command1.Left = .Width-.Command1.Width
      .Command1.Top = .Height-.Command1.Height
      .Command1.Tag = ALLT(STR(.Command1.Left))

      .SetTransparent()
    ENDWITH
  ENDPROC

  PROCEDURE Destroy
    oCapturaImg = .F.
    RELEASE oCapturaImg
  ENDPROC
ENDDEFINE

DEFINE CLASS myCmdButton AS Commandbutton
  Top = 126
  Left = 97
  Height = 21
  Width = 18
  FontName = "Webdings"
  Caption = "6"
  ToolTipText = "Options"
  Name = "Command1"

  PROCEDURE Click
    cOptMenu = ""
    DEFINE POPUP _menu_clip SHORTCUT RELATIVE FROM MROW(), MCOL()
    DEFINE BAR CNTBAR("_menu_clip")+1 OF _menu_clip PROMPT "Copy to Clipboard"
    ON SELECTION BAR CNTBAR("_menu_clip") OF _menu_clip cOptMenu = "CLIPBOARD"
    DEFINE BAR CNTBAR("_menu_clip")+1 OF _menu_clip PROMPT "Copy to file"
    ON SELECTION BAR CNTBAR("_menu_clip") OF _menu_clip cOptMenu = "FILE"
    ACTIVATE POPUP _menu_clip
    RELEASE POPUPS _menu_clip

    DO CASE
      CASE cOptMenu == "CLIPBOARD"
        THISFORM.CopyToClipBoard()

      CASE cOptMenu == "FILE"
        THISFORM.CopyToFile()
    ENDCASE
  ENDPROC
ENDDEFINE

DRAWING ON GIFS OR INDEXED PIXEL FORMAT IMAGES WITH GDI+

It's very common to need to draw some shapes, texts or to apply some effects to images.
But GDI+ has a limitation when working with images created in indexed pixel formats, such as 1bppindexed (0x00030101), 4bppindexed (0x00030402) and 8bppindexed (0x00030803). these are the pixel formats used by gif (graphics interchange format) files too. if you try to draw on these kind of images you may receive an error message like this :

A very simple solution is to load the GIF using gpImage, and retrieve some properties, like width and height. then create a new and empty bitmap object with the same size from the original gif, but using a non indexed pixel format. _gdiplus.vcx uses pixelformat_32bpppargb as default.

The next step is to "draw" the original gif image on the new created bitmap in the just created non indexed pixel format image using the procedure drawimage. now you can draw freely on this new image.

Finally, you can save the new image as gif or any other type.
An important detail that you must know is that when you tell gdi+ to save as gif, it will automatically convert the image again to 8bppindexed pixel format, that is the default for Gdi+.

Here's a sample code that draws 2 ellipses and a rectangle on a GIF.

#DEFINE gdiplus_pixelformat_1bppindexed 0x00030101
#DEFINE gdiplus_pixelformat_4bppindexed 0x00030402
#DEFINE gdiplus_pixelformat_8bppindexed 0x00030803
#DEFINE gdiplus_pixelformat_16bppgrayscale 0x00101004
#DEFINE gdiplus_pixelformat_16bpprgb555 0x00021005
#DEFINE gdiplus_pixelformat_16bpprgb565 0x00021006
#DEFINE gdiplus_pixelformat_16bppargb1555 0x00061007
#DEFINE gdiplus_pixelformat_24bpprgb 0x00021808
#DEFINE gdiplus_pixelformat_32bpprgb 0x00022009
#DEFINE gdiplus_pixelformat_32bppargb 0x0026200a
#DEFINE gdiplus_pixelformat_32bpppargb 0x000e200b
#DEFINE gdiplus_pixelformat_48bpprgb 0x0010300c

LOCAL lcSource, lcDest
LOCAL lcPixFormat, hImg, wImg
m.lcSource = GETPICT("gif")
IF EMPTY(m.lcSource)
    RETURN
ENDIF
m.lcDest = ADDBS(JUSTPATH(m.lcSource)) + "_" + JUSTSTEM(m.lcSource)

*** load image and check if indexed :
LOCAL loImage AS gpImage OF ffc / _GdiPlus.vcx
m.loImage = NEWOBJECT('gpimage',HOME() + 'ffc/_gdiplus.vcx')
m.loImage.CreateFromFile(m.lcSource)
m.wImg = m.loImage.ImageWidth
m.hImg = m.loImage.ImageHeight
m.lcPixFormat = GetPixFormatName(m.loImage.PixelFormat)
IF NOT "indexed" $ UPPER(m.lcPixFormat)
    MESSAGEBOX("draw directly on the image, cause it's not" + ;
          "of an indexed pixel format !",64, "use common technique")
    RETURN
ENDIF

*** create new bitmap with same dimensions :
LOCAL loBitmap AS gpBitmap OF ffc / _GdiPlus.vcx
m.loBitmap = NEWOBJECT("gpbitmap", HOME() + "ffc/_gdiplus.vcx")
LOCAL loGraph AS gpGraphics OF HOME() + ffc / _GdiPlus.vcx
m.loGraph = NEWOBJECT('gpgraphics', HOME() + "ffc/_gdiplus.vcx")
m.loBitmap.CREATE(m.wImg, m.hImg, gdiplus_pixelformat_16bpprgb555 )

*** paste original image to the new created :
m.loGraph.CreateFromImage(m.loBitmap)
m.loGraph.DrawImageScaled(m.loImage, 0, 0, m.wImg, m.hImg)

*** now we can draw anything we want to the image :
LOCAL loBlue, loRed, loGreen AS gpColor OF ffc / _GdiPlus.vcx
LOCAL loPen AS gpPen OF HOME() + ffc / _GdiPlus.vcx

m.loBlue = NEWOBJECT("gpcolor", HOME() + "ffc/_gdiplus.vcx","",40,40,240 )
m.loRed = NEWOBJECT("gpcolor", HOME() + "ffc/_gdiplus.vcx","",240,40,40 )
m.loGreen = NEWOBJECT("gpcolor", HOME() + "ffc/_gdiplus.vcx","",40,230,40 )

m.loPen = NEWOBJECT("gppen", HOME() + "ffc/_gdiplus.vcx")
m.loPen.CREATE(m.loBlue, 12)
m.loGraph.drawellipse( m.loPen, 0, 0, m.wImg, m.hImg)

m.loPen.pencolor = m.loRed
m.loGraph.drawellipse( m.loPen, 0 + 12, 0 + 12 , m.wImg - 24 , m.hImg - 24)

m.loPen.pencolor = m.loGreen
m.loGraph.drawrectangle( m.loPen, 0 + 30, 0 + 30 , m.wImg - 60 , m.hImg - 60)

*** save image in gif and jpg :
m.loBitmap.SaveToFile(m.lcDest + ".jpg","image/jpeg","quality=100")
m.loBitmap.SaveToFile(m.lcDest + ".gif","image/gif")

RETURN

PROCEDURE GetPixFormatName(npix)
    DO CASE
        CASE m.npix = 0x00030101
            RETURN "1bppindexed"
        CASE m.npix = 0x00030402
            RETURN "4bppindexed"
        CASE m.npix = 0x00030803
            RETURN "8bppindexed"
        CASE m.npix = 0x00101004
            RETURN "16bppgrayscale"
        CASE m.npix = 0x00021005
            RETURN "16bpprgb555"
        CASE m.npix = 0x00021006
            RETURN "16bpprgb565"
        CASE m.npix = 0x00061007
            RETURN "16bppargb1555"
        CASE m.npix = 0x00021808
            RETURN "24bpprgb"
        CASE m.npix = 0x00022009
            RETURN "32bpprgb"
        CASE m.npix = 0x0026200a
            RETURN "32bppargb"
        CASE m.npix = 0x000e200b
            RETURN "32bpppargb"
        CASE m.npix = 0x0010300c
            RETURN "48bpprgb"
        CASE m.npix = 0x001c400e
            RETURN "64bpppargb"
        OTHERWISE
            RETURN "unidentified"
    ENDCASE
ENDPROC

This procedure will cause a big inconvenient, because in this automatic conversion, gdi+ writes the file by using a halftone palette to which the image object's bits have been color reduced. gdi+ does a color conversion from 32 bits-per-pixel (32 bpp) when it writes the image to the file. 

According to szaak priester, "when gdi+ saves a bitmap in gif format, it performs a very crude form of color quantization. it always uses the same color palette, mostly filled with the 216 'web-safe colors.' in the early years of the internet, these colors were the only ones to be displayed consistently by most browsers; hence the name. ... on top of that, the 216 web-safe colors were chosen purely on the basis of their technical merits (they uniformly divide the rgb color space), and not because of their visual qualities. as a consequence, the web-safe palette (also called the 'halftone palette') contains many almost indiscernible purples and a lot of muddy greenish and brownish colors, whereas some more useable parts of the spectrum are seriously underpopulated."
Below you can see the result obtained using the technique discussed here.

gif - original image	gif - 8bppindexed image	jpeg - 32bppargb

 

Pay attention to the differences of quality between the three images.
This technique can be used also to resize any image, including gifs. for resizing purposes, all you need to change in the previous code are the instructions that deal with the image size, lobitmap.create(newwidth, newheight, pixelformat) and when pasting the original image to the new created bitmap, lograph.drawimageportionat(looriginalimage, 0, 0, newwidth, newheight).
You just need to know the gifs limitations, and decide if you will save it as gif or as another image format.

 

Here are some differences between gifs and jpegs, according to MSDN :

GIF vs. JPEG

Should you store images in gif format or jpeg format? although this question doesn't relate directly to palette management, it confuses a lot of people, and it is somewhat relevant to our subject matter.

There are two major differences between gif and jpeg images:

gif images are compressed in a way that preserves all data, while jpeg images are compressed in a way that loses some data.
gif images are limited to a maximum of 256 colors, while jpeg images aren't limited in the number of colors they use.

 

But is there a way to convert an image to gif format without using a better distributed color pallete instead of the the halftone pallete that deteriorates the pictures ? Of course, but that's for another post...

GETTING METADATA INFORMATION FROM YOUR PICTURES WITH GDI+

Did you know that all the jpegs from your digital camera contain a lot of extra information ?

We can easily retrieve some interesting information such as : title, equipment make, camera model, shutter speed, lens aperture, flash mode, date of picture, and much more ! these metadata "tags" are stored in a jpeg file to indicate various camera settings and picture taking conditions that occurred while creating the photo. several image file formats enable you to store metadata along with an image, such as jpeg, tiff and png.



Again GDI+ makes our lives easier, providing to us a function to get these information : getpropertyitem, stored in the gpimage class from _gdiplus.vcx .

Download and execute this file, and select an image from any digital camera, and you'll see all metadata stored in it.

On the first part of this code, i get the most common properties, from the gpimage class, like imagewidth, imageheight, horizontalresolution, verticalresolution and pixelformat.

On the rest i retrieve the metadata from the image file, using getpropertyidlist and getpropertyitem. it's important to notice that getpropertyidlist receives an array as a parameter, and returns that array populated with the metadata.

lcsource = getpict()
local loimage as gpimage of ffc/_gdiplus.vcx
loimage = newobject("gpimage", home() + "ffc/_gdiplus.vcx")
loimage.createfromfile(lcsource)

dimension rapropidlist(1)
local ncount, n, lctagname, lnprop, luprop

ncount = loimage.getpropertyidlist(@rapropidlist)
for n = 1 to ncount
lnprop = rapropidlist(n)
luprop = loimage.getpropertyitem(lnprop)

? transform(lnprop), transform(luprop)
endfor

It is possible to get some other really cool information from pictures. Take a look at the 2 last items in the picture, exiflightsource and exifflash. in both cases we have a zero value. check this table, to see what each possible value could mean :

tagid : 0x9208 (37384) - lightsource int16u exififd
1 = daylight
2 = fluorescent
3 = tungsten
4 = flash
9 = fine weather
10 = cloudy
11 = shade
12 = daylight fluorescent
13 = day white fluorescent
14 = cool white fluorescent
15 = white fluorescent
17 = standard light a
18 = standard light b
19 = standard light c
20 = d55
21 = d65
22 = d75
23 = d50
24 = iso studio tungsten
255 = other

 

tagid : 0x9209 (37385) - flash int16u exififd �
0x0 = no flash
0x1 = fired
0x5 = fired, return not detected
0x7 = fired, return detected
0x9 = on
0xd = on, return not detected
0xf = on, return detected
0x10 = off
0x18 = auto, did not fire
0x19 = auto, fired
0x1d = auto, fired, return not detected
0x1f = auto, fired, return detected
0x20 = no flash function
0x41 = fired, red-eye reduction
0x45 = fired, red-eye reduction, return not detected
0x47 = fired, red-eye reduction, return detected
0x49 = on, red-eye reduction
0x4d = on, red-eye reduction, return not detected
0x4f = on, red-eye reduction, return detected
0x59 = auto, fired, red-eye reduction
0x5d = auto, fired, red-eye reduction, return not detected
0x5f = auto, fired, red-eye reduction, return detected

At this link you can find some other great information about metadata tags :

http://www.sno.phy.queensu.ca/~phil/exiftool/tagnames/exif.html

It is obviously possible to remove, change or set the metadata property items from images with gdi+ too, but for this task, it is necessary use some extra code, once _gdiplus.vcx doesn't bring this feature.

 

Comment added in 04/06/06

I wrote a much more detailed article on this subject to the universalthread magazine published in the april/2006 issue:
Saving and retrieving metadata information from your pictures with GDI+

 It's really worth to have a look there, where you will find a subclass for gpimage that permits to you to read, write or remove image tags.

GETTING IMAGE PROPERTIES WITH GDI+

LOCAL lcSource, lcInfo, lnWidth, lnHeight, lnHorRes, lnVerRes, lnPixForm
LOCAL lcpixform
m.lcSource = GETPICT()

LOCAL loImage AS gpImage OF FFC / _GdiPlus.vcx
m.loImage = NEWOBJECT("gpimage", HOME() + "ffc/_gdiplus.vcx")
m.loImage.CreateFromFile(m.lcSource)

m.lnWidth = m.loImage.ImageWidth
m.lnHeight = m.loImage.ImageHeight
m.lnHorRes = m.loImage.HorizontalResolution
m.lnVerRes = m.loImage.VerticalResolution
m.lnPixForm = m.loImage.PixelFormat
m.lcpixform = GetPixFormatName(m.lnPixForm)

m.lcInfo = "image : " + m.lcSource + CHR(13) + CHR(13) + ;
    "width : " + TRANSFORM(m.lnWidth) + " pixels" + CHR(13) + ;
    "height : " + TRANSFORM(m.lnHeight) + " pixels" + CHR(13) + ;
    "pixel format : " + m.lcpixform + CHR(13) + ;
    "hor. resol : " + TRANSFORM(m.lnHorRes) + " pixels/inch" + CHR(13) + ;
    "ver. resol : " + TRANSFORM(m.lnVerRes) + " pixels/inch" + CHR(13)

MESSAGEBOX(m.lcInfo, 64, "image information")
RETURN

PROCEDURE GetPixFormatName(npix)
    DO CASE
        CASE m.npix = 0x00030101
            RETURN "1bppindexed"
        CASE m.npix = 0x00030402
            RETURN "4bppindexed"
        CASE m.npix = 0x00030803
            RETURN "8bppindexed"
        CASE m.npix = 0x00101004
            RETURN "16bppgrayscale"
        CASE m.npix = 0x00021005
            RETURN "16bpprgb555"
        CASE m.npix = 0x00021006
            RETURN "16bpprgb565"
        CASE m.npix = 0x00061007
            RETURN "16bppargb1555"
        CASE m.npix = 0x00021808
            RETURN "24bpprgb"
        CASE m.npix = 0x00022009
            RETURN "32bpprgb"
        CASE m.npix = 0x0026200a
            RETURN "32bppargb"
        CASE m.npix = 0x000e200b
            RETURN "32bpppargb"
        CASE m.npix = 0x0010300c
            RETURN "48bpprgb"
        CASE m.npix = 0x001c400e
            RETURN "64bpppargb"
        OTHERWISE
            RETURN "unidentified"
    ENDCASE
ENDPROC