• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

FordTaunus

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

4 mensagens neste tópico

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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!

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

Cumps

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

Obrigado pela resposta de qualquer forma.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora