Опять UserControl

[inf]

Доброго времени суток.

У меня снова проблемы с UserControl.

Я добавляю в UserControl картинку-маску по которой UserControl обрезается, но если на UserControl поместить картинку в Image, то обрезается прямоугольник по Image. Как сделать чтобы обрезалась не прямоугольная область а произвольная? Пробывал по-всякому делать. Может я не вижу очевидного решения. Помогите.

З.Ы. пробывал обрезать по цвету как форму, но с контролом апи не работает.

[tyomitch]

Покажи код.

[inf]

Понятия не имею зачем ты его спросил , но если оч надо то вот:

Код: Выделить всё

Const LWA_COLORKEY = &H1
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Sub Command2_Click()
  Dim aStyle As Long
  Dim TransparentColor As Long
  TransparentColor = vbBlack
  aStyle = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
  aStyle = aStyle Or WS_EX_LAYERED
  Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, aStyle)
  Call SetLayeredWindowAttributes(Me.hWnd, TransparentColor, 0, LWA_COLORKEY)
End Sub

[inf]

Впринципе можно обрезать UserControl с помощью gdi32 и user32, но это очень долго париться надо. И в будущем я расчитываю сделать скины разные к программе.
так что мне этот способ не подходит

З.Ы.

фишка такая: работает UserControl на нем несколько Image и в определенный момент показывается нужный Image. (вот, что мне нужно то) Если есть альтернативные способы то говорите.
Если загружать в сам UserControl картинку, то надо одной так делать, а у меня их несколько.

[tyomitch]

Понятия не имею зачем ты его спросил , но если оч надо то вот:

Это в контроле-то


Код я спросил не из любопытства, а потому что не умею отлаживать проги телепатически. Соответственно, нужен тот код, который должен работать, но не работает. А не тот, который работать и не должен.

[inf]

нет. Ты меня не понял. Я не знаю кода чтобы обрезать контрол по цвету. Вот этот код что я написал работает только в форме, а мне нужен тотже самый эфект но с контролом и я не знаю как так сделать.

[alibek]

Во-первых, работает и через API.
Во-вторых, зацени MaskPicture, что намного проще.

[inf]

Во-первых, работает и через API.
Во-вторых, зацени MaskPicture, что намного проще.

через маскпикчер пробовал не получается. Если на контроле есть Image то и остается Image, а не становится прозрачным и это место вырезается прямоугольником.

[inf]

Апи gdi32 и user32? Не подходит слишком мутарно каждый полигончег обходить. Надо чтоб работало по цвету? Если знаешь, то напиши код плиз, а то я нууу всеее перепробывал.

[Antonariy]

Эээ...
Не то?

Код: Выделить всё

Option Explicit

Private Declare Function CreateRectRgn Lib "gdi32" (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 SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Const RGN_OR = 2

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Public Sub SetTransparent(frm As Form, TransColor As Long)
Dim lRgn As Long
    Screen.MousePointer = vbHourglass
    lRgn = lGetRegion(frm, TransColor, frm.Picture)
    SetWindowRgn frm.hwnd, lRgn, True
    Screen.MousePointer = vbDefault
End Sub

Private Function lGetRegion(frm As Form, ByVal lBackColor As Long, ByVal Picture As StdPicture) As Long
Dim lRgn As Long
Dim lSkinRgn As Long
Dim lStart As Long
Dim lX As Long
Dim lY As Long
Dim ms As Long
Dim bi As BITMAPINFOHEADER, bits() As Long, hdc As Long
    With bi
        .biSize = LenB(bi)
        .biWidth = frm.ScaleX(Picture.Width, vbHimetric, vbPixels)
        .biHeight = frm.ScaleY(Picture.Height, vbHimetric, vbPixels)
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = 0
        ReDim bits(0 To .biWidth - 1, 0 To .biHeight - 1)
        hdc = CreateCompatibleDC(0)
        GetDIBits hdc, Picture, 0, bi.biHeight, bits(0, 0), bi, 0
        DeleteDC (hdc)
        lSkinRgn = CreateRectRgn(0, 0, 0, 0)
        For lX = 0 To .biHeight - 1
            lY = 0
            Do While lY < .biWidth
                Do While lY < .biWidth
                    If bits(lY, lX) <> lBackColor Then Exit Do
                    lY = lY + 1
                Loop
                If lY < .biWidth Then
                    lStart = lY
                    Do While lY < .biWidth
                        If bits(lY, lX) = lBackColor Then Exit Do
                        lY = lY + 1
                    Loop
                    If lY > .biWidth Then lY = .biWidth
                    lRgn = CreateRectRgn(lStart, .biHeight - lX - 1, lY, .biHeight - lX)
                    CombineRgn lSkinRgn, lSkinRgn, lRgn, RGN_OR
                    DeleteObject lRgn
                End If
            Loop
        Next
    End With
    lGetRegion = lSkinRgn
End Function

[alibek]

Только заменить frm As Form на ctl As UserControl.

[inf]

2Antonariy
надо UserControl по цвету обрезать, а не форму.

З.Ы. Зачем столько кода чтобы обрезать по цвету когда можно это сделать более меньшим кодом.

З.Ы.Ы. Нужно тоже самое но чтоб работало с UserControl

[Antonariy]

З.Ы. Зачем столько кода чтобы обрезать по цвету когда можно это сделать более меньшим кодом.

Этот вопрос к Темычу - его код. Я думаю, если бы было возможно, он бы сделал меньше.
Но ты похоже невероятно крут в данном вопросе, и с легкостью его затмишь.

З.Ы.Ы. Нужно тоже самое но чтоб работало с UserControl

Заменяешь As Form на As UserControl, а в самом контроле выводишь наружу функции ScaleX, ScaleY и свойства Picture и hWnd.

[inf]

не получается. ругается в этом месте:

Код: Выделить всё

lRgn = lGetRegion(frm, TransColor, frm.Picture)

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

Если я бы был таким то не задавал такой вопрос.

[inf]

2Antonariy
Кстати код не работает...

[Antonariy]

Я уже сказал, что нужно сделать, чтобы он заработал.

Заменяешь As Form на As UserControl, а в самом контроле выводишь наружу функции ScaleX, ScaleY и свойства Picture и hWnd.

[inf]

2Antonariy
сделал я так. Все равно прямоугольники вырезает. Что был код - что его небыло. одно и тоже.

[inf]

хм...
нашел пост 2005 года. там [url=http://bbs.vbstreets.ru/viewtopic.php?t=19538&sid=89826b9bdce5fd365caaaa52c89a0bda[/url]этотже вопрос[/url] остался открытым....