.:: ترفنــــــدهای خفن،آموزش و غیره ::.

کنترلهای لازم در برنامه :

1-         دو فرم به اندازه ی دلخواه

               در فرم اولی :

                                    الف) دو Picture Box   به نامهای B1   و  B2  

                                    ب)   چهار تا دکمه به نامهای Command1   تا  Command4

                                    ج)    دو تا از کنترل از CommonDialog   به نامهای  CDOB1  و CDOB2

                 بعد هم کد زیر را کپی کن :

   Dim Digit

Dim P1r, P1g, P1b

Dim P2r, P2g, P2b

Dim dP1r, dP1g, dP1b

Dim dP2r, dP2g, dP2b

Dim tP1r, tP1g, tP1b

Dim tP2r, tP2g, tP2b

Sub PaP(p1 As PictureBox, p2 As PictureBox, w As Long, H As Long, C As Long, DDD)

    Dim X, Y, a, AP, DD1, DD2

    D = 10  ' for decimal digit in percentile part. d= 1 or 10 or 100

    For X = 0 To w - 100 Step C  ' StepbyStep for PixelComparable of both picture

        For Y = 0 To H - 100 Step C

            P1r = p1.Point(X, Y) And 255

            P1g = (p1.Point(X, Y) \ 256) And 255

            P1b = (p1.Point(X, Y) \ 65536) And 255

            P2r = p2.Point(X, Y) And 255

            P2g = (p2.Point(X, Y) \ 256) And 255

            P2b = (p2.Point(X, Y) \ 65536) And 255

            'limit register(-80 To 80)

            dP1r = P1r - 80 'dp1r-> d=down , p1=picture1 , r=red

            dP1g = P1g - 80

            dP1b = P1b - 80

            dP2r = P2r - 80

            dP2g = P2g - 80

            dP2b = P2b - 80

            tP1r = P1r + 80 'tp1r-> t=top , p1=picture1 , r= red

            tP1g = P1g + 80

            tP1b = P1b + 80

            tP2r = P2r + 80

            tP2g = P2g + 80

            tP2b = P2b + 80

            If P1r <= tP2r And P1r >= dP2r And P1g <= tP2g And P1g >= dP2g And P1b <= tP2b And P1b >= dP2b Or P2r <= tP1r And P2r >= dP1r And P2g <= tP1g And P2g >= dP1g And P2b <= tP1b And P2b >= dP1b Then AP = AP + 1    ' if picture1 pointcolor ~ picture2 pointcolor |>counter=++1

                a = a + 1  ' a=programme counter

        Next

    Next

    DD1 = (AP * 100) \ a 'percentile

    DD2 = Right$((AP * (100 * D)) \ a, Len(D) - 1) 'decimal part

    DDD = DD1 & "." & DD2 & "%" ' wrought percent

End Sub

Private Sub B1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Form2.Wedit.Caption = "Picture1"

    ' register commands posation

    Command2.Left = B1.Left + 100

    Command3.Left = Command2.Left + Command3.Width

    Command4.Left = Command3.Left + Command4.Width

End Sub

Private Sub B2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Form2.Wedit.Caption = "Picture2"

    ' register commands posation

    Command2.Left = B2.Left + 100

    Command3.Left = Command2.Left + Command3.Width

    Command4.Left = Command3.Left + Command4.Width

End Sub

Private Sub Command1_Click()

    MousePointer = 13

    PaP B1, B2, B1.Width - 50, B2.Height - 50, 15, Digit

    MsgBox "Similarity between two photos = " & Digit

    MousePointer = 0

End Sub

Private Sub Command2_Click()

    ' Select your picture and move to mainbox(Picturebox)

    If Form2.Wedit.Caption = "Picture1" Then ' for show your selected picture in other form

        On Error GoTo er: ' for skip from error massages

        CDOB1.ShowOpen

    If Not LoadPicture(CDOB1.FileName) = 0 Then ' only Load  real picture

        B1.Picture = LoadPicture(CDOB1.FileName)

    End If

