Недавно я зарегистрировал эту рассылку на американском сервисе ListPower. Пожалуйста, заполните расположенную ниже форму. Никаких последствий для Вас не будет. Рассылка будет продолжать выходить на Subscribe.ru с той же периодичностью.

Имя
E-mail

Читайте!

Книги

	Microsoft Visual Basic 6.0. Мастерская разработчика (+ CD-ROM) Книга состоит из 3 частей (34 главы) и предметного указателя. Написанная живо и доходчиво, она позволит освоить множество полезных приемов программирования, в том числе объектно-ориентированного, и научит, как создавать 32-разрядные приложения для Windows 95/98 и Windows NT — от экранных заставок до программ, ориентированных на Интернет. Кроме того, Вы узнаете, как расширить возможности языка за счет функций Win32 API и воспользоваться преимуществами технологии ActiveX. Автор: Джон Кларк Крейг, Джефф Уэбб Издательство: Русская Редакция Год издания: 2001 Кол-во страниц: 720 Стоимость: 272 р. Формат: 70х100/16 Переплёт: твёрдый
	VB Script и ActiveX Книга предназначена для разработчиков Web - приложений на языке VBScript, желающих повысить свой профессиональный уровень и стать экспертами в этой области. В ней подробно рассказывается о новых возможностях VBScript, включая использование именованных констант, функций, переменных и коллекций, приводится вся необходимая информация о технологии ActiveX, принципах взаимодействия VBScript и Visual Basic при создании приложений, работающих на сервере. Прочитав эту книгу, вы научитесь использовать звуковые эффекты, создавать анимированную графику, строить формы для ввода данных, узнаете, как с помощью VBScript создать в Web электронный магазин и отслеживать число посетителей и деланные ими покупки. Вы даже сумеете написать увлекательную мультимедийную игру для Web. Автор: Скотт Палмер Издательство: Питер Год издания: 1999 Кол-во страниц: 368 Стоимость: 94 р. Формат: 70х100/16 Переплёт: мягкий
	VBA 2000. Самоучитель В книге содержится краткий курс по использованию языка и системы VBA для Word и Excel 2000. Книга предназначена для начинающих программировать в среде Windows 95/98 с использованием в качестве базовых таких объектов Word и Excel, как документы, рабочие книги, листы и так далее. Материала книги достаточно для создания как простых макросов, помогающих автоматизировать рутинную повторяющуюся работу над документами и электронными таблицами, так и для разработки достаточно сложных приложений, обрабатывающих данные в диалоговых окнах, обеспечивающих пользователя самыми современными интерфейсными средствами. Автор: Кузьменко В Издательство: Бином Год издания: 2000 Кол-во страниц: 416 Стоимость: 116 р. Формат: 70х100/16 Переплёт: мягкий
	Visual Basic 6 Desktop. Экзамен 70-176 Книги серии `Экзамен – экстерном` представляют собой удобные, сжатые, хорошо структурированные конспекты для подготовки к сдаче сертификационных экзаменов на звание Microsoft Certified Solution Developer. Книга `Visual Basic 6.0 Desktop. Экзамен 70-176` содержит только действительно необходимый материал, типовые вопросы с ответами и пример экзамена. Возможно, некоторые подходы, применяемые автором, покажутся вам не совсем привычными - не удивляйтесь: это не учебник по Visual Basic; организация материала в этой книге призвана максимально облегчить задачу экзаменуемого. Учтите, что в ряде случаев экзаменационные вопросы выходят за рамки тем, отраженных в документации по Visual Basic, а иной раз правильные ответы на них даже входят в противоречие с `официальной` информацией. Автор: Майкл Макдоналд Издательство: Питер Год издания: 2001 Кол-во страниц: 608 Стоимость: 123 р. Формат: 60x90/16 Переплёт: мягкий
	Visual Basic 6. Руководство разработчика (+ CD-ROM) Эта книга, написанная известным специалистом и неутомимым пропагандистом Visual Basic, представляет собой прекрасный путеводитель по одному из наиболее популярных визуальных средств разработки Windows-приложений. Подробно освещаются такие ключевые темы программирования на Visual Basic, как проектирование и использование элементов ActiveX, программирование баз данных и разработка Web-приложений. Несомненный интерес представляют главы, посвященные работе с графикой. Большое количество тщательно продуманных примеров облегчает восприятие материала. Подбор материала и стиль изложения делают издание интересным и полезным для программистов разных уровней. Автор: Евангелос Петрусос Издательство: BHV, Ирина, SYBEX Inc Год издания: 2000 Кол-во страниц: 1072 Стоимость: 267 р. Формат: 70x100/32 Переплёт: твёрдый

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

наверх

---

Стандартные свойства любого контрола

