تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
تطبيق منقول - عمل Drag & Drop
#1
كاتب الموضوع : AhmedEssawy


كود :
'
'Written by Margus Martsepp aka m2s87
'
Dim WithEvents x1 As New TextBox
Dim WithEvents x2 As New Label
Dim WithEvents x3 As New PictureBox
Dim WithEvents x4 As New ListBox

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
With x1 : .Parent = Me : .AllowDrop = True : .Top = 10 : .Visible = True : End With
With x2 : .Parent = Me : .AllowDrop = True : .Top = 35 : .Visible = True _
: .BackColor = Color.WhiteSmoke : End With
With x3 : .Parent = Me : .AllowDrop = True : .Top = 8 : .Left = 110 _
: .BorderStyle = BorderStyle.FixedSingle : .Visible = True : End With
With x4 : .Parent = Me : .AllowDrop = True : .Top = 60 : .Width = 210 : .Visible = True : End With
With Me : .Size = New Size(220, 200) : .Text = "Drag & Drop" : End With
End Sub
'
'The source
'
Private Sub alla(ByVal sender As Object, ByVal e As MouseEventArgs) Handles x1.MouseDown
x1.DoDragDrop(x1.Text, DragDropEffects.Move)
End Sub
'
'Label
'
Private Sub sisse1(ByVal sender As Object, ByVal e As DragEventArgs) Handles x2.DragEnter
If (e.Data.GetDataPresent(DataFormats.Text)) Then
e.Effect = DragDropEffects.Move
End If
End Sub

Private Sub lahti1(ByVal sender As Object, ByVal e As DragEventArgs) Handles x2.DragDrop
x2.Text = e.Data.GetData(DataFormats.Text).ToString
x1.Text = ""
End Sub
'
'Picturebox
'
Private Sub sisse2(ByVal sender As Object, ByVal e As DragEventArgs) Handles x3.DragEnter
If (e.Data.GetDataPresent(DataFormats.Text)) Then
e.Effect = DragDropEffects.Move
End If
End Sub

Private Sub lahti2(ByVal sender As Object, ByVal e As DragEventArgs) Handles x3.DragDrop

Select Case e.Data.GetData(DataFormats.Text).ToString.ToUpper
Case "EESTI", "ESTONIAN"
Dim v() As System.Drawing.Color = {Color.RoyalBlue, Color.Black, Color.WhiteSmoke}
x3.Image = lipp(v, x3.Width, x3.Height)
Case "DEUTSCHLAND", "GERMANY"
Dim v() As System.Drawing.Color = {Color.Black, Color.Red, Color.Yellow}
x3.Image = lipp(v, x3.Width, x3.Height)
Case "LATVIJA", "LATVIA"
Dim v() As System.Drawing.Color = {Color.DarkRed, Color.WhiteSmoke, Color.DarkRed}
x3.Image = lipp(v, x3.Width, x3.Height)
Case "LIETUVA", "LITHUANIA"
Dim v() As System.Drawing.Color = {Color.DarkKhaki, Color.DarkGreen, Color.DarkRed}
x3.Image = lipp(v, x3.Width, x3.Height)
Case "NEDERLAND", "NETHERLANDS"
Dim v() As System.Drawing.Color = {Color.DarkRed, Color.WhiteSmoke, Color.DarkBlue}
x3.Image = lipp(v, x3.Width, x3.Height)
Case "Р�СС�Я", "RUSSIA"
Dim v() As System.Drawing.Color = {Color.White, Color.Blue, Color.Red}
x3.Image = lipp(v, x3.Width, x3.Height)
Case Else : x3.Image = Nothing
End Select

x1.Text = ""
End Sub
'
'Generates the picture
'
Function lipp(ByVal v() As System.Drawing.Color, _
Optional ByVal x As Integer = 200, _
Optional ByVal y As Integer = 100) As Bitmap
Dim flag As New Bitmap(x, y)
Dim z As Integer

For y = 0 To flag.Height - 1
z = IIf(y < Int(flag.Height / 3), 0, IIf(Int(flag.Height / 3) * 2 > y, 1, 2))
For x = 0 To flag.Width - 1
flag.SetPixel(x, y, v(z))
Next x
Next y

Return flag
End Function
'
'Listbox
'
Private Sub sisse3(ByVal sender As Object, ByVal e As DragEventArgs) Handles x4.DragEnter
If (e.Data.GetDataPresent(DataFormats.Text)) Then
e.Effect = DragDropEffects.Move
End If
End Sub

Private Sub lahti3(ByVal sender As Object, ByVal e As DragEventArgs) Handles x4.DragDrop
x4.Items.Add(e.Data.GetData(DataFormats.Text).ToString)
x1.Text = ""
End Sub
}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  كود بسيط لفحص الاتصال بالانترنت + تطبيق على الكود RaggiTech 0 2,460 17-10-12, 09:52 PM
آخر رد: RaggiTech
  تطبيق منقول - لعمل زر update now RaggiTech 0 1,553 17-10-12, 05:08 PM
آخر رد: RaggiTech
  تطبيق منقول - لعبة تيك تاك تو RaggiTech 0 1,705 17-10-12, 05:07 PM
آخر رد: RaggiTech

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم