Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 |

 

  Вопрос: Окно произвольной формы Добавлено: 04.08.06 18:07  

Автор вопроса:  FIX | ICQ: 348680795 
нашел статью по созданию окон сложной произвольной формы( http://www.vbrussian.com/Article.asp?ID=74 ).Дошел до создания простых нестандартных окон. Сделал вроде всё как там, но неработает. Хелп плиз. Мой код:
'----------------------------------------------------
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public 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
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const HWND_TOPMOST = -1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2

Private Type POINTAPI
        x As Long
        y As Long
End Type

Public Sub SetFormPosition(frmHandl As Long, TopPosition As Boolean)
      If TopPosition Then
           SetWindowPos frmHandl, HWND_TOPMOST, 0, 0, 0, 0, _
                        SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE
       Else
           SetWindowPos frmHandl, HWND_NOTOPMOST, 0, 0, 0, 0, _
                        SWP_NOSIZE Or SWP_NOMOVE
       End If
End Sub

Public Function lGetRegion(Pic As PictureBox, lBackColor As Long) As Long
   Dim lRgn As Long
   Dim lSkinRgn As Long
   Dim lStart As Long
   Dim lX As Long
   Dim lY As Long
   Dim lHeight As Long
   Dim lWidth As Long

   'ñîçäàåì ïóñòîé ðåãèîí, ñ êîòîðîãî íà÷íåì ðàáîòó
   lSkinRgn = CreateRectRgn(0, 0, 0, 0)
   With Pic
      'ïîäñ÷èòàåì ðàçìåðû ðèñóíêà â Pixel
      lHeight = .Height / Screen.TwipsPerPixelY
      lWidth = .Width / Screen.TwipsPerPixelX
      For lX = 0 To lHeight - 1
         lY = 0
         Do While lY < lWidth
            '&#232;&#249;&#229;&#236; &#237;&#243;&#230;&#237;&#251;&#233; Pixel
            Do While lY < lWidth And GetPixel(.hdc, lY, lX) = lBackColor
               lY = lY + 1
            Loop
            If lY < lWidth Then
               lStart = lY
            Do While lY < lWidth And GetPixel(.hdc, lY, lX) <> lBackColor
               lY = lY + 1
            Loop
            If lY > lWidth Then lY = lWidth
               '&#237;&#243;&#230;&#237;&#251;&#233; Pixel &#237;&#224;&#233;&#228;&#229;&#237;, &#228;&#238;&#225;&#224;&#226;&#232;&#236; &#229;&#227;&#238; &#226; &#240;&#229;&#227;&#232;&#238;&#237;
               lRgn = CreateRectRgn(lStart, lX, lY, lX + 1)
               CombineRgn lSkinRgn, lSkinRgn, lRgn, RGN_OR
               DeleteObject lRgn
            End If
         Loop
      Next
   End With
   lGetRegion = lSkinRgn
End Function

Sub Main()
        Dim lRgn As Long
        Load Form1
        Form1.Pic.Picture = LoadPicture("C:\Pictures\3\BtnClose.bmp")
        lRgn = lGetRegion(Form1.Pic, vbWhite)
        SetWindowRgn Form1.hwnd, lRgn, True
        DeleteObject lRgn
        Form1.Show
        SetFormPosition Form1.hwnd, True
End Sub

Ответить

  Ответы Всего ответов: 24  

Номер ответа: 1
Автор ответа:
 FIX



ICQ: 348680795 

Вопросов: 39
Ответов: 62
 Профиль | | #1 Добавлено: 04.08.06 18:51
Я видимо многовато выложил... Но здесь не всё так страшно, помогите плз.

Ответить

Номер ответа: 2
Автор ответа:
 Серёга



ICQ: 262809473 

Вопросов: 17
Ответов: 561
 Web-сайт: houselab.narod.ru
 Профиль | | #2
Добавлено: 04.08.06 20:08
Private Const RGN_OR = 2

Ответить

Номер ответа: 3
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
 Профиль | | #3 Добавлено: 04.08.06 20:32
народ, научитесь ли вы когда-нить юзать Option Explicit? Будет вам счастья, и не будет таких ошибок!

Ответить

Номер ответа: 4
Автор ответа:
 [root]



Вопросов: 45
Ответов: 1212
 Web-сайт: bit.pirit.info
 Профиль | | #4
Добавлено: 04.08.06 21:45
Option Explicit
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 SetWindowRgn _
    Lib "user32" (ByVal hwnd As Long, _
    ByVal hRgn As Long, _
    ByVal bRedraw As Long) As Long
Private Declare Function CreatePolygonRgn _
    Lib "gdi32" (lpPoint As Koor, _
    ByVal nCount As Long, _
    ByVal nPolyFillMode As Long) As Long
Private Type Koor
   x As Long
   y As Long
End Type

Private Sub Form_Load()
Dim MakeRegion As Long
MakeRegion = CreateRoundRectRgn(0 / Screen.TwipsPerPixelX, _
     0 / Screen.TwipsPerPixelY, 2000 / Screen.TwipsPerPixelX, _
     2000 / Screen.TwipsPerPixelY, 50, 50)
Call SetWindowRgn(Me.hwnd, MakeRegion, True)
End Sub


И еще вариант почти идентичный:
Option Explicit

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 Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Koor, _
    ByVal nCount As Long, ByValnPolyFillMode As Long) As Long
