Парочка вопросов...

[--=GAMER=--]

Вот несколько моих вопросов (позже я добавлю ещё несколько).


1. Как сделать что-бы в текстовом поле вводились только английские буквы

2. Как сделать чат через WinSock без *.тхт файла

3.
а) Можно-ли вкл./выкл. Num, Scroll и Caps lock'и через VB6

б) Можно-ли управлять CD-ROM'ом через VB6


Ответы типа: "Как делать, как делать - РУЧКАМИ!" -
НЕ ПРИНИМАЮТСЯ!

[Tarik]

1. Примерно так:

Код: Выделить всё

Private Sub Text1_Change()
If Len(Text1.Text) = 0 Then Exit Sub
If Asc(Right$(Text1.Text, 1)) < 65 Or Asc(Right$(Text1.Text, 1)) > 122 Then
    Text1.Text = Left$(Text1.Text, Len(Text1.Text) - 1)
    Text1.SelStart = Len(Text1.Text)
End If
End Sub


2. Не совсем понятен вопрос - что значит "без *.тхт файла"?

[--=GAMER=--]

Tarik поясняю:

Я делал так, что, если ты что-то написал, то всё записывалась в *.тхт
(Находящегося в общей папке лок. сети), затем это всё из *.тхт "вставлялось" в текстовое поле человека по ту сторону провода.
Прим. схема:

Отправитель --------> |*.txt|--------> Получатель

[--=GAMER=--]

Чё ни кто не знает?

[--=GAMER=--]

Вот ещё впросик.....

Можно-ли в VB6 файлы из обычных превратить в скрытые или сделать их способными только для чтения

[A.A.Z.]

Код: Выделить всё

Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
'Нужные константы добавляешь во второй параметр вышеобъявленной функции, разделяя Or'ом: SetFileAttributes FileName, Parameter1 Or Parameter2 Or ... Or ParameterN
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20               'архивный
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800           'сжатый
Private Const FILE_ATTRIBUTE_DEVICE As Long = &H40                'устройство
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10             'папка
Private Const FILE_ATTRIBUTE_ENCRYPTED As Long = &H4000           'зашифрованный
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2                 'скрытый
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80                'обычный
Private Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED As Long = &H2000 'не готов для индексирования
Private Const FILE_ATTRIBUTE_OFFLINE As Long = &H1000             'содержимое файла на данный момент недоступно
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1               'только чтение
Private Const FILE_ATTRIBUTE_REPARSE_POINT As Long = &H400
Private Const FILE_ATTRIBUTE_SPARSE_FILE As Long = &H200
Private Const FILE_ATTRIBUTE_SYSTEM As Long = &H4                 'системный
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100            'временный

Private Sub Form_Load()
Open "c:\bla.bla" For Output As #1: Close #1
SetFileAttributes "C:\bla.bla", FILE_ATTRIBUTE_READONLY Or FILE_ATTRIBUTE_HIDDEN 'только что созданному файлу "C:\bla.bla" присваеваем параметры "только чтение" и "скрытый"
End Sub

[--=GAMER=--]

Вопрос к A.A.Z.:
Почему or? Насколько я знаю or переводится как или, а вот and как и!

[GSerg]

Да, переводится именно так... Однако законы алгебры множеств неплохо было бы изучить, а?

[Andrey Fedorov]

1. Как сделать что-бы в текстовом поле вводились только английские буквы

Самое простое - в событии KeyPress обнуляй KeyAscii для символов которые тебе не нужны.

2. Как сделать чат через WinSock без *.тхт файла

Поищи примеры на www.planet-Source-Code.com там полно подобных.
Сам там смотрел когда-то.

3. а) Можно-ли вкл./выкл. Num, Scroll и Caps lock'и через VB6

Можно - через API-шную SetKeyboardState.

б) Можно-ли управлять CD-ROM'ом через VB6

Можно. Самое простое - используюя Nero SDK.
Иначе самому через API-шные дебри придется пробираться.

[--=GAMER=--]

А можно поподробнее, а то я ентом нифига не знаю....

[A.A.Z.]

1) Код позволяет печатать цифры, символы над цифрами на клавиатуре (только черные) и англ. буквы

Код: Выделить всё

Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii > Asc("z") Then Beep: KeyAscii = 0
End Sub

2) Простой чат через WinSock, с комментариями на англ. языке

3) Использование:
TurnOn VK_NUMLOCK - вкл. Num Lock
TurnOn VK_CAPITAL - вкл. Caps Lock
TurnOn VK_SCROLL - вкл. Scroll Lock

TurnOff VK_NUMLOCK - выкл. Num Lock
TurnOff VK_CAPITAL - выкл. Caps Lock
TurnOff VK_SCROLL - выкл. Scroll Lock

Код: Выделить всё

Private Const VK_NUMLOCK = &H90
Private Const VK_CAPITAL = &H14
Private Const VK_SCROLL = &H91

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Dim Num As Boolean, Caps As Boolean, Scroll As Boolean

