Новый выпуск...
Читайте!

Книги

		Переход на VB .NET. Стратегии, концепции, код (цена ~ 158 руб.) Эта книга была задумана как одна из первых книг о.NET, которая ознакомит читателя с основными идеями новой архитектуры и подготовит его к знакомству с более детальной литературой, например документацией Microsoft и ее толкованиями, которая неизбежно появится на рынке. Она поможет вам взглянуть на эту технологию с позиций ваших собственных рабочих планов и быстро освоить те концепции, которые покажутся необычными для большинства прогр...
		Автор(ы): Дан Эпплман, Издательство: Питер, 2002 г.
		Программирование на VB.NET. Учебный курс (цена ~ 119 руб.) Эта книга является вводным курсом по изучению языка программирования Visual Basic .NET. Даны основные принципы объектно-ориентированного программирования в контексте языка VB .NET, поскольку без хорошей подготовки в этой области невозможно в полной мере пользоваться всеми преимуществами VB .NET. Изложены азы всех аспектов языка, которыми должен владеть любой профессиональный разработчик VB .NET
		Автор(ы): Г. Корнелл, Дж. Моррисон, Издательство: Питер, 2002 г.
		VB.NET для разработчиков (цена ~ 125 руб.) Основная задача книги - быстро ознакомить разработчиков Visual Basic с изменениями в .NET Framework. Программисты, использующие Java, C++, Delphi или другие инструменты разработки приложений и интересующиеся Visual Basic или технологией .NET Framework, также найдут эту книгу полезной. Хотя книга посвящена Visual Basic.NET, ее основная цель - продемонстрировать взаимодействие Visual Basic и ...
		Автор(ы): Кит Франклин, Издательство: Вильямс, 2002 г.

Остальные книги о VB можно найти здесь.

наверх

---

Определить, использует ли компьютер большие или маленькие шрифты

Данный пример покажет, какой размер шрифта установлен в настройках экрана. Данные опции устанавливаются через Панель Управления - Свойства Экрана - вкладка Настройка - кнопка Дополнительно - РазмерШрифта.

Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Const MM_TEXT = 1
Private Type TEXTMETRIC
tmHeight As Integer
tmAscent As Integer
tmDescent As Integer
tmInternalLeading As Integer
tmExternalLeading As Integer
tmAveCharWidth As Integer
tmMaxCharWidth As Integer
tmWeight As Integer
tmItalic As String * 1
tmUnderlined As String * 1
tmStruckOut As String * 1
tmFirstChar As String * 1
tmLastChar As String * 1
tmDefaultChar As String * 1
tmBreakChar As String * 1
tmPitchAndFamily As String * 1
tmCharSet As String * 1
tmOverhang As Integer
tmDigitizedAspectX As Integer
tmDigitizedAspectY As Integer
End Type

Public Function SmallFonts() As Boolean
Dim hdc As Long
Dim hwnd As Long
Dim PrevMapMode As Long
Dim tm As TEXTMETRIC
SmallFonts = True
hwnd = GetDesktopWindow()
hdc = GetWindowDC(hwnd)
If hdc Then
PrevMapMode = SetMapMode(hdc, MM_TEXT)
GetTextMetrics hdc, tm
PrevMapMode = SetMapMode(hdc, PrevMapMode)
ReleaseDC hwnd, hdc
If tm.tmHeight > 16 Then SmallFonts = False
End If
End Function

Private Sub Form_Load()
'В случае маленького фрифта вы получите сообщение "TRUE", иначе получите сообщение "FALSE".
MsgBox SmallFonts
End Sub

наверх

---

Получить имя шрифта заголовка активного окна

Private Const LF_FACESIZE = 32
Private Const SPI_GETNONCLIENTMETRICS = 41
Private Type LOGFONT
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(1 To LF_FACESIZE) As Byte
End Type
Private Type NONCLIENTMETRICS
cbSize As Long
iBorderWidth As Long
iScrollWidth As Long
iScrollHeight As Long
iCaptionWidth As Long
iCaptionHeight As Long
lfCaptionFont As LOGFONT
iSMCaptionWidth As Long
iSMCaptionHeight As Long
lfSMCaptionFont As LOGFONT
iMenuWidth As Long
iMenuHeight As Long
lfMenuFont As LOGFONT
lfStatusFont As LOGFONT
lfMessageFont As LOGFONT
End Type
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Function ActiveTitleBarFontName()
Dim s As String
Dim i As Byte
Dim ncm As NONCLIENTMETRICS
Dim sdfont As StdFont
ncm.cbSize = Len(ncm)
If SystemParametersInfo(41, ncm.cbSize, ncm, 0) Then
s = StrConv(ncm.lfCaptionFont.lfFaceName, vbUnicode)
i = InStr(s, vbNullChar)
If i > 0 Then s = Left(s, i - 1)
End If
ActiveTitleBarFontName = s
End Function

