1. VisualBasic / Говнокод #14127

    −132

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    1.TextWindow.WriteLine ("Напиши число от 0 до 9 и я переведу его на английский")

2.Число = TextWindow.ReadNumber()

3.If Число = "0" Then

4.TextWindow.WriteLine ("Zero")

5.ElseIf Число = "1" Then

6.TextWindow.WriteLine ("One")

7.ElseIf Число = "2" Then

8.TextWindow.WriteLine ("Two")

9.ElseIf Число = "3" Then

10.TextWindow.WriteLine ("Three")

11.ElseIf Число = "4" Then

12.TextWindow.WriteLine ("Four")

13.ElseIf Число = "5" Then

14.TextWindow.WriteLine ("Five")

15.ElseIf Число = "6" Then

16.TextWindow.WriteLine ("Six")

17.ElseIf Число = "7" Then

18.TextWindow.WriteLine ("Seven")

19.ElseIf Число = "8" Then

20.TextWindow.WriteLine ("Eight")

21.ElseIf Число = "9" Then

22.TextWindow.WriteLine ("Nine")

23.Else

24.TextWindow.WriteLine ("Не знаю таких больших цифр")

25.EndIf

    elseif число=10 then
    msgbox "программа бо-бо"
    else
    msgbox "программа бо-бо"

    http://vbbook.ru/small-basic/ysloviya--primeru-small-basic/

    Stertor, 23 Ноября 2013

    Комментарии (40)

  2. VisualBasic / Говнокод #13839

    −97

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    System.Diagnostics.Process.Start("ShutDown", "/s") ' Выключение
System.Diagnostics.Process.Start("ShutDown", "/r") ' Перезагрузка
System.Diagnostics.Process.Start("ShutDown", "/l") ' Выход из пол-ля
System.Diagnostics.Process.Start("ShutDown", "/h") ' Спящий режим

Автор: Release
E-mail: [email protected]
Сайт: ds-release.ru

    http://vbbook.ru/vb.net/zavershenie-rabotu/

    Я бью земные поклоны и от чистого сердца благодарю бога за то, что он избавил меня от необходимости учить этот дебильный язык.

    Stertor, 21 Сентября 2013

    Комментарии (130)

  3. VisualBasic / Говнокод #13838

    −87

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    Программа на цикл.

Мы запускаем цикл, который можно остановить только если прописать слово "Стоп" :

Dim Slovo As String
Do
Slovo = InputBox("Введите слово", "Слово")
MsgBox(Slovo & "!", , "Слово")
Loop Until Slovo = "Стоп"





Автор: Release
E-mail: [email protected]
Сайт: ds-release.ru

    http://vbbook.ru/vb.net/programma-na-cikl/
    Вначале было слово.
    Потом тоже было слово.
    Потом тоже было слово.
    Потом тоже было слово.
    Потом тоже было слово.
    Потом тоже было слово.
    Потом тоже было слово.
    Потом тоже было слово.
    Потом тоже было слово.
    Потом тоже было слово.
    application halted with error

    Stertor, 21 Сентября 2013

    Комментарии (162)

  4. VisualBasic / Говнокод #13779

    −106

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    Всякий раз наводя курсор на кнопку "Пуск" в Windows 7 вы видели как она менялась. 
И вы наверно думали: а как реолизовать такой эффект в VB6? Давайте попробуем
Код:

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.Picture = LoadPicture("C:Безымянный.bmp") ' при наведении курсора на имейдж в него загрузится картинка
End Sub

Ну теперь запускаем. Чтож мы видим? Навели курсор - картинка в имейдже измнилась.
 Но ведь она должна изменятся обратно при отведении курсора. Но почему-то MuseMove этого не поддерживает. 
Тогда придётся втянуть в это дело форму. Наведением курсора на форму мы будем имитировать отведение курсора от имейджа.