ZOrder - отвечает за программное переключение Send To Back, Send To Front?
Что это такое? К примеру, вы располагаете на форме два различных элемента один над другим. Так вот если вы нажмете правой клавишой мыши на любом из этих элементов вы можете установить, какой их элементов будет поверх другого. Синтаксис использования свойства ZOrder прост:

object.ZOrder position

где position определяет уровень (0 - самый верхний уровень)

наверх

---

Добавить контрол во время выполнения программы

Добавьте TextBox на форму
В свойствах TextBox'а измените Index на 0
Этот пример покажет, как добавить TextBox'ы во время выполнения программы
Вы получите новый TextBox под именем Text1(1).
Вместо TextBox, конечно, можно использовать и другие контролы

Private Sub Form_Load()
Load Text1(1)
Text1(1).Left = 400
Text1(1).Top = 400
Text1(1).Visible = True
'Для того, чтобы добавить еще textbox, просто добавьте:
'Load Text1(2)
'Text1(2).Left = 400
'Text1(2).Top = 200
'Text1(2).Visible = True
End Sub

наверх

---

Отцентрировать контрол на форме

Добавьте 1 CommandButton. При нажатии на кнопку, она переместится в центр вашей формы

Private Sub Command1_Click()
'Replace all the 'Command1' below with the name of the control you want to center.
Command1.Left = (Form1.Width - Command1.Width) / 2
Command1.Top = (Form1.Height / 2 - Command1.Height)
End Sub

наверх

---

Создание формы или контрола произвольной формы

Добавьте на форму 3 CommandButton. Запустите проект и поочередно нажимайте на кнопки

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim Result As Long
'замените цифру '4' ниже на то количество углов, которое вы хотите получить при создании формы
Dim Points(1 To 4) As POINTAPI
Private Sub Command1_Click()
'демонстрация того, как изменится форма
Call Polyline(Form1.hdc, Points(1), 4)
End Sub
Private Sub Command2_Click()
'создание произвольной формы
hRgn = CreatePolygonRgn(Points(1), 4, 1)
'Если вы хотите создать произвольную форму любому контролу, замените, к примеру Form1.hWnd на Command1.hWnd
'вместо Command1 вы можете использовать любой контрол, имеющий .hWnd
Result = SetWindowRgn(Form1.hWnd, hRgn, True)
End Sub
Private Sub Command3_Click()
'восстановить оригинальные значения формы
Result = SetWindowRgn(Form1.hWnd, 0, True)
End Sub
Private Sub Form_Load()
Points(1).X = 500
Points(1).Y = 500
Points(2).X = 0
Points(2).Y = 0
Points(3).X = 1000
Points(3).Y = 0
Points(4).X = 500
Points(4).Y = 500
End Sub

наверх

---

Работа с элементами CommonDialog библиотеки Comdlg32.dll

1. Создайте новый проект Microsoft Visual Basic 6.0.
2. Добавьте на форму элемент CommandButton.
3. Добавьте в проект модуль.

Далее в событии Command1_Click() снимаете комментарий с необходимого вам события CommonDialog и пользуетесь.

'КОД ФОРМЫ

Private Sub Command1_Click()
Module1.ShowAbout 'вызвать окно "О программе"
'Module1.ShowColor 'вызвать окно выбора цвета
'Module1.ShowFindFiles 'вызвать окно "Поиск файлов и папок"
'Module1.ShowFont 'вызвать окно "Выбор шрифта"
'Module1.ShowFormat 'вызвать окно "Форматирование дискеты"
'Module1.ShowHelp 'скорее всего, вызов помощи в программе
'Module1.ShowIcon 'выбор иконки для вашего приложения
'Module1.ShowObjectProp 'вызов окна "Свойство: Система"
'Module1.ShowOpen 'вызов окна "Открытие файла"
'Module1.ShowPrinter 'вызов окна "Печать"
'Module1.ShowRestart 'вызов окна "Перезарузить сейчас: ДА | НЕТ"
'Module1.ShowRun 'вызов окна "Запустить программу" (Меню ПУСК | ВЫПОЛНИТЬ)
'Module1.ShowSave 'вызов окна "Сохранение файла"
'Module1.ShowShutDown 'вызов окна "Завершение работы Windows"
'Module1.ShowFolder 'на моем компьютере данная функция "Вызвала недопустимую опреацию"
End Sub

'КОД МОДУЛЯ

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
RGBResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Const LF_FACESIZE = 32
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(LF_FACESIZE) As Byte
End Type

Private Type ChooseFont
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

Const CF_INITTOLOGFONTSTRUCT = &H40&
Const SCREEN_FONTTYPE = &H2000
Const BOLD_FONTTYPE = &H100
Const FW_BOLD = 700
Const LOGPIXELSY = 90

