نمایش تصاویر با افکت)silde show

[seyed_27]

یه مشکلی دارم. چطور میشه تصاویر رو با افکت های زیادی نمایش داد. این امکان در دلفی بدون هیچ اکتیوایکسی هست ولی در وی بی نیست.

[kuh_nur]

سلام این کد 14 افکت مختلف و وزیبا


Private Sub Command1_Click()
Dim barnumber As Integer, barwidth As Integer
Dim i, j As Integer
barwidth = 300
Picture2.Picture = Picture33.Picture
barnumber = Picture1.ScaleWidth / barwidth
On Error Resume Next
For i = 1 To barwidth
For j = 0 To barnumber
Picture2.PaintPicture Picture1.Picture, j * barwidth, 0, i, Picture1.ScaleHeight, j * barwidth, 0, i, Picture1.ScaleHeight, &HCC0029
DoEvents
Next
Next
End Sub

Private Sub Command10_Click()
Dim barwidth, barheight As Integer
Dim i As Single
If Picture1.ScaleWidth > Picture1.ScaleHeight Then
barwidth = Picture1.ScaleWidth - Picture1.ScaleHeight
barheight = 1
ElseIf Picture1.ScaleWidth < Picture1.ScaleHeight Then
barwidth = 1
barheight = Picture1.ScaleHeight - Picture1.ScaleWidth
Else
barwidth = 1: barheight = 1
End If
On Error Resume Next
For i = 1 To Picture1.ScaleWidth - barwidth
Picture2.PaintPicture Picture1.Picture, Int((Picture1.ScaleWidth - barwidth) / 2), Int((Picture1.ScaleHeight - barheight) / 2), barwidth, barheight, Int((Picture1.ScaleWidth - barwidth) / 2), barwidth, barheight, &HCC0020
barwidth = barwidth + 1: barheight = barheight + 1
DoEvents
Next
End Sub

Private Sub Command11_Click()
Dim barwidth As Integer, barheight As Integer
Dim i As Integer
Picture2.Picture = Picture33.Picture
barwidth = 1: barheight = Picture1.ScaleHeight
On Error Resume Next
For i = 1 To Picture1.ScaleWidth / 2
Picture2.PaintPicture Picture1.Picture, (Picture1.ScaleWidth - barwidth) / 2, 0, barwidth, barheight, (Picture1.ScaleWidth - barwidth) / 2, 0, barwidth, barheight, &HCC0020
barwidth = barwidth + 4
DoEvents
Next
End Sub


Private Sub Command12_Click()
Dim barnumber As Integer, barwidth, barheight As Integer
Dim i, j As Integer
barwidth = 300
barheigth = 300
Picture2.Picture = Picture33.Picture
barnumber = Picture1.ScaleWidth / barwidth
On Error Resume Next
For i = 1 To barwidth / 2 Step 3
For j = 0 To barnumber
Picture2.PaintPicture Picture1.Picture, j * barwidth, 0, i, Picture1.ScaleHeight, j * barwidth, 0, i, Picture1.ScaleHeight, &HCC0029
DoEvents
Next
Next
For i = 1 To barheigth Step 11
For j = 0 To barnumber
Picture2.PaintPicture Picture1.Picture, 0, j * barheigth, Picture1.ScaleWidth, i, 0, j * barheigth, Picture1.ScaleWidth, i, &HCC0020
DoEvents
Next
Next

End Sub

Private Sub Command13_Click()
Dim barnumber As Integer, barwidth, barheight As Integer
Dim i, j As Integer
barwidth = 300
barheigth = 300
On Error Resume Next
Picture2.Picture = Picture33.Picture
For i = 1 To Picture1.ScaleWidth Step 12
Picture2.PaintPicture Picture1.Picture, 0, 0, i, Picture1.ScaleHeight, 0, 0, i, Picture1.ScaleHeight, &HCC0020
Picture2.PaintPicture Picture1.Picture, 0, j * barheigth, Picture1.ScaleWidth, i, 0, j * barheigth, Picture1.ScaleWidth, i, &HCC0020
DoEvents
Next

