WinDev (Show me the code)

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

Code Select Expand

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?