er:

    End If

    If Form2.Wedit.Caption = "Picture2" Then

        On Error GoTo er2:

        CDOB2.ShowOpen

    If Not LoadPicture(CDOB2.FileName) = 0 Then

        B2.Picture = LoadPicture(CDOB2.FileName)

    End If

er2:

    End If

End Sub

Private Sub Command3_Click()

    'For edit your picture and save it in mainbox

    Form2.sh.Visible = False ' for turn off select tools

    Form2.PSelect.Visible = False

    Form2.Show ' Show PictureEdit form

    If Form2.Wedit.Caption = "Picture1" Then 'for edit selected picture

        Form2.Pedit.Picture = B1.Picture

    End If

    If Form2.Wedit.Caption = "Picture2" Then

        Form2.Pedit.Picture = B2.Picture

    End If

    Me.Visible = False

End Sub

Private Sub Command4_Click()

    If Form2.Wedit.Caption = "Picture1" Then

        B1.Picture = Me.Picture 'Picture1 = empty

        B1.Picture = Clipboard.GetData

    End If

    If Form2.Wedit.Caption = "Picture2" Then

        B2.Picture = Me.Picture 'Picture2 = empty

        B2.Picture = Clipboard.GetData

    End If

End Sub

Private Sub Form_Load()

MsgBox "WWW.HSN.COO.IR"

End Sub

                در فرم دومی :

                                الف)  یازده دکمه به نامهای Command1   تا  Command11

                           ب)  سه TextBox   به نامهای  Text   و PenSize  و  BrightV

                           ج)  یک   ListBox  به نام List1

                                 د) یک CommonDialog   به نام CDRGB

                                 هـ ) یک Picture Box   به نام TempP

                بعد هم کد زیر را کپی کن :

Dim SX, SY 'SX=StartpointX

Private Sub Command1_Click()

'For pick color

Pedit.MousePointer = 2 '

End Sub

Private Sub Command10_Click()

'For move selected

sh.Left = PSelect.Left

sh.Top = PSelect.Top

sh.Width = PSelect.Width

sh.Height = PSelect.Height

For X = 0 To sh.Width - 10 Step 15

For Y = 0 To sh.Height - 10 Step 15

sh.PSet (X, Y), Pedit.Point(X + sh.Left, Y + sh.Top)

Next

Next

sh.Picture = sh.Image

PSelect.Visible = False

sh.Visible = True

End Sub

Private Sub Command11_Click()

'For Draw text on mainbox

Pedit.MousePointer = 3

End Sub

Private Sub Command2_Click()

'For select color from ColorBox

On Error GoTo er3:

CDRGB.ShowColor

ShowColor.BackColor = CDRGB.Color

er3:

End Sub

Private Sub Command3_Click()

'For Save picture in mainbox and close PictureEdit

If Not sh.Picture = Me.Picture Then

For X = sh.Left To sh.Left + sh.Width - 10 Step 15

For Y = sh.Top To sh.Top + sh.Height - 10 Step 15

Pedit.PSet (X, Y), sh.Point(X - sh.Left, Y - sh.Top)

Next

Next

Pedit.Picture = Pedit.Image 'For view changes

End If

Me.Hide

Form1.Visible = True

If Wedit.Caption = "Picture1" Then

Form1.B1.Picture = Pedit.Image

End If

If Wedit.Caption = "Picture2" Then

Form1.B2.Picture = Pedit.Image

End If

End Sub

Private Sub Command4_Click()

'For drawing on mainbox

Pedit.MousePointer = 10

End Sub

Private Sub Command5_Click()

'For bright selected picture

Dim r, g, b ' r=red , g=green , b= blue

On Error GoTo er4:

MousePointer = 13

For X = 0 To Pedit.Width - 50 Step 15

For Y = 0 To Pedit.Height - 50 Step 15

r = Pedit.Point(X, Y) And 255

g = (Pedit.Point(X, Y) \ 256) And 255

b = (Pedit.Point(X, Y) \ 65536) And 255

Pedit.PSet (X, Y), RGB(r + Val(BrightV.Text), g + Val(BrightV.Text), b + Val(BrightV.Text))

Next

Next

er4:

MousePointer = 0

End Sub

Private Sub Command7_Click()