Private Sub Form_Load()
MsgBox ActiveTitleBarFontName
End Sub

наверх

---

Как узнать значения кодовых таблиц

Как известно, Windows использует в своей работе две кодовые таблицы, которые мы обычно называем DOS и Windows, но формально они именуются OEM и ANSI. Довольно многие функции обработки строковых переменных зависят от значения кодовых таблиц, установленных при инсталляции системы, которые можно определить с помощью функций API:

Private Declare Function GetACP Lib "kernel32" () As Long
Private Declare Function GetOEMCP Lib "kernel32" () As Long
Private Sub Form_Load()
MsgBox "ACP = " & GetACP & vbCrLf & "OEMCP = " & GetOEMCP
End Sub

В принципе значения кодовых таблиц можно менять уже после инсталляции Windows. Мы не советуем злоупотреблять этим, но такая коррекция может быть полезной при тестировании и анализе работы программ. Параметры ACP и OEMCP хранятся в разделе HKEY_Local_Machine/System/CurrentControlSet/Control/Nls/Codepage файла Реестра и редактируются с помощью утилиты REGEDIT.EXE. Для их активизации нужно перезагрузить Windows.

Номера таблиц, которые могут понадобиться:

OEMCP = 866 (Russian), 437 (US — default), 850 (International), 855 (Cyrilic)
ACP = 1250 (Eastern European), 1251 (Cyrilic & Russian), 1252 (US & Western European), 1200 (Unicode)

© 1999, Андрей Колесов, Ольга Павлова

'КОД ФОРМЫ

Private Sub Command1_Click()
MsgBox GetFileDescription("c:\win\system\shell32.dll")
'MsgBox GetFileDescription(Text1.Text)
End Sub


'КОД МОДУЛЯ

Option Explicit
Private Declare Function GetLocaleInfoA Lib "kernel32.dll" (ByVal lLCID As Long, ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As Long) As Long
Private Declare Sub lstrcpyn Lib "kernel32.dll" (ByVal strDest As String, ByVal strSrc As Any, ByVal lBytes As Long)
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As Long, ByVal lpSize As Long, ByVal lpBuf As Long) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, lpBufPtr As Long, lLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long

Public Function StringFromBuffer(buffer As String) As String
Dim nPos As Long
nPos = InStr(buffer, vbNullChar)
If nPos > 0 Then
StringFromBuffer = Left$(buffer, nPos - 1)
Else
StringFromBuffer = buffer
End If
End Function

Public Function GetFileDescription(ByVal sFile As String) As String
Dim lVerSize As Long
Dim lTemp As Long
Dim lRet As Long
Dim bInfo() As Byte
Dim lpBuffer As Long
Dim sDesc As String
Dim sKEY As String
lVerSize = GetFileVersionInfoSize(sFile, lTemp)
ReDim bInfo(lVerSize)
If lVerSize > 0 Then
lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VarPtr(bInfo(0)))
If lRet <> 0 Then
sKEY = GetNLSKey(bInfo)
lRet = VerQueryValue(VarPtr(bInfo(0)), sKEY & "\FileDescription", lpBuffer, lVerSize)
If lRet <> 0 Then
sDesc = Space$(lVerSize)
lstrcpyn sDesc, lpBuffer, lVerSize
GetFileDescription = StringFromBuffer(sDesc)
End If
End If
End If
End Function

Public Function GetNLSKey(byteVerData() As Byte) As String
Static strLANGCP As String
Dim lpBufPtr As Long
Dim strNLSKey As String
Dim fGotNLSKey As Integer
Dim intOffset As Integer
Dim lVerSize As Long
Dim lTmp As Long
Dim lBufLen As Long
Dim lLCID As Long
Dim strTmp As String
On Error GoTo GNLSKCleanup
If VerQueryValue(VarPtr(byteVerData(0)), "\VarFileInfo\Translation", lpBufPtr, lVerSize) <> 0 Then
If Len(strLANGCP) = 0 Then
lLCID = GetUserDefaultLCID()
If lLCID > 0 Then
strTmp = Space$(8)
GetLocaleInfoA lLCID, 11, strTmp, 8
strLANGCP = StringFromBuffer(strTmp)
Do While Len(strLANGCP) < 4
strLANGCP = "0" & strLANGCP
Loop
GetLocaleInfoA lLCID, 9, strTmp, 8
strLANGCP = StringFromBuffer(strTmp) & strLANGCP
Do While Len(strLANGCP) < 8
strLANGCP = "0" & strLANGCP
Loop
End If
End If
If VerQueryValue(VarPtr(byteVerData(0)), strLANGCP, lTmp, lBufLen) <> 0 Then
strNLSKey = strLANGCP
Else
For intOffset = 0 To lVerSize - 1 Step 4
CopyMemory lTmp, ByVal lpBufPtr + intOffset, 4
strTmp = Hex$(lTmp)
Do While Len(strTmp) < 8
strTmp = "0" & strTmp
Loop
strNLSKey = "\StringFileInfo\" & Right$(strTmp, 4) & Left$(strTmp, 4)
If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then
fGotNLSKey = True
Exit For
End If
Next
If Not fGotNLSKey Then
strNLSKey = "\StringFileInfo\040904E4"
If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then
fGotNLSKey = True
End If
End If
End If
End If
GNLSKCleanup:
If fGotNLSKey Then
GetNLSKey = strNLSKey
End If
End Function

наверх

---

Получить список запущенных приложений

Расположите на форме элемент CommandButton и элемент ListBox.

Const TH32CS_SNAPPROCESS As Long = 2&
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelpSnapshot Lib "Kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "Kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "Kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)

Private Sub Command1_Click()
List1.Clear
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim r As Long
hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If hSnapShot = 0 Then
Exit Sub
End If
uProcess.dwSize = Len(uProcess)
r = ProcessFirst(hSnapShot, uProcess)
Do While r
List1.AddItem uProcess.szExeFile
r = ProcessNext(hSnapShot, uProcess)
Loop
Call CloseHandle(hSnapShot)
End Sub

наверх

---

Получить список запущенных процессов

Расположите на форме 2 элемента CommandButton и элемент ListBox.

