سورس برنامه نویسی ، آموزش ، قالب وردپرس ، اسکریپت ، گرافیک ، آموزش کاربردی، دانلود رایگان ، قالب

تبليغات شما در داده باران
تبلیغات در داده باران

مجموعه سورس کدهای ویژوالبیسیک ۶ قسمت ۱۴

مجموعه سورس کدهای ویژوالبیسیک ۶ قسمت ۱۴Reviewed by داده باران on Oct 2Rating:

جهت مطالعه و دسترسی به سورس ها به ادامه مطلب مراجعه نمائید

افکت روی عکس

خب ببینم امروز چی داریم یه برنامه برای ایجاد افکت روی عکس یعنی وقتی یه عکس داره تبدیل می شه به عکس دومی به شکل
زیبایی محو بشه.خب برای هر چیز قشنگی باید زحمت کشید
پس با جدیت شروع کنید تو کادر عکسPictureبه فرم اضافه کنید سپس
خاصیتAutoReDrawعکس اولیه روTrueودومیه رو Falseکنید تا تصویر بعد از طراحی باقی بمونه
ویک دکمه که باید بازدن اون افکت اجرا بشه.یه ماژول اضافه کنید و کد زیر رو براش بنویسید
دو تا عکس به سلیقه خودتون داخل کادر عکس ها بندازید سعی کنید هم اندازه باشند

در خط اول کد های فرم کد های زیر رو بنویسید

Option Explicit
Dim hBrush As Variant
Dim PixelSetSequence(64) As Integer
Dim DissolveStep As Long
Const NumberOfSteps = 8′————————————–
Private Function CreateDissolveBrush(DissolveStep As Long) As Long
Dim hCompBitmap As Long
Dim BrushBitmapInfo As BITMAPINFO
Dim Counter As Integer
Dim PixelData As String * 32
Dim Dummy As Long
Dim Row As Integer
Dim Column As Integer
With BrushBitmapInfo.bmiHeader
.biSize = 40
.biWidth = 8
.biHeight = 8
.biPlanes = 1
.biBitCount = 1
.biCompression = 0
.biSizeImage = 0
.biXPelsPerMeter = 0
.biYPelsPerMeter = 0
.biClrUsed = 0
.biClrImportant = 0

End With
‘ Set the color table values for
‘ the brush to black and white.
With BrushBitmapInfo.bmiColors(0)
.rgbBlue = 0
.rgbGreen = 0
.rgbRed = 0
.rgbReserved = 0

End With

With BrushBitmapInfo.bmiColors(1)
.rgbBlue = 255
.rgbGreen = 255
.rgbRed = 255
.rgbReserved = 0
End With

‘ Initialize brush bitmap pixel data to all white.

For Counter = 0 To 7
Mid$(PixelData, Counter * 4 + 1, 1) = Chr$(&HFF)
Next Counter
‘ Set the bits representing the black pixels to 0.

For Counter = 1 To DissolveStep * (64 / NumberOfSteps)
Row = (PixelSetSequence(Counter) – 1) 8
Column = (PixelSetSequence(Counter) – 1) Mod 8
Mid$(PixelData, Row * 4 + 1, 1) = Chr$(Asc(Mid$(PixelData, Row * 4 + 1, 1)) And (Not (2 ^ Column)))

Next Counter

‘ Convert the DIB into a DDB and create the pattern brush.

hCompBitmap = CreateDIBitmap(Disolve1.hDC, BrushBitmapInfo.bmiHeader, CBM_INIT, PixelData, BrushBitmapInfo, DIB_RGB_COLORS)

CreateDissolveBrush = CreatePatternBrush(hCompBitmap)

Dummy = DeleteObject(hCompBitmap)

End Function’————————————————

Private Sub Picture2_Paint()
Dim hRgn As Long
Dim Dummy As Long
Dim hOldBrush As Long
hBrush = CreateDissolveBrush(DissolveStep)
hOldBrush = SelectObject(Picture2.hDC, hBrush)
Dummy = BitBlt(Picture2.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hDC, 0, 0, &HAC0744)
‘Dummy = StretchBlt%(Picture2.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, &HAC0744)
Dummy = SelectObject(Picture2.hDC, hOldBrush)
Dummy = DeleteObject(hBrush)
End Sub’———————————–

Private Sub CreatePixelSetSequence()
Dim Counter As Integer
Dim PixelNumberString As String * 5
Const PixelListFile = 1
Open App.Path & “PixelLst.TXT” For Input As #PixelListFile
For Counter = 1 To 64
Input #PixelListFile, PixelNumberString
PixelSetSequence(Counter) = Val(PixelNumberString)
Next Counter
End Sub’————————

 

حتما بخوانید  دانلود سورس وضعیت فضای موجود درایوها با نمودار

حالا یه تایمر به فرم اضافه کنید و خاصیتIntervalآن را به۵۶وEnabledآن را به Falseتغییر دهید
وبه ترتیب برای دکمه ها کد های زیر را بنویسید

رویداد کلیک دکمه

Command1.Enabled = False
Timer1.Enabled = True

رویداد لواد فرم

 

CreatePixelSetSequence
DissolveStep = 0

 
رویداد کلیک عکس دومی

If DissolveStep < NumberOfSteps Then
DissolveStep = DissolveStep + 1
Picture2_Paint
End If

روداد تایمر کنترل تایمر

If DissolveStep < NumberOfSteps Then
DissolveStep = DissolveStep + 1
Picture2_Paint
Else
Timer1.Enabled = False
End If
End Sub

لينك كوتاه اين مطلب : http://www.dadebaran.ir/?p=609

رمز فايل : DADEBARAN.IR




تبلیغات در داده باران
ارسال دیدگاه

قبل از نوشتن دیدگاه به نکات زیر توجه کنید:
    » نظراتی که با تایپ فارسی نباشند تایید نخواهند شد
    » نظرات تبلیغاتی اسپم محسوب میشوند و IP شخص مسدود خواهد شد.

پاسخ دهید

نکته: نظر شما در انتظار بررسی است و پس از تایید مدیریت در سایت نمایش داده میشود..