• Welcome to PowerBasic Museum 2020-A.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

WinDev (Show me the code)

Started by Patrice Terrier, May 30, 2009, 05:23:22 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Patrice Terrier

For those of you who have no idea of what WinDev is, here is an example of procedure written in W-Language.

Its purpose is to replace one specific color in a bitmap with another one.

:o

PROCEDURE ReplaceColor(LOCAL hDC is int, LOCAL OldColor is int, LOCAL NewColor is int)
bi is BITMAPINFO
bm is BITMAP
x, y, bmW, bmH, nSbPtr, nNcPtr are 4-byte int

sb, oc, nc are COLORBYTES

oc.R = RGBRed(OldColor)
oc.G = RGBGreen(OldColor)
oc.B = RGBBlue(OldColor)

nc.R = RGBRed(NewColor)
nc.G = RGBGreen(NewColor)
nc.B = RGBBlue(NewColor)

IF hDC THEN
   hBitmap is int = GetCurrentObject(hDC, OBJ_BITMAP)
   IF hBitmap THEN
      hDibDC is int = CreateCompatibleDC(hDC)
      SelectObject(hDibDC, hBitmap)
      bmSize is int = Dimension(bm)
      bmptr is int = &bm
      GetObjectA(hBitmap, Dimension(bm), &bm)
      bi.bmiHeader.biSize        = Dimension(bi.bmiHeader)
      bi.bmiHeader.biWidth       = bm.bmWidth
      bi.bmiHeader.biHeight      = -bm.bmHeight // Origine to TOP instead on bottom!
      bi.bmiHeader.biPlanes      = 1
      bi.bmiHeader.biBitCount    = bm.bmBitsPixel
      bi.bmiHeader.biCompression = BI_RGB
      hDib is int = CreateDIBSection(hDibDC, &bi, DIB_RGB_COLORS, 0, 0, 0)
      SelectObject(hDibDC, hDib)
      BitBlt(hDibDC, 0, 0, bm.bmWidth, bm.bmHeight, hDC, 0, 0, SRCCOPY)
      GetObjectA(hDib, Dimension(bm), &bm)
      pBits is int = bm.bmBits
      bmW = bm.bmWidth
      bmH = bm.bmHeight
      nSbPtr = &sb
      nNcPtr = &nc
      FOR x = 1 TO bmW
          FOR y = 1 TO bmH
              Transfer(nSbPtr, pBits, 4)
              IF sb.R = oc.R THEN
                 IF sb.G = oc.G THEN
                    IF sb.B = oc.B THEN Transfer(pBits, nNcPtr, 4)
                 END
              END
              pBits += 4
          END
      END
      BitBlt(hDC, 0, 0, bm.bmWidth, bm.bmHeight, hDibDC, 0, 0, SRCCOPY)
      DeleteDC(hDibDC)
      DeleteObject(hDib)                     
   END
END


Don't you feel like at home with it?

;D
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com