Results 1 to 18 of 18

Thread: [RESOLVED] Best/Fastest Way to Generate Checkboard Background

  1. #1

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    7,930

    Resolved [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. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  2. #2
    Frenzied Member
    Join Date
    Dec 2014
    Posts
    1,935

    Re: Best/Fastest Way to Generate Checkboard Background

    use stretchbitblt
    and a couple of pictureboxes with the color u want to use.

  3. #3

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    7,930

    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. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  4. #4
    Frenzied Member
    Join Date
    Dec 2014
    Posts
    1,935

    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)

  5. #5
    Angel of Code Niya's Avatar
    Join Date
    Nov 2011
    Posts
    7,731

    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.
    Treeview with NodeAdded/NodesRemoved events | BlinkLabel control | Calculate Permutations | Object Enums | ComboBox with centered items | .Net Internals article(not mine) | Wizard Control | Understanding Multi-Threading | Simple file compression | Demon Arena

    Copy/move files using Windows Shell | I'm not wanted

    C++ programmers will dismiss you as a cretinous simpleton for your inability to keep track of pointers chained 6 levels deep and Java programmers will pillory you for buying into the evils of Microsoft. Meanwhile C# programmers will get paid just a little bit more than you for writing exactly the same code and VB6 programmers will continue to whitter on about "footprints". - FunkyDexter

    There's just no reason to use garbage like InputBox. - jmcilhinney

    The threads I start are Niya and Olaf free zones. No arguing about the benefits of VB6 over .NET here please. Happiness must reign. - yereverluvinuncleber

  6. #6
    Frenzied Member
    Join Date
    Dec 2014
    Posts
    1,935

    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.

  7. #7

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    7,930

    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
    
    Name:  Checker.png
Views: 101
Size:  1.6 KB

    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. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  8. #8
    Frenzied Member
    Join Date
    Dec 2014
    Posts
    1,935

    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

  9. #9

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    7,930

    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. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  10. #10

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    7,930

    Re: Best/Fastest Way to Generate Checkboard Background

    Quote Originally Posted by baka View Post
    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. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  11. #11
    Frenzied Member
    Join Date
    Dec 2014
    Posts
    1,935

    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.

  12. #12

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    7,930

    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. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  13. #13
    PowerPoster
    Join Date
    Feb 2006
    Posts
    23,550

    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

  14. #14

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    7,930

    Re: [RESOLVED] Best/Fastest Way to Generate Checkboard Background

    Quote Originally Posted by dilettante View Post
    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. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  15. #15

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    7,930

    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. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  16. #16
    PowerPoster
    Join Date
    Feb 2006
    Posts
    23,550

    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.

  17. #17
    Frenzied Member
    Join Date
    Dec 2014
    Posts
    1,935

    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

  18. #18
    PowerPoster
    Join Date
    Jun 2013
    Posts
    6,121

    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
  •  



Click Here to Expand Forum to Full Width