Private Type PrintDlg
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
hdc As Long
flags As Long
nFromPage As Integer
nToPage As Integer
nMinPage As Integer
nMaxPage As Integer
nCopies As Integer
hInstance As Long
lCustData As Long
lpfnPrintHook As Long
lpfnSetupHook As Long
lpPrintTemplateName As String
lpSetupTemplateName As String
hPrintTemplate As Long
hSetupTemplate As Long
End Type

Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Private Type DEVNAMES
wDriverOffset As Integer
wDeviceOffset As Integer
wOutputOffset As Integer
wDefault As Integer
extra As String * 100
End Type

Const DM_DUPLEX = &H1000&
Const DM_ORIENTATION = &H1&
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As ChooseFont) As Long
Private Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PrintDlg) As Long
Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hOwner As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
Private Declare Function SHShutDownDialog Lib "Shell32" Alias "#60" (ByVal YourGuess As Long) As Long
Private Declare Function SHRestartSystem Lib "Shell32" Alias "#59" (ByVal hOwner As Long, ByVal sPrompt As String, ByVal uFlags As Long) As Long
Private Declare Function SHRunDialog Lib "Shell32" Alias "#61" (ByVal hOwner As Long, ByVal hIcon As Long, ByVal sDir As Long, ByVal szTitle As String, ByVal szPrompt As String, ByVal uFlags As Long) As Long
Private Declare Function SHFormatDrive Lib "Shell32" (ByVal hwndOwner As Long, ByVal iDrive As Long, ByVal iCapacity As Long, ByVal iFormatType As Long) As Long
Private Declare Function SHBrowseForFolder Lib "Shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHChangeIconDialog Lib "Shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As String, ByVal Reserved As Long, lpIconIndex As Long) As Long
Private Declare Function SHObjectProperties Lib "Shell32" Alias "#178" (ByVal hOwner As Long, ByVal uFlags As Long, ByVal sName As String, ByVal sParam As String) As Long
Private Declare Function SHAbout Lib "Shell32" Alias "ShellAboutA" (ByVal hOwner As Long, ByVal sAppName As String, ByVal sPrompt As String, ByVal hIcon As Long) As Long
Private Declare Function SHFindFiles Lib "Shell32" Alias "#90" (ByVal pidlRoot As Long, ByVal pidlSavedSearchas As Long) As Boolean
Private Declare Function SHSimpleIDListFromPath Lib "Shell32" Alias "#162" (ByVal szPath As String) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHFree Lib "Shell32" Alias "#196" ()
Private Declare Function ILFree Lib "Shell32" Alias "#195" (ByVal pidlFree As Long)
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Declare Function CopyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Declare Function ExtractIconEx Lib "Shell32" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
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 GetDC Lib "user32" (ByVal hOwner As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (p1 As Any, p2 As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)


Public Enum CommonDialog_Actions
cdlgOpen = 1
cdlgSave = 2
cdlgColor = 3
cdlgFont = 4
cdlgPrinter = 5
cdlgHelp = 6
cdlgAbout = 7
cdlgFolder = 8
cdlgFormat = 9
cdlgIcon = 10
cdlgObjectProp = 11
cdlgRestart = 12
cdlgRun = 13
cdlgShutDown = 14
End Enum

Public Enum CommonDialog_IconSize
IconSizeSmall = 16
IconSizeLarge = 32
End Enum

Public Enum CommonDialog_Flags
cdlOFNAllowMultiselect = &H200
cdlOFNCreatePrompt = &H2000
cdlOFNExplorer = &H80000
cdlOFNExtensionDifferent = &H400
cdlOFNFileMustExist = &H1000
cdlOFNHelpButton = &H10
cdlOFNHideReadOnly = &H4
cdlOFNLongNames = &H200000
cdlOFNNoChangeDir = &H8
cdlOFNNoDereferenceLinks = &H100000
cdlOFNNoLongNames = &H40000
cdlOFNNoReadOnlyReturn = &H8000
cdlOFNNoValidate = &H100
cdlOFNOverwritePrompt = &H2
cdlOFNPathMustExist = &H800
cdlOFNReadOnly = &H1
cdlOFNShareAware = &H4000
cdlCCFullOpen = &H2
cdlCCHelpButton = &H8
cdlCCPreventFullOpen = &H4
cdlCCRGBInit = &H1
cdlPDAllPages = &H0
cdlPDCollate = &H10
cdlPDDisablePrintToFile = &H80000
cdlPDHelpButton = &H800
cdlPDHidePrintToFile = &H100000
cdlPDNoPageNums = &H8
cdlPDNoSelection = &H4
cdlPDNoWarning = &H80
cdlPDPageNums = &H2
cdlPDPrintSetup = &H40
cdlPDPrintToFile = &H20
cdlPDReturnDC = &H100
cdlPDReturnDefault = &H400
cdlPDReturnIC = &H200
cdlPDSelection = &H1
cdlPDUseDevModeCopies = &H40000
cdlCFANSIOnly = &H400
cdlCFApply = &H200
cdlCFBoth = &H3
cdlCFEffects = &H100
cdlCFFixedPitchOnly = &H4000
cdlCFForceFontExist = &H10000
cdlCFHelpButton = &H4
cdlCFLimitSize = &H2000
cdlCFNoFaceSel = &H80000
cdlCFNoSimulations = &H1000
cdlCFNoSizeSel = &H200000
cdlCFNoStyleSel = &H100000
cdlCFNoVectorFonts = &H800
cdlCFPrinterFonts = &H2
cdlCFScalableOnly = &H20000
cdlCFScreenFonts = &H1
cdlCFTTOnly = &H40000
cdlCFWYSIWYG = &H8000
Restart_Logoff = &H0
Restart_ShutDown = &H1
Restart_Reboot = &H2
Restart_Force = &H4
Run_NoBrowse = &H10
Run_NoDefault = &H20
Run_CalcDir = &H40
Run_NoLable = &H80
ObjProp_System = &H0
ObjProp_Printer = &H100
ObjProp_File = &H200
ObjProp_Mouse = &H300
ObjProp_Locale = &H400
ObjProp_MMedia = &H500
ObjProp_TimeDate = &H600
ObjProp_Network = &H700
ObjProp_Screen = &H800
ObjProp_Internet = &H900
Folder_COMPUTER = &H1000
Folder_PRINTER = &H2000
Folder_INCLUDEFILES = &H4001
End Enum
Public Enum CommonDialog_HelpCommand
HelpCommandHelp = &H102&
HelpContents = &H3&
HelpContext = &H1
HelpContextPOPUP = &H8&
HelpForceFile = &H9&
HelpHelpOnHelp = &H4
HelpIndex = &H3
HelpKeyHelp = &H101
HelpPartialKey = &H105&
HelpQuit = &H2
HelpSetContents = &H5&
HelpSetIndex = &H5
HelpMultiKey = &H201&
HelpSetWinPos = &H203&
End Enum

Private RetValue As Long
Const MAX_PATH = 260
Private OFN As OPENFILENAME
Private mFileName As String
Private mFileTitle As String
Private mhOwner As Long
Private mDialogTitle As String
Private mFilter As String
Private mInitDir As String
Private mDefaultExt As String
Private mFilterIndex As Long
Private mHelpFile As String
Private mHelpCommand As CommonDialog_HelpCommand
Private mHelpKey As Long
Private mRGBResult As Long
Private mItalic As Boolean
Private mUnderline As Boolean
Private mStrikethru As Boolean
Private mFontName As String
Private mFontSize As Long
Private mBold As Boolean
Private mDialogPrompt As String
Private mFlags As CommonDialog_Flags
Private mCancelError As Boolean
Private mhIcon As Long
Private mAppName As String
Private mIconSize As CommonDialog_IconSize
Public Property Let Action(ByVal New_Action As CommonDialog_Actions)
Select Case New_Action
Case 1
ShowOpen
Case 2
ShowSave
Case 3
ShowColor
Case 4
ShowFont
Case 5
ShowPrinter
Case 6
ShowHelp
Case 7
ShowAbout
Case 8
ShowFolder
Case 9
ShowFormat
Case 10
ShowIcon
Case 11
ShowObjectProp
Case 12
ShowRestart
Case 13
ShowRun
Case 14
ShowShutDown
Case Else
End Select
End Property

Public Property Let CancelError(ByVal vData As Boolean)
mCancelError = vData
End Property

Public Property Get CancelError() As Boolean
CancelError = mCancelError
End Property

Public Property Get hOwner() As Long
hOwner = mhOwner
End Property

Public Property Let hOwner(ByVal New_hOwner As Long)
mhOwner = New_hOwner
End Property

Public Property Get flags() As CommonDialog_Flags
flags = mFlags
End Property

Public Property Let flags(ByVal New_Flags As CommonDialog_Flags)
mFlags = New_Flags
End Property

Public Property Get DialogTitle() As String
DialogTitle = mDialogTitle
End Property

Public Property Let DialogTitle(sTitle As String)
mDialogTitle = sTitle
End Property

Public Property Get DialogPrompt() As String
DialogPrompt = mDialogPrompt
End Property

Public Property Let DialogPrompt(ByVal New_Prompt As String)
mDialogPrompt = New_Prompt
End Property

Public Property Get AppName() As String
AppName = mAppName
End Property

Public Property Let AppName(ByVal New_AppName As String)
mAppName = New_AppName
End Property

Public Property Let hIcon(ByVal vData As Long)
mhIcon = vData
End Property

Public Property Get hIcon() As Long
hIcon = mhIcon
End Property
Public Property Get Bold() As Boolean
Bold = mBold
End Property

Public Property Let Bold(bBold As Boolean)
mBold = bBold
End Property

Public Property Get FontName() As String
FontName = mFontName
End Property

Public Property Let FontName(sName As String)
mFontName = sName
End Property

Public Property Get FontSize() As Long
FontSize = mFontSize
End Property

Public Property Let FontSize(lSize As Long)
mFontSize = lSize
End Property

Public Property Get Italic() As Boolean
Italic = mItalic
End Property

Public Property Let Italic(BItalic As Boolean)
mItalic = BItalic
End Property

Public Property Get StrikeThru() As Boolean
StrikeThru = mStrikethru
End Property

Public Property Let StrikeThru(bStrikethru As Boolean)
mStrikethru = bStrikethru
End Property

Public Property Get Underline() As Boolean
Underline = mUnderline
End Property

Public Property Let Underline(bUnderline As Boolean)
mUnderline = bUnderline
End Property
Public Property Get DefaultExt() As String
DefaultExt = mDefaultExt
End Property

Public Property Let DefaultExt(sDefExt As String)
mDefaultExt = DefaultExt
End Property

Public Property Get FileName() As String
FileName = mFileName
End Property

Public Property Let FileName(sFileName As String)
mFileName = sFileName
End Property

Public Property Get FileTitle() As String
FileTitle = mFileTitle
End Property

Public Property Let FileTitle(sTitle As String)
mFileTitle = sTitle
End Property

Public Property Get Filter() As String
Filter = mFilter
End Property

Public Property Let Filter(sFilter As String)
mFilter = sFilter
End Property

Public Property Get FilterIndex() As Long
FilterIndex = mFilterIndex
End Property

Public Property Let FilterIndex(lIndex As Long)
mFilterIndex = lIndex
End Property

Public Property Get InitDir() As String
InitDir = mInitDir
End Property

Public Property Let InitDir(sDir As String)
mInitDir = sDir
End Property

Public Property Get IconSize() As CommonDialog_IconSize
If mIconSize <> IconSizeLarge And mIconSize <> IconSizeSmall Then mIconSize = IconSizeLarge
IconSize = mIconSize
End Property

Public Property Let IconSize(nSize As CommonDialog_IconSize)
If nSize <> IconSizeLarge And nSize <> IconSizeSmall Then nSize = IconSizeLarge
mIconSize = nSize
End Property
Public Property Get HelpCommand() As CommonDialog_HelpCommand
HelpCommand = mHelpCommand
End Property

Public Property Let HelpCommand(lCommand As CommonDialog_HelpCommand)
mHelpCommand = lCommand
End Property

Public Property Get HelpFile() As String
HelpFile = mHelpFile
End Property

Public Property Let HelpFile(sFile As String)
mHelpFile = sFile
End Property

Public Property Get HelpKey() As Long
HelpKey = mHelpKey
End Property

Public Property Let HelpKey(sKey As Long)
mHelpKey = sKey
End Property
Public Property Get RGBResult() As Long
RGBResult = mRGBResult
End Property

Public Property Let RGBResult(lValue As Long)
mRGBResult = lValue
End Property

Public Function ShowShutDown()
SHShutDownDialog mhOwner
End Function
Public Function ShowRestart()
Dim uFlag As Long
uFlag = mFlags And (&H0 Or &H1 Or &H2 Or &H4)
SHRestartSystem mhOwner, mDialogPrompt, uFlag
End Function
Public Function ShowRun()
Dim uFlag As Long
uFlag = mFlags And (&H10 Or &H20 Or &H40 Or &H80)
uFlag = uFlag / 16
SHRunDialog mhOwner, mhIcon, 0, mDialogTitle, mDialogPrompt, uFlag
End Function
Public Function ShowFormat(Optional ByVal iDrive As Long, Optional ByVal iCapacity As Long, Optional ByVal iFormatType As Long) As Long
ShowFormat = SHFormatDrive(mhOwner, iDrive, iCapacity, iFormatType)
End Function
Public Function ShowIcon()
Dim nIconIdx As Long, OldFileName As String
Dim hSmallIcon As Long, hLargeIcon As Long, NewIcon As Long
If Right(mFileName, 1) = "\" Then Exit Function
OldFileName = mFileName
mFileName = mFileName & String$(MAX_PATH - Len(mFileName), 0) 'FileName must be maximum lenth
If SHChangeIconDialog(0, mFileName, 0, nIconIdx) Then
If ExtractIconEx(mFileName, nIconIdx, hLargeIcon, hSmallIcon, 1) > 0 Then
NewIcon = IIf(mIconSize - 32, hSmallIcon, hLargeIcon)
mhIcon = CopyIcon(NewIcon)
DestroyIcon hSmallIcon
DestroyIcon hLargeIcon
End If
End If
mFileName = OldFileName
End Function
Public Function ShowFolder() As String
On Error GoTo errhan
Dim bi As BROWSEINFO
Dim pidl As Long, path As String, pos As Integer, uFlag As Long
TopFolder = TopFolder & Chr$(0)
SelFolder = SelFolder & Chr$(0)
bi.hOwner = mhOwner
bi.pidlRoot = SHSimpleIDListFromPath(mInitDir)
bi.lpszTitle = mDialogPrompt

uFlag = mFlags And (&H1000 Or &H2000 Or &H4001)
If uFlag < Folder_COMPUTER Then
bi.ulFlags = &H1
Else
bi.ulFlags = uFlag
End If
pidl = SHBrowseForFolder(bi)
path = String$(MAX_PATH, 0)
If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
pos = InStr(path, Chr$(0))
InitDir = Left(path, pos - 1)
End If
Call CoTaskMemFree(pidl)
Exit Sub
errhan:
End Function

Public Function ShowObjectProp(Optional ByVal sObjectName As String, Optional ByVal sTab As String)
Dim uFlag As Long, sObj As String
Dim sPath As String
uFlag = mFlags And (&H100 Or &H200 Or &H300 Or &H400 Or &H500 Or &H600 Or &H700 Or &H800 Or &H900)
uFlag = uFlag / 256
Select Case uFlag
Case 1, 2
sObj = sObjectName
Case 3
uFlag = 0
Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl,,0", vbNormalFocus)
Case 4
uFlag = 0
Call Shell("rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,0", vbNormalFocus)
Case 5
uFlag = 0
Call Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,0", vbNormalFocus)
Case 6
uFlag = 0
Call Shell("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,0", vbNormalFocus)
Case 7
uFlag = 0
Call Shell("rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl,,0", vbNormalFocus)
Case 8
uFlag = 0
Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0", vbNormalFocus)
Case 9
uFlag = 0
Call Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0", vbNormalFocus)
Case Else
uFlag = 2
sObj = ""
End Select
If uFlag > 0 Then SHObjectProperties mhOwner, uFlag, sObj, sTab
End Function
Public Function ShowAbout()
If mAppName = "" Then mAppName = Chr$(0)
SHAbout mhOwner, mAppName, mDialogPrompt, mhIcon
End Function
Public Sub ShowOpen()
Dim iDelim As Integer
InitOFN
RetValue = GetOpenFileName(OFN)
If RetValue > 0 Then
iDelim = InStr(OFN.lpstrFileTitle, vbNullChar)
If iDelim Then mFileTitle = Left$(OFN.lpstrFileTitle, iDelim - 1)
iDelim = InStr(OFN.lpstrFile, vbNullChar)
If iDelim Then mFileName = Left$(OFN.lpstrFile, iDelim - 1)
Else
If mCancelError Then Err.Raise 0
End If
End Sub
Public Sub ShowSave()
Dim iDelim As Integer
InitOFN
RetValue = GetSaveFileName(OFN)
If RetValue > 0 Then
iDelim = InStr(OFN.lpstrFileTitle, vbNullChar)
If iDelim Then mFileTitle = Left$(OFN.lpstrFileTitle, iDelim - 1)
iDelim = InStr(OFN.lpstrFile, vbNullChar)
If iDelim Then mFileName = Left$(OFN.lpstrFile, iDelim - 1)
Else
If mCancelError Then Err.Raise 0
End If
End Sub
Private Sub InitOFN()
Dim sTemp As String, i As Integer
Dim uFlag As Long
uFlag = mFlags And (&H1 Or &H2 Or &H4 Or &H8 Or &H10 Or &H100 Or &H200 Or &H400 Or &H800 Or &H1000 Or &H2000 Or &H4000 Or &H8000 Or &H40000 Or &H80000 Or &H100000 Or &H200000)
With OFN
.lStructSize = Len(OFN)
.hwndOwner = mhOwner
.flags = uFlag
.lpstrDefExt = mDefaultExt
sTemp = mInitDir
If sTemp = "" Then sTemp = App.path
.lpstrInitialDir = sTemp
sTemp = mFileName
.lpstrFile = sTemp & String$(255 - Len(sTemp), 0)
.nMaxFile = 255
.lpstrFileTitle = String$(255, 0)
.nMaxFileTitle = 255
sTemp = mFilter
For i = 1 To Len(sTemp)
If Mid(sTemp, i, 1) = "|" Then
Mid(sTemp, i, 1) = vbNullChar
End If
Next
sTemp = sTemp & String$(2, 0)
.lpstrFilter = sTemp
.nFilterIndex = mFilterIndex
.lpstrTitle = mDialogTitle
.hInstance = App.hInstance
End With
End Sub
Public Sub ShowHelp()
RetValue = WinHelp(mhOwner, mHelpFile, mHelpCommand, mHelpKey)
End Sub
Public Sub ShowColor()
Dim CC As CHOOSECOLOR
Dim CustomColors() As Byte
Dim uFlag As Long
ReDim CustomColors(0 To 16 * 4 - 1) As Byte
For i = LBound(CustomColors) To UBound(CustomColors)
CustomColors(i) = 255
Next i
uFlag = mFlags And (&H1 Or &H2 Or &H4 Or &H8)
With CC
.lStructSize = Len(CC)
.hwndOwner = mhOwner
.hInstance = App.hInstance
.lpCustColors = StrConv(CustomColors, vbUnicode)
.flags = uFlag
.RGBResult = mRGBResult
RetValue = ChooseColorAPI(CC)
If RetValue = 0 Then
If mCancelError Then Err.Raise (RetValue)
Else
CustomColors = StrConv(.lpCustColors, vbFromUnicode)
mRGBResult = .RGBResult
End If
End With
End Sub
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
Public Sub ShowPrinter()
Dim PD As PrintDlg
Dim DM As DEVMODE
Dim DN As DEVNAMES
Dim lpDevMode As Long, lpDevName As Long
Dim objPrinter As Printer, NewPrinterName As String
Dim strSetting As String
Dim uFlag As Long
uFlag = mFlags And (&H0 Or &H1 Or &H2 Or &H4 Or &H8 Or &H10 Or &H20 Or &H40 Or &H80 Or &H100 Or &H200 Or &H400 Or &H800 Or &H40000 Or &H80000 Or &H100000)
With PD
.lStructSize = Len(PD)
.hwndOwner = mhOwner
.hdc = GetDC(mhOwner)
.flags = uFlag
End With
On Error GoTo ErrorHandler
With DM
.dmDeviceName = Printer.DeviceName
.dmSize = Len(DM)
.dmFields = DM_ORIENTATION Or DM_DUPLEX
.dmOrientation = Printer.Orientation
On Error Resume Next
.dmDuplex = Printer.Duplex
On Error GoTo 0
End With
PD.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DM))
lpDevMode = GlobalLock(PD.hDevMode)
If lpDevMode > 0 Then
CopyMemory ByVal lpDevMode, DM, Len(DM)
RetValue = GlobalUnlock(lpDevMode)
End If
With DN
.wDriverOffset = 8
.wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
.wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
.wDefault = 0
End With
With Printer
DN.extra = .DriverName & vbNullChar & .DeviceName & vbNullChar & .Port & vbNullChar
End With
PD.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DN))
lpDevName = GlobalLock(PD.hDevNames)
If lpDevName > 0 Then
CopyMemory ByVal lpDevName, DN, Len(DN)
RetValue = GlobalUnlock(lpDevName)
End If
RetValue = PrintDlg(PD)
If RetValue = 0 Then
If mCancelError Then Err.Raise (RetValue)
Else
mhOwner = PD.hdc
lpDevName = GlobalLock(PD.hDevNames)
CopyMemory DN, ByVal lpDevName, 45
RetValue = GlobalUnlock(lpDevName)
GlobalFree PD.hDevNames
lpDevMode = GlobalLock(PD.hDevMode)
CopyMemory DM, ByVal lpDevMode, Len(DM)
RetValue = GlobalUnlock(PD.hDevMode)
GlobalFree PD.hDevMode
NewPrinterName = UCase$(Left(DM.dmDeviceName, InStr(DM.dmDeviceName, vbNullChar) - 1))
If Printer.DeviceName <> NewPrinterName Then
For Each objPrinter In Printers
If UCase$(objPrinter.DeviceName) = NewPrinterName Then
Set Printer = objPrinter
End If
Next
End If
On Error Resume Next

