•   
  •   
  •   
  •   
  •   
  •   
  •   
  •   
  • :
    :
    :
    -

    . «»

    HashFlare

    , . .

    Option Explicit
    '
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    ' hdc .
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    ' hdc. hdc. HDC. .
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    ' hdc .
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    ' . .
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    ' hdc.
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    ' . , hdc, . . .
    Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
    ' hdc . hdc .
    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
    ' . FillRect.
    Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
    ' Rect
    Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
    ' . - long. .
    Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long
    ' , . .

    Private Type RECT
    Left As Long
    top As Long
    Right As Long
    Bottom As Long
    End Type

    ' hdc.
    Dim DC As Long
    ' DC
    Dim BUFFER_DC As Long
    ' . CreatePen.
    Dim DRAW_PARAM As Long
    ' , X Y .

    Private Type _
    X As Integer
    Y As Integer
    End Type

    ' . 4 . - 0, - 1, - 2, - 3.
    Dim _ As Integer
    ' .
    Dim (50) As _
    ' .
    Dim _ As Integer

    ' -
    Private Type
    X As Integer
    Y As Integer
    ' . False -
    As Boolean

    End Type
    Dim As

    ' -
    Private Type
    X As Integer
    Y As Integer
    ' . False -
    As Boolean
    End Type

    Dim As
    '. , .
    Dim _ As Integer
    ' .
    Dim _ As Integer
    ' .
    Dim As RECT
    ' FOR NEXT
    Dim K As Integer
    ',
    Dim Prompt As String
    Dim Title As String
    Dim
    '

    Private Sub Command3_Click()
    '
    MsgBox " - . - ( ) ( ). , , . - , . , , . - . , ." & Chr(13) & " - -31 " & Chr(13) & " 2004"
    End Sub

    Private Sub Form_Activate()
    '
    _
    End Sub

    Sub _()
    '
    _ = 3
    ' .
    _ = 300
    ' .
    _ = 10
    ' hdc .
    DC = CreateCompatibleDC(Me.hdc)
    '
    BUFFER_DC = CreateCompatibleBitmap(Me.hdc, _, _)
    ' DC BUFFER_DC
    SelectObject DC, BUFFER_DC
    ' BUFFER_DC
    DeleteObject BUFFER_DC
    '
    _
    End Sub

    '
    Private Sub Command1_Click()
    ' 1
    Option1.Enabled = False
    ' 2
    Option2.Enabled = False
    ' 3
    Option3.Enabled = False
    ' 4
    Option4.Enabled = False
    '
    Command1.Enabled = False
    Command3.Enabled = False
    '
    Dim T As Integer
    '
    ' 1, = 150
    If Option1 Then T = 150 Else
    ' 2, = 90
    If Option2 Then T = 90 Else
    ' 3, = 50
    If Option3 Then T = 50 Else
    ' 4, = 20
    If Option4 Then T = 20
    '
    Static As Long
    = GetCurrentTime
    Do
    ', , .
    If GetCurrentTime - > T Then
    '
    Call PatBlt(DC, 0, 0, _, _, &H42)
    ' DC
    _
    ' DC
    _
    '
    _
    ' .
    Call BitBlt(Me.hdc, 0, 0, _, _, DC, 0, 0, &HCC0020)
    '
    = GetCurrentTime
    End If
    DoEvents
    Loop
    End Sub

    '
    Sub _()
    ' X
    (0).X = _ / 2
    ' X
    (0).Y = _ / 2
    For K = 0 To _ - 1
    ' .
    (K + 1).X = (K).X
    (K + 1).Y = (K).Y
    Next
    End Sub

    '
    Sub _()
    ' FillRect, &HFF00&
    DRAW_PARAM = CreatePen(0, 3, &HFFFF&)
    ' + .
    If GetAsyncKeyState(37) Then If _ <> 2 Then _ = 0
    If GetAsyncKeyState(39) Then If _ <> 0 Then _ = 2
    If GetAsyncKeyState(38) Then If _ <> 3 Then _ = 1
    If GetAsyncKeyState(40) Then If _ <> 1 Then _ = 3
    ' - , .
    If _ > UBound() Then _ = UBound()
    ' _
    Select Case _
    Case 0
    (0).X = (0).X - _
    Case 1
    (0).Y = (0).Y - _
    Case 2
    (0).X = (0).X + _
    Case 3
    (0).Y = (0).Y + _
    End Select
    ' , .
    For K = _ To 1 Step -1
    ' .
    If (0).X = (K).X And (0).Y = (K).Y Then
    '
    _
    Exit Sub
    End If
    ' , .
    (K).X = (K - 1).X
    (K).Y = (K - 1).Y
    ' . . DC
    Call DRAW_BLOCK((K).X, (K).Y)
    Next
    ' .
    If (0).X < 0 Then __
    If (0).Y < 0 Then __
    If (0).X = _ Then __
    If (0).Y = _ Then __
    End Sub

    ' .
    Sub _()
    ' FillRect, &HFF00&
    DRAW_PARAM = CreatePen(0, 3, &HFF00&)
    '
    If (0).X = .X And (0).Y = .Y Then
    '
    Call _(1)
    '
    . = False
    End If
    If . = False Then
    ' . _.
    '
    .X = Int(Rnd * _ / _) * _
    .Y = Int(Rnd * _ / _) * _
    ' true
    . = True
    End If
    '
    Call DRAW_BLOCK(.X, .Y)
    End Sub

    Sub _()
    ' FillRect, &HFF
    DRAW_PARAM = CreatePen(0, 3, &HFF)
    If (0).X = .X And (0).Y = .Y Then
    ' , .
    Call _(1)
    '
    . = False
    End If
    ' . _.
    If . = False Then
    .X = Int(Rnd * _ / _) * _
    .Y = Int(Rnd * _ / _) * _
    . = True
    End If
    Call DRAW_BLOCK(.X, .Y)
    End Sub

    Sub _(N As Integer)
    ' ,
    For K = _ To _ + N
    (K + 1).X = (K).X
    (K + 1).Y = (K).Y
    Next
    ' N
    _ = _ + N
    ', 50
    If _ = 20 Then
    '

    End If
    End Sub

    Sub _(N As Integer)
    '
    _ = _ - N
    ', = 0,
    If _ = 0 Then
    '

    End If End Sub

    '
    Private Function DRAW_BLOCK(X As Integer, Y As Integer)
    '
    .Left = X + 1
    .top = Y + 1
    .Right = X + _ - 1
    .Bottom = Y + _ - 1
    '
    Call FillRect(DC, , DRAW_PARAM)
    End Function

    Sub ()
    '
    Prompt = " " & Chr(13) & " " & _ * 100 & " "
    Prompt = Prompt & Chr(13) & Chr(10)
    Prompt = Prompt & " ?"
    Title = ""
    = MsgBox(Prompt, vbYesNo, Title)
    If = vbNo Then
    End
    Else
    If = vbYes Then _
    End If
    '
    End
    End Sub

    Sub __()
    '
    Prompt = " " & Chr(13) & " " & _ * 100 & " "
    Prompt = Prompt & Chr(13) & Chr(10)
    Prompt = Prompt & " ?"
    Title = "GAME OWER"
    = MsgBox(Prompt, vbYesNo, Title)
    If = vbNo Then
    End
    Else
    If = vbYes Then _
    End If
    End Sub

    Sub _()
    '
    Prompt = " " & Chr(13) & " " & _ * 100 & " "
    Prompt = Prompt & Chr(13) & Chr(10)
    Prompt = Prompt & " ?"
    Title = "GAME OWER"
    = MsgBox(Prompt, vbYesNo, Title)
    If = vbNo Then
    End
    Else
    If = vbYes Then _
    End If
    '
    ' End
    End Sub

    Sub ()
    '
    Prompt = " = 0" & Chr(13) & " " & _ * 100 & " "
    Prompt = Prompt & Chr(13) & Chr(10)
    Prompt = Prompt & " ?"
    Title = "GAME OWER"
    = MsgBox(Prompt, vbYesNo, Title)
    If = vbNo Then
    End
    Else
    If = vbYes Then _
    End If
    End Sub

    Private Sub Command2_Click()
    '
    End
    End Sub





    © Copyright 2006-2017. . .