Отправляет email-рассылки с помощью сервиса Sendsay

Visual Basic: новости сайтов, советы, примеры кодов.

Подписаться Бесплатная «Серебряная» новостная рассылка . Подписчиков 4.063 RSS
←   Ноябрь 2002   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
16.11.2002
14:03:23
14:03:33
17
18
19
20
21
22
23
24
25
26
27
28
29
30


За последние 60 дней ни разу не выходила


Сайт рассылки: http://vbnet.ru
Открыта: 31-07-2001

Автор
Павел Сурменок

Статистика

4.063 подписчиков
0 за неделю
←   Все выпуски   →

Visual Basic: новости сайтов, советы, примеры кодов. Выпуск 107.


Информационный Канал Subscribe.Ru

Visual Basic: новости сайтов, советы, примеры кодов.
Выпуск 107.

VBNet VBMania
Голосование:

Голосования сайта VBNet.Ru. Результаты голосований передаются на сайт. Проследите, что есть соединение с интернетом.


Рассылки Subscribe.Ru
VB.NET-World
Новости сайта IgorykSoft и советы по программированию
Visual Basic.NET Уроки.
Доска почёта:

Sergey Y. Tkachev
Кононенко Роман
Kirill
Ссылки:

  • Улицы VB
  • Использование VB
  • Азбука VB
  • VB на русском
  • Улицы VB
  • Кирпичики VB
  • CообЧа VB
  • Snoozex Design
  • IgorykSoft
    		• Господа!!! читайте MSDN!!!

    Несколько слов от автора:

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


    Содержание выпуска

    Книги

    Переход на 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 Sub Command1_Click()
    MsgBox "Количество запущенных заданий: " & GetPrinterQueue(Printer.DeviceName)
    End Sub

    'КОД МОДУЛЯ

    Option Explicit
    Public Const CCHDEVICENAME = 32
    Public Const CCHFORMNAME = 32
    Public Const PRINTER_ACCESS_ADMINISTER = &H4
    Public Const PRINTER_ACCESS_USE = &H8
    Public 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 Long
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    End Type
    Public Type PRINTER_DEFAULTS
    pDatatype As String
    pDevMode As DEVMODE
    DesiredAccess As Long
    End Type
    Public Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
    End Type
    Public Type JOB_INFO_1_API
    JobId As Long
    pPrinterName As Long
    pMachineName As Long
    pUserName As Long
    pDocument As Long
    pDatatype As Long
    pStatus As Long
    Status As Long
    Priority As Long
    Position As Long
    TotalPages As Long
    PagesPrinted As Long
    Submitted As SYSTEMTIME
    End Type
    Public Type JOB_INFO_1
    JobId As Long
    pPrinterName As String
    pMachineName As String
    pUserName As String
    pDocument As String
    pDatatype As String
    pStatus As String
    Status As Long
    Priority As Long
    Position As Long
    TotalPages As Long
    PagesPrinted As Long
    Submitted As SYSTEMTIME
    End Type
    Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long
    Public Declare Function EnumJobs Lib "winspool.drv" Alias "EnumJobsA" (ByVal HPrinter As Long, ByVal FirstJob As Long, ByVal NoJobs As Long, ByVal Level As Long, ByVal pJob As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
    Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
    Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
    Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long
    Private Declare Function HeapAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
    Private Declare Function HeapFree Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
    Public JobsDesc(0 To 127) As JOB_INFO_1

    Public Function TrimStr(strName As String) As String
    'Finds a null then trims the string
    Dim x As Integer
    x = InStr(strName, vbNullChar)
    If x > 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
    End Function

    Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
    Dim lngLength As Long
    'Get number of characters in string
    lngLength = lstrlenW(lngPointer) * 2
    'Initialize string so we have something to copy the string into
    LPSTRtoSTRING = String(lngLength, 0)
    'Copy the string
    CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
    'Convert to Unicode
    LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
    End Function

    'Get the number of Jobs in the specified Printer Queue (max 128)... the PrinterName can be a network path: "\\MYSERVER\MYPRINTER"
    Function GetPrinterQueue(PrinterName As String) As Long
    Dim PrinterStruct As PRINTER_DEFAULTS
    Dim HPrinter As Long
    Dim ret As Boolean
    Dim Jobs(0 To 127) As JOB_INFO_1_API
    Dim pcbNeeded As Long
    Dim pcReturned As Long
    Dim i As Integer
    Dim TempBuff As Long
    'Initialize the Printer structure
    PrinterStruct.pDatatype = vbNullString
    PrinterStruct.pDevMode.dmSize = Len(PrinterStruct.pDevMode)
    PrinterStruct.DesiredAccess = PRINTER_ACCESS_USE
    'Get the printer Handle
    ret = OpenPrinter(PrinterName, HPrinter, PrinterStruct)
    'Get the Printer active jobs
    ret = EnumJobs(HPrinter, 0, 127, 1, TempBuff, 0, pcbNeeded, pcReturned)
    If pcbNeeded = 0 Then
    GetPrinterQueue = 0
    Else
    'Allocate the Buffer
    TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
    ret = EnumJobs(HPrinter, 0, 127, 1, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
    CopyMem Jobs(0), ByVal TempBuff, pcbNeeded
    For i = 0 To pcReturned - 1
    JobsDesc(i).pPrinterName = LPSTRtoSTRING(Jobs(i).pPrinterName)
    JobsDesc(i).pMachineName = LPSTRtoSTRING(Jobs(i).pMachineName)
    JobsDesc(i).pUserName = LPSTRtoSTRING(Jobs(i).pUserName)
    JobsDesc(i).pDocument = LPSTRtoSTRING(Jobs(i).pDocument)
    JobsDesc(i).pDatatype = LPSTRtoSTRING(Jobs(i).pDatatype)
    JobsDesc(i).pStatus = LPSTRtoSTRING(Jobs(i).pStatus)
    JobsDesc(i).JobId = Jobs(i).JobId
    JobsDesc(i).Status = Jobs(i).Status
    JobsDesc(i).Priority = Jobs(i).Priority
    JobsDesc(i).Position = Jobs(i).Position
    JobsDesc(i).TotalPages = Jobs(i).TotalPages
    JobsDesc(i).PagesPrinted = Jobs(i).PagesPrinted
    JobsDesc(i).Submitted = Jobs(i).Submitted
    Next
    If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
    GetPrinterQueue = pcReturned
    End If
    ret = CloseHandle(HPrinter)
    End Function

    наверх

    Получить список доступных портов

    Вам понадобится дополнительный модуль.

    'КОД ФОРМЫ

    Private Sub Command1_Click()
    Dim NumPorts As Long
    Dim i As Integer
    NumPorts = GetAvailablePorts("")
    List1.Clear
    For i = 0 To NumPorts - 1
    List1.AddItem Ports(i).pPortName
    Next
    End Sub

    'КОД МОДУЛЯ

    Option Explicit
    Private Declare Function EnumPorts Lib "winspool.drv" Alias "EnumPortsA" (ByVal pName As String, ByVal Level As Long, ByVal lpbPorts As Long, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
    Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long
    Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
    Private Declare Function HeapAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
    Private Declare Function HeapFree Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long

    Private Type PORT_INFO_2
    pPortName As String
    pMonitorName As String
    pDescription As String
    fPortType As Long
    Reserved As Long
    End Type
    Private Type API_PORT_INFO_2
    pPortName As Long
    pMonitorName As Long
    pDescription As Long
    fPortType As Long
    Reserved As Long
    End Type
    Public Ports(0 To 100) As PORT_INFO_2

    Public Function TrimStr(strName As String) As String
    Dim x As Integer
    x = InStr(strName, vbNullChar)
    If x > 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
    End Function

    Public Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
    Dim lngLength As Long
    'Get number of characters in string
    lngLength = lstrlenW(lngPointer) * 2
    'Initialize string so we have something to copy the string into
    LPSTRtoSTRING = String(lngLength, 0)
    'Copy the string
    CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
    'Convert to Unicode
    LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
    End Function

    'Use ServerName to specify the name of a Remote Workstation i.e. "//WIN95WKST"
    'or leave it blank "" to get the ports of the local Machine
    Public Function GetAvailablePorts(ServerName As String) As Long
    Dim ret As Long
    Dim PortsStruct(0 To 100) As API_PORT_INFO_2
    Dim pcbNeeded As Long
    Dim pcReturned As Long
    Dim TempBuff As Long
    Dim i As Integer
    'Get the amount of bytes needed to contain the data returned by the API call
    ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned)
    'Allocate the Buffer
    TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
    ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
    If ret Then
    'Convert the returned String Pointer Values to VB String Type
    CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded
    For i = 0 To pcReturned - 1
    Ports(i).pDescription = LPSTRtoSTRING(PortsStruct(i).pDescription)
    Ports(i).pPortName = LPSTRtoSTRING(PortsStruct(i).pPortName)
    Ports(i).pMonitorName = LPSTRtoSTRING(PortsStruct(i).pMonitorName)
    Ports(i).fPortType = PortsStruct(i).fPortType
    Next
    End If
    GetAvailablePorts = pcReturned
    'Free the Heap Space allocated for the Buffer
    If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
    End Function

    наверх

    Вызвать окно "Форматирование: Диск А:"

    Private Declare Function SHFormatDrive Lib "shell32.dll" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As Long
    Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
    Const DRIVE_CDROM = 5
    Const DRIVE_FIXED = 3
    Const DRIVE_RAMDISK = 6
    Const DRIVE_REMOTE = 4
    Const DRIVE_REMOVABLE = 2
    Const SHFMT_ID_DEFAULT = &HFFFF ' Option bits for options parameter
    Const SHFMT_OPT_FULL = 1
    Const SHFMT_OPT_SYSONLY = 2
    Public Sub FormatFloppy(hWndOwner As Long, ByVal DriveLetter As String)
    Dim DriveNum As Long
    Dim DriveType As Long
    Dim ret As Long
    DriveLetter = Left(DriveLetter, 1) & ":\"
    ' Преобразование имени диска в номер устройства: A=0, B=1...
    DriveNum = Asc(UCase(DriveLetter)) - Asc("A")
    DriveType = GetDriveType(DriveLetter)
    ' проверка, а флоппи ли это...
    If DriveType = DRIVE_REMOVABLE Then
    ret = SHFormatDrive(hWndOwner, DriveNum, SHFMT_ID_DEFAULT, SHFMT_OPT_FULL)
    Else
    MsgBox "Это не флоппи!", vbExclamation
    End If
    End Sub
    Private Sub Command1_Click()
    FormatFloppy Me.hwnd, "A"
    End Sub

    наверх

    Формирование из числа его "строковое" представление

    Многим из вас приходилось формировать из числа, содержащего количество секунд, строку, показывающую количество часов, минут и секунд. Для этого можно воспользоваться готовым примером.

    Private Sub Command1_Click()
    'Передаем функции 260 минут, получаем: 4 часа 20 минут
    MsgBox FormatTime(260)
    End Sub

    'Формирует строку с указанием количества минут(часов, секунд)
    Public Function FormatTime(lTime As Long) As String
    Dim lSec As Long
    Dim lMin As Long
    Dim lHour As Long
    Dim lTemp As Long
    Dim i As Long
    If lTime < 60 Then
    FormatTime = lTime & " сек"
    ElseIf lTime / 60 < 60 Then
    lTemp = lTime
    Do While lTemp > 60
    i = i + 1
    lTemp = lTemp - 60
    Loop
    lMin = i
    lSec = lTime - (lMin * 60)
    FormatTime = lMin & " мин " & lSec & " сек"
    Else
    lTemp = lTime
    Do While lTemp > 60 * 60
    i = i + 1
    lTemp = lTemp - 60 * 60
    Loop
    lHour = i
    i = 0
    lTemp = lTime - (lHour * 60 * 60)
    Do While lTemp > 60
    i = i + 1
    lTemp = lTemp - 60
    Loop
    lMin = i
    lSec = lTime - (lHour * 60 * 60) - (lMin * 60)
    FormatTime = lHour & " час " & lMin & " мин " & lSec & " сек"
    End If
    End Function

    наверх

    Как показать песочные часы во время работы программы

    Если Вам необходимо сделать действие, во время которого пользователю не "рекомендуется" пользоваться мышью (например сделать расчеты), то лучше всего сменить курсор мыши на песочные часы. Используйте эту функцию и для восстановления вида курсора.

    'Процедура служит для смены кусора на песочные часы
    'и восстановления его после вторичного вызова
    Public Sub HourGlass(obj As Object)
    Static ordMouse As Integer
    Static fOn As Boolean
    On Error Resume Next
    'если повторный вызов
    If Not fOn Then
    ordMouse = obj.MousePointer 'запомнить старый
    obj.MousePointer = vbHourglass 'установить новый
    fOn = True 'запомнить, что уже вызывали
    Else 'Если нужно восстановить
    obj.MousePointer = ordMouse 'восстановить курсор
    fOn = False 'запомнить, что уже восстановили
    End If
    End Sub

    Private Sub Command1_Click()
    Call HourGlass(Form1)
    End Sub

    наверх

    Перекодировка текста из DOS в Windows формат

    Если Вам нужно конвертировать текст формата DOS в Windows (1251), то в API есть на этот случай хорошая функция: OemToChar.

    Объявляется она так:

    Public Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

    Используют её следующим образом:
    Dim l_lReturn as Long
    Dim l_sSource as String 'исходный текст
    Dim l_sDestination as String 'возвращаемый текст
    l_lReturn = oemtochar(l_sSource, l_sDestination)

    Кроме этой полезной функции в API имеется и обратная её функция: CharToOem. Она служит для выполнения той же работы, только наоборот, т.е.Windows (1251) в DOS.

    Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

    наверх

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

    BalloonMessage for MS Agent

       BalloonMessage for Microsoft Agent реализует диалог программы с пользователем, используя при этом технологию Microsoft Agent. OCX реализует три типа диалоговых окон: InputBox, MsgBox и MsgLabels.

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

    наверх

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

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

    Вопросы:

    Нет вопросов.


    Ответы:

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

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

    наверх

    Выпуск подготовили:

    		 Сурменок Павел
    http://subscribe.ru/
    E-mail: ask@subscribe.ru     		Отписаться
    Убрать рекламу
    В избранное