Ajuda: Controlo OCX que não memoriza configurações

FordTaunus · April 26, 2008 at 10:50 PM

Boas,

Estou a tentar fazer o meu primeiro controlo OCX.

A ideia é fazer uma coisa parecida com o objecto 'Frame' já existente no VB6, mas um pouco mais estiloso, como permitir colocar uma imagem de fundo.

Em princípio, está tudo bem, mas acontecem duas coisas estranhas:

1- Quando coloco o controlo numa Form, faço as configurações necessárias, mas ao fazer F5, o controlo perde todas as configurações e aparece no modo 'Default';

2- Usando a opção de fundo transparente, a Label usada para o título aparece 'ratada'.

Alguém pode ajudar a resolver estes 2 problemas?

O código fonte está aqui (inclui 3 imagens para testarem a inserção de imagens: http://rapidshare.com/files/110659578/Advanced_Frame_Control.rar.html

Em alternativa, o código segue em baixo:

Option Explicit

'Cores para a frame
Const crDarkGrey = &H404040
Const crGrey = &H808080
Const crLightGrey = &HB9B9B9
Const crWhite = &HFFFFFF
Const crDarkBlue = &H703816
Const crLightBlue = &HF3E7DC
Const crDarkRed = &H80&
Const crLightRed = &HF4F4FF
Const crDarkOrange = &H80FF&
Const crLightOrange = &HECF9FF
Const crDarkYellow = &H33DBFF
Const crLightYellow = &HF2FEFF
Const crDarkSky = &HE36E03
Const crLightSky = &HFFF9F2
Const crDarkGreen = &H5E46&
Const crLightGreen = &HEAFFFA

'Private m_Estilo As mStyle

Public Enum mTransp
    Transparent = 0
    Opaque = 1
End Enum

Public Enum mStyle
    Fundo
    Elevado
End Enum

Public Enum mBorder
    Small = 1
    Normal = 2
    Big = 3
End Enum

Public Enum mFrameColor
    Blue = 1
    DarkGrey = 2
    Grey = 3
    LightGrey = 4
    Green = 5
    Orange = 6
    Red = 7
    Sky = 8
    Yellow = 9
End Enum

'Default Property Values:
Const m_def_Appearance = 0
Const m_def_FrameBaseColor = 3
Const m_def_BackStyle = 0
Const m_def_BorderWidth = 2

'Property Variables:
Dim m_Appearance As mStyle
Dim m_FrameBaseColor As mFrameColor
Dim m_BackStyle As mTransp
Dim m_BorderWidth As Integer

'Event Declarations:
Event Hide() 'MappingInfo=UserControl,UserControl,-1,Hide

Private Sub UserControl_Initialize()
    'Posição da Label
    lblCaption.Left = 10
    lblCaption.Top = 30
    
    'Linha Topo
    lnFrame(0).X1 = 10
    lnFrame(0).X2 = Width
    lnFrame(0).Y1 = 250
    lnFrame(0).Y2 = 250
    
    'Linha Direita
    lnFrame(1).X1 = Width - 15
    lnFrame(1).X2 = Width - 15
    lnFrame(1).Y1 = 250
    lnFrame(1).Y2 = Height - 15
    
    'Linha Fundo
    lnFrame(2).X1 = 10
    lnFrame(2).X2 = Width
    lnFrame(2).Y1 = Height - 15
    lnFrame(2).Y2 = Height - 15
    
    'Linha Esquerda
    lnFrame(3).X1 = 10
    lnFrame(3).X2 = 10
    lnFrame(3).Y1 = 250
    lnFrame(3).Y2 = Height - 15
    
    'Posição e tamanho da Imagem
    imgFramePicture.Left = 0
    imgFramePicture.Top = 250
    imgFramePicture.Width = Width
    imgFramePicture.Height = Height - 251
    
End Sub

Private Sub UserControl_Resize()
   Dim sngMinH As Single
   Dim sngMinW As Single

    sngMinW = 1500
    sngMinH = 800

    If Width < sngMinW Then Width = sngMinW
    If Height < sngMinH Then Height = sngMinH
    
    'Regula tamanho das linhas da Frame
    If m_Appearance = Fundo Then
        'Linha Topo
        lnFrame(0).X1 = 10
        lnFrame(0).X2 = Width
        lnFrame(0).Y1 = 250
        lnFrame(0).Y2 = 250
        'Linha Direita
        If m_BorderWidth = 3 Then
            lnFrame(1).X1 = Width - 30
            lnFrame(1).X2 = Width - 30
        Else
            lnFrame(1).X1 = Width - 10
            lnFrame(1).X2 = Width - 10
        End If
        lnFrame(1).Y1 = 250
        lnFrame(1).Y2 = Height - 10
        'Linha Fundo
        lnFrame(2).X1 = 10
        lnFrame(2).X2 = Width - 10
        If m_BorderWidth = 3 Then
            lnFrame(2).Y1 = Height - 30
            lnFrame(2).Y2 = Height - 30
        Else
            lnFrame(2).Y1 = Height - 10
            lnFrame(2).Y2 = Height - 10
        End If
        'Linha Esquerda
        lnFrame(3).X1 = 10
        lnFrame(3).X2 = 10
        lnFrame(3).Y1 = 250
        lnFrame(3).Y2 = Height - 10
    Else
        'Linha Topo
        lnFrame(0).X1 = 10
        lnFrame(0).X2 = Width - 10
        If m_BorderWidth = 3 Then
            lnFrame(0).Y1 = Height - 30
            lnFrame(0).Y2 = Height - 30
        Else
            lnFrame(0).Y1 = Height - 10
            lnFrame(0).Y2 = Height - 10
        End If
        'Linha Direita
        lnFrame(1).X1 = 10
        lnFrame(1).X2 = 10
        lnFrame(1).Y1 = 250
        lnFrame(1).Y2 = Height - 10
        'Linha Fundo
        lnFrame(2).X1 = 10
        lnFrame(2).X2 = Width
        lnFrame(2).Y1 = 250
        lnFrame(2).Y2 = 250
        'Linha Esquerda
        If m_BorderWidth = 3 Then
            lnFrame(3).X1 = Width - 30
            lnFrame(3).X2 = Width - 30
        Else
            lnFrame(3).X1 = Width - 10
            lnFrame(3).X2 = Width - 10
        End If
        lnFrame(3).Y1 = 250
        lnFrame(3).Y2 = Height - 10
    End If
    
    'Regula tamanho da imagem de fundo do controlo
    imgFramePicture.Width = Width
    imgFramePicture.Height = Height - 250
    
End Sub

Private Sub lblCaption_Change()
    If Width < lblCaption.Width Then Width = lblCaption.Width
End Sub


Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
   'Save properties . . .
    Call PropBag.WriteProperty("Caption", lblCaption.Caption, "Caption")
    Call PropBag.WriteProperty("Appearance", m_Appearance, m_def_Appearance)
    Call PropBag.WriteProperty("FrameBaseColor", FrameBaseColor, m_def_FrameBaseColor)
    Call PropBag.WriteProperty("BackStyle", BackStyle, m_def_BackStyle)
    Call PropBag.WriteProperty("BorderWidth", m_BorderWidth, m_def_BorderWidth)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("Font", lblCaption.Font, Ambient.Font)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
End Sub



'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=lblCaption,lblCaption,-1,Caption
Public Property Get Caption() As String
    Caption = lblCaption.Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    lblCaption.Caption() = New_Caption
    PropertyChanged "Caption"
End Property


Public Property Get BackStyle() As mTransp
    BackStyle = m_BackStyle
End Property

Public Property Let BackStyle(ByVal New_BackStyle As mTransp)
    m_BackStyle = New_BackStyle
    UserControl.BackStyle = m_BackStyle
    lblCaption.BackStyle = m_BackStyle
    Refresh
    PropertyChanged "BackStyle"
End Property


Public Property Get FrameBaseColor() As mFrameColor
    FrameBaseColor = m_FrameBaseColor
End Property

Public Property Let FrameBaseColor(ByVal New_FrameBaseColor As mFrameColor)
    
    m_FrameBaseColor = New_FrameBaseColor
  
    Select Case m_FrameBaseColor
        Case Blue
            lnFrame(0).BorderColor = crDarkBlue
            lnFrame(1).BorderColor = crLightBlue
            lnFrame(2).BorderColor = crLightBlue
            lnFrame(3).BorderColor = crDarkBlue
        Case DarkGrey
            lnFrame(0).BorderColor = crDarkGrey
            lnFrame(1).BorderColor = crLightGrey
            lnFrame(2).BorderColor = crLightGrey
            lnFrame(3).BorderColor = crDarkGrey
        Case Grey
            lnFrame(0).BorderColor = crGrey
            lnFrame(1).BorderColor = crWhite
            lnFrame(2).BorderColor = crWhite
            lnFrame(3).BorderColor = crGrey
        Case LightGrey
            lnFrame(0).BorderColor = crLightGrey
            lnFrame(1).BorderColor = crWhite
            lnFrame(2).BorderColor = crWhite
            lnFrame(3).BorderColor = crLightGrey
        Case Green
            lnFrame(0).BorderColor = crDarkGreen
            lnFrame(1).BorderColor = crLightGreen
            lnFrame(2).BorderColor = crLightGreen
            lnFrame(3).BorderColor = crDarkGreen
        Case Orange
            lnFrame(0).BorderColor = crDarkOrange
            lnFrame(1).BorderColor = crLightOrange
            lnFrame(2).BorderColor = crLightOrange
            lnFrame(3).BorderColor = crDarkOrange
        Case Red
            lnFrame(0).BorderColor = crDarkRed
            lnFrame(1).BorderColor = crLightRed
            lnFrame(2).BorderColor = crLightRed
            lnFrame(3).BorderColor = crDarkRed
        Case Sky
            lnFrame(0).BorderColor = crDarkSky
            lnFrame(1).BorderColor = crLightSky
            lnFrame(2).BorderColor = crLightSky
            lnFrame(3).BorderColor = crDarkSky
        Case Yellow
            lnFrame(0).BorderColor = crDarkYellow
            lnFrame(1).BorderColor = crLightYellow
            lnFrame(2).BorderColor = crLightYellow
            lnFrame(3).BorderColor = crDarkYellow
    End Select
    Refresh
    PropertyChanged "FrameBaseColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=24,0,0,0
Public Property Get Appearance() As mStyle
    Appearance = m_Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As mStyle)
    m_Appearance = New_Appearance
    If New_Appearance = Fundo Then
        'Linha Topo
        lnFrame(0).X1 = 10
        lnFrame(0).X2 = Width
        lnFrame(0).Y1 = 250
        lnFrame(0).Y2 = 250
        'Linha Direita
        lnFrame(1).X1 = Width - 10
        lnFrame(1).X2 = Width - 10
        lnFrame(1).Y1 = 250
        lnFrame(1).Y2 = Height - 10
        'Linha Fundo
        lnFrame(2).X1 = 10
        lnFrame(2).X2 = Width - 10
        lnFrame(2).Y1 = Height - 10
        lnFrame(2).Y2 = Height - 10
        'Linha Esquerda
        lnFrame(3).X1 = 10
        lnFrame(3).X2 = 10
        lnFrame(3).Y1 = 250
        lnFrame(3).Y2 = Height - 10
    Else
        'Linha Topo
        lnFrame(0).X1 = 10
        lnFrame(0).X2 = Width - 10
        lnFrame(0).Y1 = Height - 10
        lnFrame(0).Y2 = Height - 10
        'Linha Direita
        lnFrame(1).X1 = 10
        lnFrame(1).X2 = 10
        lnFrame(1).Y1 = 250
        lnFrame(1).Y2 = Height - 10
        'Linha Fundo
        lnFrame(2).X1 = 10
        lnFrame(2).X2 = Width
        lnFrame(2).Y1 = 250
        lnFrame(2).Y2 = 250
        'Linha Esquerda
        lnFrame(3).X1 = Width - 10
        lnFrame(3).X2 = Width - 10
        lnFrame(3).Y1 = 250
        lnFrame(3).Y2 = Height - 10
    End If
    Refresh
    PropertyChanged "Appearance"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=lnFabricante(0),lnFabricante,0,BorderWidth