Private Type Koor
   X As Long
   Y As Long
End Type


Private Sub Form_Load()
Dim MakeCircle As String
MakeCircle = CreateEllipticRgn(100 / Screen.TwipsPerPixelX, _
     100 / Screen.TwipsPerPixelY, 1400 / Screen.TwipsPerPixelX, _
     400 / Screen.TwipsPerPixelY)
Call SetWindowRgn(Me.hWnd, MakeCircle, True)
End Sub


Ответить

Номер ответа: 5
Автор ответа:
 VβÐUηìt



Вопросов: 246
Ответов: 3333
 Web-сайт: смекаешь.рф
 Профиль | | #5
Добавлено: 05.08.06 10:04
ПАЛОШ БЯКУ!!! Поищи в инете Form Generator!

Ответить

Номер ответа: 6
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
 Профиль | | #6 Добавлено: 05.08.06 12:43
Поищи в инете Form Generator!
ПАЛОШ БЯКУ!!!

Ответить

Номер ответа: 7
Автор ответа:
 VβÐUηìt



Вопросов: 246
Ответов: 3333
 Web-сайт: смекаешь.рф
 Профиль | | #7
Добавлено: 05.08.06 15:09
Поищи в инете Form Generator!
ПАЛОШ БЯКУ!!!
ЭТО НЕ БЯКА!!! НЕКОМУ НЕ ЛОЖИТЬ ЭТУ НЕ БЯКУ!!!

Ответить

Номер ответа: 8
Автор ответа:
 Серёга



ICQ: 262809473 

Вопросов: 17
Ответов: 561
 Web-сайт: houselab.narod.ru
 Профиль | | #8
Добавлено: 06.08.06 21:08
ЭТО НЕ БЯКА!!! НЕКОМУ НЕ ЛОЖИТЬ ЭТУ НЕ БЯКУ!!!

Эту бяку можно и не ложить :))), но самому прикольные окошки тоже нужно уметь делать (на случай если бяки под рукой не окажется) :)

Ответить

Номер ответа: 9
Автор ответа:
 Djon



Вопросов: 61
Ответов: 471
 Web-сайт: www.vk-book.ru
 Профиль | | #9
Добавлено: 06.08.06 21:37
Ещё есть классная прога, для создания нестандартных форм Greator Forms.

http://www.tut-soft.narod.ru/program_creatorforms.html

Ответить

Номер ответа: 10
Автор ответа:
 [root]



Вопросов: 45
Ответов: 1212
 Web-сайт: bit.pirit.info
 Профиль | | #10
Добавлено: 07.08.06 07:18
MakeCircle и MakeRegion рулят, нафиг вам проги.
Форм генератор и выдает такой же код, бгааа

Ответить

Номер ответа: 11
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
 Профиль | | #11 Добавлено: 07.08.06 12:17
нафиг вам проги.
наверно затем, что api не понимают)))

Ответить

Номер ответа: 12
Автор ответа:
 [root]



Вопросов: 45
Ответов: 1212
 Web-сайт: bit.pirit.info
 Профиль | | #12
Добавлено: 07.08.06 12:23
Ну так разжевали же, че не понять то.
Тем более вопрос уже раз 200 обсуждался
Эх народ ...
:)

Ответить

Номер ответа: 13
Автор ответа:
 LamerOnLine



ICQ: 334781088 

Вопросов: 108
Ответов: 2822
 Профиль | | #13 Добавлено: 07.08.06 13:14
Ну что за тяга такая к кривым окнам...

Ответить

Номер ответа: 14
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
 Профиль | | #14 Добавлено: 07.08.06 19:04
ну что за тяга такая к прогам создания кривых окон...

Ответить

Номер ответа: 15
Автор ответа:
 Djon



Вопросов: 61
Ответов: 471
 Web-сайт: www.vk-book.ru
 Профиль | | #15
Добавлено: 07.08.06 19:32
Кривые окна рулят!
И проги для создания кривых окон тоже рулят!
Т.к проги получаются красивей! А проги чтобы быстрей поличалось!

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам