Откройте свой Мир!

Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long


Private Sub Timer1_Timer()
FlashWindow Me.hwnd, 2
End Sub

Private Const WM_KEYDOWN = &H100

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Sub Command1_Click()
Dim HwndWMP As Long

' Ищем главное окно Винампа
HwndWMP = FindWindow("Winamp v1.x", 0)
If HwndWMP = 0 Then MsgBox "Winamp не запущен!": Exit Sub

' Отправляем окну Винампа сообщения о нажатии клавиш
Call PostMessage(HwndWMP, WM_KEYDOWN, 88, 1) ' Воспроизвести
'Call PostMessage(HwndWMP, WM_KEYDOWN, 86, 1) ' Стоп
'Call PostMessage(HwndWMP, WM_KEYDOWN, 67, 1) ' Пауза
'Call PostMessage(HwndWMP, WM_KEYDOWN, 90, 1) ' Предыдущий трек
'Call PostMessage(HwndWMP, WM_KEYDOWN, 66, 1) ' Следующий трек
'Call PostMessage(HwndWMP, WM_KEYDOWN, 37, 1) ' Промотать назад
'Call PostMessage(HwndWMP, WM_KEYDOWN, 39, 1) ' Промотать вперёд
'Call PostMessage(HwndWMP, WM_KEYDOWN, 40, 1) ' Сделать тише
'Call PostMessage(HwndWMP, WM_KEYDOWN, 38, 1) ' Сделать громче
End Sub

Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long


Private Sub Form_Load()
SetWindowRgn Me.hWnd, 2, True
End Sub

Sub MakeDirPath(dirname As String)
Dim i As Long, path As String
Do
i = InStr(i + 1, dirname & "\", "\")
path = Left$(dirname, i - 1)
If Right$(path, 1) <> ":" And Dir$(path, vbDirectory) = "" Then
MkDir path
End If
Loop Until i >= Len(dirname)
End Sub

Private Sub Command1_Click()
Call MakeDirPath("c:\1\2\3\4\") 'или свой путь
End Sub

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long




Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hwnd, &HA1, 2, 2
End Sub

'Добавте image и туда картинку размером 32x32
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move X - 200, Y - 200
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.Drag vbBeginDrag
End Sub

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Private Sub Command1_Click()
sndPlaySound "C:\windows\media\tada.wav", 1 'можно другой файл
End Sub

Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Dim el As Long



Private Sub Form_Load()
Form1.Height = 5955
Form1.BackColor = &H808080


el = CreateEllipticRgn(100, 300, 300, 100)
el = SetWindowRgn(Me.hWnd, el, True)

End Sub

'Добавте LABEL
Option Explicit
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Const IDC_HAND = 32649&
Private Const IDC_ARROW = 32512&
Private Const IDC_IBEAM = 32513&
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Sub SetHandCur(isHand As Boolean)
If isHand Then
SetCursor LoadCursor(0, IDC_HAND)
Else
SetCursor LoadCursor(0, IDC_ARROW)
End If
End Sub

Private Sub Form_Load()
Label1.Caption = "Мой майл:Romka-9625@mail.ru"
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.ForeColor = vbBlack
Label1.Font.Underline = False
End Sub

Private Sub Label1_Click()
Dim Success&
Success = ShellExecute(Me.hwnd, vbNullString, "mailto:romka-9625@mail.ru", vbNullString, "C:\", SW_SHOWNORMAL) ' можно свой но не уберать слово mailto:

End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
SetHandCur True
End Sub

'Применение:
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.ForeColor = vbBlue
Label1.Font.Underline = True
SetHandCur True
End Sub

Можно конечно пользоваться MDI формами, а можно использовать этот код.

---

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)

Private Sub Command1_Click()
Dim tmp As Long
tmp = GetWindowLong(me.hwnd, GWL_STYLE)
Call SetWindowLong(Picture1.hwnd, GWL_STYLE, tmp)
End Sub

---

Разместите на форме PictureBox и CommandButton

как передавать и принимать данные на USB, с помощью Visual Basic? Подскажите кто знает.

С чего начать?

Может кто сталкивался  с задачей о том как заставить объект shape вращаться вокруг своей оси? Где не искал найти не смог. И возможно ли это вобще?