With Printer
.Copies = DM.dmCopies
.Duplex = DM.dmDuplex
.Orientation = DM.dmOrientation
End With
On Error GoTo 0
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbExclamation, "Printer Error"
Resume ExitSub
End Sub

Public Sub ShowFindFiles()
SHFindFiles 0, 0
End Sub
Private Sub UserControl_Resize()
With UserControl
.Width = 555
.Height = 540
.ScaleLeft = 0
.ScaleHeight = 540
.ScaleWidth = 555
End With
End Sub

наверх

---

Диалог "Открытие файла" без использования OCX

Данный пример покажет, как можно вывести диалог "Открытие файла" без использования OCX. Таких, к примеру, как библиотека Microsoft Common Dialog Control 6.0

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Sub Command1_Click()
Dim ofn As OPENFILENAME
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = Form1.hWnd
ofn.hInstance = App.hInstance
ofn.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "Rich Text Files (*.rtf)" + Chr$(0) + "*.rtf" + Chr$(0)
ofn.lpstrFile = Space$(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space$(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = CurDir
ofn.lpstrTitle = "Our File Open Title"
ofn.flags = 0
Dim a
a = GetOpenFileName(ofn)

If (a) Then
MsgBox "File to Open: " + Trim$(ofn.lpstrFile)
Else
MsgBox "Cancel was pressed"
End If
End Sub

наверх

---

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

BalloonMessage for MS Agent


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

наверх

---

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

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

Вопросы:

---

Автор вопроса: Анастасия

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

   А как в Win'2000 изменить цвет названия иконок на рабочем столе??? Например: надпись "Корзина" написана белым цветом на синем раочем столе, а я хочу чтобы надпись была чёрной.

---

Автор вопроса: Вадим Александрович Ярошенко

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

   Подскажите как можно в VB работать с BTrieve - файлами.

---

Автор вопроса: Анастасия

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

   А как в Win'2000 измерить загруженность процессора???

---

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

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

   VB6 не понимает никаких БД, кроме DataAcces,после установки Office2000, хотя раньше брал Excel97, Access97...

---

Автор вопроса: СаНеК

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

   Допустим у меня есть форма на которой есть Textbox и 2 кнопки. По нажатию 1 кнопки нужно прочитать из файла NN.nn первые х строк и вывести их в textbox, а по нажатию второй сохранить эти строки в NN.nn на то же место. Пожалуйста помогите

---

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

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

   Подскажите как путём перестановки всех цифр в числе получить все возможные числа.

---

Автор вопроса: Юрий Чернов

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

   Встречал ли кто-либо ActiveX для работы с USB-портом (аналог MsComm32.ocx для COM-порта)?

---

Ответы:

---

Вопрос:

   Почему исполнение в MS Word любого польяовательского макроса на VB, даже не очень объемного, яанимает слишком много времени. Причем это происходит только при первом его яапуске. В дальнейшем работа любого существующего макроса происходит с яавидной скоростью.

Здесь же хотел бы спросить почему иногда происходит яаметное яамедление яакрытия и открытия несложных документов в MS Word. Если кто-нибудь с этим уже сталкивался - поясните.

Ответ:

Автор ответа: Shemyakin, Dmitry

Дело в том, что при первом запуске код макроса предварительно компилируется и храниться в так называемом пи-коде. Это и требует некоторого времени. В дальнейшем используется только этот скомпилированный код. Когда кто либо вносит изменения в макрос, код перекомпилируется.

---

Вопрос:

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

Ответ:

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

Это связано со спецификой Word. Ты на верное замечал что даже не очень большой текст по размеру файла становится весомым. Это потому что Word в файлы кладет свою информацию (шрифт и т.д), а при загрузке он её анализирует, этим и обуславливается задержка

---

Вопрос:

   Как на VB6 сделать чтобы текст типа 5x-2y введеный в TextBox присвоился переменной не как текст, а как уравнение с неизвесными?

Ответ:

Автор ответа: Shemyakin, Dmitry

с неизвестными? что то новенькое :)
Надо писать парсер. А дело это не из простых, тем более, что нужно будет самому программировать весь математический аппарат, который умеет оперировать с уравнениями.

---

Вопрос:

   Народ, подскажите кто-нить, почему API функция ExitWindowsEx не завершает работу или не выключает комп, а завершает сеанс данного юзера и предлагает войти под новым именем ?

Ответ:

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

Возможно, что у тебя используется константа = 0 (см. ниже), она равносильна входу в систему под другим именем.
Нужно делать так:
Private EWX_LOGOFF = 0 'Входит в систему под другим именем.
Private EWX_SHUTDOWN = 1 'Завершает работу и выключает питание
Private EWX_REBOOT = 2 'Перезагружает компьютер
Private EWX_FORCE = 4 'Закрывает все программы не сохраняя файлы
Private EWX_POWEROFF = 8 'Завершает работу системы и если есть возможность выключает компьютер
Пример:
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
  
Form_Load
ExitWindowsEx EWX_REBOOT 'Перезагружаем компьютер
End Sub
Вот и все.

---

Вопрос:

   Народ, подскажите кто-нить, почему API функция ExitWindowsEx не завершает работу или не выключает комп, а завершает сеанс данного юзера и предлагает войти под новым именем ?

Ответ:

Автор ответа: Владимир Капустин

Может попробуете функцию ExitWindows ?

Public Declare Function ExitWindows Lib "user32" Alias "ExitWindows" (ByVal dwReserved As Long, ByVal
uReturnCode As Long) As Long
' MyExit - любая переменная
1.Перезагрузить Windows
MyExit = ExitWindows(dwReserved,&H42)
2.Выйти в DOS(VB3) или Выключить Питание(VB6)
MyExit = ExitWindows(dwReserved,0)
3. Перезагрузить ЭВМ
MyExit = ExitWindows(dwReserved,&H43)
  
Если не сработает, тогда попробуйте подставить вместо 16-ричных значений эти константы (они взяты из API TEXT Viewer для 6.0 про(рус)).
Public Const EWX_FORCE = 4
Public Const EWX_LOGOFF = 0
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
  
К сожелению проверить их не могу, так как тяжело подключится к Интернет после перезагрузки. Если это не сработает, напишите мне. Я сделаю пример.

---

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

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

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

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

наверх