CLASSE DO VB6 PARA O VB.NET
Bom dia a todos....
Tenho essa Classe em VB6 e estou tentando passar para o VB.NET..mas ta osso o negócio....alguem sabe me ajudar ae...
Segue a Classe em VB6
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function FillRect Lib [Ô]user32[Ô] (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib [Ô]gdi32[Ô] (ByVal crColor As Long) As Long
Private Declare Function TextOut Lib [Ô]gdi32[Ô] Alias [Ô]TextOutA[Ô] (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function GetDeviceCaps Lib [Ô]gdi32[Ô] (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Declare Function MulDiv Lib [Ô]kernel32[Ô] (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Const LF_FACESIZE = 32
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type
Private Declare Function CreateFontIndirect Lib [Ô]gdi32[Ô] Alias [Ô]CreateFontIndirectA[Ô] (lpLogFont As LOGFONT) 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 Const FW_NORMAL = 400
Private Const FW_BOLD = 700
Private Const FF_DONTCARE = 0
Private Const DEFAULT_QUALITY = 0
Private Const DEFAULT_PITCH = 0
Private Const DEFAULT_CHARSET = 1
Private Declare Function OleTranslateColor Lib [Ô]OLEPRO32.DLL[Ô] (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Const CLR_INVALID = -1
Private m_picThis As PictureBox
Private m_sCaption As String
Private m_bRGBStart(1 To 3) As Integer
Private m_oStartColor As OLE_COLOR
Private m_bRGBEnd(1 To 3) As Integer
Private m_oEndColor As OLE_COLOR
Public Property Let Caption(ByVal sCaption As String)
m_sCaption = sCaption
End Property
Public Property Get Caption() As String
Caption = m_sCaption
End Property
Public Property Let DrawingObject(ByRef picThis As PictureBox)
Set m_picThis = picThis
End Property
Public Property Get StartColor() As OLE_COLOR
StartColor = m_oStartColor
End Property
Public Property Let StartColor(ByVal oColor As OLE_COLOR)
Dim lColor As Long
If (m_oStartColor <> oColor) Then
m_oStartColor = oColor
OleTranslateColor oColor, 0, lColor
m_bRGBStart(1) = lColor And &HFF&
m_bRGBStart(2) = ((lColor And &HFF00&) \ &H100)
m_bRGBStart(3) = ((lColor And &HFF0000) \ &H10000)
If Not (m_picThis Is Nothing) Then
Draw
End If
End If
End Property
Public Property Get EndColor() As OLE_COLOR
EndColor = m_oEndColor
End Property
Public Property Let EndColor(ByVal oColor As OLE_COLOR)
Dim lColor As Long
If (m_oEndColor <> oColor) Then
m_oEndColor = oColor
OleTranslateColor oColor, 0, lColor
m_bRGBEnd(1) = lColor And &HFF&
m_bRGBEnd(2) = ((lColor And &HFF00&) \ &H100)
m_bRGBEnd(3) = ((lColor And &HFF0000) \ &H10000)
If Not (m_picThis Is Nothing) Then
Draw
End If
End If
End Property
Public Sub Draw()
Dim lHeight As Long, lWidth As Long
Dim lYStep As Long
Dim lY As Long
Dim bRGB(1 To 3) As Integer
Dim tLF As LOGFONT
Dim hFnt As Long
Dim hFntOld As Long
Dim lR As Long
Dim rct As RECT
Dim hBr As Long
Dim hdc As Long
Dim dR(1 To 3) As Double
On Error GoTo DrawError
hdc = m_picThis.hdc
lHeight = m_picThis.Height \ Screen.TwipsPerPixelY
rct.Right = m_picThis.Width \ Screen.TwipsPerPixelY
lYStep = lHeight \ 255
If (lYStep = 0) Then
lYStep = 1
End If
rct.Bottom = lHeight
bRGB(1) = m_bRGBStart(1)
bRGB(2) = m_bRGBStart(2)
bRGB(3) = m_bRGBStart(3)
dR(1) = m_bRGBEnd(1) - m_bRGBStart(1)
dR(2) = m_bRGBEnd(2) - m_bRGBStart(2)
dR(3) = m_bRGBEnd(3) - m_bRGBStart(3)
For lY = lHeight To 0 Step -lYStep
rct.Top = rct.Bottom - lYStep
hBr = CreateSolidBrush((bRGB(3) * &H10000 + bRGB(2) * &H100& + bRGB(1)))
FillRect hdc, rct, hBr
DeleteObject hBr
rct.Bottom = rct.Top
bRGB(1) = m_bRGBStart(1) + dR(1) * (lHeight - lY) / lHeight
bRGB(2) = m_bRGBStart(2) + dR(2) * (lHeight - lY) / lHeight
bRGB(3) = m_bRGBStart(3) + dR(3) * (lHeight - lY) / lHeight
Next lY
pOLEFontToLogFont m_picThis.Font, hdc, tLF
tLF.lfEscapement = 900
hFnt = CreateFontIndirect(tLF)
If (hFnt <> 0) Then
hFntOld = SelectObject(hdc, hFnt)
lR = TextOut(hdc, 0, lHeight - 16, m_sCaption, Len(m_sCaption))
SelectObject hdc, hFntOld
DeleteObject hFnt
End If
m_picThis.Refresh
Exit Sub
DrawError:
Debug.Print [Ô]Problem: [Ô] & Err.Description
End Sub
Private Sub pOLEFontToLogFont(fntThis As StdFont, hdc As Long, tLF As LOGFONT)
Dim sFont As String
Dim iChar As Integer
With tLF
sFont = fntThis.Name
For iChar = 1 To Len(sFont)
.lfFaceName(iChar - 1) = CByte(Asc(Mid$(sFont, iChar, 1)))
Next iChar
.lfHeight = -MulDiv((fntThis.Size), (GetDeviceCaps(hdc, LOGPIXELSY)), 72)
.lfItalic = fntThis.Italic
If (fntThis.Bold) Then
.lfWeight = FW_BOLD
Else
.lfWeight = FW_NORMAL
End If
.lfUnderline = fntThis.Underline
.lfStrikeOut = fntThis.Strikethrough
End With
End Sub
Private Sub Class_Initialize()
StartColor = vbBlue
EndColor = vbWhite
End Sub
Tenho essa Classe em VB6 e estou tentando passar para o VB.NET..mas ta osso o negócio....alguem sabe me ajudar ae...
Segue a Classe em VB6
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function FillRect Lib [Ô]user32[Ô] (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib [Ô]gdi32[Ô] (ByVal crColor As Long) As Long
Private Declare Function TextOut Lib [Ô]gdi32[Ô] Alias [Ô]TextOutA[Ô] (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function GetDeviceCaps Lib [Ô]gdi32[Ô] (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Declare Function MulDiv Lib [Ô]kernel32[Ô] (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Const LF_FACESIZE = 32
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type
Private Declare Function CreateFontIndirect Lib [Ô]gdi32[Ô] Alias [Ô]CreateFontIndirectA[Ô] (lpLogFont As LOGFONT) 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 Const FW_NORMAL = 400
Private Const FW_BOLD = 700
Private Const FF_DONTCARE = 0
Private Const DEFAULT_QUALITY = 0
Private Const DEFAULT_PITCH = 0
Private Const DEFAULT_CHARSET = 1
Private Declare Function OleTranslateColor Lib [Ô]OLEPRO32.DLL[Ô] (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Const CLR_INVALID = -1
Private m_picThis As PictureBox
Private m_sCaption As String
Private m_bRGBStart(1 To 3) As Integer
Private m_oStartColor As OLE_COLOR
Private m_bRGBEnd(1 To 3) As Integer
Private m_oEndColor As OLE_COLOR
Public Property Let Caption(ByVal sCaption As String)
m_sCaption = sCaption
End Property
Public Property Get Caption() As String
Caption = m_sCaption
End Property
Public Property Let DrawingObject(ByRef picThis As PictureBox)
Set m_picThis = picThis
End Property
Public Property Get StartColor() As OLE_COLOR
StartColor = m_oStartColor
End Property
Public Property Let StartColor(ByVal oColor As OLE_COLOR)
Dim lColor As Long
If (m_oStartColor <> oColor) Then
m_oStartColor = oColor
OleTranslateColor oColor, 0, lColor
m_bRGBStart(1) = lColor And &HFF&
m_bRGBStart(2) = ((lColor And &HFF00&) \ &H100)
m_bRGBStart(3) = ((lColor And &HFF0000) \ &H10000)
If Not (m_picThis Is Nothing) Then
Draw
End If
End If
End Property
Public Property Get EndColor() As OLE_COLOR
EndColor = m_oEndColor
End Property
Public Property Let EndColor(ByVal oColor As OLE_COLOR)
Dim lColor As Long
If (m_oEndColor <> oColor) Then
m_oEndColor = oColor
OleTranslateColor oColor, 0, lColor
m_bRGBEnd(1) = lColor And &HFF&
m_bRGBEnd(2) = ((lColor And &HFF00&) \ &H100)
m_bRGBEnd(3) = ((lColor And &HFF0000) \ &H10000)
If Not (m_picThis Is Nothing) Then
Draw
End If
End If
End Property
Public Sub Draw()
Dim lHeight As Long, lWidth As Long
Dim lYStep As Long
Dim lY As Long
Dim bRGB(1 To 3) As Integer
Dim tLF As LOGFONT
Dim hFnt As Long
Dim hFntOld As Long
Dim lR As Long
Dim rct As RECT
Dim hBr As Long
Dim hdc As Long
Dim dR(1 To 3) As Double
On Error GoTo DrawError
hdc = m_picThis.hdc
lHeight = m_picThis.Height \ Screen.TwipsPerPixelY
rct.Right = m_picThis.Width \ Screen.TwipsPerPixelY
lYStep = lHeight \ 255
If (lYStep = 0) Then
lYStep = 1
End If
rct.Bottom = lHeight
bRGB(1) = m_bRGBStart(1)
bRGB(2) = m_bRGBStart(2)
bRGB(3) = m_bRGBStart(3)
dR(1) = m_bRGBEnd(1) - m_bRGBStart(1)
dR(2) = m_bRGBEnd(2) - m_bRGBStart(2)
dR(3) = m_bRGBEnd(3) - m_bRGBStart(3)
For lY = lHeight To 0 Step -lYStep
rct.Top = rct.Bottom - lYStep
hBr = CreateSolidBrush((bRGB(3) * &H10000 + bRGB(2) * &H100& + bRGB(1)))
FillRect hdc, rct, hBr
DeleteObject hBr
rct.Bottom = rct.Top
bRGB(1) = m_bRGBStart(1) + dR(1) * (lHeight - lY) / lHeight
bRGB(2) = m_bRGBStart(2) + dR(2) * (lHeight - lY) / lHeight
bRGB(3) = m_bRGBStart(3) + dR(3) * (lHeight - lY) / lHeight
Next lY
pOLEFontToLogFont m_picThis.Font, hdc, tLF
tLF.lfEscapement = 900
hFnt = CreateFontIndirect(tLF)
If (hFnt <> 0) Then
hFntOld = SelectObject(hdc, hFnt)
lR = TextOut(hdc, 0, lHeight - 16, m_sCaption, Len(m_sCaption))
SelectObject hdc, hFntOld
DeleteObject hFnt
End If
m_picThis.Refresh
Exit Sub
DrawError:
Debug.Print [Ô]Problem: [Ô] & Err.Description
End Sub
Private Sub pOLEFontToLogFont(fntThis As StdFont, hdc As Long, tLF As LOGFONT)
Dim sFont As String
Dim iChar As Integer
With tLF
sFont = fntThis.Name
For iChar = 1 To Len(sFont)
.lfFaceName(iChar - 1) = CByte(Asc(Mid$(sFont, iChar, 1)))
Next iChar
.lfHeight = -MulDiv((fntThis.Size), (GetDeviceCaps(hdc, LOGPIXELSY)), 72)
.lfItalic = fntThis.Italic
If (fntThis.Bold) Then
.lfWeight = FW_BOLD
Else
.lfWeight = FW_NORMAL
End If
.lfUnderline = fntThis.Underline
.lfStrikeOut = fntThis.Strikethrough
End With
End Sub
Private Sub Class_Initialize()
StartColor = vbBlue
EndColor = vbWhite
End Sub
O que exatamente esse código faz? Me parece que ele desenha alguma coisa, talvez fazendo um preenchimento gradiente e então desenha um texto. Se for isso mesmo pode não compensar converter este código já que existem formas melhores de fazer isso no .Net
Caro
O Coreto seria primeiro entender o que sua programação no Vb 6.0 faz para depois refazer a mesma programação no VB.Net
VB.Net é semelhante ao VB 6.0 e não é igual.................
Olhe isso no seu Código
Vb 6.0-------------------------------------------------------------
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
A mesma coisa em VB.Net ----------------------------------------------------------------------
Structure RECT
Public Left As Long
Public Top As Long
Public Right As Long
Public Bottom As Long
End Structure
Descreva o que essa linhas faz no seu cpodigo em vbv 6 para que possamos ajudar nas transcrição........................... para VB.Net............
Boa Sorte
Boa sorte
O Coreto seria primeiro entender o que sua programação no Vb 6.0 faz para depois refazer a mesma programação no VB.Net
VB.Net é semelhante ao VB 6.0 e não é igual.................
Olhe isso no seu Código
Vb 6.0-------------------------------------------------------------
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
A mesma coisa em VB.Net ----------------------------------------------------------------------
Structure RECT
Public Left As Long
Public Top As Long
Public Right As Long
Public Bottom As Long
End Structure
Descreva o que essa linhas faz no seu cpodigo em vbv 6 para que possamos ajudar nas transcrição........................... para VB.Net............
Boa Sorte
Boa sorte
é assim...o OCELOT matou a charada...realmente desenha na Tela....
Tenho um Picture no Form e dentro desse Picture eu monto um Label com Alinhamento Vertical...
Ficaria assim, o Picture em Gradiente com Label na Vertical...SE existir algo mais fácil me fala ae...
Tenho um Picture no Form e dentro desse Picture eu monto um Label com Alinhamento Vertical...
Ficaria assim, o Picture em Gradiente com Label na Vertical...SE existir algo mais fácil me fala ae...
Basicamente tudo isso dai você pode substituir por isso
Precisa também adicionar um Imports no cabeçalho do arquivo
Imports System.Drawing.Drawing2D
Para usar você coloca no evento Paint de um picture box algo do tipo
Public Shared Sub TextoVertical(g As Graphics, Width As Integer, Height As Integer, Texto As String, CorTexto As Color, NomeFonte As String, TamanhoFonte As Integer, CorInicial As Color, CorFinal As Color)
Dim gradientBrush As New LinearGradientBrush(Point.Empty, New Point(0, Height), CorFinal, CorInicial)
g.FillRectangle(gradientBrush, New Rectangle(0, 0, Width, Height))
gradientBrush.Dispose()
g.TranslateTransform(0, Height)
g.RotateTransform(270)
Dim fonte As New Font(NomeFonte, TamanhoFonte)
Dim brush As New SolidBrush(CorTexto)
Dim sf As New StringFormat(StringFormatFlags.NoWrap)
sf.LineAlignment = StringAlignment.Center
g.DrawString(Texto, fonte, brush, New RectangleF(0, 0, Height, Width), sf)
sf.Dispose()
brush.Dispose()
fonte.Dispose()
End SubPrecisa também adicionar um Imports no cabeçalho do arquivo
Imports System.Drawing.Drawing2D
Para usar você coloca no evento Paint de um picture box algo do tipo
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
TextoVertical(e.Graphics, PictureBox1.Width, PictureBox1.Height, [Ô]Teste[Ô], Color.White, [Ô]Arial[Ô], 16, Color.Blue, SystemColors.Control)
End Sub
certinho OCELOT...seu exemplo deu pra eu montar tbm no C#...
Valews...
Valews...
Tópico encerrado , respostas não são mais permitidas