Option Explicit


'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Fun??o para gerar n?meros aleat?rios com distgribui??o normal entre - DP e + DP


Function rnorm(mean As Single, std As Single) As Double


    Dim U1 As Double, U2 As Double
    Dim Pi As Double
        
        Pi = 4 * Atn(1)
        
        U1 = Rnd
        U2 = Rnd
    
        rnorm = mean + (Sqr(-2 * (Log(U1))) * Cos(2 * Pi * U2) * std)
End Function
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX



Sub MID_1D()
    
    Dim i As Integer, j As Integer
    
    Dim points() As Variant
    Dim power As Integer
    Dim width As Integer, height As Integer, roughness As Single, displace As Single

    Dim r As Range

    Dim initial As Single
    
    
    Set r = Range("a1")
    
    Randomize
    
    width = r(4, 2)
    height = r.Cells(5, 2)
    roughness = r.Cells(6, 2)
    displace = r.Cells(7, 2)
    
       
        
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    power = 2 ^ (Log(width) / Log(2))
     
    ReDim points(power)
    
    Set r = Range("a10")
       
    points(0) = WorksheetFunction.Max(height * initial + (rnorm(0, 1) * displace * 2) - displace, 0)
   
    points(0) = r(256, 1)
    
    r.Cells(1, 1) = points(0)
    
    points(power) = WorksheetFunction.Max(height * initial + (rnorm(0, 1) * displace * 2) - displace, 0)

    r.Cells(power + 1, 1) = points(power)
 
    displace = displace * roughness
     
 
    i = 1
    Do
        j = (power / i) / 2
        Do
 
            points(j) = ((points(j - (power / i) / 2) + points(j + (power / i) / 2)) / 2)
 
            points(j) = WorksheetFunction.Max(points(j) + (rnorm(0, 1) * displace * 2) - displace, 0)
            
            r.Cells(j + 1, 1) = points(j)
            j = j + power / i
        '}
        Loop While j < power
        
        displace = displace * roughness
        i = i * 2
    Loop While i < power

    
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate
    Application.ScreenUpdating = True
    
End Sub




Sub prepara()

    Columns("A:IX").Select
    Selection.ColumnWidth = 0.2
    Rows("1:257").Select
    Selection.RowHeight = 2
    Selection.Clear
    Range(Cells(1, 1), Cells(256, 258)).Interior.Color = RGB(250, 250, 250)
    Range("a1").Select


End Sub






Sub MID_3D()   ' para fazer 3D
    
    Dim points() As Single
    Dim power As Integer
    Dim width As Integer, height As Single, roughness As Single, displace As Single
    Dim i As Integer, j As Integer, k As Integer
    Dim passo As Integer
    Dim r As Range, s As Range, o As Range
    Dim normal As Boolean
    Dim initial As Single
    Dim folga As Single    'define o m?ltiplo do DP da distribui??o normal   2/foga ser? o dp
    Dim Colmax As Double
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    
    
    Set r = Range("IZ260")
    
    
    Randomize
    width = r.Cells(1, 1)
    height = r.Cells(2, 1)
    roughness = r.Cells(3, 1)
    displace = r.Cells(4, 1)
    initial = 0.5
    
    folga = 6
    
    normal = True
    
    power = 2 ^ (Log(width) / Log(2))
    ReDim points(power, power)
    
    
        
    'coloca os quatro cantos
    'initial = Rnd
    
    points(0, 0) = height * initial + (rnorm(0, 1) * displace * 2) - displace
    points(0, power) = height * initial + (rnorm(0, 1) * displace * 2) - displace
    points(power, 0) = height * initial + (rnorm(0, 1) * displace * 2) - displace
    points(power, power) = height * initial + (rnorm(0, 1) * displace * 2) - displace
    
    points(0, 0) = WorksheetFunction.Max(points(0, 0), 0)
    points(0, power) = WorksheetFunction.Max(points(0, power), 0)
    points(power, 0) = WorksheetFunction.Max(points(power, 0), 0)
    points(power, power) = WorksheetFunction.Max(points(power, power), 0)
    
    ' coloca a ?ltima coluna (power)
    displace = displace * roughness
    i = 1
    Do
        passo = (power / i) / 2
        j = passo
        Do
            points(j, power) = ((points(j - passo, power) + points(j + passo, power)) / 2)
            points(j, power) = points(j, power) + (rnorm(0, 1) * displace * 2) - displace
            points(j, power) = WorksheetFunction.Max(points(j, power), 0)
            j = j + power / i
        Loop While j < power
        displace = displace * roughness
        i = i * 2
    Loop While i < power

    displace = r.Cells(4, 1) * roughness
    ' coloca a ?ltima linha (power)
    
    i = 1
    Do
        passo = (power / i) / 2
        j = passo
        Do
            points(power, j) = ((points(power, j - passo) + points(power, j + passo)) / 2)
            points(power, j) = points(power, j) + (rnorm(0, 1) * displace * 2) - displace
            points(power, j) = WorksheetFunction.Max(points(power, j), 0)
            j = j + power / i
        Loop While j < power
        displace = displace * roughness
        i = i * 2
    Loop While i < power
    
    displace = r.Cells(4, 1) * roughness
    
    'faz o mei?o
    i = 1
    Do
        passo = (power / i) / 2
        k = passo
        Do
            j = passo
            Do
                points(k, j) = ((points(k - passo, j - passo) + points(k - passo, j + passo)) / 4) + _
                               ((points(k + passo, j - passo) + points(k + passo, j + passo)) / 4)
                points(k, j) = points(k, j) + (rnorm(0, 1) * displace * 2) - displace
                points(k, j) = WorksheetFunction.Max(points(k, j), 0)
                
                points(k - passo, j) = ((points(k - passo, j - passo) + points(k - passo, j + passo)) / 4) + _
                               ((points(k, j)) / 2)
                points(k - passo, j) = points(k - passo, j) + (rnorm(0, 1) * displace * 2) - displace
                points(k - passo, j) = WorksheetFunction.Max(points(k - passo, j), 0)
                
                points(k, j - passo) = ((points(k - passo, j - passo) + points(k + passo, j - passo)) / 4) + _
                               ((points(k, j)) / 2)
                points(k, j - passo) = points(k, j - passo) + (rnorm(0, 1) * displace * 2) - displace
                points(k, j - passo) = WorksheetFunction.Max(points(k, j - passo), 0)

                j = j + power / i
            Loop While j < power
            
            k = k + power / i
        Loop While k < power
        
        displace = displace * roughness
        i = i * 2
    Loop While i < power

    For i = 1 To power
        For j = 1 To power
            If Colmax < points(i, j) Then Colmax = points(i, j)
        Next j
    Next i
    
    Set r = Range("A1")
    For i = 1 To power
        For j = 1 To power
            r.Cells(i, j) = points(i, j)
        'r.Cells(i, j).Interior.Color = RGB(0, 0, Int(255 / Colmax * points(i, j)))
        Next j
    Next i

    

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Application.Calculate

End Sub