Sub Form_Load()
Num = GetKeyState(VK_NUMLOCK)
Caps = GeyKeyState(VK_CAPITAL)
Scroll = GetKeyState(VK_SCROLL)
End Sub

Sub TurnOn(ByVal Lock As Long)
Select Case Lock
Case VK_NUMLOCK
If Num Then
Exit Sub
Else
keybd_event VK_NUMLOCK, 0, 0, 0
keybd_event VK_NUMLOCK, 0, 2, 0
Num = True
End If
Case VK_CAPITAL
If Caps Then
Exit Sub
Else
keybd_event VK_CAPITAL, 0, 0, 0
keybd_event VK_CAPITAL, 0, 2, 0
Caps = True
End If
Case VK_SCROLL
If Scroll Then
Exit Sub
Else
keybd_event VK_SCROLL, 0, 0, 0
keybd_event VK_SCROLL, 0, 2, 0
Scroll = True
Case Else
Beep
End Select
End Sub

Sub TurnOff(ByVal Lock As Long)
Select Case Lock
Case VK_NUMLOCK
If Not Num Then
Exit Sub
Else
keybd_event VK_NUMLOCK, 0, 0, 0
keybd_event VK_NUMLOCK, 0, 2, 0
Num = False
End If
Case VK_CAPITAL
If Not Caps Then
Exit Sub
Else
keybd_event VK_CAPITAL, 0, 0, 0
keybd_event VK_CAPITAL, 0, 2, 0
Caps = False
End If
Case VK_SCROLL
If Not Scroll Then
Exit Sub
Else
keybd_event VK_SCROLL, 0, 0, 0
keybd_event VK_SCROLL, 0, 2, 0
Scroll = False
Case Else
Beep
End Select
End Sub

4) Использование:
OpenCD - открыть CD-ROM
CloseCD - закрыть CD-ROM

Код: Выделить всё

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub OpenCD()
mciSendString "set cdaudio door open", 0, 0, 0
End Sub

Private Sub CloseCD()
mciSendString "set cdaudio door closed", 0, 0, 0
End Sub

Вот только почему-то у меня не работает, хотя раньше работало...

[XATTAB]

Есть у меня примерчик с диска к книге.Правда там на английском комментарии

[--=GAMER=--]

Новой вопрос:

а)Как добавить свою программу в список вызываемый правой кнопкой мышки?


б)Как добавить значок своей программы список возле "часов"(правый нижний угол", и возле "Пуска"(левый нижний угол).

На сегодня ВСЁ!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

[sanches]

Новой вопрос:
б)Как добавить значок своей программы список возле "часов"...

no comments ...
Раз, наверное, в 150 спрашивается

[--=GAMER=--]

Нифига! Ни где НЕ ВИДЕЛ!

[A.A.Z.]

Как сказал Ducis, об этом не спрашивал только ленивый!
Значит, так: пример от GoGosh'ы: создай меню с помощью Menu Editor'а с несколькими подпунктами; имя у самого первого меню (не у подпункта!) должно быть Menu.

Код: Выделить всё

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd 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 Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_NULL = &H0

Private Type NOTIFYICONDATA
    cbSize           As Long
    hWnd             As Long
    uID              As Long
    uFlags           As Long
    uCallbackMessage As Long
    hIcon            As Long
    szTip            As String * 64
End Type

Private NID As NOTIFYICONDATA

Private m_hWnd          As Long
Private m_Icon          As Long
Private m_ToolTipText   As String

Public Enum TrayIcon_Mouse
    TRAYICON_MOUSE_NONE = 0
    TRAYICON_MOUSE_LEFTDOWN = 1
    TRAYICON_MOUSE_LEFTUP = 2
    TRAYICON_MOUSE_LEFTDBLCLICK = 3
    TRAYICON_MOUSE_RIGHTDOWN = 4
    TRAYICON_MOUSE_RIGHTUP = 5
    TRAYICON_MOUSE_RIGHTDBLCLICK = 6
End Enum

Public Sub Add(hWnd As Long, Icon As Long, Tip As String)
    Dim ret As Long
     
    NID.uID = hWnd
    NID.hWnd = hWnd
    NID.hIcon = Icon
    NID.szTip = Left(Tip, 63) & Chr(0)
    NID.uFlags = NIF_TIP + NIF_MESSAGE + NIF_ICON
    NID.uCallbackMessage = WM_RBUTTONDOWN
    NID.cbSize = Len(NID)

    ret = Shell_NotifyIcon(NIM_ADD, NID)
End Sub

Public Sub Delete(hWnd As Long)
    Dim ret As Long
     
    NID.uID = hWnd
    NID.hWnd = hWnd
    NID.cbSize = Len(NID)

    ret = Shell_NotifyIcon(NIM_DELETE, NID)
End Sub

Private Sub Form_Load()
    Add Me.hWnd, Me.Icon, "МЕНЮ!!!"
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Y = 0 And X = 7740 Then
'щелчок правой клавишей мыши
PopupMenu Menu
ElseIf Y = 0 And X = 7695 Then
'щелчок левой клавишей мыши
PopupMenu Menu
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Delete Me.hWnd
End Sub