Public Property Get BorderWidth() As mBorder
    BorderWidth = lnFrame(0).BorderWidth
End Property

Public Property Let BorderWidth(ByVal New_BorderWidth As mBorder)
Dim iCur As Integer

    m_BorderWidth = New_BorderWidth
    
    For iCur = 0 To 3
        lnFrame(iCur).BorderWidth = m_BorderWidth
    Next iCur
    
    UserControl_Resize
    Refresh
    PropertyChanged "BorderWidth"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    Refresh
    PropertyChanged "Enabled"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=lblCaption,lblCaption,-1,Font
Public Property Get Font() As Font
    Set Font = lblCaption.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set lblCaption.Font = New_Font
    Refresh
    PropertyChanged "Font"
End Property

Private Sub UserControl_Hide()
    RaiseEvent Hide
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Picture
Public Property Get Picture() As Picture
    Set Picture = UserControl.Picture
End Property

Public Property Set Picture(ByVal New_Picture As Picture)
    'Set UserControl.Picture = New_Picture
    Set imgFramePicture.Picture = New_Picture
    Refresh
    PropertyChanged "Picture"
End Property


'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    Refresh
    PropertyChanged "BackColor"
End Property

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_Appearance = m_def_Appearance
    m_FrameBaseColor = m_def_FrameBaseColor
    m_BorderWidth = 2
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    lblCaption.Caption = PropBag.ReadProperty("Caption", "Caption")
    m_Appearance = PropBag.ReadProperty("Appearance", m_def_Appearance)
    m_FrameBaseColor = PropBag.ReadProperty("FrameBaseColor", m_def_FrameBaseColor)
    m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
    m_BorderWidth = PropBag.ReadProperty("BorderWidth", m_def_BorderWidth)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    Set lblCaption.Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set Picture = PropBag.ReadProperty("Picture", imgFramePicture.Picture)
End Sub

FordTaunus · April 30, 2008 at 06:46 PM

Vá lá, eu sei que é um problema de iniciante, mas é mesmo esse o problema.

Por favor, alguém ajude!!! Já estou a dar em doido sem perceber o que se passa!

Obrigado!

NuGuN · May 3, 2008 at 09:12 PM

Boas, coloquei uma imagem na imagebox que tens no controlo OCX e depois de abrir o programa, ficou com aquela imagem de fundo.

Cumps

FordTaunus · May 6, 2008 at 12:59 AM

Continua a não funcionar, mas já percebi que trocando a ordem de algumas funções funciona melhor...

Obrigado pela resposta de qualquer forma.

Sign In

Ajuda: Controlo OCX que não memoriza configurações

Recommended Posts

FordTaunus

Link to comment

Share on other sites

FordTaunus

Link to comment

Share on other sites

NuGuN

Link to comment

Share on other sites

FordTaunus

Link to comment

Share on other sites

Create an account or sign in to comment

Create an account

Sign in

Home

Activity

Revista PROGRAMAR

Important Information