کد:
Dim a(512, 512) As Long
Dim b(512, 512) As Long
Dim sum As Long
Dim l(64, 64) As Long
Private Sub dct_Click(Index As Integer)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim pi As Integer
Dim ai As Double
For i = 1 To 512
For j = 1 To 512
a(i, j) = Pic.Point(i, j)
Next j
Next i
For i = 1 To 64
For j = 1 To 64
l(i, j) = Pic1.Point(i, j)
Next j
Next i
sum = 0
pi = 3.14
For i = 1 To 512
For j = 1 To 512
sum = 0
For k = 1 To 512
ai = 1
If k = 0 Then
ai = (1 / Sqr(2))
End If
sum = sum + ai * (Cos(((pi * j) / (2 * 512)) * (2 * k + 1))) * a(i, k)
Next k
sum = sum * Sqr(2 / 512)
b(i, j) = sum
Next j
Next i
sum = 0
For j = 1 To 512
For i = 1 To 512
sum = 0
For k = 1 To 512
ai = 1
If k = 1 Then
ai = (1 / Sqr(2))
End If
sum = sum + ai * (Cos(((pi * i) / (2 * 512)) * (2 * k + 1))) * b(k, j)
Next k
sum = sum * Sqr(2 / 512)
a(i, j) = sum
Next i
Next j
End Sub
Private Sub dctlogo_Click(Index As Integer)
sum = 0
pi = 3.14
For i = 1 To 64
For j = 1 To 64
sum = 0
For k = 1 To 64
ai = 1
If k = 1 Then
ai = (1 / Sqr(2))
End If
sum = sum + ai * (Cos(((pi * j) / (2 * 64)) * (2 * k + 1))) * l(i, k)
Next k
sum = sum * Sqr(2 / 64)
l(i, j) = sum
Next j
Next i
sum = 0
For j = 1 To 64
For i = 1 To 64
sum = 0
For k = 1 To 64
ai = 1
If k = 1 Then
ai = (1 / Sqr(2))
End If
sum = sum + ai * (Cos(((pi * i) / (2 * 512)) * (2 * k + 1))) * l(k, j)
Next k
sum = sum * Sqr(2 / 512)
l(i, j) = sum
Next i
Next j
For i = 1 To 64
For j = 1 To 64
Pic1.PSet (i, j), l(i, j)
Next j
Next i
End Sub
Private Sub Form_Load()
End Sub
Private Sub load1_Click(Index As Integer)
Pic.Picture = LoadPicture("e:\a.bmp")
Pic1.Picture = LoadPicture("e:\l.bmp")
End Sub
Private Sub merg_Click(Index As Integer)
Dim ph As Integer
Dim pl As Integer
pl = UBound(a) / 2 - UBound(l) / 2
ph = UBound(a) / 2 + UBound(l)
For i = pl To ph
For j = pl To ph
a(i, j) = b(i, j) + l(i, j)
Next j
Next i
For i = 1 To 512
For j = 1 To 512
Pic.PSet (i, j), a(i, j)
Next j
Next i
End Sub
Private Sub save1_Click(Index As Integer)
Call SavePicture(Pic, "e:\a1.bmp")
End Sub
Private Sub split_Click(Index As Integer)
Dim ph As Integer
Dim pl As Integer
pl = UBound(a) / 2 - UBound(l) / 2
ph = UBound(a) / 2 + UBound(l)
For i = pl To ph
For j = pl To ph
a(i, j) = b(i, j) - l(i, j)
Next j
Next i
For i = 1 To 512
For j = 1 To 512
Pic.PSet (i, j), a(i, j)
Next j
Next i
End Sub