1. Можно ли создать место за которое можно растягивать форму ??
2. Если 1 можно, то как ограничить ??
3.Может кто нибудь расказать про операции на мышкой например MouseDown, MouseUp и т.д.
4.Как програмно открыть *.mp3 файлы ??
5.Можно ли сдедать поис по имени файла ??
1. Зачем? за края не тянется?
2. If Me.Width>=300 Then Me.Width=300... Что-то вроде этого.
3. Операции или события ???_MouseDown...?
4. Уже было в форуме. В яндекс.
5. Можно, рекурсивно сканируя каталоги...
6. Хотя бы через CommonDialog.ShowFont
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
1. Можно
2. Блоком IF или спец API-функцией
3. Операции над мышкой API mouse_event
4. Open "file.mp3" For Binary As #1
5. Можно
6. Добавить компонент CommanDialog и вызвать ShowFont
2.Private Sub Form_Resize()
If Me.Width >= 900 Then Me.Width = 900
If Me.Height >= 900 Then Me.Height = 900
End Sub
5.Создай на форме label1,text1,dir1,drive1,label2,command1,file1,text2
Dim cDir As String ' путь к папке, в которой будет
' производиться поиск
Dim fileMask As String ' имя или маска для поиска
Dim n As Integer ' количество файлов, удовлетворяющих
Dim fn As String
Dim ln As String
Dim fullPathAndFileName As String
' параметрам поиска
' поиск файла в указанном каталоге и его подкаталогах
' осуществляется при помощи рекурсивной функции find
Function find(dir_path As String)
 im back_path As String ' обратный путь если есть
' подкаталоги
 ir1.Path = dir_path
File1.Path = dir_path
' поиск в текущем каталоге
If File1.ListCount <> 0 Then
' File1.ListCount - количество файлов по адресу
' File1.Path
If Mid(fileMask, 1, 1) = "*" Then
' установка фильтра на список File1, если нужны все
' файлы с определенным расширением или любые файлы,
' и вывод всех найденных файлов в список List1
File1.Pattern = fileMask
For i = 0 To (File1.ListCount - 1) Step 1
n = n + 1
' добавление найденного файла в список List1
' (в список добавляется полный путь к файлу)
If Len(File1.Path) <> 3 Then
Text2.Text = Text2.Text + Chr(13) + Chr(10) + File1.Path + "\" + File1.List(i)
End If
' List1.AddItem File1.Path + File1.List(i) -
' добавление элемента File1.Path + File1.List(i)
' в список List1
Next i
Else
' если нужны файлы с конкретным именем и расширением
For i = 0 To (File1.ListCount - 1) Step 1
If File1.List(i) = fileMask Then
n = n + 1
' добавление найденного файла в список List1
If Len(File1.Path) <> 3 Then
List1.AddItem File1.Path + "\" + _
File1.List(i)
Else: List1.AddItem File1.Path + File1.List(i)
End If
End If
Next i
End If
End If
' заход в подкаталог каталога Dir1.Path осуществляется
' следующим образом:
' Dir1.List(i), где i - номер подкаталога;
' всего подкаталогов - Dir1.ListCount,
' их нумерация идет от 0 до Dir1.ListCount-1
' если есть подкаталоги
If Dir1.ListCount <> 0 Then
back_path = Dir1.Path ' обратный путь
For j = 0 To (Dir1.ListCount - 1) Step 1
 ir1.Path = back_path
