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

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


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

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


VBNet
Ссылки:

  • GotDotNet
  • Улицы VB
  • Азбука VB
  • VB по русски
  • MDesign
  • DanSoft
  • Хрестоматия VB
  • VBCoder
  • Господа, читайте MSDN!

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

       Рассылка пробудилась из непродолжительного отпуска... Надолго ли - пока не знаю, все еще очень много оффлайновых и онлайновых дел, не дающих мне покоя :)

       Меня попросили упомянуть в рассылке сайт "avalon-z"... Привожу текст письма :)

    Здраствуйте! Не могли бы вы в своей рассылке напечатать адрес моего сайта. На сайте есть много исходников по VB и ASM. Есть несколько моих программ. Работает форум, гостевая и чат. Читатели рассылки могут писать вопросы в форум и получать ответы на них практически моментально.
    http://avalon-z.nm.ru/

    P.S. Если вы напишете адрес в вашей рассылке я буду очень благодарен вам.

    С уважением, NeoN.
    Читайте!


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




    Как узнать, какую область окна перерисовывать?

    .NET >>> WinForms

    Вопрос:

    Если моё окно частично перекрывает другое окно, а потом открывает, то как узнать область, необходимую для перерисовки?

    Ответ:

    В обработчике OnPaint анализируйте свойство PaintEventArgs.ClipRectangle.

    наверх


    Как блокировать пользователя домена?

    .NET

    Вопрос:

    Необходимо создать маленькую утилитку, которая блокировала или разблокировала бы учетную запись в домене.
    Создаем вхождение:

    DirectoryEntry entry = new DirectoryEntry("WinNT://domain/user");

    и получаем через entry.Properties набор свойств. Насколько я понимаю, за состояние учетной записи отвечает свойство userFlags. Но как понять какой бит за что отвечает? Как нужно поменять этот флаг для того, чтобы например заблокировать запись?

    Ответ:

    Судя по значению маски UF_ACCOUNTDISABLE - это 1-ый бит (если считать с 0-го), когда он установлен - account в disabled состоянии.
    Вот функция для изменения этого флага:

    void EnableAccount(string path, bool enable)
    {
        DirectoryEntry entry = new DirectoryEntry(path);
        entry.UsePropertyCache = false;
        PropertyValueCollection valueCollection =
    entry.Properties["userFlags"];
        int userFlags = (int)valueCollection[0];
        if (enable)
            userFlags &= ~2;
        else
            userFlags |= 2;
        valueCollection[0] = userFlags;
    }


    А вот ее использование (перевод в состояние disabled account'a Гость):

    EnableAccount("WinNT://COMPUTER/Гость", false);

    наверх


    Где можно почитать о рисовании при помощи GDI+?

    .NET

    Вопрос:

    Где можно почитать о рисовании при помощи GDI+?

    Ответ:

    Painting techniques using Windows Forms for the Microsoft .NET Framework

    наверх


    Как делать массивы элементов?

    .NET >>> WinForms

    Вопрос:

    По-тихоньку перехожу на VB.Net. Меня волнует вопрос о создании массивов объектов. В версии 6 можно было добавить новый элемент в коллекцию с помощью Load, и проблем не было. Здесь же этого сделать не получается.

    Ответ:

    В VB .NET массивов элеметов нет. Однако, вы сами можете создать массив объектов из кода приложения. Посмотрите, как создаются элементы в коде в регионе Form Designer (он сверху в редакторе). Просто на уровне формы объявить массив нужного типа. А потом в обработчике события загрузки формы создать сами объекты, ссылки загруить в массив и установить их свойства.

    наверх


    Как произвести шифрование текста?

    .NET

    Вопрос:

    Мне необходимо зашифровать, а потом расшифровать текстовый файл. Как это сделать?

    Ответ:

    Посмотрите пространство имен System.Security.Cryptography. На сайте vbnet.ru в библиотеке кодов есть примерчик по симметричному шифрованию, а в разделе Статьи - статья по той же теме.

    наверх


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

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

    Вопросы:


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

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

       Как можно менять картинки на форме в зависимости от времени (предположим с 12 00 до 2 00 одни, а с2 00 до 12 00 другие)?


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

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

       Где можно скачать примеры функций API?


    Автор вопроса: Котофей

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

       Я использую в программе RichtextBox. При копировании текста например из письма Outlook, и вставке в мой RichTextBox, он отображается в какой-то корявой кодировке. Как от этого можно избавиться?


    Автор вопроса: Котофей

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

       Richtextbox постоянно переключается с русского на английский и наоборот. Что можно сделать?


    Автор вопроса: Котофей

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

       Есть ли какие-нибудь учебники по написанию ActiveX Control? (Я имею ввиду не
    пару статей.)




    Ответы:


    Вопрос:

       Нужно определить существование папки. Я делаю при помощи функции:

    Function DirExist(dirName As String) As Boolean
    On Error Resume Next
    If Dir$(dirName, vbDirectory) <> "" Then
      DirExist = True
    Else
      DirExist = False
    End If
    If Err.Number <> 0 Then DirExist = False
    End Function

    Но почему-то функция иногда равна False, хотя папка действительно существует, например DirExist("D:\Documents and Settings\My_Documents\My Save Games").

    Ответ:

    Автор ответа: Пащенко А.

    Попробуй:

    Dir$("""" & dirName & """", vbDirectory)



    Ответ:

    Автор ответа: Хатламаджиян

    Используй API

    Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long

    Им можно проверять существование файлов и директорий.


    Вопрос:

       Как отскриншотить экран? При этом вставить его содержимое в Image (или другой графический контрол) и сохранить как рисунок.

    Ответ:

    Автор ответа: Хатламаджиян

    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As
    Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Private Sub Form_Load()
         Dim DeskDС As Long
         DeskDС = GetDC(GetDesktopWindow)
         Picture1.Width = Screen.Width 'необходимо подогнать размер
         Picture1.Height = Screen.Height 'PictureBox'а по размер экрана
         BitBlt Picture1.hDC, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, DeskDС, 0, 0,
    vbSrcCopy
         SavePicture Picture1.Image, "C:\pic.bmp"
    End Sub

    Рисунки могут сохраняться только в формате BMP



    Ответ:

    Автор ответа: C...R...a...S...H

    Imports System.Drawing
    Public Class ScreenToStream
         Private Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Integer
         Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
         Private Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Integer, ByVal nWidth As Integer, ByVal
    nHeight As Integer) As Integer
         Private Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Integer, ByVal iCapabilitiy As Integer) As Integer
         Private Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal hDC As Integer, ByVal wStartIndex As Integer,
    ByVal wNumEntries As Integer, ByRef lpPaletteEntries As PALETTEENTRY) As Integer
         Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Integer) As Integer
         Private Declare Function CreatePalette Lib "GDI32" (ByRef lpLogPalette As LOGPALETTE) As Integer
         Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Integer, ByVal hPalette As Integer, ByVal
    bForceBackground As Integer) As Integer
         Private Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Integer) As Integer
         Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
         Private Declare Function BitBlt Lib "GDI32" (ByVal hDCDest As Integer, ByVal XDest As Integer, ByVal YDest As Integer,
    ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hDCSrc As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer,
    ByVal dwRop As Integer) As Integer
         'Private Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Integer) As Integer
         Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Integer) As Integer
         Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
         Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Integer) As Integer
         Private Declare Function GetDesktopWindow Lib "USER32" () As Integer
         Private Const RASTERCAPS As Integer = 38
         Private Const RC_PALETTE As Integer = &H100S
         Private Const SIZEPALETTE As Integer = 104
         Private Structure PALETTEENTRY
             Dim peRed As Byte
             Dim peGreen As Byte
             Dim peBlue As Byte
             Dim peFlags As Byte
         End Structure
         Private Structure LOGPALETTE
             Dim palVersion As Short
             Dim palNumEntries As Short
             Dim palPalEntry() As PALETTEENTRY ' Enough for 256 colors
         End Structure
         Private Function CaptureWindow(ByVal hWndSrc As Integer, ByVal bClient As Boolean, ByVal LeftSrc As Integer, ByVal
    TopSrc As Integer, ByVal WidthSrc As Integer, ByVal HeightSrc As Integer) As System.Drawing.Image
             Dim hDCMemory As Integer
             Dim hBmp As Integer
             Dim hBmpPrev As Integer
             Dim r As Integer
             Dim hDCSrc As Integer
             Dim hPal As Integer
             Dim hPalPrev As Integer
             Dim RasterCapsScrn As Integer
             Dim HasPaletteScrn As Integer
             Dim PaletteSizeScrn As Integer
             Dim LogPal As LOGPALETTE
             hDCSrc = GetDC(hWndSrc) 'Get DC for Client area.
             hDCMemory = CreateCompatibleDC(hDCSrc)
             hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
             hBmpPrev = SelectObject(hDCMemory, hBmp)
             RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) 'Raster capabilities
             HasPaletteScrn = RasterCapsScrn And RC_PALETTE 'Palette support
             PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) 'Palette size
             If HasPaletteScrn And (PaletteSizeScrn = 256) Then
                 LogPal.palVersion = &H300S
                 LogPal.palNumEntries = 256
                 r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
                 hPal = CreatePalette(LogPal)
                 hPalPrev = SelectPalette(hDCMemory, hPal, 0)
                 r = RealizePalette(hDCMemory)
             End If
             r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, SRCCOPY)
             hBmp = SelectObject(hDCMemory, hBmpPrev)
             If HasPaletteScrn And (PaletteSizeScrn = 256) Then
                 hPal = SelectPalette(hDCMemory, hPalPrev, 0)
             End If
             r = DeleteDC(hDCMemory)
             r = ReleaseDC(hWndSrc, hDCSrc)
             Dim im As Bitmap
             Return im.FromHbitmap(New IntPtr(hBmp))
         End Function

         Public Function CaptureScreen() As System.Drawing.Image
             Dim hWndScreen As Integer
             hWndScreen = GetDesktopWindow()
             CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width,
    System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height)
         End Function
         Public Function ScreenToStream() As IO.MemoryStream
             Dim bb As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
             Dim bn As IO.Stream
             bn = New IO.MemoryStream
             bb.Serialize(bn, CaptureScreen())
             Return bn
         End Function
    End Class
    ---------------------------------------------------------------------------------------------

    -------------------------------------COPY----------------------------------------------------
    Cкриншот экрана, активного окна, печать и сохранение в файл

    Данный пример покажет, как можно сделать скриншот всего экрана, текущего окна (с заголовком и без), текущего окна по
    таймеру. А также пример печати скриншота и сохранения в файл.
    Расположите на форме 7 элементов CommandButton, элемент PictureBox (растяните изображение PictureBox как можно больше). А
    также расположите на форме элемент Microsoft Common Dialog Control 6.0 через меню Project | Components.

    Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
    End Type
    Private Type PALETTEENTRY
    peRed As Byte
    peGreen As Byte
    peBlue As Byte
    peFlags As Byte
    End Type
    Private Type LOGPALETTE
    palVersion As Integer
    palNumEntries As Integer
    palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors.
    End Type
    Private Type PicBmp
    Size As Long
    Type As Long
    hBmp As Long
    hPal As Long
    Reserved As Long
    End Type
    Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type

    Private Declare Function BitBlt Lib "GDI32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth
    As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
    Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long
    Private Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As
    Long) As Long
    Private Declare Function CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) As Long
    Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long
    Private Declare Function GetDesktopWindow Lib "USER32" () As Long
    Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long
    Private Declare Function GetForegroundWindow Lib "USER32" () As Long
    Private Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal hDC As Long, ByVal wStartIndex As Long, ByVal
    wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
    Private Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Long) As Long
    Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long
    Private Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As Long
    Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal
    fPictureOwnsHandle As Long, IPic As IPicture) As Long
    Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long
    Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal hPalette As Long, ByVal bForceBackground As
    Long) As Long

    Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long,
    ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
    Dim hDCMemory As Long
    Dim hBmp As Long
    Dim hBmpPrev As Long
    Dim r As Long
    Dim hDCSrc As Long
    Dim hPal As Long
    Dim hPalPrev As Long
    Dim RasterCapsScrn As Long
    Dim HasPaletteScrn As Long
    Dim PaletteSizeScrn As Long
    Dim LogPal As LOGPALETTE
    If Client Then
    hDCSrc = GetDC(hWndSrc)
    Else
    hDCSrc = GetWindowDC(hWndSrc)
    End If
    hDCMemory = CreateCompatibleDC(hDCSrc)
    hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
    hBmpPrev = SelectObject(hDCMemory, hBmp)
    RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)
    HasPaletteScrn = RasterCapsScrn And RC_PALETTE
    PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)
    If HasPaletteScrn And (PaletteSizeScrn = 256) Then
    LogPal.palVersion = &H300
    LogPal.palNumEntries = 256
    r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
    hPal = CreatePalette(LogPal)
    hPalPrev = SelectPalette(hDCMemory, hPal, 0)
    r = RealizePalette(hDCMemory)
    End If
    r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)
    hBmp = SelectObject(hDCMemory, hBmpPrev)
    If HasPaletteScrn And (PaletteSizeScrn = 256) Then
    hPal = SelectPalette(hDCMemory, hPalPrev, 0)
    End If
    r = DeleteDC(hDCMemory)
    r = ReleaseDC(hWndSrc, hDCSrc)
    Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
    End Function

    Public Function CaptureActiveWindow() As Picture
    Dim hWndActive As Long
    Dim r As Long
    Dim RectActive As RECT
    hWndActive = GetForegroundWindow()
    r = GetWindowRect(hWndActive, RectActive)
    Set CaptureActiveWindow = CaptureWindow(hWndActive, False, 0, 0, RectActive.Right - RectActive.Left, RectActive.Bottom -
    RectActive.Top)
    End Function

    Public Function CaptureClient(frmSrc As Form) As Picture
    Set CaptureClient = CaptureWindow(frmSrc.hWnd, True, 0, 0, frmSrc.ScaleX(frmSrc.ScaleWidth, frmSrc.ScaleMode, vbPixels),
    frmSrc.ScaleY(frmSrc.ScaleHeight, frmSrc.ScaleMode, vbPixels))
    End Function

    Public Function CaptureScreen() As Picture
    Dim hWndScreen As Long
    hWndScreen = GetDesktopWindow()
    Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, Screen.Width \ Screen.TwipsPerPixelX, Screen.Height \
    Screen.TwipsPerPixelY)
    End Function

    Public Function CaptureForm(frmSrc As Form) As Picture
    Set CaptureForm = CaptureWindow(frmSrc.hWnd, False, 0, 0, frmSrc.ScaleX(frmSrc.Width, vbTwips, vbPixels),
    frmSrc.ScaleY(frmSrc.Height, vbTwips, vbPixels))
    End Function

    Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
    Dim r As Long
    Dim Pic As PicBmp
    Dim IPic As IPicture
    Dim IID_IDispatch As GUID
    With IID_IDispatch
    .Data1 = &H20400
    .Data4(0) = &HC0
    .Data4(7) = &H46
    End With
    With Pic
    .Size = Len(Pic)
    .Type = vbPicTypeBitmap
    .hBmp = hBmp
    .hPal = hPal
    End With
    r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
    Set CreateBitmapPicture = IPic
    End Function

    Public Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture)
    Const vbHiMetric As Integer = 8
    Dim PicRatio As Double
    Dim PrnWidth As Double
    Dim PrnHeight As Double
    Dim PrnRatio As Double
    Dim PrnPicWidth As Double
    Dim PrnPicHeight As Double
    If Pic.Height >= Pic.Width Then
    Prn.Orientation = vbPRORPortrait
    Else
    Prn.Orientation = vbPRORLandscape
    End If
    PicRatio = Pic.Width / Pic.Height
    PrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, vbHiMetric)
    PrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, vbHiMetric)
    PrnRatio = PrnWidth / PrnHeight
    If PicRatio >= PrnRatio Then
    PrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, Prn.ScaleMode)
    PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, vbHiMetric, Prn.ScaleMode)
    Else
    PrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, Prn.ScaleMode)
    PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, vbHiMetric, Prn.ScaleMode)
    End If
    Prn.PaintPicture Pic, 0, 0, PrnPicWidth, PrnPicHeight
    End Sub

    Private Sub Command1_Click()
    Set Picture1.Picture = CaptureScreen()
    End Sub
    Private Sub Command2_Click()
    Set Picture1.Picture = CaptureForm(Me)
    End Sub
    Private Sub Command3_Click()
    MsgBox "Через 3 секунды после закрытия окна вы получите изображение окна"
    Dim EndTime As Date
    EndTime = DateAdd("s", 3, Now)
    Do Until Now > EndTime
    DoEvents
    Loop
    Set Picture1.Picture = CaptureActiveWindow()
    Me.SetFocus
    End Sub
    Private Sub Command4_Click()
    Set Picture1.Picture = CaptureClient(Me)
    End Sub
    Private Sub Command5_Click()
    PrintPictureToFitPage Printer, Picture1.Picture
    Printer.EndDoc
    End Sub
    Private Sub Command6_Click()
    CommonDialog1.DefaultExt = ".BMP"
    CommonDialog1.Filter = "Bitmap Image (*.bmp)|*.bmp"
    CommonDialog1.ShowSave
    If CommonDialog1.FileName <> "" Then
    SavePicture Picture1.Picture, CommonDialog1.FileName
    End If
    End Sub
    Private Sub Command7_Click()
    Set Picture1.Picture = Nothing
    End Sub
    Private Sub Form_Load()
    Command1.Caption = "Весь экран"
    Command2.Caption = "Активное окно"
    Command3.Caption = "Активное окно (3 сек)"
    Command4.Caption = "Акт. окно бе загол."
    Command5.Caption = "Напечатать картинку"
    Command6.Caption = "Сохранить картинку"
    Command7.Caption = "Очистить"
    End Sub


    Вопрос:

       Как правильно работать с модемом, например открыть порт, набрать номер, соединиться с удаленным компьютером?

    Ответ:

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

    Можно использовать RASAPI.


    Вопрос:

       Как изменить вид формы, допустим, сделать форму круглой?

    Ответ:

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

    Через Path:
      
        Private Declare Function SelectClipPath Lib "gdi32" _
                (ByVal hdc As Long, ByVal iMode As Long) As Long
        Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
        Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
        Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc 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 Const RGN_COPY = 5
      
        Private Sub Form_Load()
           ' Don't forget to set Form.BorderStyle property to None !
           Const TXT = " Cool programm" & vbCrLf & " from" & vbCrLf & _
                       "Cool Company" & vbCrLf & "CopyLeft by Ark"
           Dim hRgn As Long
           Font.Name = "Times New Roman"
           Font.Bold = True
           Font.Size = 60
           Width = TextWidth(TXT)
           Height = TextHeight(TXT)
           BeginPath hdc
           CurrentX = 0
           CurrentY = 0
           Print TXT
      
           ' Здесь вместо текста можно рисовать фигуры
           EndPath hdc
           hRgn = PathToRegion(hdc)
           SetWindowRgn hWnd, hRgn, False
      
           ' Hачинаем фантазировать с формой. Можно так
           Picture = LoadPicture("c:\windows\облака.bmp")
           ' А можно так
        ' dclr = 256 / (TextHeight(TXT) / 30)
        ' clr = 0
        ' For i = 120 To 120 + TextHeight(TXT) Step 30
        ' Line (0, i)-Step(5000, 0), RGB(0, 0, clr)
        ' clr = clr + dclr
        ' Next i
           ' Можно дать форме градиентную заливку и т.д.
           ' Двигаем к центру, а можно в таймере крутить
           Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
        End Sub



    Ответ:

    Автор ответа: Пащенко А.

    http://vbnet.ru/articles/showarticle.aspx?id=22



    Ответ:

    Автор ответа: Хатламаджиян

       Попробуй так. (Код поставь на форму)

    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 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 CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As
    Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
    Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As
    Long) As Long
    Dim mDC As Long
    Private Sub Form_Load()
         Dim mRGN As Long
         mRGN = CreateEllipticRgn(0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)

    ' mRGN = CreateEllipticRgn(0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
    ' mRGN = CreateRectRgn(0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
    ' mRGN = CreateRoundRectRgn(0, 0, Me.Width / Screen.TwipsPerPixelX,Me.Height / Screen.TwipsPerPixelY, 50, 50)
    ' mRGN = CreateRoundRectRgn(0, 0, Me.Width / Screen.TwipsPerPixelX,Me.Height / Screen.TwipsPerPixelY, & _
                 Me.Width / Screen.TwipsPerPixelX,Me.Height / Screen.TwipsPerPixelY)

         SetWindowRgn Me.hWnd, mRGN, True
         DeleteObject mRGN
    End Sub
    Private Sub Form_Unload(Cancel As Integer)
         DeleteDC mDC
    End Sub


    Вопрос:

       Как можно сделать TextBox прозрачным, так чтобы было видно картинку на форме? Или как можно в TextBox на фон вставить картинку?

    Ответ:

    Автор ответа: Хатламаджиян

       На сколько я знаю, обычный TextBox нельзя сделать прозрачным и вставить рисунок.

       К сожалению, не помню где именно, но в Net'е был контрол, у которого можно было добавить фоновый рисунок. Поищи, может, этот ресурс ещё остался.




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

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

    наверх


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

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

    Subscribe.Ru
    Поддержка подписчиков
    Другие рассылки этой тематики
    Другие рассылки этого автора
    Подписан адрес:
    Код этой рассылки: comp.soft.prog.vbnewsadvices
    Отписаться
    Вспомнить пароль

    В избранное