Strona: [  << <   1 2   > >>  ]  z  2     
Autor Temat: Regiony - problem
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004
Regiony - problem

Witam

Czyli Tak - za pomocą regionów usuwam sobie tło kontrolki i wszystko jest OK ale wtedy gdy np. funkcję usuwania tła za pomocą regionów odpalę np. gdy kliknę na Buttona czyli wtedy gdy forma jest już widoczna.

A jak zrobić aby funkcja była odpalana w momencie ładowania programu.

Gdy wstawiam funkcję do Form_Load albo Form_Initialize tło nie jest usuwane

Gdzie mam wstawić wywołanie funkcji ??


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

12-11-2004 20:23
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
losmac
"profesorek"




Typ: neutral
Postów: 758
Zarejestrowany: May 2003

może Form_Activate lub Form_Repaint

[Post edytowany dnia 12-11-2004 21:26 przez losmac]


_____________________________________________
POSTULATY STARUSZKA:
1) Ludzie, dbajcie o polszczyznę!!!
2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!!

Powodzenia
Maciej Łoś

12-11-2004 21:25
Pokaż profil losmac  Wyślij email do losmac   Odwiedź stronę losmac  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Form_Activate nie pomaga a Form_RePaint - hmmm jest takie zdarzenie w VB6 dla formy ?? Ja nie widzę


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

12-11-2004 22:13
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

I cały mój wykłąd o tym, ze w Windowsie nie ma tła poszedł na marne =_=... nie będę złoźliwy i nie podam ci sposobu na usunięcie bitmapy z formy, bo właściwie to teraz powinienem zrobić. Zakładajac, że masz na myśli okno, nie tło, odpowiadam tak:

Sprawdź, czy masz dobrze kod wpisany, bo u mnie działa bez zarzutu:
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 Sub Form_Load()
    Dim hRgn_a As Long
    hRgn_a = CreateEllipticRgn(0, 0, 100, 100)
    SetWindowRgn hWnd, hRgn_a, True
End Sub


Zdarzenia repaint nie ma, jest za to paint.

[Post edytowany dnia 13-11-2004 01:09 przez marcin_an]


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

13-11-2004 01:07
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004


I cały mój wykłąd o tym, ze w Windowsie nie ma tła poszedł na marne =_=... nie będę złoźliwy i nie podam ci sposobu na usunięcie bitmapy z formy, bo właściwie to teraz powinienem zrobić.


O co ci chodzi ?? <hmmm>

P.S. Jeżeli chodzi o tło to ja sobie to tak nazywam ale wiadomo o co chodzi - hmmm

[Post edytowany dnia 13-11-2004 02:43 przez DJK]


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

13-11-2004 02:42
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

"wykład":
http://board.freeweb.pl/posts.php?board_id=1543&topic_id=86219&post_id=1009432&select=1009432#post1009432
I widzę, że on był adresowany włąśnie do ciebie, zeby było śmieszniej

Regiony: działa ten kod, który podałem?


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

13-11-2004 04:05
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Nadal nie wiem co ten twój "wykład" ma wspólnego z moim pytaniem.

Przykładu jeszcze nie sprawdzałem

Pozdrawiam


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

13-11-2004 11:02
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
Piotr T




Typ: neutral
Postów: 176
Zarejestrowany: May 2004

NP; dajesz jakąś bitmapę na formę i

Private Sub Form_Load()
    ' zamiana formatki na region graficzny
  If Me.Picture <> 0 Then
      Call SetAutoRgn(Me)
  End If

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' ROLA: przesuwanie formy na ekranie
If Button = 1 Then
        ReleaseCapture
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub





Teraz w module wklejasz ten kod



Option Explicit
' deklaracje bibliotek
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
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 Const RGN_OR = 2

Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

'deklaracja bibliotek potrzebnych do przesuwania formy
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1

'fdeklaracje dla efektu transluescencji Win 2000, i usunięcie z win9x lub NT
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
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)
Public Const LWA_ALPHA = &H2
Public Const LWA_COLORKEY = &H1


Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type


Public Sub SetAutoRgn(hForm As Form, Optional transColor As Long = vbNull)
  Dim X As Long, Y As Long
  Dim Rgn1 As Long, Rgn2 As Long
  Dim SPos As Long, EPos As Long
  Dim Wid As Long, Hgt As Long
  Dim xoff As Long, yoff As Long
  Dim DIB As New cDIBSection
  Dim bDib() As Byte
  Dim tSA As SAFEARRAY2D
   
    'pobranie rozmiaru obrazka znajdującego się na formie
  DIB.CreateFromPicture hForm.Picture
  Wid = DIB.Width
  Hgt = DIB.Height
 
  With hForm
    .ScaleMode = vbPixels
    'przesunięcie paska tytułowego formy
    xoff = (.ScaleX(.Width, vbTwips, vbPixels) - .ScaleWidth) / 2
    yoff = .ScaleY(.Height, vbTwips, vbPixels) - .ScaleHeight - xoff
    'zmiana rozmiaru formy
    .Width = (Wid + xoff * 2) * Screen.TwipsPerPixelX
    .Height = (Hgt + xoff + yoff) * Screen.TwipsPerPixelY
  End With
 
  ' matryca pikseli
    With tSA
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = DIB.Height
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = DIB.BytesPerScanLine
        .pvData = DIB.DIBSectionBitsPtr
    End With
    CopyMemory ByVal VarPtrArray(bDib), VarPtr(tSA), 4
       
     
' ustawienie koloru przezroczystego
  If transColor = vbNull Then transColor = RGB(bDib(0, 0), bDib(1, 0), bDib(2, 0))
 
  Rgn1 = CreateRectRgn(0, 0, 0, 0)
 
  For Y = 0 To Hgt - 1
    X = -3
    Do
    X = X + 3
   
    While RGB(bDib(X, Y), bDib(X + 1, Y), bDib(X + 2, Y)) = transColor And (X < Wid * 3 - 3)
      X = X + 3 ' przeskocz piksel transparentny
    Wend
    SPos = X / 3
    While RGB(bDib(X, Y), bDib(X + 1, Y), bDib(X + 2, Y)) <> transColor And (X < Wid * 3 - 3)
      X = X + 3 'przeskocz piksel normalny
    Wend
    EPos = X / 3
   
    'właściwe ustalenie regionów
    If SPos <= EPos Then
        Rgn2 = CreateRectRgn(SPos + xoff, Hgt - Y + yoff, EPos + xoff, Hgt - 1 - Y + yoff)
        CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR
        DeleteObject Rgn2
    End If
    Loop Until X >= Wid * 3 - 3
  Next Y
 
  SetWindowRgn hForm.hwnd, Rgn1, True  ' wyrysowanie regionu
  DeleteObject Rgn1

End Sub




_____________________________________________
Visual Basic.NET - Mercedes dla programistów

13-11-2004 13:20
Pokaż profil Piotr T  Wyślij email do Piotr T   Odwiedź stronę Piotr T  
Piotr T




Typ: neutral
Postów: 176
Zarejestrowany: May 2004

Druga część FAQ - gdyż post zawiera więcej jak 10 tyś znaków

A teraz w module klasy wklejasz ten kod
z planet source code

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER '40 bytes
    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
Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
' Note - this is not the declare in the API viewer - modify lplpVoid to be
' Byref so we get the pointer back:
Private Declare Function CreateDIBSection Lib "gdi32" _
    (ByVal hdc As Long, _
    pBitmapInfo As BITMAPINFO, _
    ByVal un As Long, _
    lplpVoid As Long, _
    ByVal handle As Long, _
    ByVal dw 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 Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Const BI_RGB = 0&
Private Const BI_RLE4 = 2&
Private Const BI_RLE8 = 1&
Private Const DIB_RGB_COLORS = 1 '  color table in RGBs

Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

' Clipboard functions:
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Const CF_BITMAP = 2
Private Const CF_DIB = 8

' Handle to the current DIBSection:
Private m_hDIb As Long
' Handle to the old bitmap in the DC, for clear up:
Private m_hBmpOld As Long
' Handle to the Device context holding the DIBSection:
Private m_hDC As Long
' Address of memory pointing to the DIBSection's bits:
Private m_lPtr As Long
' Type containing the Bitmap information:
Private m_tBI As BITMAPINFO

Public Function CopyToClipboard( _
        Optional ByVal bAsDIB As Boolean = True _
    ) As Boolean
Dim lhDCDesktop As Long
Dim lHDC As Long
Dim lhBmpOld As Long
Dim hObj As Long
Dim lFmt As Long
Dim b() As Byte
Dim tBI As BITMAPINFO
Dim lPtr As Long
Dim hDibCopy As Long

    lhDCDesktop = GetDC(GetDesktopWindow())
    If (lhDCDesktop <> 0) Then
        lHDC = CreateCompatibleDC(lhDCDesktop)
        If (lHDC <> 0) Then
            If (bAsDIB) Then
              MsgBox "I don't know how to put a DIB on the clipboard! Copy as bitmap instead!!!"
             
            Else
                ' Create a compatible bitmap and copy to
                ' the clipboard:
                hObj = CreateCompatibleBitmap(lhDCDesktop, Width, Height)
                If (hObj <> 0) Then
                    lhBmpOld = SelectObject(lHDC, hObj)
                    PaintPicture lHDC
                    SelectObject lHDC, lhBmpOld
                    lFmt = CF_BITMAP
                    ' Now set the clipboard to the bitmap:
                    If (OpenClipboard(0) <> 0) Then
                        EmptyClipboard
                        If (SetClipboardData(lFmt, hObj) <> 0) Then
                            CopyToClipboard = True
                        End If
                        CloseClipboard
                    End If
                End If
            End If
            DeleteDC lHDC
        End If
        DeleteDC lhDCDesktop
    End If
End Function

Public Function CreateDIB( _
        ByVal lHDC As Long, _
        ByVal lWidth As Long, _
        ByVal lHeight As Long, _
        ByRef hDib As Long _
    ) As Boolean
    With m_tBI.bmiHeader
        .biSize = Len(m_tBI.bmiHeader)
        .biWidth = lWidth
        .biHeight = lHeight
        .biPlanes = 1
        .biBitCount = 24
        .biCompression = BI_RGB
        .biSizeImage = BytesPerScanLine * .biHeight
    End With
    hDib = CreateDIBSection( _
            lHDC, _
            m_tBI, _
            DIB_RGB_COLORS, _
            m_lPtr, _
            0, 0)
    CreateDIB = (hDib <> 0)
End Function
Public Function CreateFromPicture( _
        ByRef picThis As StdPicture _
    )
Dim lHDC As Long
Dim lhDCDesktop As Long
Dim lhBmpOld As Long
Dim tBMP As BITMAP
   
    GetObjectAPI picThis.handle, Len(tBMP), tBMP
    If (Create(tBMP.bmWidth, tBMP.bmHeight)) Then
        lhDCDesktop = GetDC(GetDesktopWindow())
        If (lhDCDesktop <> 0) Then
            lHDC = CreateCompatibleDC(lhDCDesktop)
            DeleteDC lhDCDesktop
            If (lHDC <> 0) Then
                lhBmpOld = SelectObject(lHDC, picThis.handle)
                LoadPictureBlt lHDC
                SelectObject lHDC, lhBmpOld
                DeleteObject lHDC
            End If
        End If
    End If
End Function
Public Function Create( _
        ByVal lWidth As Long, _
        ByVal lHeight As Long _
    ) As Boolean
    ClearUp
    m_hDC = CreateCompatibleDC(0)
    If (m_hDC <> 0) Then
        If (CreateDIB(m_hDC, lWidth, lHeight, m_hDIb)) Then
            m_hBmpOld = SelectObject(m_hDC, m_hDIb)
            Create = True
        Else
            DeleteObject m_hDC
            m_hDC = 0
        End If
    End If
End Function
Public Property Get BytesPerScanLine() As Long
    ' Scans must align on dword boundaries:
    BytesPerScanLine = (m_tBI.bmiHeader.biWidth * 3 + 3) And &HFFFFFFFC
End Property

Public Property Get Width() As Long
    Width = m_tBI.bmiHeader.biWidth
End Property
Public Property Get Height() As Long
    Height = m_tBI.bmiHeader.biHeight
End Property

Public Sub LoadPictureBlt( _
        ByVal lHDC As Long, _
        Optional ByVal lSrcLeft As Long = 0, _
        Optional ByVal lSrcTop As Long = 0, _
        Optional ByVal lSrcWidth As Long = -1, _
        Optional ByVal lSrcHeight As Long = -1, _
        Optional ByVal eRop As RasterOpConstants = vbSrcCopy _
    )
    If lSrcWidth < 0 Then lSrcWidth = m_tBI.bmiHeader.biWidth
    If lSrcHeight < 0 Then lSrcHeight = m_tBI.bmiHeader.biHeight
    BitBlt m_hDC, 0, 0, lSrcWidth, lSrcHeight, lHDC, lSrcLeft, lSrcTop, eRop
End Sub


_____________________________________________
Visual Basic.NET - Mercedes dla programistów

13-11-2004 13:23
Pokaż profil Piotr T  Wyślij email do Piotr T   Odwiedź stronę Piotr T  
Piotr T




Typ: neutral
Postów: 176
Zarejestrowany: May 2004

Trzecia część FAQ


Public Sub PaintPicture( _
        ByVal lHDC As Long, _
        Optional ByVal lDestLeft As Long = 0, _
        Optional ByVal lDestTop As Long = 0, _
        Optional ByVal lDestWidth As Long = -1, _
        Optional ByVal lDestHeight As Long = -1, _
        Optional ByVal lSrcLeft As Long = 0, _
        Optional ByVal lSrcTop As Long = 0, _
        Optional ByVal eRop As RasterOpConstants = vbSrcCopy _
    )
    If (lDestWidth < 0) Then lDestWidth = m_tBI.bmiHeader.biWidth
    If (lDestHeight < 0) Then lDestHeight = m_tBI.bmiHeader.biHeight
    BitBlt lHDC, lDestLeft, lDestTop, lDestWidth, lDestHeight, m_hDC, lSrcLeft, lSrcTop, eRop
End Sub

Public Property Get hdc() As Long
    hdc = m_hDC
End Property
Public Property Get hDib() As Long
    hDib = m_hDIb
End Property
Public Property Get DIBSectionBitsPtr() As Long
    DIBSectionBitsPtr = m_lPtr
End Property
Public Sub RandomiseBits( _
        Optional ByVal bGray As Boolean = False _
    )
Dim bDib() As Byte
Dim X As Long, Y As Long
Dim lC As Long
Dim tSA As SAFEARRAY2D
Dim xEnd As Long
   
    ' Get the bits in the from DIB section:
    With tSA
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = m_tBI.bmiHeader.biHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = BytesPerScanLine()
        .pvData = m_lPtr
    End With
    CopyMemory ByVal VarPtrArray(bDib()), VarPtr(tSA), 4

    ' random:
    Randomize Timer
   
    xEnd = (Width - 1) * 3
    If (bGray) Then
        For Y = 0 To m_tBI.bmiHeader.biHeight - 1
            For X = 0 To xEnd Step 3
                lC = Rnd * 255
                bDib(X, Y) = lC
                bDib(X + 1, Y) = lC
                bDib(X + 2, Y) = lC
            Next X
        Next Y
    Else
        For X = 0 To xEnd Step 3
            For Y = 0 To m_tBI.bmiHeader.biHeight - 1
                bDib(X, Y) = 0
                bDib(X + 1, Y) = Rnd * 255
                bDib(X + 2, Y) = Rnd * 255
            Next Y
        Next X
    End If
   
    ' Clear the temporary array descriptor
  ' This is necessary under NT4.
  CopyMemory ByVal VarPtrArray(bDib), 0&, 4
   
End Sub

Public Sub ClearUp()
    If (m_hDC <> 0) Then
        If (m_hDIb <> 0) Then
            SelectObject m_hDC, m_hBmpOld
            DeleteObject m_hDIb
        End If
        DeleteObject m_hDC
    End If
    m_hDC = 0: m_hDIb = 0: m_hBmpOld = 0: m_lPtr = 0
End Sub

Public Function Resample( _
        ByVal lNewHeight As Long, _
        ByVal lNewWidth As Long _
    ) As cDIBSection
Dim cDib As cDIBSection
    Set cDib = New cDIBSection
    If cDib.Create(lNewWidth, lNewHeight) Then
        If (lNewWidth <> m_tBI.bmiHeader.biWidth) Or (lNewHeight <> m_tBI.bmiHeader.biHeight) Then
            ' Change in size, do resample:
            ResampleDib cDib
        Else
            ' No size change so just return a copy:
            cDib.LoadPictureBlt m_hDC
        End If
        Set Resample = cDib
    End If
End Function

Private Function ResampleDib(ByRef cDibTo As cDIBSection) As Boolean
Dim bDibFrom() As Byte
Dim bDibTo() As Byte

Dim tSAFrom As SAFEARRAY2D
Dim tSATo As SAFEARRAY2D

    ' Get the bits in the from DIB section:
    With tSAFrom
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = m_tBI.bmiHeader.biHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = BytesPerScanLine()
        .pvData = m_lPtr
    End With
    CopyMemory ByVal VarPtrArray(bDibFrom()), VarPtr(tSAFrom), 4

    ' Get the bits in the to DIB section:
    With tSATo
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = cDibTo.Height
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = cDibTo.BytesPerScanLine()
        .pvData = cDibTo.DIBSectionBitsPtr
    End With
    CopyMemory ByVal VarPtrArray(bDibTo()), VarPtr(tSATo), 4

Dim xScale As Single
Dim yScale As Single

Dim X As Long, Y As Long, xEnd As Long, xOut As Long

Dim fX As Single, fY As Single
Dim ifY As Long, ifX As Long
Dim dX As Single, dy As Single
Dim r As Long, r1 As Single, r2 As Single, r3 As Single, r4 As Single
Dim g As Long, g1 As Single, g2 As Single, g3 As Single, g4 As Single
Dim b As Long, b1 As Single, b2 As Single, b3 As Single, b4 As Single
Dim ir1 As Long, ig1 As Long, ib1 As Long
Dim ir2 As Long, ig2 As Long, ib2 As Long

    xScale = (Width - 1) / cDibTo.Width
    yScale = (Height - 1) / cDibTo.Height
   
    xEnd = cDibTo.Width - 1
       
    For Y = 0 To cDibTo.Height - 1
       
        fY = Y * yScale
        ifY = Int(fY)
        dy = fY - ifY
       
        For X = 0 To xEnd
            fX = X * xScale
            ifX = Int(fX)
            dX = fX - ifX
           
            ifX = ifX * 3
            ' Interpolate using the four nearest pixels in the source
            b1 = bDibFrom(ifX, ifY): g1 = bDibFrom(ifX + 1, ifY): r1 = bDibFrom(ifX + 2, ifY)
            b2 = bDibFrom(ifX + 3, ifY): g2 = bDibFrom(ifX + 4, ifY): r2 = bDibFrom(ifX + 5, ifY)
            b3 = bDibFrom(ifX, ifY + 1): g3 = bDibFrom(ifX + 1, ifY + 1): r3 = bDibFrom(ifX + 2, ifY + 1)
            b4 = bDibFrom(ifX + 3, ifY + 1): g4 = bDibFrom(ifX + 4, ifY + 1): r4 = bDibFrom(ifX + 5, ifY + 1)
           
            ' Interplate in x direction:
            ir1 = r1 * (1 - dy) + r3 * dy: ig1 = g1 * (1 - dy) + g3 * dy: ib1 = b1 * (1 - dy) + b3 * dy
            ir2 = r2 * (1 - dy) + r4 * dy: ig2 = g2 * (1 - dy) + g4 * dy: ib2 = b2 * (1 - dy) + b4 * dy
            ' Interpolate in y:
            r = ir1 * (1 - dX) + ir2 * dX: g = ig1 * (1 - dX) + ig2 * dX: b = ib1 * (1 - dX) + ib2 * dX
           
            ' Set output:
            If (r < 0) Then r = 0
            If (r > 255) Then r = 255
            If (g < 0) Then g = 0
            If (g > 255) Then g = 255
            If (b < 0) Then b = 0
            If (b > 255) Then
                b = 255
            End If
            xOut = X * 3
            bDibTo(xOut, Y) = b
            bDibTo(xOut + 1, Y) = g
            bDibTo(xOut + 2, Y) = r
           
        Next X
       
    Next Y

    ' Clear the temporary array descriptor
    ' This is necessary under NT4.
    CopyMemory ByVal VarPtrArray(bDibFrom), 0&, 4
    CopyMemory ByVal VarPtrArray(bDibTo), 0&, 4


End Function

Private Sub Class_Terminate()
    ClearUp
End Sub




To dotyczyło regionów, a teraz jeśli chcesz zrobić
jakąś kontrolkę graficzną np; CheckBox - robisz dwa obrazeczki imitujące Checkbox jeden zaznaczony, a drugi nie i wkładasz je do kontrolki
ImageList i w FormLoad wpisujesz taką instrukcję

ImageList1.ListImages(NumerObrazka).Draw Me.hdc, X, Y, imlTransparent

i na tak wymalowany obrazek nakładasz Label, który w zdarzeniu Click będzie Ci odpowiednio malował
obrazek z ImageList i oczywiście nie zapomnij dostawić zmiennej Boolean dla rozpoznania czy Check jest True czy False

[Post edytowany dnia 13-11-2004 13:24 przez Piotr T]


_____________________________________________
Visual Basic.NET - Mercedes dla programistów

13-11-2004 13:23
Pokaż profil Piotr T  Wyślij email do Piotr T   Odwiedź stronę Piotr T  
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

DJK:
Kod: To sprawdź i daj znać
"Wykład": Wykład był o tym, że nie ma pojęcia "tło" w okienkach. Tu nie chodzi o to, że się czepiam, ale któregoś dnia kotś może poprostu zupełnie nie zrozumieć o czym mówisz, jeśli powiesz tło. Prawda jest taka, że gdybym był złoźliwy, to w tym przypadku powinienem ci podać rzeczywiscie kod usuwania tła (czyli właściwie - usunięcia bitmapy z okna).

---

Piotr T.
Całkiem ładne... tylko jaki to ma związek z problemem DJK? O_o


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

13-11-2004 14:08
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
Piotr T




Typ: neutral
Postów: 176
Zarejestrowany: May 2004

Piotr T.
Całkiem ładne... tylko jaki to ma związek z problemem DJK? O_o


No właśnie dlatego, że nie zabardzo rozumiem pytania kolegi DJK - dlatego wsadziłem opis tworzenia Regionów i stworzenia kontrolki graficznej imitującej np; przeźroczysty CheckBox


_____________________________________________
Visual Basic.NET - Mercedes dla programistów

13-11-2004 14:31
Pokaż profil Piotr T  Wyślij email do Piotr T   Odwiedź stronę Piotr T  
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

No własnie ja też... :/
Sądzę, że chodzi o ograniczenie kształtu okna regionem, ale to tylko przypuszczenia. Chociaz z drugiej strony, jeśli nie działa mu w Load i w Initialize to może to być jednak kwestia rysowania czegoś na okienku... a wtedy może lepiej by było, gdyby ustawił właściwość .Autoredraw = True , powinno pomóc.


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

13-11-2004 14:33
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Do marcin_an - nie wydaje mi się, że gdy okno nazywam tłem to nikt by tego nie zrozumiał a wręcz przeciwnie - dla kogoś kto ma mało z tym do czynienia najprawdopodobniej okno które nazywam tłem skojarzy mu się właśnie z tłem - dobra nieważne - ja to tak poprostu nazywam

P.S. Skoro nazwa "tło" nie pasuje to jakbyś to najprościej nazwał ??

Do Piotr_T: teże się zdziwiłem jak wkleiłeś mi ten kod ale cóż lepsza jakaś pomoc niż żadna dlatego dzieki za chęci

A wracając do tematu:

Mam pewną funkcję która wykorzystuje funkcje API związane z regionami itp. i ma ona na celu spowodowanie tego by okno, które ja nazywam tłem (np. Button ma wokół samego przycisku obwódkę w kolorze BTNFACE - domyślnie każda kontrolka taki ma, która ma właściwość BackColor) zostało usunięte.

I funkcja działa ale jest problem. Otóż powiedzmy, że użyję takiego wywołania mojej funkcji:

Private Sub Command1_Click()
Zmienna = MojaFunkcja(parametry)
End Sub

to wszystko działa - obwódka w kolrze BTNFACE znika.

Ale gdy zrobię to tak:

Private Sub Form_Load()
Zmienna = MojaFunkcja(parametry)
End Sub

obwódka nie znika

Chodzi pewnie o to że forma musi być już chyba widoczna żeby wykorzystać Regiony (może się mylę)

I tak to wygląda

Spróbujcie wstawić Tabstrip XP Style i na nim umieścić ramkę ale w taki sposób by nie przysłaniała gradientu jaki posiada każda zakładka w Tabstrip i widoczny był tylko Caption ramki wraz z obramowaniem.

Pozdrawiam


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

13-11-2004 15:32
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

Może daj tutaj poprostu kod tej funkcji i tyle - będzie prościej .


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

13-11-2004 17:00
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Właśnie też nad tym pomyślałem

Private Sub SetTrans(Ctl As Control)

    Dim X As Long
    Dim Y As Long
    Dim width As Long
    Dim height As Long

    Dim rgnCtl As Long
    Dim rgnPixel As Long
    Dim colPixel As Long
    Dim ctlDC As Long
    Dim backColor As Long
   
    backColor = GetSysColor(COLOR_BTNFACE)
   
    width = Me.ScaleX(Ctl.width, Me.ScaleMode, vbPixels)
    height = Me.ScaleX(Ctl.height, Me.ScaleMode, vbPixels)

    rgnCtl = CreateRectRgn(0, 0, width, height)
   
    ctlDC = GetDC(Ctl.hwnd)
   
    For Y = 0 To height
        For X = 0 To width
            colPixel = GetPixel(ctlDC, X, Y)
            If colPixel = backColor Then
                rgnPixel = CreateRectRgn(X, Y, X + 1, Y + 1)
                CombineRgn rgnCtl, rgnCtl, rgnPixel, RGN_XOR
                DeleteObject rgnPixel
            End If
        Next X
    Next Y
           
ReleaseDC Ctl.hwnd, ctlDC
   
DeleteObject SetWindowRgn(Ctl.hwnd, rgnCtl, True)

End Sub


I funkcja działa ale gdy wywołamy ją np. zdarzeniem Command1_Click a z Form_Load nie

Najlepiej wrzucić jakiś obrazek na formę i przykryć go ramką i wywołać funkcję np.

SetTrans Frame1

Ehhh cały czas piszę ze to funkcja a to jest procedura

[Post edytowany dnia 13-11-2004 17:18 przez DJK]


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

13-11-2004 17:17
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
Piotr T




Typ: neutral
Postów: 176
Zarejestrowany: May 2004

backColor = GetSysColor(COLOR_BTNFACE)

a gdzie jest kod tej funkcji.?

wklej wszystkie funkcje

[Post edytowany dnia 13-11-2004 17:43 przez Piotr T]


_____________________________________________
Visual Basic.NET - Mercedes dla programistów

13-11-2004 17:40
Pokaż profil Piotr T  Wyślij email do Piotr T   Odwiedź stronę Piotr T  
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

Gdybyś dał to od razu to nie byłoby tyle problemów

Ta procedurka nie będzie działała dopuki kontrolka nie będzie widoczna, co za tym idzie - dopuki forma nie będzie widoczna . Proponuję albo w Form_Load dać taki kod:

    Show
    DoEvents
    SetTrans(TwojaKontrolka)

Lub wrzucić to do pierwszego wywołania procedury Form_Repaint.


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

13-11-2004 17:40
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

Piotr T:
GetSysColor to funkcja WinAPI, pobiera wskazany kolor systemowy.


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

13-11-2004 17:42
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

No na tym polega cały problem że forma musi być już widoczna

Hmmm Form_Repaint <---- Co to jest?

Forma nie ma takiego zdarzenia

Marcinie ten fragment który podałeś działa tzn. Show ....

ale

Forma się pokazuje i dopiero funkcja zaczyna działać

Użytkownik widzi jak znika COLOR_BTNFACE a ja bym chciał aby forma po pokazaniu się miała już ukryte te kolory.

Może macie jakiś zupełnie inny pomysł jak to zrobić.

Jak widzicie po działaniu tej funkcji chodzi mi o zwykłe zaimplementowanie sztucznego Transparentu dla kontrolki

A tak na marginesie to dziwię się że w ogóle poruszyłem tak "trudny" problem. Czyżby nikt nie korzystał z Tabstrip albo nie robił formy na której znajdują obrazki czy coś podobnego ??

Przynajmniej wiecie już o co mi chodzi

[Post edytowany dnia 13-11-2004 17:57 przez DJK]


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

13-11-2004 17:49
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
Wszystkich odpowiedzi: 37 :: Maxymalnie na stronę: 20
Strona: [  << <   1 2   > >>  ]  z  2