Call find(Dir1.List(j))
Next j
End If
If n = 0 Then
Call MsgBox("Файлов, удовлетворяюших параметру " + _
"поиска не найдено.", , "Поиск файла"
End If
Else
Call MsgBox("Нужно ввести параметр поиска.", , _
"Поиск файла"
End If
End Sub
Private Sub Command3_Click()
End Sub
' смена диска
Private Sub Drive1_Change()
' В случае смены диска может возникнуть ошибка (выбор
' дисковода в том случае, если в нем нет диска). Для
' обработки этой ошибки используется переход
' к метке drive_error (смотри ниже).
On Error GoTo drive_error
 ir1.Path = Drive1.Drive + "\"
' обработка ошибок
drive_error:
' если возникла ошибка, то выбирается диск,
' выбранный раньше
 rive1.Drive = Dir1.Path
End Sub
' инициализация формы
Private Sub Form_Initialize()
 rive1.Drive = "c"
File1.Visible = False
On Error GoTo drive_error
 ir1.Path = Drive1.Drive + "\"
' обработка ошибок
drive_error:
' если возникла ошибка, то выбирается диск,
' выбранный раньше
 rive1.Drive = Dir1.Path
If Text1.Text <> "" Then
 ir1.Visible = False
Command1.Enabled = False
If n = 0 Then
Call MsgBox("Файлов, удовлетворяюших параметру " + _
"поиска не найдено.", , "Поиск файла"
End If
Else
Call MsgBox("Нужно ввести параметр поиска.", , _
"Поиск файла"
End If
ln = Text2.Text
Open "c:\win.txt" For Output As #1
Print #1, ln
Close #1
End Sub
' нажатие клавиши в поле ввода имени файла или маски
' для поиска
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1.SetFocus
End Sub
На мой взгляд лучше откривать через какойто проиграватель которий стоит по умолчанию через ShellExecute.
З.Ы Извини но змузикой дя игры ничего не вышло туфта полная стыдно показывать
1) Можно, есть даже примеры, если напрячся можно найти... Все сводится к обычному сабклассингу формы...
2)
*.bas
Option Explicit
Private Const GWL_WNDPROC = -4
Private Const WM_GETMINMAXINFO = &H24
Dim minWidth As Long
Dim minHeight As Long
Dim maxWidth As Long
Dim maxHeight As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Global lpPrevWndProc As Long
Global gHW As Long
Private Declare Function GetModuleFileName Lib "KERNEL32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function DefWindowProc Lib "user32" Alias "efWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Sub CopyMemoryToMinMaxInfo Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub CopyMemoryFromMinMaxInfo Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, ByVal cbCopy As Long)
Public Sub Hook(hWnd As Long, minimumWidth As Long, minimumHeight As Long, Optional maximumWidth As Long = 0, Optional maximumHeight As Long = 0)
If DebugMode = False Then
'Start subclassing.
gHW = hWnd
minWidth = minimumWidth
minHeight = minimumHeight
maxWidth = maximumWidth
maxHeight = maximumHeight
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End If
End Sub
Public Sub Unhook()
Dim temp As Long
If DebugMode = False Then
'Cease subclassing.
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End If
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MinMax As MINMAXINFO
'Check for request for min/max window sizes.
If uMsg = WM_GETMINMAXINFO Then
'Retrieve default MinMax settings
CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax)
'Specify new minimum size for window.
MinMax.ptMinTrackSize.x = minWidth / Screen.TwipsPerPixelX
MinMax.ptMinTrackSize.y = minHeight / Screen.TwipsPerPixelY
If maxWidth <> 0 Then
'Specify new maximum size for window.
MinMax.ptMaxTrackSize.x = maxWidth / Screen.TwipsPerPixelX
MinMax.ptMaxTrackSize.y = maxHeight / Screen.TwipsPerPixelY
End If
'Copy local structure back.
CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax)
WindowProc = DefWindowProc(hw, uMsg, wParam, lParam)
Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End If
End Function
Public Property Get DebugMode() As Boolean
Dim strFileName As String
Dim lngCount As Long
strFileName = String(255, 0)
lngCount = GetModuleFileName(App.hInstance, strFileName, 255)
strFileName = Left(strFileName, lngCount)
If UCase(Right(strFileName, 7)) <> "VB6.EXE" Then
 ebugMode = False
Else
 ebugMode = True
