VBNet - Форум - Сложное окно

Вопрос: Сложное окно Добавлено: 29.11.09 17:43

Автор вопроса: $@ny@PG | ICQ: 468469477

Option Explicit

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "User32" ()
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Private Const RGN_OR = 2

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32.dll" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32.dll" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32.dll" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
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 = ScaleY(Picture1.Picture.Height, vbHimetric, vbPixels)
      lWidth = ScaleX(Picture1.Picture.Width, vbHimetric, vbPixels)
      For lX = 0 To lHeight - 1
         lY = 0
         Do While lY < lWidth
            'èùåì íóæíûé 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
               'íóæíûé Pixel íàéäåí, äîáàâèì åãî â ðåãèîí
               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
Private Sub Form_Load()
Form1.Height = Picture1.Height
Form1.Width = Picture1.Width
Main
End Sub
Sub Main()
   Dim lRgn As Long
   lRgn = lGetRegion(Form1.Picture1, vbWhite)
   SetWindowRgn hwnd, lRgn, True
   DeleteObject lRgn
End Sub

Как теперь на созданную форму добавить объекты с предыдущей формы???
Ответить

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

Номер ответа: 1 Автор ответа: VβÐUηìt Вопросов: 246 Ответов: 3333	Web-сайт: смекаешь.рф Профиль \| \| #1	Добавлено: 29.11.09 17:55
	SetParent? Ответить

Номер ответа: 2 Автор ответа: $@ny@PG ICQ: 468469477 Вопросов: 71 Ответов: 196	Профиль \| \| #2	Добавлено: 29.11.09 17:57
	А можно поподробней об этой функции? Ответить

Номер ответа: 3 Автор ответа: $@ny@PG ICQ: 468469477 Вопросов: 71 Ответов: 196	Профиль \| \| #3	Добавлено: 29.11.09 18:02
	Спасибо, огромное все получилось на 5+, а я себе голову ломал, еще раз спасибо, этот сайт меня никогда не подводил! И знает ответ на любой вопрос!!! Ответить

Номер ответа: 4 Автор ответа: AWP ICQ: 345685652 Вопросов: 96 Ответов: 1212	Web-сайт: xawp.narod.ru Профиль \| \| #4	Добавлено: 01.12.09 03:31
	GetPixel? Будет время - перепиши его в более быстрый. Или найду, у меня где-то был... Ответить

Номер ответа: 5 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #5	Добавлено: 01.12.09 09:06
	$@ny@PG, формы по цвету пикселя вырезаются вот таким образом: Option Explicit Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Const LWA_ALPHA = &H2 Private Const LWA_COLORKEY As Long = &H1 Private Const GWL_EXSTYLE = (-20) Private Const WS_EX_LAYERED = &H80000 Public Sub SetTranspColor(ByVal hWnd As Long, ByVal color As Long) Call SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED) Call SetLayeredWindowAttributes(hWnd, color, 0, LWA_COLORKEY) 'делаем прозрачным цвет color End Sub намного проще. Ответить

Номер ответа: 6 Автор ответа: $@ny@PG ICQ: 468469477 Вопросов: 71 Ответов: 196	Профиль \| \| #6	Добавлено: 02.12.09 15:30
	Спасибо, действительно намного проще. Ответить

Номер ответа: 7 Автор ответа: $@ny@PG ICQ: 468469477 Вопросов: 71 Ответов: 196	Профиль \| \| #7	Добавлено: 03.12.09 20:51
	А как анимированную форму сделать? Ответить

Страница: 1 |