|
|
|
|
|
|
|
|
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
|
|
|
|
|