ВАЖНОЕ ПРИМЕЧАНИЕ: БУДЬТЕ АККУРАТНЫ ПРИ ИСПОЛЬЗОВАНИИ ЭТОГО ПРИМЕРА

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (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
Const GW_HWNDFIRST = 0
Const GW_HWNDNEXT = 2
Const WM_CLOSE = &H10
Const WM_QUIT = &H12
Dim CurrWnd As String
Dim ListItem As String
Dim Length As String

Sub GetTaskList()
CurrWnd = GetWindow(Me.hwnd, GW_HWNDFIRST)
Do While CurrWnd <> 0
Length = GetWindowTextLength(CurrWnd)
ListItem = Space(Length + 1)
Length = GetWindowText(CurrWnd, ListItem, Length + 1)
If Length <> 0 Then
List1.AddItem ListItem
End If
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
DoEvents
Loop
End Sub

Private Sub Command1_Click()
List1.Clear
GetTaskList
End Sub

Private Sub Command2_Click()
hW = FindWindow(vbNullString, List1.Text & Chr(0))
PostMessage hW, WM_QUIT, 0, 0
End Sub

Private Sub Form_Load()
Left = (Screen.Width - Width) \ 2
Top = (Screen.Height - Height) \ 2
GetTaskList
Command1.Caption = "получить список"
Command2.Caption = "Закрыть приложение"
End Sub

наверх

---

Использование функции Environ

В Бэйсике есть одна ОЧЕНЬ полезная, но многими забытая функция Environ! Она возвращает имена и содержание всех переменных среды операционной системы!!! Так, например, чтобы получить директорию Windows, совсем не надо прибегать к API-функции GetWindowsDirectory!!!!!! А получить её можно так:
A = Environ ("windir")
Но и это ещё не всё! Также можно получить следующие перменные:

A = Environ ("TMP") 'директория временных файлов TEMP
A = Environ ("BLASTER") 'координаты звуковой карты
A = Environ ("PATH") 'пути, объявленные в autoexec.bat

НО И ЭТО ВСЁ ЕЩЁ НЕ ВСЁ!!!

'Добавьте на форму элементы TextBox (установите свойство Multiline=True) и CommandButton. Скопируйте следующий код, запустите программу, нажмите на кнопку...

Private Sub Command1_Click()
m = 1
Do
EnvString = Environ(m)
Text1.Text = Text1.Text & vbNewLine & Environ(m)
m = m + 1
Loop Until EnvString = ""
End Sub

наверх

---

Мои программы

BalloonMessage for MS Agent


Автор: Шатрыкин Иван. Соавтор: Павел Сурменок.

наверх

---

Вопрос/Ответ

Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.

Вопросы:

---

Автор вопроса: Владимир

Ответ ожидается по этому адресу

       Есть код работы с базой открытой таким образом
           
     Dim db1 As Database
     Dim rs1 As Recordset

     Dim strDBName1 As String
     Dim strRSName1 As String

     strDBName1 = App.Path & "\фигня.mdb"
     strRSName1 = "фигня1"

     Set db1 = DBEngine.OpenDatabase(strDBName1)
     Set rs1 = db1.OpenRecordset(strRSName1, dbOpenDynaset)

     таблица Фигня1 имеет пару полей
     Хочу чтобы при выборе в Combobox на форме значения, оно находилось в таблице и к другому числовому полю таблицы добавлялось число из текстбокса лежащего на форме

---

Автор вопроса: Артем Белоусов

Ответ ожидается по этому адресу

   Подскажите пожалуйста, как проверить есть ли связь с интернет

---

Автор вопроса: Геннадий

Ответ ожидается по этому адресу

   Как из VB поменять screensaver (из имеющихся)

---

Автор вопроса: Krab

Ответ ожидается по этому адресу

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

---

Автор вопроса: P@Ssword

Ответ ожидается по этому адресу

   Можно ли уянать яначения свойств контролов на форме, получаемые ими при яагруяке, после ияменения этих самых яначений, но бея переяагруяки формы?

---

Автор вопроса: P@Ssword

Ответ ожидается по этому адресу

   Как уянать, что по такому-то IP-адресу на таком-то порту висит моя программа?

---

Автор вопроса: @LEXis

Ответ ожидается по этому адресу

   В текстовом документе нужно от определенного слова до еще одного слова выделить этот блок и скопировать в буфер. Как это осуществить?

---

Автор вопроса: Иван

Ответ ожидается по этому адресу

   Вояможно ли программно соядать файл MS Access? Если можно, то как? И как соядавать в ней таблицы?

---

Автор вопроса: Анатолий

Ответ ожидается по этому адресу

   У меня есть главная форма, на ней две подч-ые формы. При перемещении по записям 1-й подч. формы скрытое поле имеет данные [поле14]=Forms![Должности]![пф Должности].[Form]![Номер]и показывает номер текущей записи. Этот номер используется для сортировки 2-й подч-й формы, которая имеет подчиненное поле с главной формой (чтобы включить автоподстановку).Проблема: Вначале происходит событие Enter 1-й подч-й формы, где у меня есть Requery 2-й подч-й формы. Не работает, т.к. [поле14]обновляется после того, как обновилась 2-я п.ф. (события Enter 1-й пф.) Пробовал поле14 cделать свободным, а в макрос 1-й пф формы вставить me.поле14=...(все, как выше). Далее на событие Changе [поле14] в макрос написал Requery 2-й подч-й формы. Т.е. теперь вначале обновляем поле14 (номер записи), а затем пф2. ... Не работает!

---

Ответы:

---

Вопрос:

   Как спрятать программу в SysTray и сделать для не? там иконку?

Ответ:

Автор ответа: Duke

Ну не знаю как делают все ,а я пользуюсь контролом (systray.ocx). Если надо напиши я дам, или найди в инете там их туевы хучи. А вообще это все через API.

---

Вопрос:

   У меня есть MDI форма, у которой есть дочерняя форма с расположенным на ней элементом Data. Мне нужно, чтобы при загрузке программы была видна только MDI форма. Но как только я присваиваю программным путем свойству DataBaseName какое-то значение, то дочерняя форма тут же выскакивает на экран. Как от этого избавиться?

Ответ:

Автор ответа: ALEX

Попробуй после присвоения значения свойству DataBaseName написать
  
имя_дочерней_формы.hide
  
(у меня работает)

---

Вопрос:

   Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

Ответ:

Автор ответа: Kurt Haeldar

При запуске проги можно инициализировать какую-либо переменную, а затем в событии таймера увеличивать ее значение на 1. Там же нужно проверять это значение. Если оно равно нужному количеству запусков таймера, то этот таймер отключется.
Если все это написать как код, то получится вроде этого:
  
Private sub Timer1_Timer()
k = k + 1
if k = 2 then Timer1.Enabled = False
End Sub

---

Вопрос:

   Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

Ответ:

Автор ответа: Rafis

Используй у таймера свойство Enabled=False

---

Вопрос:

   Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

Ответ:

Автор ответа: Duke

Напиши в таймере после всех действий timer1.enabled=false т.е. 1 раз исполняет и останавливается. А чтобы 2 раза делал напиши следующее

Dim a as byte' может в VB раньш 6 версии нет типа BYTE тогда пиши INTEGER

Private Sub Timer1_Timer()
'твой код вставляй сюда
a=a+1
if a =2 then timer1.enabled=false
'При следующем запуске надо a = 0
End Sub

---

Вопрос:

   Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

Ответ:

Автор ответа: Rutshtein Alex

Option Explicit
  
Dim Counter As Integer

Private Sub Timer1_Timer()
  
If Counter > 2 Then
   Timer1.Enabled = False
   Exit Sub
End If
Counter = Counter + 1
  
End Sub

---

Вопрос:

   Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

Ответ:

Автор ответа: P@Ssword

В событии Timer пишешь:

Static Count As Long
         Count = Count + 1
         if Count > 2 Then Timer1.Enabled = False

---

Вопрос:

   Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

Ответ:

Автор ответа: Медведев Эдуард

Решение очень простое...
в таймере пишешь:

х=х+1
if x=1 then timer1.interval=0' х=1 если один раз,х =2 для двух...
  
или просто игнор

if x=2 then exit sub

---

Вопрос:

   Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

Ответ:

Автор ответа: Игорь Шаронов

Вам придется определить какую-либо глобальную переменную в разделе Declaration или на уровне модуля. К примеру...

Dim Check as Integer

А в событии таймера timer1_timer()...

Check = Check + 1
If Check > 2 Then Timer1.Enabled = False

Пожалуй, все!
Советую вам посмотреть страницу, посвященную элементу Timer - http://vbnet.ru/faq/showtopic.asp?id=261

---

Вопрос:

   Уважаемые программисты, подскажите каким способом лучше всего разбить ботьшой файл на маленькие, размером 1,44 Mb средствами VB 6.0 а затем их же склеить! Спасибо!

Ответ:

Автор ответа: P@Ssword

Разбить можно так:

const size as long = 1457664 ' Это длина одного блока в байтах

sub Расчленить(File1 as string, File2 as string)
dim ind as long
dim buffer(0 to size - 1) as byte

     open file1 for binary as #1
     for ind = 0 to iif(lof(1) mod size, lof(1) \ size - 1, lof(1) \ size)
         get #1, , buffer
         open file2 & "." & ind for binary as #2
         put #2, , buffer
         close #2
     next ind
     close #1
end sub

Соответственно, объединять в обратном порядке, но здесь желательно знать кол-во фрагМЕНТОВ:

sub Объединить(File1 as string, File2 as string, Фрагментов as long)
dim ind as long
dim buffer(0 to size - 1) as byte

     open file1 for binary as #1
     for ind = 0 to Фрагментов
         open file2 & "." & ind for binary as #2
         get #2, , buffer
         put #1, , buffer
         close #2
     next ind
     close #1
end sub

---

Вопрос:

      Нужна помощь! У меня такой вопрос: в моей программе есть форма с настройками и при нажатии кнопки применить происходит следущее:

    Private Sub Command2_Click()
     If Check1.Value = 1 Then cbdend = 1 'открыть вначале работы
     If Check2.Value = 1 Then cbdtim = 1 'открыть в конце работы
      sbdh = Text2.Text 'имя
      sbdm = Text3.Text 'фамилия
     If Check3.Value = 1 Then arcpro = 1 'есть архив
     If Check4.Value = 1 Then arcend = 1 'нет архива
      pathbd = Text1.Text 'путь к файлам
     End Sub

   Вот так формируются переменные на основе моих настроек и как их теперь записать в файл "setup.ini" в дирректории моей программы, а потом считать их оттуда при следующей загрузке программы? Спасибо!

Ответ:

Автор ответа: Rutshtein Alex

Поместить в модуль!!!


'Работа с INI-файлами
'====================
  
'Для чтения значения из INI-файла вызовите функцию:
'ReadINI(File, Heading, Section)
  
'Для записи значения в INI-файл вызовите функцию:
'WriteINI(File, Heading, Section, Value)
  
'File - путь к INI-файлу
'Heading - название раздела
'Section - название параметра
'Value - значение параметра
  
Option Explicit
  
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As Any, ByVal lsString As Any, ByVal lplFilename As String) As Long
Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPriviteProfileIntA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  
Global File
Global ApplicName
Global Keyname
Global Value
  