Вот код вместе с первым примером. 

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.Picture = LoadPicture("C:Безымянный1.bmp")' при наведении курсора на форму в имейдж загрузится картинка которая была раньше
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.Picture = LoadPicture("C:Безымянный.bmp")' при наведении курсора на имейдж в него загрузится картинка
End Sub

    Еще пара таких кодов, и мне начнет нравиться Борис М.
    А че, интересный парень.

    Stertor, 11 Сентября 2013

    Комментарии (13)

  5. VisualBasic / Говнокод #13753

    −81

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    Private Sub Command1_Click()
Dim a As String, b As String ' обявим переменные тип текст
For i = 1 To Len(Text1.Text) ' откроем цикл от 1 до количество букв в текстбоксе с шагом 1,,
a = Mid(Text1.Text, i, 1)    ' в переменную а берем по одному букву
b = Asc(a) '- 3              ' переменную а переобразуем в аскикод
Text2.Text = Text2.Text & b  ' //// выводим данные в текстбос
Next                         ' закрываем цикл
End Sub

    Кто первый угадает национальность быдлокодера по комментариям, тот получит кусочек сахару )

    Stertor, 08 Сентября 2013

    Комментарии (1)

  6. VisualBasic / Говнокод #13752

    −353

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    Dim ll As Byte 
Private Sub Command1_Click() ' При нажатие на кнопку "Кодировка" 
For i = 1 To Len(Text1) Step 1 ' Читаем тест 1 от начало до канца с шагом 1 
l = Asc(Mid(Text1, i, 1)) 
Text2.Text = Text2 & Len(l) & Asc(Mid(Text1, i, 1)) ' записываем код в text 
2 
' l = Asc(Mid(Text1, i, 1)) и Len(l) - это для того что б знать сколько 
чисел у закодированого символа. Это нам нужно для раскодировки 
Next i ' конец чтению текста 1 
End Sub 
Private Sub Command2_Click() ' При нажатии кнопки "Раскодировка" 
ll=1 ' пишим начало от счёта 
timer1.enabled=true ' включаем таймер 
End Sub 
Private Sub Text1_Change() 
Text2 = "" ' сдесь при изменение текста 1 текст 2 = "" (вы можете этого и не 
делать) 
End Sub 
Private Sub Text2_Change() 
Text4 = Text2 " тут при изменение кода в тексте 2 этот код копируеться в 
текст4 
End Sub 
Private Sub Text4_Change() 
Text3 = "" ' сдесь при изменение текста 4 текст 3 = "" (вы можете этого и 
не делать) 
End Sub 
Private Sub Timer1_Timer() 
   
For i2 = 1 To 255 Step 1 
If Mid(Text4, ll, 1) = "1" Or Mid(Text4, ll, 1) = "2" Or Mid(Text4, ll, 1) = 
"3" Then If Val(Mid(Text4, ll + 1, Mid(Text4, ll, 1))) = i2 Then Text3 = 
Text3 & asc1(Val(Mid(Text4, ll + 1, Mid(Text4, ll, 1)))): ll = ll + 
Val(Mid(Text4, ll, 1)) + 1 ' сначало сравниваем числа 1,2,3 с кодом , эти 
чилса обозначают из скольки символов состоит следующий код символа, потом мы 
читаем и сравниваем код символа с перечисленым кодом , дальше мы записываем 
каждую прочитанную букву при помощи моей функцией она записана в модуле 

Next i2 
If ll > Len(Text4) Then Timer1.Enabled = False ' если ll станет больше числа 
символов в тексте, тогда таймер выключаеться 
End Sub 

