-
Jul 4th, 2022, 11:42 AM
#1
[RESOLVED] Best/Fastest Way to Generate Checkboard Background
I'd like to generate a checkerboard background on a form, with the squares being any color I specify. And I'd also like it to be any size I'd like, possibly resizing (re-generating) when the form is resized.
I could certainly do it with VB6's drawing tools, and then flatten it (.Picture = .Image). But I'm wondering if there's a faster/better way to do it.
What do y'all think?
I'd also like to specify the size of the squares (in pixels). For now, let's just assume DPI aware (screen pixel = specified pixel).
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Jul 4th, 2022, 12:51 PM
#2
Re: Best/Fastest Way to Generate Checkboard Background
use stretchbitblt
and a couple of pictureboxes with the color u want to use.
-
Jul 4th, 2022, 01:51 PM
#3
Re: Best/Fastest Way to Generate Checkboard Background
Oh gosh, I don't want to use any PictureBoxes, and I want to pick any color I'd like. I've been working on some other stuff, but I'll get something together in a bit.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Jul 4th, 2022, 02:10 PM
#4
Re: Best/Fastest Way to Generate Checkboard Background
the pictureboxes are only use for color. those are invisible.
this so stretchbitblt can copy and stretch it to whatever rectangle.
of course u could create a memorydc and apply fillrect with a color or even create color using copymemory in a memorydc. (only gdi32 is needed for this)
-
Jul 4th, 2022, 02:27 PM
#5
Re: Best/Fastest Way to Generate Checkboard Background
I've seen a lot of examples on these boards of this being done using Cairo through RC6. Maybe Olaf can shed some light on what technique he used.
Personally, I'd just use some math to draw and align coloured rectangles.
-
Jul 4th, 2022, 02:32 PM
#6
Re: Best/Fastest Way to Generate Checkboard Background
yeah, using a picturebox to "store" the color (u can even use setpixel) and after that stretchbitblt,
hard to make it smaller. also stretchbitblt is quite fast as well.
even GdiAlphaBlend is possible to use, u can even create opacity.
-
Jul 4th, 2022, 02:33 PM
#7
Re: Best/Fastest Way to Generate Checkboard Background
Well, here's my first pass at this. I wouldn't mind tips to make it faster, but it seems to work pretty good the way it is.
(I'm not going to use Cairo just to do this, just FYI.)
Code:
Option Explicit
Private Sub Form_Resize()
CheckerBoard vbRed, vbBlue, 10&
End Sub
Private Sub CheckerBoard(iColor1 As Long, iColor2 As Long, iPixelsWidePerBox As Long)
'
' Clear out anything.
Me.Picture = LoadPicture()
Me.Cls
Me.AutoRedraw = True ' Necessary to flatten.
'
' Save original scale.
Dim iOrigScaleMode As Long
iOrigScaleMode = Me.ScaleMode
Dim fOrigScaleLeft As Single, fOrigScaleWidth As Single, fOrigScaleTop As Single, fOrigScaleHeight As Single
fOrigScaleLeft = Me.ScaleLeft: fOrigScaleWidth = Me.ScaleWidth
fOrigScaleTop = Me.ScaleTop: fOrigScaleHeight = Me.ScaleHeight
'
' Set scalemode to pixels.
Me.ScaleMode = vbPixels
'
' We can just use the back color for one of them.
Me.BackColor = iColor1
'
' Now draw boxes of the other color.
Dim x1 As Long, y1 As Long
Do
Do
Me.Line (x1, y1)-(x1 + iPixelsWidePerBox - 1&, y1 + iPixelsWidePerBox - 1&), iColor2, BF
x1 = x1 + iPixelsWidePerBox * 2&
If x1 >= Me.ScaleWidth Then
x1 = (x1 + iPixelsWidePerBox) Mod iPixelsWidePerBox * 2&
Exit Do
End If
Loop
y1 = y1 + iPixelsWidePerBox
If y1 >= Me.ScaleHeight Then Exit Do
Loop
'
' Flatten.
Me.Picture = Me.Image
'
' Restore whatever scaling was there to start.
Me.ScaleLeft = fOrigScaleLeft: Me.ScaleWidth = fOrigScaleWidth
Me.ScaleTop = fOrigScaleTop: Me.ScaleHeight = fOrigScaleHeight
Me.ScaleMode = iOrigScaleMode
End Sub
EDIT: Changed ">" to ">=" in the loop ending tests, as this saves a bit of time in certain circumstances.
Last edited by Elroy; Jul 4th, 2022 at 02:42 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Jul 4th, 2022, 02:47 PM
#8
Re: Best/Fastest Way to Generate Checkboard Background
Code:
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Sub Form_Resize()
CheckerBoard vbRed, vbBlue, 10&
End Sub
Private Sub CheckerBoard(iColor1 As Long, iColor2 As Long, iPixelsWidePerBox As Long)
Dim x&, y&, s&
Me.BackColor = iColor2
Me.Cls
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
SetPixel Me.hdc, 0, 0, iColor1
For y = 0 To Me.ScaleHeight Step iPixelsWidePerBox
If s = 0 Then s = iPixelsWidePerBox Else s = 0
For x = s To Me.ScaleWidth Step iPixelsWidePerBox * 2
StretchBlt Me.hdc, x, y, iPixelsWidePerBox, iPixelsWidePerBox, Me.hdc, 0, 0, 1, 1, vbSrcCopy
Next x
Next y
End Sub
-
Jul 4th, 2022, 02:52 PM
#9
Re: Best/Fastest Way to Generate Checkboard Background
Here, try this one for some fun.
Code:
Option Explicit
'
Dim miColor1 As Long, miColor2 As Long, miBoxSize As Long
'
Private Sub Form_Click()
SetRandomCheckerBoard
CheckerBoard miColor1, miColor2, miBoxSize
End Sub
Private Sub Form_Load()
SetRandomCheckerBoard
End Sub
Private Sub Form_Resize()
CheckerBoard miColor1, miColor2, miBoxSize
End Sub
Private Sub SetRandomCheckerBoard()
miColor1 = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
miColor2 = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
miBoxSize = Int((41) * Rnd + 10) ' 10 to 50 pixel squares.
End Sub
Private Sub CheckerBoard(iColor1 As Long, iColor2 As Long, iPixelsWidePerBox As Long)
'
' Clear out anything.
Me.Picture = LoadPicture()
Me.Cls
Me.AutoRedraw = True ' Necessary to flatten.
'
' Save original scale & autoredraw.
Dim iOrigScaleMode As Long
iOrigScaleMode = Me.ScaleMode
Dim fOrigScaleLeft As Single, fOrigScaleWidth As Single, fOrigScaleTop As Single, fOrigScaleHeight As Single
fOrigScaleLeft = Me.ScaleLeft: fOrigScaleWidth = Me.ScaleWidth
fOrigScaleTop = Me.ScaleTop: fOrigScaleHeight = Me.ScaleHeight
'
' Set scalemode to pixels.
Me.ScaleMode = vbPixels
'
' We can just use the back color for one of them.
Me.BackColor = iColor1
'
' Now draw boxes of the other color.
Dim x1 As Long, y1 As Long
Do
Do
Me.Line (x1, y1)-(x1 + iPixelsWidePerBox - 1&, y1 + iPixelsWidePerBox - 1&), iColor2, BF
x1 = x1 + iPixelsWidePerBox * 2&
If x1 >= Me.ScaleWidth Then
x1 = (x1 + iPixelsWidePerBox) Mod iPixelsWidePerBox * 2&
Exit Do
End If
Loop
y1 = y1 + iPixelsWidePerBox
If y1 >= Me.ScaleHeight Then Exit Do
Loop
'
' Flatten.
Me.Picture = Me.Image
'
' Restore whatever scaling was there to start.
Me.ScaleLeft = fOrigScaleLeft: Me.ScaleWidth = fOrigScaleWidth
Me.ScaleTop = fOrigScaleTop: Me.ScaleHeight = fOrigScaleHeight
Me.ScaleMode = iOrigScaleMode
End Sub
Click the form to change colors and box sizes.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Jul 4th, 2022, 03:02 PM
#10
Re: Best/Fastest Way to Generate Checkboard Background
Originally Posted by baka
Code:
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Sub Form_Resize()
CheckerBoard vbRed, vbBlue, 10&
End Sub
Private Sub CheckerBoard(iColor1 As Long, iColor2 As Long, iPixelsWidePerBox As Long)
Dim x&, y&, s&
Me.BackColor = iColor2
Me.Cls
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
SetPixel Me.hdc, 0, 0, iColor1
For y = 0 To Me.ScaleHeight Step iPixelsWidePerBox
If s = 0 Then s = iPixelsWidePerBox Else s = 0
For x = s To Me.ScaleWidth Step iPixelsWidePerBox * 2
StretchBlt Me.hdc, x, y, iPixelsWidePerBox, iPixelsWidePerBox, Me.hdc, 0, 0, 1, 1, vbSrcCopy
Next x
Next y
End Sub
Yes, I think that's better/faster. Also, I think yours is better with AutoRedraw=False, as it's drawing directly onto the background anyway, so no need for it to be True. Also, setting it to false makes it correct on initial form loading.
EDIT: Also, Baka, I'm not sure you noticed, but you got the pixel at 0,0 wrong.
Last edited by Elroy; Jul 4th, 2022 at 03:07 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Jul 4th, 2022, 03:06 PM
#11
Re: Best/Fastest Way to Generate Checkboard Background
yeah. exactly, no need for it. and with autoredraw = false it will render even faster.
but with false, u need to move the "resize" to Form_Paint() instead.
edit:
really? well it works at least
edit:
and since u use the whole form, u dont need Me.Cls
only need me.cls when u change size of the squares.
Last edited by baka; Jul 4th, 2022 at 03:12 PM.
-
Jul 4th, 2022, 03:21 PM
#12
Re: Best/Fastest Way to Generate Checkboard Background
Turns out that Autoredraw=True is faster.
Here's where I landed:
Code:
Option Explicit
'
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Dim miColor1 As Long, miColor2 As Long, miPixelsWidePerBox As Long
'
Private Sub Form_Click()
SetRandomCheckerBoard
CheckerBoard
End Sub
Private Sub Form_Load()
'
' Setup for our checkers.
Me.AutoRedraw = True ' It's VERY slow if we make this False.
Me.ScaleMode = vbPixels
SetRandomCheckerBoard
End Sub
Private Sub Form_Resize()
CheckerBoard
End Sub
Private Sub SetRandomCheckerBoard()
miColor1 = RGB(Int(256! * Rnd), Int(256! * Rnd), Int(256! * Rnd))
miColor2 = RGB(Int(256! * Rnd), Int(256! * Rnd), Int(256! * Rnd))
miPixelsWidePerBox = Int(41! * Rnd + 10!) ' 10 to 50 pixel squares.
End Sub
Private Sub CheckerBoard()
' We're going to assume that nothing else will be using the form's background nor DC,
' so we just take total control, and assume our miColor1, miColor2, & miBoxSize are set.
' Thanks to Baka (VbForums) for improvements to this.
'
If miPixelsWidePerBox < 1& Then Exit Sub ' Stop an infinite loop.
'
' Set our backcolor with one of the colors.
Me.BackColor = miColor2
'
' Set the top-left pixel to the other color.
SetPixel Me.hdc, 0&, 0&, miColor1
'
' Loops to draw all the boxes, using the color of the pixel in top-left.
Dim x As Long, y As Long, s As Long
For y = 0& To Me.ScaleHeight Step miPixelsWidePerBox
For x = s To Me.ScaleWidth Step miPixelsWidePerBox * 2&
StretchBlt Me.hdc, x, y, miPixelsWidePerBox, miPixelsWidePerBox, Me.hdc, 0&, 0&, 1&, 1&, vbSrcCopy
Next x
s = (s + miPixelsWidePerBox) Mod miPixelsWidePerBox * 2&
Next y
End Sub
I think that's probably about as good as it gets. I'm gonna call this one done.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Jul 4th, 2022, 04:19 PM
#13
Re: [RESOLVED] Best/Fastest Way to Generate Checkboard Background
Oh, so just refill the entire Form client area erasing everything already present?
Code:
Option Explicit
Private Const WIN32_NULL As Long = 0
Private Declare Function CreateBitmap Lib "gdi32" ( _
ByVal Width As Long, _
ByVal Height As Long, _
ByVal Planes As Long, _
ByVal BitsPerPixel As Long, _
ByRef Bits As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBM As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function FillRect Lib "user32" ( _
ByVal hDC As Long, _
ByRef RECT As RECT, _
ByVal hBrush As Long) As Long
Private Declare Function GetClientRect Lib "user32" ( _
ByVal hWnd As Long, _
ByRef RECT As RECT) As Long
Private Declare Function OleTranslateColor Lib "oleaut32" ( _
ByVal clr As OLE_COLOR, _
ByVal hpal As Long, _
ByRef colorref As Long) As Long
Private Function ARGB(ByVal OLE_COLOR As OLE_COLOR) As Long
OleTranslateColor OLE_COLOR, WIN32_NULL, OLE_COLOR
ARGB = &HFF000000 _
Or (OLE_COLOR And &HFF&) * &H10000 _
Or (OLE_COLOR And &HFF00&) _
Or OLE_COLOR \ &H10000
End Function
Private Sub CheckerFill(ByVal SquareSize As Long, ByVal Color0 As OLE_COLOR, ByVal Color1 As OLE_COLOR)
Dim Bits() As Long
Dim Y As Long
Dim X As Long
Dim hBM As Long
Dim hBrush As Long
Dim RECT As RECT
Color0 = ARGB(Color0)
Color1 = ARGB(Color1)
ReDim Bits(SquareSize * SquareSize * 4 - 1)
For Y = 0 To SquareSize - 1
For X = 0 To SquareSize - 1
Bits(SquareSize * 2 * Y + X) = Color0
Bits(SquareSize + (SquareSize * 2 * Y + X)) = Color1
Bits(SquareSize * 2 * (SquareSize + Y) + X) = Color1
Bits(SquareSize + (SquareSize * 2 * (SquareSize + Y) + X)) = Color0
Next
Next
hBM = CreateBitmap(SquareSize * 2, SquareSize * 2, 1, 32, Bits(0))
Erase Bits
hBrush = CreatePatternBrush(hBM)
DeleteObject hBM
GetClientRect hWnd, RECT
FillRect hDC, RECT, hBrush
DeleteObject hBrush
End Sub
Private Sub Form_Load()
AutoRedraw = True
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then CheckerFill 24, vbBlack, vbRed
End Sub
-
Jul 4th, 2022, 04:48 PM
#14
Re: [RESOLVED] Best/Fastest Way to Generate Checkboard Background
Originally Posted by dilettante
Oh, so just refill the entire Form client area erasing everything already present?
Code:
Option Explicit
Private Const WIN32_NULL As Long = 0
Private Declare Function CreateBitmap Lib "gdi32" ( _
ByVal Width As Long, _
ByVal Height As Long, _
ByVal Planes As Long, _
ByVal BitsPerPixel As Long, _
ByRef Bits As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBM As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function FillRect Lib "user32" ( _
ByVal hDC As Long, _
ByRef RECT As RECT, _
ByVal hBrush As Long) As Long
Private Declare Function GetClientRect Lib "user32" ( _
ByVal hWnd As Long, _
ByRef RECT As RECT) As Long
Private Declare Function OleTranslateColor Lib "oleaut32" ( _
ByVal clr As OLE_COLOR, _
ByVal hpal As Long, _
ByRef colorref As Long) As Long
Private Function ARGB(ByVal OLE_COLOR As OLE_COLOR) As Long
OleTranslateColor OLE_COLOR, WIN32_NULL, OLE_COLOR
ARGB = &HFF000000 _
Or (OLE_COLOR And &HFF&) * &H10000 _
Or (OLE_COLOR And &HFF00&) _
Or OLE_COLOR \ &H10000
End Function
Private Sub CheckerFill(ByVal SquareSize As Long, ByVal Color0 As OLE_COLOR, ByVal Color1 As OLE_COLOR)
Dim Bits() As Long
Dim Y As Long
Dim X As Long
Dim hBM As Long
Dim hBrush As Long
Dim RECT As RECT
Color0 = ARGB(Color0)
Color1 = ARGB(Color1)
ReDim Bits(SquareSize * SquareSize * 4 - 1)
For Y = 0 To SquareSize - 1
For X = 0 To SquareSize - 1
Bits(SquareSize * 2 * Y + X) = Color0
Bits(SquareSize + (SquareSize * 2 * Y + X)) = Color1
Bits(SquareSize * 2 * (SquareSize + Y) + X) = Color1
Bits(SquareSize + (SquareSize * 2 * (SquareSize + Y) + X)) = Color0
Next
Next
hBM = CreateBitmap(SquareSize * 2, SquareSize * 2, 1, 32, Bits(0))
Erase Bits
hBrush = CreatePatternBrush(hBM)
DeleteObject hBM
GetClientRect hWnd, RECT
FillRect hDC, RECT, hBrush
DeleteObject hBrush
End Sub
Private Sub Form_Load()
AutoRedraw = True
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then CheckerFill 24, vbBlack, vbRed
End Sub
Oh goodness Dil. You really went all out. Hmm, now I've possibly got some benchmarking to do to see which is fastest.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Jul 4th, 2022, 04:50 PM
#15
Re: [RESOLVED] Best/Fastest Way to Generate Checkboard Background
Dil, your vbMinimized check is definitely something I need to add.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Jul 4th, 2022, 04:53 PM
#16
Re: [RESOLVED] Best/Fastest Way to Generate Checkboard Background
I suppose you might also cache the hBrush to use across resizings. Just delete it and recreate it when you change the SquareSize or the colors.
Or perhaps just cache the Bits array to avoid retaining the hBrush for long periods of time.
-
Jul 4th, 2022, 05:03 PM
#17
Re: [RESOLVED] Best/Fastest Way to Generate Checkboard Background
u dont need more performance wise,
its just checkboard we are dealing with.
sure u can create a memorydc, and create a "screen*screen" sized checkboard
after that just use bitblt to render the size of the form.
that should be as fast u can get
-
Jul 5th, 2022, 04:33 AM
#18
Re: [RESOLVED] Best/Fastest Way to Generate Checkboard Background
In the end, it all boils down to blitting a pre-created tile-bitmap
(which was constructed under the constraint of a "repeatable pattern").
The Blit-Loop is then quite simple...
Code:
Private Sub Form_Resize()
Dim x, y
For y = 0 To ScaleHeight Step Tile.Width
For x = 0 To ScaleWidth Step Tile.Height
PaintPicture Tile.Picture, x, y
Next x, y
End Sub
So, what remains is, to construct such a Tile-Bitmap-Object (usable in the PaintPicture-call)...
Although we don't have a true "headless DIB-Object-Helper" in the vbRuntime-lib,
we can still resort to a "dynamically created PicBox" as an alternative.
Here's the full code for this approach:
Code:
Option Explicit
Private Tile As VB.PictureBox
Private Sub Form_Load()
ScaleMode = vbPixels: AutoRedraw = True 'let's work in Pixelmode
'create a 16x16 Tile-Bitmap-Object (here as an invisible VB-PicBox)
Set Tile = Controls.Add("VB.PictureBox", "Tile") 'create an invisible PicBox
Tile.BorderStyle = 0: Tile.AutoRedraw = True
Tile.ScaleMode = vbPixels: Tile.Move 0, 0, 16, 16 '<- set the tiles pxl-size
Tile.Line (0, 0)-(6, 6), vbRed, BF 'draw two squares ...
Tile.Line (8, 8)-(14, 14), vbRed, BF '...diagonally (to fullfill the "repeatable" constraint)
Set Tile.Picture = Tile.Image 'manifest the drawn result in the Tiles Picture-Prop
End Sub
Private Sub Form_Resize()
Dim x, y
For y = 0 To ScaleHeight Step Tile.Width
For x = 0 To ScaleWidth Step Tile.Height
PaintPicture Tile.Picture, x, y
Next x, y
End Sub
HTH
Olaf
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|