Public Function WriteINI(File As String, Heading As String, Section As String, Value As String)
  
On Error Resume Next
  
Dim lpApplicName As String, lpFileName As String, lpKeyName As String, lpString As String
Dim U As Long
  
lpApplicName = Heading
lpKeyName = Section
lpString = Value
lpFileName = File
U = WritePrivateProfileString(lpApplicName, lpKeyName, lpString, lpFileName)
If U <> 0 Then
   Store = "Success"
End If
  
End Function
  
Public Function ReadINI(File As String, Heading As String, Section As String)
  
On Error Resume Next
  
Dim X As Long
Dim Temp As String * 50
Dim lpApplicName As String, lpKeyName As String, lpDefault As String, lpFileName As String
  
lpApplicName = Heading
lpKeyName = Section
lpDefault = no
lpFileName = File
X = GetPrivateProfileString(lpApplicName, lpKeyName, lpDefault, Temp, Len(Temp), lpFileName)
  
If X <> 0 Then
   ReadINI = GetInput(Trim(Temp))
End If
  
End Function
  
Public Function GetInput(Inp As String) As String
  
On Error Resume Next
  
Dim P As Integer
P = InStr(1, Inp, Chr(0))
If P <> 0 Then Inp = Left(Inp, P - 1)
GetInput = Inp
  