Select Case ch
Case 48: asc1 = "0": Case 49: asc1 = "1": Case 50: asc1 = "2": Case 51: asc1 
= "3": Case 52: asc1 = "4": Case 53: asc1 = "5": Case 54: asc1 = "6": Case 
55: asc1 = "7": Case 56: asc1 = "8": Case 57: asc1 = "9"
Case 65: asc1 = "A": Case 66: asc1 = "B": Case 67: asc1 = "C": Case 68: asc1 
= "D": Case 69: asc1 = "E": Case 70: asc1 = "F": Case 71: asc1 = "G": Case 
72: asc1 = "H": Case 73: asc1 = "I": Case 74: asc1 = "J": Case 75: asc1 = 
"K": Case 76: asc1 = "L": Case 77: asc1 = "M": Case 78: asc1 = "N": Case 79: 
asc1 = "O": Case 80: asc1 = "P": Case 81: asc1 = "Q": Case 82: asc1 = "R": 
Case 83: asc1 = "S": Case 84: asc1 = "T": Case 85: asc1 = "U": Case 86: asc1 
= "V": Case 87: asc1 = "W": Case 88: asc1 = "X": Case 89: asc1 = "Y": Case 
90: asc1 = "Z"
Case 97: asc1 = "a": Case 98: asc1 = "b": Case 99: asc1 = "c": Case 100: 
asc1 = "d": Case 101: asc1 = "e": Case 102: asc1 = "f": Case 103: asc1 = 
"g": Case 104: asc1 = "h": Case 105: asc1 = "i": Case 106: asc1 = "j": Case 
107: asc1 = "k": Case 108: asc1 = "l": Case 109: asc1 = "m": Case 110: asc1 
= "n": Case 111: asc1 = "o": Case 112: asc1 = "p": Case 113: asc1 = "q": 
Case 114: asc1 = "r": Case 115: asc1 = "s": Case 116: asc1 = "t": Case 117: 
asc1 = "u": Case 118: asc1 = "v": Case 119: asc1 = "w": Case 120: asc1 = 
"x": Case 121: asc1 = "y": Case 122: asc1 = "z"
Case 192: asc1 = "А": Case 193: asc1 = "Б": Case 194: asc1 = "В": Case 195: 
asc1 = "Г": Case 196: asc1 = "Д": Case 197: asc1 = "Е": Case 168: asc1 = 
"Ё": Case 198: asc1 = "Ж": Case 199: asc1 = "З": Case 200: asc1 = "И": Case 
201: asc1 = "Й": Case 202: asc1 = "К": Case 203: asc1 = "Л": Case 204: asc1 
= "М": Case 205: asc1 = "Н": Case 206: asc1 = "О": Case 207: asc1 = "П": 
Case 208: asc1 = "Р": Case 209: asc1 = "С": Case 210: asc1 = "Т": Case 211: 
asc1 = "У": Case 212: asc1 = "Ф": Case 213: asc1 = "Х": Case 214: asc1 = 
"Ц": Case 215: asc1 = "Ч": Case 216: asc1 = "Ш": Case 217: asc1 = "Щ": Case 
218: asc1 = "Ъ": Case 219: asc1 = "Ы": Case 220: asc1 = "Ь": Case 221: asc1 
= "Э": Case 222: asc1 = "Ю": Case 223: asc1 = "Я"
Case 224: asc1 = "а": Case 225: asc1 = "б": Case 226: asc1 = "в": Case 227: 
asc1 = "г": Case 228: asc1 = "д": Case 229: asc1 = "е": Case 184: asc1 = 
"ё": Case 230: asc1 = "ж": Case 231: asc1 = "з": Case 232: asc1 = "и": Case 
233: asc1 = "й": Case 234: asc1 = "к": Case 235: asc1 = "л": Ca



