| If you need some textures then this is a good way to start. You can create simple textures. See preset 2 for a sea effect. The code works by placing random pixels in a picture. You can make backgrounds for your homepage or your desktop with this one. I made it to create grass and sea tiles for my game programming. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop 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 ' This array here can store 3 presets Dim Preset_color(1 To 3, 1 To 12) Private Sub Form_Load() Show ' show the form Call setup ' run the setup Call zoomed ' zoom the texture in Call mapped ' Show a mapped preview End Sub Private Sub zoomed() ' used to scale ' hdc,xloc,yloc,newsizex,newsizey,sourcehdc,xloconsourcehdc,yloconsourcehdc,widthsource,heightsource,paintmode StretchBlt Me.hdc, 64, 16, 128, 128, Texture_Picture.hdc, 0, 0, 32, 32, vbSrcCopy End Sub Private Sub mapped() ' draw a tiled map using the texture For x = 0 To 4 For y = 0 To 4 BitBlt Me.hdc, (x * 32) + 228, (y * 32) + 16, 32, 32, Texture_Picture.hdc, 0, 0, vbSrcCopy Next Next End Sub Private Sub Form_Paint() ' keep refreshed Call zoomed Call mapped End Sub Private Sub Generate_Texture_Button_Click() ' pass 1 (backcolor) For x = 0 To 32 For y = 0 To 32 Texture_Picture.PSet (x, y), Pass1_Picture.BackColor Next Next ' pass 2 (light green) Randomize Timer For x = 0 To 32 For y = 0 To 32 If Fix(Rnd * Pass2_Combo.Text) = 1 Then Texture_Picture.PSet (x, y), Pass2_Picture.BackColor End If Next Next ' pass 3 (less lighter green) Randomize Timer For x = 0 To 32 For y = 0 To 32 If Fix(Rnd * Pass3_Combo.Text) = 1 Then Texture_Picture.PSet (x, y), Pass3_Picture.BackColor End If Next Next ' pass 4 (less browner green) Randomize Timer For x = 0 To 32 For y = 0 To 32 If Fix(Rnd * Pass4_Combo.Text) = 1 Then Texture_Picture.PSet (x, y), Pass4_Picture.BackColor End If Next Next Call Form_Paint ' Show our results Refresh ' refresh so we can view the result End Sub Private Sub setup() ' Set up the picture box Texture_Picture.Width = 32 * 15 Texture_Picture.Height = 32 * 15 ' Fill in the default and preset colors ' Set 1 Preset_color(1, 1) = 26 ' backcolor Preset_color(1, 2) = 47 Preset_color(1, 3) = 27 Preset_color(1, 4) = 40 ' pass 1 Preset_color(1, 5) = 66 Preset_color(1, 6) = 37 Preset_color(1, 7) = 49 ' pass 2 Preset_color(1, 8) = 78 Preset_color(1, 9) = 44 Preset_color(1, 10) = 49 ' pass 3 Preset_color(1, 11) = 70 Preset_color(1, 12) = 24 ' Set 2 Preset_color(2, 1) = 16 Preset_color(2, 2) = 63 Preset_color(2, 3) = 87 Preset_color(2, 4) = 17 Preset_color(2, 5) = 66 Preset_color(2, 6) = 88 Preset_color(2, 7) = 17 Preset_color(2, 8) = 66 Preset_color(2, 9) = 89 Preset_color(2, 10) = 22 Preset_color(2, 11) = 74 Preset_color(2, 12) = 94 ' Set 3 Preset_color(3, 1) = 87 Preset_color(3, 2) = 70 Preset_color(3, 3) = 55 Preset_color(3, 4) = 93 Preset_color(3, 5) = 76 Preset_color(3, 6) = 59 Preset_color(3, 7) = 106 Preset_color(3, 8) = 87 Preset_color(3, 9) = 67 Preset_color(3, 10) = 120 Preset_color(3, 11) = 98 Preset_color(3, 12) = 74 ' Set the default pass intensity Pass2_Combo.Text = 10 ' default intensity Pass3_Combo.Text = 10 Pass4_Combo.Text = 10 ' Fill the pictures with the default colors Pass1_Picture.BackColor = RGB(Preset_color(1, 1), Preset_color(1, 2), Preset_color(1, 3)) Pass2_Picture.BackColor = RGB(Preset_color(1, 4), Preset_color(1, 5), Preset_color(1, 6)) Pass3_Picture.BackColor = RGB(Preset_color(1, 7), Preset_color(1, 8), Preset_color(1, 9)) Pass4_Picture.BackColor = RGB(Preset_color(1, 10), Preset_color(1, 11), Preset_color(1, 12)) End Sub Private Sub Pass1_Picture_Click() ' we can set our own colors Dialog.ShowColor Pass1_Picture.BackColor = Dialog.Color End Sub Private Sub Pass2_Picture_Click() Dialog.ShowColor Pass2_Picture.BackColor = Dialog.Color End Sub Private Sub Pass3_Picture_Click() Dialog.ShowColor Pass3_Picture.BackColor = Dialog.Color End Sub Private Sub Pass4_Picture_Click() Dialog.ShowColor Pass4_Picture.BackColor = Dialog.Color End Sub Private Sub Pass2_Combo_Change() ' Setting the intensity ' 1 is high, 10 is low a = Pass2_Combo.Text If a < 1 Then Pass2_Combo.Text = 1 If a > 15 Then Pass2_Combo.Text = 15 End Sub Private Sub Pass3_Combo_Change() a = Pass3_Combo.Text If a < 1 Then Pass3_Combo.Text = 1 If a > 15 Then Pass3_Combo.Text = 15 End Sub Private Sub Pass4_Combo_Change() a = Pass4_Combo.Text If a < 1 Then Pass4_Combo.Text = 1 If a > 15 Then Pass4_Combo.Text = 15 End Sub Private Sub Default_Button_Click() ' reset to preset 1 Call setup End Sub Private Sub Fullscreen_Button_Click() ' Show a fullscreen example Fullscreen.Show End Sub Private Sub Save_Texture_button_Click() ' let us be able to save ' Set the initial directory Dialog.InitDir = App.Path ' We can only save bmaps Dialog.Filter = "Bitmap (*.bmp)|*.BMP" ' Show the save dialog Dialog.ShowSave ' If we do not decide to save then If Dialog.FileName = "" Then Exit Sub End If a = Dialog.FileName ' Always save with a .bmp extension If Mid(a, Len(a) - 3, 1) = "." Then If Right(a, 3) = "bmp" Then SavePicture Texture_Picture.Image, a Else Mid(a, Len(a) - 3, 4) = ".bmp" SavePicture Texture_Picture.Image, a End If Else a = a + ".bmp" SavePicture Texture_Picture.Image, a End If End Sub Private Sub Preset1_button_Click() ' set to preset 1 Pass1_Picture.BackColor = RGB(Preset_color(1, 1), Preset_color(1, 2), Preset_color(1, 3)) Pass2_Picture.BackColor = RGB(Preset_color(1, 4), Preset_color(1, 5), Preset_color(1, 6)) Pass3_Picture.BackColor = RGB(Preset_color(1, 7), Preset_color(1, 8), Preset_color(1, 9)) Pass4_Picture.BackColor = RGB(Preset_color(1, 10), Preset_color(1, 11), Preset_color(1, 12)) End Sub Private Sub Preset2_button_Click() ' set to preset 2 Pass1_Picture.BackColor = RGB(Preset_color(2, 1), Preset_color(2, 2), Preset_color(2, 3)) Pass2_Picture.BackColor = RGB(Preset_color(2, 4), Preset_color(2, 5), Preset_color(2, 6)) Pass3_Picture.BackColor = RGB(Preset_color(2, 7), Preset_color(2, 8), Preset_color(2, 9)) Pass4_Picture.BackColor = RGB(Preset_color(2, 10), Preset_color(2, 11), Preset_color(2, 12)) End Sub Private Sub Preset3_button_Click() ' set to preset 3 Pass1_Picture.BackColor = RGB(Preset_color(3, 1), Preset_color(3, 2), Preset_color(3, 3)) Pass2_Picture.BackColor = RGB(Preset_color(3, 4), Preset_color(3, 5), Preset_color(3, 6)) Pass3_Picture.BackColor = RGB(Preset_color(3, 7), Preset_color(3, 8), Preset_color(3, 9)) Pass4_Picture.BackColor = RGB(Preset_color(3, 10), Preset_color(3, 11), Preset_color(3, 12)) End Sub |
Textures |
Express News India | Freelance ecommerce web development India