End If
End Property
3) API mouse_event
4) Открыть или проиграть?
Можно использовать MMControlCDPlayer, или API MciSendString
5)
Option Explicit
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Sub InterateObject(Source As String)
Dim objName As String
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Cont = True
hSearch = FindFirstFile(Source & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
objName = Left(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
If Not (objName = "." Or objName = ".." Then
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = 0 Then
List1.AddItem Source & objName
Else
InterateObject Source & objName & "\"
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
End Sub
6)
a) Кинуть на форуму MicrosoftCommodDialog, вызвать метод ShowFonts
b)
Const LF_FACESIZE = 32 'Font Dialog
Private Type LOGFONT 'Font Dialog
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type
Private Type ChooseFont 'Font Dialog
lStructSize As Long
hwndOwner As Long
hdc As Long
lpLogFont As Long
iPointSize As Long
flags As Long
rgbColors As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
hInstance As Long
lpszStyle As String
nFontType As Integer
MISSING_ALIGNMENT As Integer
nSizeMin As Long
nSizeMax As Long
End Type
' extra font constant
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const SCREEN_FONTTYPE = &H2000
Const BOLD_FONTTYPE = &H100
Const FW_BOLD = 700
Const LOGPIXELSY = 90
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As ChooseFont) As Long
' user32 functions
' For Font and Printer Dialog
Private Declare Function GetDC Lib "user32" (ByVal hOwner As Long) As Long
' kernel32 functions
' For Font Dialog
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (p1 As Any, p2 As Any) As Long
Public Sub ShowFont()
Dim CF As ChooseFont
Dim LF As LOGFONT
Dim TempByteArray() As Byte
Dim ByteArrayLimit As Long
Dim OldhDC As Long
Dim FontToUse As Long
Dim tbuf As String * 80
Dim x As Long
Dim uFlag As Long
uFlag = mFlags And (&H1 Or &H2 Or &H3 Or &H4 Or &H100 Or &H200 Or &H400 Or &H800 Or &H1000 Or &H2000 Or &H4000 Or &H8000 Or &H10000 Or &H20000 Or &H40000 Or &H80000 Or &H100000 Or &H200000)
TempByteArray = StrConv(mFontName & vbNullChar, vbFromUnicode)
ByteArrayLimit = UBound(TempByteArray)
With LF
For x = 0 To ByteArrayLimit
.lfFaceName(x) = TempByteArray(x)
Next
.lfHeight = mFontSize / 72 * GetDeviceCaps(GetDC(mhOwner), LOGPIXELSY)
.lfItalic = mItalic * -1
.lfUnderline = mUnderline * -1
.lfStrikeOut = mStrikethru * -1
If mBold Then .lfWeight = FW_BOLD
End With
With CF
.lStructSize = Len(CF)
.hwndOwner = mhOwner
.hdc = GetDC(mhOwner)
.lpLogFont = lstrcpy(LF, LF)
If Not uFlag Then
.flags = cdlCFScreenFonts
Else
.flags = uFlag Or cdlCFWYSIWYG
End If
.flags = .flags Or cdlCFEffects Or CF_INITTOLOGFONTSTRUCT
.rgbColors = mRGBResult
.lCustData = 0
.lpfnHook = 0
.lpTemplateName = 0
.hInstance = 0
.lpszStyle = 0
.nFontType = SCREEN_FONTTYPE
.nSizeMin = 0
.nSizeMax = 0
.iPointSize = mFontSize * 10
End With
RetValue = ChooseFont(CF)
If RetValue = 0 Then
If mCancelError Then Err.Raise (RetValue)
Else
With LF
mItalic = .lfItalic * -1
mUnderline = .lfUnderline * -1
mStrikethru = .lfStrikeOut * -1
End With
With CF
mFontSize = .iPointSize \ 10
mRGBResult = .rgbColors
If .nFontType And BOLD_FONTTYPE Then
mBold = True
Else
mBold = False
End If
End With
FontToUse = CreateFontIndirect(LF)
If FontToUse = 0 Then Exit Sub
OldhDC = SelectObject(CF.hdc, FontToUse)
RetValue = GetTextFace(CF.hdc, 79, tbuf)
mFontName = Mid$(tbuf, 1, RetValue)
End If
End Sub