и еще до кучи символов... )

    Суровое школоло на службе КГБ.

    Кодирование и раскодирование текста, Урок 197 чать 2
    http://vbbook.ru/visual-basic/kodirovanie-i-raskodirovanie-teksta-yrok-197-chat-2/

    Stertor, 08 Сентября 2013

    Комментарии (24)

  7. VisualBasic / Говнокод #12764

    −110

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    Select Case Figure mod 6  
 ...
 Case chsQueen 'Ферзь
   Picture.Line (X + 0.45 * Side, Y + 0.55 * Side)-(X + 0.5 * Side, Y + 0.15 * Side), Border
   Picture.Line (X + 0.55 * Side, Y + 0.55 * Side)-(X + 0.5 * Side, Y + 0.15 * Side), Border
   Picture.Circle (X + 0.5 * Side, Y + 0.15 * Side), 0.08 * Side, Border
   Picture.Line (X + 0.45 * Side, Y + 0.55 * Side)-(X + 0.3 * Side, Y + 0.25 * Side), Border
   Picture.Line (X + 0.35 * Side, Y + 0.6 * Side)-(X + 0.3 * Side, Y + 0.25 * Side), Border
   Picture.Circle (X + 0.3 * Side, Y + 0.25 * Side), 0.08 * Side, Border
   Picture.Line (X + 0.55 * Side, Y + 0.55 * Side)-(X + 0.7 * Side, Y + 0.25 * Side), Border
   Picture.Line (X + 0.65 * Side, Y + 0.6 * Side)-(X + 0.7 * Side, Y + 0.25 * Side), Border
   Picture.Circle (X + 0.7 * Side, Y + 0.25 * Side), 0.08 * Side, Border
   Picture.Line (X + 0.65 * Side, Y + 0.6 * Side)-(X + 0.85 * Side, Y + 0.35 * Side), Border
   Picture.Line (X + 0.73 * Side, Y + 0.65 * Side)-(X + 0.85 * Side, Y + 0.35 * Side), Border
   Picture.Circle (X + 0.85 * Side, Y + 0.35 * Side), 0.08 * Side, Border
   Picture.Line (X + 0.35 * Side, Y + 0.6 * Side)-(X + 0.15 * Side, Y + 0.35 * Side), Border
   Picture.Line (X + 0.27 * Side, Y + 0.65 * Side)-(X + 0.15 * Side, Y + 0.35 * Side), Border
   Picture.Circle (X + 0.15 * Side, Y + 0.35 * Side), 0.08 * Side, Border
   Picture.Line (X + 0.27 * Side, Y + 0.65 * Side)-(X + 0.27 * Side, Y + 0.8 * Side), Border
   Picture.Line (X + 0.73 * Side, Y + 0.65 * Side)-(X + 0.73 * Side, Y + 0.8 * Side), Border
   Picture.Circle (X + 0.5 * Side, Y + 0.35 * Side), 0.5 * Side, Border, 1.35 * Pi, 1.65 * Pi
   Call FloodFill(Picture.hdc, X + 0.5 * Side, Y + 0.5 * Side, Border)
   Picture.Circle (X + 0.5 * Side, Y + 1.24 * Side), 0.5 * Side, Border, 0.35 * Pi, 0.65 * Pi
   Picture.Circle (X + 0.5 * Side, Y + 1.1 * Side), 0.5 * Side, Border, 0.35 * Pi, 0.65 * Pi
   Picture.Line (X + 0.73 * Side, Y + 0.68 * Side)-(X + 0.65 * Side, Y + 0.7 * Side), Border
   Picture.Line (X + 0.73 * Side, Y + 0.77 * Side)-(X + 0.65 * Side, Y + 0.7 * Side), Border
   Picture.Line (X + 0.27 * Side, Y + 0.68 * Side)-(X + 0.35 * Side, Y + 0.7 * Side), Border
   Picture.Line (X + 0.27 * Side, Y + 0.77 * Side)-(X + 0.35 * Side, Y + 0.7 * Side), Border
   Picture.Line (X + 0.4 * Side, Y + 0.68 * Side)-(X + 0.5 * Side, Y + 0.63 * Side), Border
   Picture.Line (X + 0.4 * Side, Y + 0.68 * Side)-(X + 0.5 * Side, Y + 0.72 * Side), Border
   Picture.Line (X + 0.6 * Side, Y + 0.68 * Side)-(X + 0.5 * Side, Y + 0.63 * Side), Border
   Picture.Line (X + 0.6 * Side, Y + 0.68 * Side)-(X + 0.5 * Side, Y + 0.72 * Side), Border
   Let Picture.FillColor = Border
   Call FloodFill(Picture.hdc, X + 0.5 * Side, Y + 0.7 * Side, Border)
   Call FloodFill(Picture.hdc, X + 0.73 * Side, Y + 0.7 * Side, Border)
   Call FloodFill(Picture.hdc, X + 0.31 * Side, Y + 0.68 * Side, Border)
   Let Picture.FillColor = Fill
 ...