End Function

---

Вопрос:

   Как изменить яркость картинки ?
В NT добиваюсь результата с помощью API- функций StretchBlt, SetStretchBltMode, GetColorAdjustment, SetColorAdjustment, GetStretchBltMode
А в Win9x/ME функции GetColorAdjustment, SetColorAdjustment не поддерживаются.
Кто нибудь знает как обойтись без них?

Ответ:

Автор ответа: Duke

Не знаю какой у тебя там win9x но в моем все прекрасно работает. Синтаксис проверь.

---

Вопрос:

   Такой код для добавления hotkey:

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_SETHOTKEY = &H32
Private Const WM_SHOWWINDOW = &H18
Private Const HK_SHIFTA = &H141 'Shift + A
Private Const HK_SHIFTB = &H142 'Shift + B
Private Const HK_CONTROLA = &H241 'Control + A
Private Const HK_ALTZ = &H45A
Private Sub Form_Load()
'Позволить узнать windows какая горячая клавиша в вашем приложении
erg& = SendMessage(Me.hwnd, WM_SETHOTKEY, HK_ALTZ, 0)
If erg& <> 1 Then MsgBox "You need another hotkey", vbOKOnly, "Error"
'Сказать windows что делать при нажатии на hotkey
'в данном случае - показать окно программы
erg& = DefWindowProc(Me.hwnd, WM_SHOWWINDOW, 0, 0)
End Sub

Так вот, я прячу программу через form.hide и показываю значок в трее, и этот hotkey не работает. А просто так, когда форма не спрятана, а просто неактивна, то какое сообщение не пиши в DefWindowProc, форма просто становится активной. Объясните, пожалуйста, что здесь можно исправить или подскажите другой способ.

Ответ:

Автор ответа: P@Ssword

Есть принципиально другое предложение (ему не страшен даже form.hide - проверял):

Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312

Private Type POINTAPI
     x As Long
     y As Long
End Type

Private Type Msg
     hWnd As Long
     Message As Long
     wParam As Long
     lParam As Long
     time As Long
     pt As POINTAPI
End Type

Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long

Private bCancel As Boolean

Private Sub ProcessMessages()
     Dim Message As Msg
     ' повторяем до тех пор, пока переменной bCancel не будет присвоено True
     Do While Not bCancel
         ' ожидаем "оконного" события
         WaitMessage
         ' проверяем, что это HOTKEY - сообщение
         If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE)
