USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (ActiveX/Controles/DLL)

Título da Dica:  Criando um Ocx Rapidamente
Postada em 10/1/2005 por Romero            
No UserControl...
Defina a Propriedade  keyPrevious  =   True

Adicione em um 3 Caixas de Imagem
Defina a Propriedade     Strech   =   True
Defina a Propriedade     Visible   =   False

Adicione em um UserControl 1 Botão de Camando
Defina a Propriedade     Visible   =   False
Top e Left  = 1000 "Para Ficar Fora da Área Visível"

Recorte 3 Imagens do mesmo tamanho, sendo a Imagem 1, 2 e 3 do Botão

No UserControl Adicione as Linhas Abaixo

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Option Explicit
Private Declare Function DrawFocusRect Lib "user32" (ByVal hDC As Long, lpRect As RECTMeu) As Long
Private Declare Function SetCapture Lib "user32" _
    (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCapture Lib "user32" () As Long

Private Type RECTMeu
        X1 As Long
        Y1 As Long
        X2 As Long
        Y2 As Long
End Type

Dim RtMeu As RECTMeu
Dim Precionado As Boolean
Event Click() 'Este Manipula o Evento Click do Mouse

'Este Command é para pegar o evento GotFocus do User Control
Private Sub Command1_GotFocus()
  ScaleMode = 3
  RtMeu.X1 = 7
  RtMeu.Y1 = 7
  RtMeu.X2 = Img01.Height - 7
  RtMeu.Y2 = Img01.Width - 7
  Command1.Tag = 1 'Aqui eu sei se Tenho que Desenhar a Linha de Selecionado
'Aqui é para desenhar uma lina de Selecionado
  DrawFocusRect UserControl.hDC, RtMeu
  ScaleMode = 1
'If Not Precionado Then UserControl.Picture = Img02.Picture
End Sub

'Este Command é para pegar o evento LostFocus do User Control
Private Sub Command1_LostFocus()
  'DrawFocusRect UserControl.hDC, RtMeu 'Antes eu usava essa, mas da muitos
                                                              'problemass
'Aqui é para Limpar a linha de Selecionado
  UserControl.Cls
  Command1.Tag = 0 'Aqui eu sei se Tenho que Desenhar a Linha de Selecionado
  UserControl.Picture = Img01.Picture
End Sub

'Aqui é quando o usuário Clica no Botão
Private Sub UserControl_Click()
  RaiseEvent Click
End Sub

'Função de Inicialização que Carrega a Imagem
Private Sub UserControl_Initialize()
UserControl.Picture = Img01.Picture
End Sub

'Esta Função é Para ter o mesmo efito de quendo se Preciona "Espaço"
'no CommanButon
Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 32 Then UserControl.Picture = Img03.Picture
End Sub

'Esta Função é Para ter o mesmo efito de quendo se Preciona "Espaço"
'no CommanButon
Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 32 Then UserControl.Picture = Img02.Picture
End Sub

'Quando se Preciona o Botão do Mouse
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Precionado = True
UserControl.Picture = Img03.Picture
End Sub

'Quando se Movimenta o Mouse sobe o UserControl
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (X < 0) Or (Y < 0) Or (X > Command1.Width) _
        Or (Y > Command1.Height) Then
        ' o pseudo-evento MOUSELEAVE
        ReleaseCapture
        ' neste exemplo, reverte o título ao normal
        'If Val(Command1.Tag) <> 1 Then
        UserControl.Picture = Img01.Picture
    ElseIf GetCapture() <> UserControl.hwnd Then
        ' o pseudo-evento MOUSEENTER
        SetCapture UserControl.hwnd
        ' neste exemplo, muda o título para negrito
         UserControl.Picture = Img02.Picture
    End If
End Sub

'Quando se Solta o Botão do Mouse
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Precionado = False
End Sub

'Aqui eu se se o Batão esta ou não com o Foco
Private Sub UserControl_Paint()
If Val(Command1.Tag) = 1 Then
ScaleMode = 3
RtMeu.X1 = 7
RtMeu.Y1 = 7
RtMeu.X2 = Img01.Height - 7
RtMeu.Y2 = Img01.Width - 7
DrawFocusRect UserControl.hDC, RtMeu
End If
End Sub

'Aqui quando o UserControl é Redimencionado ele fica sempre com o Tamanho da Imagem
Private Sub UserControl_Resize()
UserControl.Height = Img01.Height
UserControl.Width = Img01.Width
End Sub
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
 


CyberWEB Network Ltda.    © Copyright 2000-2021   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página