End Select

    Пишу свои шахматы, с блекджеком и не без них.
    Вот, набацал алгоритм векторного рисования ферзя.
    Только на это ушло около получаса времени чистого с примесями (подстройки, мать их).
    Чую нутром, лучше забить и вырвать клипарт из интернета.

    ckopo, 18 Марта 2013

    Комментарии (25)

  8. VisualBasic / Говнокод #12393

    −110

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    84. 84
    85. 85
    86. 86
    87. 87
    88. 88
    89. 89
    Sub WriteCategories(number, choice)
    
    strSql = ""
    strSql2 = ""
    
    If number = 1 Then
        strSql = "SELECT name, category_type_id" '... the rest is skipped
    Elseif number = 2 Or number = 3 Then
        strSql = "SELECT goco.category_order, goco.category_type_id," '... the rest is skipped
    End If
    
    If number = 1 And choice = 1 Then
        strSql2 = "SELECT gosct.category_type_id, goct.operator_id," '... the rest is skipped
        
    Set RS2 = db.Execute(strSql2)
        
    ' --- No sub categories are displayed if choice = 3
    Elseif choice <> 3 Then
        strSql2 = "SELECT goco.category_type_id, goco.sub_category_order, ..." 'the rest is skipped
        
        Set RS2 = db.Execute(strSql2)
    End If
    
    Set RS = db.Execute(strSql)
    
    ' --- CategoryListCurrent should not display selected category in categoryListMoveTo and vice versa.
    If number = 2 And choice = 1 Then
        '... the real code is skipped
        
        Do Until RS.EOF
            '... the real code is skipped
        Loop
    End If
    
    If number = 2 And choice = 2 Then
        '... the real code is skipped
        
        Do Until RS.EOF
            '... the real code is skipped
        Loop
    End If
    
    
    ' --- Loop through the recordset and print categories and sub categories.
    Do Until RS.EOF
        '... the real code is skipped
        
        If number = 2 And choice = 1 Then
            '... the real code is skipped
        End If

        If number = 2 And choice = 2 Then
            '... the real code is skipped
        End If
        
        If number = 3 And choice = 3 And subConfigCatId <> -1 Then
            '... the real code is skipped
        End If
        
        ' --- Print main categories
        Response.Write ("<option style=""color:"& color &""" value=""" & RS("category_type_id") & "_0"" " & tempSel & " " & disabled & ">" & RS("name") &  "</option>" &vbCrLf)
        
        If choice <> 3 Then
            ' --- Print sub categories
            RS2.MoveFirst
            If Not RS2.EOF Then
                Do Until RS2.EOF
                    '... the real code is skipped
                    
                    If catId1 <> -1 And number = 2 And choice = 1 And subCatId1 > 0 Then
                        '... the real code is skipped
                    End If
                    
                    If catId2 <> -1 And number = 2 And choice = 2 And subCatId2 > 0 Then
                        '... the real code is skipped
                    End If
                    
                    ' --- Only print sub categories under a matching category
                    If CLng(RS2("category_type_id")) = CLng(RS("category_type_id")) Then
                        Response.Write ("<option value=""" & RS2("category_type_id") & "_" & RS2("sub_category_type_id") & """ " & tempSelSub & ">  - " & RS2("name") &  "</option>" &vbCrLf)
                    End If
                    RS2.MoveNext
                Loop
            End If
        End If
        
        '... the real code is skipped
    Loop
End Sub

    Один параметр числовой. Назовём его number (C) Captain Obvious.
    Второй параметр тоже числовой. Но так как имя number занято, назовём его choice.
    Именованные константы?.. Анти-паттерн «Spaghetti Code»? Не, не слышал…

    wissenstein, 06 Января 2013

    Комментарии (0)

  9. VisualBasic / Говнокод #11421

    −98

    1. 001
    2. 002
    3. 003
    4. 004
    5. 005
    6. 006
    7. 007
    8. 008
    9. 009
    10. 010
    11. 011
    12. 012
    13. 013
    14. 014
    15. 015
    16. 016
    17. 017
    18. 018
    19. 019
    20. 020
    21. 021
    22. 022
    23. 023
    24. 024
    25. 025
    26. 026
    27. 027
    28. 028
    29. 029
    30. 030
    31. 031
    32. 032
    33. 033
    34. 034
    35. 035
    36. 036
    37. 037
    38. 038
    39. 039
    40. 040
    41. 041
    42. 042
    43. 043
    44. 044
    45. 045
    46. 046
    47. 047
    48. 048
    49. 049
    50. 050
    51. 051
    52. 052
    53. 053
    54. 054
    55. 055
    56. 056
    57. 057
    58. 058
    59. 059
    60. 060
    61. 061
    62. 062
    63. 063
    64. 064
    65. 065
    66. 066
    67. 067
    68. 068
    69. 069
    70. 070
    71. 071
    72. 072
    73. 073
    74. 074
    75. 075
    76. 076
    77. 077
    78. 078
    79. 079
    80. 080
    81. 081
    82. 082
    83. 083
    84. 084
    85. 085
    86. 086
    87. 087
    88. 088
    89. 089
    90. 090
    91. 091
    92. 092
    93. 093
    94. 094
    95. 095
    96. 096
    97. 097
    98. 098
    99. 099
    100. 100
    Private Sub Command2_Click()
Cls
For x = 1 To Text2 + 1
For y = 1 To Text2 + 1
A(x, y) = Round(Rnd(1))
If A(x, y) = 0 Then A(x, y) = -1
Next
Next
For x = 2 To Text2
For y = 2 To Text2
PSet (1200 + x * 15, 200 + y * 15), A(x, y)
Next
Next
End Sub

Private Sub Command3_Click()
Cls
For x = 1 To Text2 + 1
For y = 1 To Text2 + 1
A(x, y) = 1
Next
Next
A(Text20, Text21) = -1
A(Text22, Text23) = -1
A(Text24, Text25) = -1
A(Text26, Text27) = -1
For x = 2 To Text2
For y = 2 To Text2
PSet (1200 + x * 15, 200 + y * 15), A(x, y)
Next
Next
End Sub

Private Sub Form_Load()

For x = 1 To Text2 + 1
For y = 1 To Text2 + 1
A(x, y) = Round(Rnd(1))
If A(x, y) = 0 Then A(x, y) = -1
Next
Next



'For x = 1 To Text2 + 1
'For y = 1 To Text2 + 1
'A(x, y) = 1
'Next
'Next
'A(10, 10) = -1



End Sub

Private Sub Command1_Click()
Cls

For k = 1 To Text1

For x = 1 To Text2 + 1
A(x, 1) = A(x, Text2)
A(x, Text2 + 1) = A(x, 2)
Next

For y = 1 To Text2 + 1
A(1, y) = A(Text2, y)
A(Text2 + 1, y) = A(2, y)
Next



For x = 2 To Text2
For y = 2 To Text2

xp = A(x - 1, y - 1) + A(x, y - 1) + A(x + 1, y - 1) + A(x - 1, y) + A(x + 1, y) + A(x - 1, y + 1) + A(x, y + 1) + A(x + 1, y + 1)
Select Case xp
Case -8
B(x, y) = Text3
Case -7
B(x, y) = Text4
Case -6
B(x, y) = Text5
Case -5
B(x, y) = Text6
Case -4
B(x, y) = Text7
Case -3
B(x, y) = Text8
Case -2
B(x, y) = Text9
Case -1
B(x, y) = Text10
Case 0
B(x, y) = Text11
Case 1
B(x, y) = Text12
Case 2
B(x, y) = Text13
Case 3

    Жестокий, безумный мозг пятнадцатилетнего пацана родил клеточный автомат. Нашел свои исходники десятилетней давности.
    А ведь я себя тогда считал крутым программистом... стыдно вспоминать.

    xcont, 16 Июля 2012

    Комментарии (7)

  10. VisualBasic / Говнокод #10567

    −80

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    Dim centerX As Integer
Dim centerY As Integer
Dim radius As Integer

Private Sub Form_Activate()
    centerX = 100
    centerY = 100
    radius = 50
End Sub

Private Sub Timer1_Timer()
    Randomize
    Dim x As Integer
    Dim y As Integer
    Dim i As Integer
    Dim diff As Integer
    
    For i = 0 To 100
        Me.ForeColor = RGB(200, 0, 0)
        x = centerX + (radius * Rnd)
        y = centerY + (radius * Rnd)
        diff = Sqr(((centerX - x) ^ 2) + ((centerY - y) ^ 2))
        If (Abs(radius - diff) < 2) Then
            Me.PSet (x, y)
        End If
        
        Me.ForeColor = RGB(100, 0, 0)
        x = centerX - (radius * Rnd)
        y = centerY + (radius * Rnd)
        diff = Sqr(((centerX - x) ^ 2) + ((centerY - y) ^ 2))
        If (Abs(radius - diff) = 0) Then
            Me.PSet (x, y)
        End If
        
        x = centerX + (radius * Rnd)
        y = centerY - (radius * Rnd)
        diff = Sqr(((centerX - x) ^ 2) + ((centerY - y) ^ 2))
        If (Abs(radius - diff) = 0) Then
            Me.PSet (x, y)
        End If
        
        Me.ForeColor = RGB(0, 100, 0)
        x = centerX - (radius * Rnd)
        y = centerY - (radius * Rnd)
        diff = Sqr(((centerX - x) ^ 2) + ((centerY - y) ^ 2))
        If (Abs(radius - diff) > 2) Then
            Me.PSet (x, y)
        End If
    Next i
End Sub

    Извиняюсь за длину.
    История происхождения: в одном древнем ВБ-шном говнопроекте сомнительного происхождения эта вещь выполняла роль постепенной прорисовки "логотипа" в окне "О программе". Отрезал сам сабж.
    Вот как работает: http://tinyurl.com/ck3npah

    vistefan, 05 Июня 2012

    Комментарии (2)