Then
             ' здесь включаем в дело фантазию.....
             MsgBox "Однако"
         End If
         ' обрабатываем остальные события
         DoEvents
     Loop
End Sub

Private Sub Form_Load()
Dim ret As Long

     bCancel = False
     ' регистрируем горячую клавишу Ctrl-F
     ret = RegisterHotKey(Me.hWnd, &HBFFF&, MOD_CONTROL, vbKeyF)

     ' показываем форму
     Show
     ' обрабатываем сообщения горячей клавиши
     ProcessMessages
End Sub

Private Sub Form_Unload(Cancel As Integer)
     ' прерываем обработку сообщений
     bCancel = True
     ' отрегистрируемся от горячих клавиш :)
     UnregisterHotKey Me.hWnd, &HBFFF&
End Sub

---

Вопрос:

   Подскажите, как сделать чтобы на одной вкладке TabStrip была например кнопка, а на другой вкладке TextBox?

Ответ:

Автор ответа: P@Ssword

Весь прикол в том, что TabStrip не предоставляет контейнер для элементов, он просто рисует красивую рамочку и закладочки :-) Так что есть два выхода:

-- Выход первый. Сложнее. Продолжаем использовать TabStrip. На форму для каждого таба кладём по одному контейнеру (например, Frame). Далее в событии Click по TabStrip показываем нужный Frame, остальные при этом пряча. В общем, если с утра просто необходимо размять руки на клавиатуре, то можно сделать такой проект. Но для тех, кто занимается продуктивным трудом, а не расходом калорий, придумали другое решение. Итак, способ номер два.

++ Выход второй. Прошу любить и жаловать, Micro$oft Tabbed Dialog Control 6.0. Клик на нужный таб, поклали контролы, клик на следующий таб... Чертовски удобная штука. Им бы ещё раскраску изменить - вообще идеально. Да ладно, чё мечтать - MacroHard всё-таки...

---

Вопрос:

   ПОМОГИТЕ РАЗОБРАТЬСЯ С MSDN !!!
У меня Visual Basic 6.0 и при попытке вызвать Справку выдает, что надо типа установить MSDN Library. Долго искал всеми расхваливаемый MSDN на CD-дисках и, наконец, купил на 3-х дисках. И что же?!!?! Они друг друга НЕ ВИДЯТ. VB6.0 при попытке установить ему МСДН говорит, что это не тот диск. А запуская Setup с дисков MSDN (даже после полной установке! - это около 2-х гигов), этот "товарищ" к VB не цепляется! Как мне их установить, чтоб в VB нормально справка работатала?!?!?

Ответ:

Автор ответа: Кирилл

Тот MSDN 2002, что ты купил предназначен для .NET и только. STUDIO 6.0 работает с MSDN 2001 года. На Митино он есть, но 450р на золоте. С 2002 работать можно, но вручную, что очень неудобно

---

Вопрос:

   В SysTray создал иконку, нужно, чтобы когда я форму сворачиваю, она исчезала с экрана и панели задач, а оставалась лишь иконка в SysTray. А как ???

Ответ:

Автор ответа: P@Ssword

Просто в событии формы Form_Resize проверяешь состояние формы и, если она свёрнута, убираешь её с экрана:

if Me.WindowState = vbMinimized then
         Unload Me или Me.Visible = false
end if

Так же можно делать и при попытке закрытия формы (нажатия на кнопку Х):

private sub Form_Unload(cancel as integer)
         Me.WindowState = vbMinimized ' Сворачиваем окно,
         Me.Visible = false ' затем его убираем
end sub

---

Вопрос:

   В ListBox выбираю строку, в которой прописан путь к картинке, и Image.Picture присваиваю ее значение. Но программа пишет: несоответствие типа. Есть ли другой путь изменения картинки объекта Image?

Ответ:

Автор ответа: P@Ssword

Свойство Picture - это объект типа IPictureDisp, а не путь к файлу. Это кому интересно. А теперь к вопросу о слонах. Картинки из файла загружает, в частности, функция LoadPicture. Так что надо просто написать:

Set Image1.Picture = LoadPicture("Ю:\картинка.жэпэгэ")

---

Можете заполнить эту форму, либо отослать вопрос СЮДА

Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.

Текст сообщения:

Ваше имя
E-mail для ответа

наверх