'For flip horizontal

MousePointer = 13

RFlipH Pedit

MousePointer = 0

End Sub

Private Sub Command8_Click()

'For flip vertical

MousePointer = 13

RFlipV Pedit

MousePointer = 0

End Sub

Private Sub Command9_Click()

'For come selected to top and delete otherparts

TempP.Picture = Pedit.Picture

Pedit.Picture = Me.Picture

For X = 0 To PSelect.Width - 10 Step 15

For Y = 0 To PSelect.Height - 10 Step 15

Pedit.PSet (X, Y), TempP.Point(X + PSelect.Left, Y + PSelect.Top)

Next

Next

Pedit.Picture = Pedit.Image

PSelect.Visible = False

End Sub

Private Sub Form_Load()

  'For change text font

    On Error GoTo erf:

    Dim NUM As Single

    Dim X As Single

    NUM = Screen.FontCount

    For X = 1 To NUM

        List1.AddItem Screen.Fonts(X)

    Next X

    List1.RemoveItem (0)

erf:

End Sub

Private Sub List1_Click()

Pedit.FontName = List1.Text

End Sub

Private Sub Pedit_Click()

If Pedit.MousePointer = 2 Then

Pedit.MousePointer = 0

End If

TempP.Picture = Pedit.Picture

Pedit.Picture = Pedit.Image

End Sub

Private Sub Pedit_DblClick()

sh.Visible = False

End Sub

Private Sub Pedit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Pedit.MousePointer = 3 Then

Pedit.MousePointer = 0

Pedit.PSet (X, Y), Pedit.Point(X, Y)

Pedit.FontSize = Val(PenSize.Text)

Pedit.ForeColor = ShowColor.BackColor

Pedit.Print Text.Text

End If

SX = X

SY = Y

End Sub

Private Sub Pedit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Pedit.MousePointer = 2 Then

ShowColor.BackColor = Pedit.Point(X, Y)

End If

If Pedit.MousePointer = 10 Then

If Button = 1 Then

Pedit.DrawWidth = Val(PenSize.Text)

Pedit.PSet (X, Y), ShowColor.BackColor

End If

End If

   If Pedit.MousePointer = 0 Then

   If sh.Visible = False Then

    If Button = 1 Then

    PSelect.Visible = True

    PSelect.Left = -SX * (X > SX) - _

                  X * (X <= SX)

    PSelect.Top = -SY * (Y > SY) - _

                  Y * (Y <= SY)

    PSelect.Width = Abs(SX - X)

    PSelect.Height = Abs(SY - Y)

    sh.Visible = False

End If

    End If

End If

End Sub

Sub RFlipH(Picture As Object)

 Dim X%, Y%, w&(0 To 7000, 0 To 7000)

 For Y = 0 To Picture.Height - 50 Step 15

  For X = 0 To Picture.Width - 50 Step 15

   w(X, Y) = Picture.Point(X, Y)

  Next

 Next

 For Y = 0 To Picture.Height - 50 Step 15

  For X = Picture.Width - 50 To 0 Step -15

   Picture.PSet (X, Y), w(Picture.Width - 50 - X, Y)

  Next

 Next

End Sub

Sub RFlipV(Picture As Object)

 Dim X%, Y%, w&(0 To 7000, 0 To 7000)

 For Y = 0 To Picture.Height - 50 Step 15

  For X = 0 To Picture.Width - 50 Step 15

   w(X, Y) = Picture.Point(X, Y)

  Next

 Next

 For Y = Picture.Height - 50 To 0 Step -15

  For X = 0 To Picture.Width - 50 Step 15

   Picture.PSet (X, Y), w(X, Picture.Height - 50 - Y)

  Next

 Next

End Sub

Private Sub sh_DblClick()

sh.Visible = False

End Sub

Private Sub sh_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then

sh.Move X / 1.2, Y / 1.2

End If

End Sub

2-        حالا برنامه رو اجرا کن

                                       حال کردی نه!!!

                                        نظر بده تا بهترینشو برات بگم!!!

                                        یادت نره ها فقط نظر نظر نظر نظر . . . . . . . . .  .!!!!!