End Sub

Private Sub Command15_Click()
Dim barnumber As Integer, barheigth As Integer
Dim i, j As Integer
barheigth = 300
Picture2.Picture = Picture33.Picture
barnumber = Picture1.ScaleHeight / barheigth
On Error Resume Next
For i = 1 To barheigth
For j = 0 To barnumber
Picture2.PaintPicture Picture1.Picture, 0, j * barheigth, Picture1.ScaleWidth, i, 0, j * barheigth, Picture1.ScaleWidth, i, &HCC0020
DoEvents
Next
Next

End Sub

Private Sub Command2_Click()
Dim barnumber As Integer, barheigth As Integer
Dim i, j As Integer
barheigth = 300
Picture2.Picture = Picture33.Picture
barnumber = Picture1.ScaleHeight / barheigth
On Error Resume Next
For i = 1 To barheigth
For j = 0 To barnumber
Picture2.PaintPicture Picture1.Picture, 0, j * barheigth, Picture1.ScaleWidth, i, 0, j * barheigth, Picture1.ScaleWidth, i, &HCC0020
DoEvents
Next
Next
End Sub

Private Sub Command3_Click()
Dim i As Single
On Error Resume Next
For i = 1 To Picture1.ScaleWidth Step 12
Picture2.PaintPicture Picture1.Picture, 0, 0, i, Picture1.ScaleHeight, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, &HCC0020
Next
End Sub

Private Sub Command4_Click()
Dim i As Single
On Error Resume Next
Picture2.Picture = Picture33.Picture
For i = 1 To Picture1.ScaleWidth Step 12
Picture2.PaintPicture Picture1.Picture, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, 0, 0, i, Picture1.ScaleHeight, &HCC0020
DoEvents
Next
End Sub

Private Sub Command5_Click()
Dim i As Single
On Error Resume Next
Picture2.Picture = Picture33.Picture
For i = 1 To Picture1.ScaleWidth Step 12
Picture2.PaintPicture Picture1.Picture, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, 0, 0, Picture1.ScaleWidth, i, &HCC0020
DoEvents
Next
End Sub

Private Sub Command6_Click()
Dim i As Single
On Error Resume Next
Picture2.Picture = Picture33.Picture
For i = 1 To Picture1.ScaleWidth Step 12
Picture2.PaintPicture Picture1.Picture, 0, 0, Picture1.ScaleWidth, i, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, &HCC0020
DoEvents
Next
End Sub

Private Sub Command7_Click()
Dim i As Single
On Error Resume Next
Picture2.Picture = Picture33.Picture
For i = 1 To Picture1.ScaleWidth Step 12
Picture2.PaintPicture Picture1.Picture, 0, 0, i, Picture1.ScaleHeight, 0, 0, i, Picture1.ScaleHeight, &HCC0020
DoEvents
Next
End Sub

Private Sub Command8_Click()
Dim barwidth, barheight As Integer
Dim i As Integer

barwidth = Picture1.ScaleWidth
barheight = 1
On Error Resume Next
For i = 1 To Picture1.ScaleHeight / 2
Picture2.PaintPicture pictrue1.Picture, 0, (Picture1.ScaleHeight - barheight) / 2, barwidth, barheight, 0, (Picture1.ScaleHeight - barheight) / 2, barwidth, barheight, &HCC0020
barheight = barheight + 4
DoEvents
Next
End Sub

Private Sub Command9_Click()
Dim i As Single
On Error Resume Next
Picture2.Picture = Picture33.Picture
For i = 1 To Picture1.ScaleWidth Step 12
Picture2.PaintPicture Picture1.Picture, Picture1.ScaleWidth - i, 0, i, Picture1.ScaleHeight, Picture1.ScaleWidth - i, 0, i, Picture1.ScaleHeight, &HCC0020
DoEvents
Next
End Sub