Utilizando PNG
+3
megosarco
St4rk
Ian
7 participantes
Página 1 de 1
Utilizando PNG
por Ian Sex 18 Fev 2011, 07:48
Primeira crie uma from ou utilize qual quer uma do pro prio eclipse origins depois adicione uma picture box
e um buton depois dissu de um duplo click na from e adicione o siguinte
- Spoiler:
- Código:
Option Explicit
Private WithEvents graphics As cGraphics
Private WithEvents bitmap As cBitmap
Public Obj As Object
Private Sub Command1_Click()
LoadPicture 'esse comando sera uzado para carregar IMG ele pode ser uzado tam bem na from load para não necessitar de uzar algum button
End Sub
Private Sub LoadPicture()
Set Obj = Picture1
Set bitmap = New cBitmap
Set graphics = New cGraphics
bitmap.LoadFromFile App.Path & "\IMG.png" 'aki e o Nome da IMG que voce ira Uzar
graphics.CreateFromHDC Obj.hdc
graphics.DrawImageRectI bitmap.Handle, 0, 0, Pixel(Picture1.Width), Pixel(Picture1.Height)
graphics.Dispose
End Sub
Private Sub Form_Unload(Cancel As Integer)
'esse comandos são feitos para descarregar os modulos
Set graphics = Nothing
Set bitmap = Nothing
End Sub
Private Function Pixel(ByVal lVal As Long) As Long
Pixel = Me.ScaleX(lVal, vbTwips, vbPixels)
End Function
Private Function Twip(ByVal lVal As Long) As Long
Twip = Me.ScaleX(lVal, vbPixels, vbTwips)
End Function
depois adicione um modulo e coloque o nome dele de ModGrafico e adicione o siguinte nele
- Spoiler:
- Código:
Option Explicit
Private Declare Function BitBlt Lib "gdi32" _
(ByVal hDCDest As Long, ByVal XDest As Long, _
ByVal YDest As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hDCSrc As Long, _
ByVal XSrc As Long, ByVal YSrc As Long, _
ByVal dwRop As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hdc As Long) As Long
Public Sub PrintScreen(ByVal Frm As Form, ByVal oObj As Object)
Dim hWndDesk As Long
Dim hDCDesk As Long
Dim LeftDesk As Long
Dim TopDesk As Long
Dim WidthDesk As Long
Dim HeightDesk As Long
LeftDesk = Frm.Left + fLeft(Frm, oObj)
TopDesk = Frm.Top + fTop(Frm, oObj)
WidthDesk = oObj.Width
HeightDesk = oObj.Height
hWndDesk = GetDesktopWindow()
hDCDesk = GetWindowDC(hWndDesk)
BitBlt oObj.hdc, 0, 0, WidthDesk, HeightDesk, hDCDesk, LeftDesk, TopDesk, vbSrcCopy
ReleaseDC hWndDesk, hDCDesk
End Sub
Public Function fTop(ByVal Frm As Form, ByVal Ctl As Control) As Single
If Ctl.Container Is Frm Then
fTop = Ctl.Top
Else
fTop = Ctl.Top + fTop(Frm, Ctl.Container)
End If
End Function
Public Function fLeft(ByVal Frm As Form, ByVal Ctl As Control) As Single
If Ctl.Container Is Frm Then
fLeft = Ctl.Left
Else
fLeft = Ctl.Left + fLeft(Frm, Ctl.Container)
End If
End Function
depois dissu a dicione dois class modulo coloque 1 com nome cBitmap outro com nome cGraphics
no modulo cBitmap coloque
- Spoiler:
- Código:
Option Explicit
Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" (lpPictDesc As PICDESC, riid As CLSID, ByVal fOwn As Long, ByRef lplpvObj As Any)
Event Error(ByVal lGdiError As Long, ByVal sErrorDesc As String)
Private bitmap As Long
Private lToken As Long
Private lCurErr As Long
Private lPixelFormat As Long
Private m_lWidth As Long
Private m_lHeight As Long
Private m_lNumCodecs As Long
Private rc As RECT
Private tGuids() As CLSID
Private colCodecs As Collection
Public Function CreateFromScan0(ByVal lWidth As Long, ByVal lHeight As Long, ByVal lStride As Long, ByVal ePixelFormats As PixelFormats, ByRef lDataPtr As Long)
CreateFromScan0 = Execute(GdipCreateBitmapFromScan0(lWidth, lHeight, lStride, ePixelFormats, ByVal lDataPtr, bitmap))
GetPixelFormat
GetDimension
End Function
Public Function CreateFromHBitmap(ByVal hBitmap As Long) As Long
CreateFromHBitmap = Execute(GdipCreateBitmapFromHBITMAP(hBitmap, 0, bitmap))
End Function
Public Function CreateFromGraphics(ByVal lWidth As Long, ByVal lHeight As Long, ByVal lGraphicHandle As Long)
CreateFromGraphics = Execute(GdipCreateBitmapFromGraphics(lWidth, lHeight, lGraphicHandle, bitmap))
End Function
Public Property Get CurErr() As Long
CurErr = lCurErr
End Property
Public Sub Dispose()
If bitmap Then GdipDisposeImage bitmap
End Sub
Private Function EnumEncoders() As Long
Dim lNumEncoders As Long
Dim lEncoderSize As Long
Dim lError As Long
Dim b() As Byte
Dim i As Long
Dim codecs() As ImageCodecInfo
lError = GdipGetImageEncodersSize(lNumEncoders, lEncoderSize)
If lError = 0 Then
ReDim codecs(lNumEncoders - 1)
ReDim b(lEncoderSize - 1)
lError = GdipGetImageEncoders(lNumEncoders, lEncoderSize, b(0))
If lError = 0 Then
RtlMoveMemory codecs(0), b(0), lNumEncoders * LenB(codecs(0))
ReDim tGuids(lNumEncoders - 1)
m_lNumCodecs = lNumEncoders
Set colCodecs = Nothing
Set colCodecs = New Collection
Do While lNumEncoders
lNumEncoders = lNumEncoders - 1
tGuids(lNumEncoders) = codecs(lNumEncoders).CLSID
ParseOnChar StringFromPointerW(codecs(lNumEncoders).pwszFilenameExtension), ";", lNumEncoders
Loop
Else
RaiseEvent Error(lError, GdiErrorString(lError))
End If
Else
RaiseEvent Error(lError, GdiErrorString(lError))
End If
End Function
Friend Property Get EncoderGuid(ByVal lIndex As Long) As CLSID
EncoderGuid = tGuids(lIndex)
End Property
Private Function Execute(ByVal lReturn As Long) As Long
If lReturn Then
lCurErr = lReturn
RaiseEvent Error(lReturn, GdiErrorString(lReturn))
Else
lCurErr = 0
End If
Execute = lCurErr
End Function
Public Function ExtensionExists(ByRef sKey As String) As Long
On Error GoTo errorhandler
ExtensionExists = True
If Not colCodecs Is Nothing Then
ExtensionExists = colCodecs.Item(sKey)
End If
Exit Function
errorhandler:
End Function
Public Function LoadFromFile(ByVal sFileName As String) As Long
LoadFromFile = Execute(GdipLoadImageFromFile(sFileName, bitmap))
GetPixelFormat
GetDimension
End Function
Private Sub GetDimension()
Dim sngWidth As Single
Dim sngHeight As Single
Execute GdipGetImageDimension(bitmap, sngWidth, sngHeight)
m_lWidth = sngWidth
m_lHeight = sngHeight
rc.Right = m_lWidth
rc.bottom = m_lHeight
End Sub
Friend Sub GetPalette(ByVal lPalPointer As Long, ByVal lNumColors As Long)
Dim lSize As Long
lSize = (lNumColors * 4) + 8
Execute GdipGetImagePalette(bitmap, ByVal lPalPointer, lSize)
End Sub
Private Sub GetPixelFormat()
Execute GdipGetImagePixelFormat(bitmap, lPixelFormat)
End Sub
Public Function GdiErrorString(ByVal lError As Status) As String
Dim s As String
Select Case lError
Case GenericError: s = "Generic Error"
Case InvalidParameter: s = "Invalid Parameter"
Case OutOfMemory: s = "Out Of Memory"
Case ObjectBusy: s = "Object Busy"
Case InsufficientBuffer: s = "Insufficient Buffer"
Case NotImplemented: s = "Not Implemented"
Case Win32Error: s = "Win32 Error"
Case WrongState: s = "Wrong State"
Case Aborted: s = "Aborted"
Case FileNotFound: s = "File Not Found"
Case ValueOverflow: s = "Value Overflow"
Case AccessDenied: s = "Access Denied"
Case UnknownImageFormat: s = "Unknown Image Format"
Case FontFamilyNotFound: s = "FontFamily Not Found"
Case FontStyleNotFound: s = "FontStyle Not Found"
Case NotTrueTypeFont: s = "Not TrueType Font"
Case UnsupportedGdiplusVersion: s = "Unsupported Gdiplus Version"
Case GdiplusNotInitialized: s = "Gdiplus Not Initialized"
Case PropertyNotFound: s = "Property Not Found"
Case PropertyNotSupported: s = "Property Not Supported"
Case Else: s = "Unknown GDI+ Error"
End Select
GdiErrorString = s
End Function
Public Property Get Handle() As Long
Handle = bitmap
End Property
Public Property Get Height() As Long
Height = m_lHeight
End Property
Private Function IPictureFromBitmap(ByVal lBitmap As Long) As IPicture
Dim lError As Long
Dim hBitmap As Long
Dim picdes As PICDESC
If bitmap = 0 Then Exit Function
lError = GdipCreateHBITMAPFromBitmap(lBitmap, hBitmap, 0)
If hBitmap <> 0 Then
picdes.cbSizeOfStruct = Len(picdes)
picdes.picType = vbPicTypeBitmap
picdes.hGdiObj = hBitmap
OleCreatePictureIndirect picdes, StringToGuid(IPictureCLSID), True, IPictureFromBitmap
Else
RaiseEvent Error(lError, GdiErrorString(lError))
End If
End Function
Friend Function LockBits(ByRef rc As RECT, ByVal eMode As ImageLockMode, ByVal eFormat As PixelFormats, ByRef bd As BitmapData) As Long
LockBits = Execute(GdipBitmapLockBits(bitmap, rc, eMode, eFormat, bd))
End Function
Private Sub ParseOnChar(ByRef sIn As String, ByRef sChar As String, ByVal lGuidIndex As Long)
Dim lStartPosition As Long
Dim lFoundPosition As Long
Dim sItem As String
lFoundPosition = InStr(sIn, sChar)
lStartPosition = 1
Do While lFoundPosition
sItem = Mid$(sIn, lStartPosition, lFoundPosition - lStartPosition)
colCodecs.Add lGuidIndex, sItem
lStartPosition = lFoundPosition + 1
lFoundPosition = InStr(lStartPosition, sIn, sChar)
Loop
sItem = Trim$(Mid$(sIn, lStartPosition))
If LenB(sItem) Then colCodecs.Add lGuidIndex, sItem
End Sub
Public Property Get Picture() As StdPicture
Set Picture = IPictureFromBitmap(bitmap)
End Property
Public Property Get PixelFormat() As Long
PixelFormat = lPixelFormat
End Property
Friend Property Get Rectangle() As RECT
Rectangle = rc
End Property
Public Sub SetTransColor(ByVal lIndex As Byte)
Dim gpal As ColorPalette256
If bitmap Then
GetPalette VarPtr(gpal), 256
gpal.Entries(lIndex).Alpha = 0
SetPalette VarPtr(gpal)
End If
End Sub
Friend Function SaveToFile(ByVal sFileName As String, tEncoder As CLSID, ByVal lEncParamPointer As Long) As Long
SaveToFile = Execute(GdipSaveImageToFile(bitmap, sFileName, tEncoder, ByVal lEncParamPointer))
End Function
Public Function SetPalette(ByVal lPalPointer As Long) As Long
SetPalette = Execute(GdipSetImagePalette(bitmap, ByVal lPalPointer))
End Function
Private Function StringFromPointerW(ByVal lPointer As Long) As String
Dim lLength As Long
If lPointer Then
lLength = lstrlenW(lPointer)
StringFromPointerW = Space$(lLength)
RtlMoveMemory ByVal StrPtr(StringFromPointerW), ByVal lPointer, lLength * 2
End If
End Function
Private Function StringToGuid(ByRef sGuid As String) As CLSID
CLSIDFromString sGuid, StringToGuid
End Function
Friend Function UnlockBits(ByRef bd As BitmapData) As Long
UnlockBits = Execute(GdipBitmapUnlockBits(bitmap, bd))
End Function
Public Property Get Width() As Long
Width = m_lWidth
End Property
Private Sub Class_Initialize()
Dim gsi As GdiplusStartupInput
gsi.GdiplusVersion = 1
Execute GdiplusStartup(lToken, gsi, ByVal 0)
EnumEncoders
End Sub
Private Sub Class_Terminate()
Dispose
If lToken Then GdiplusShutdown lToken
End Sub
no outro modulo com nome cGraphics adicione
- Spoiler:
- Código:
Option Explicit
Event Error(ByVal lGdiError As Long, ByVal sErrorDesc As String)
Private graphics As Long
Private lDC As Long
Private lCurErr As Long
Public Function CreateFromGraphics(ByVal lWidth As Long, ByVal lHeight As Long, ByRef lBmpHandle As Long) As Long
CreateFromGraphics = Execute(GdipCreateBitmapFromGraphics(lWidth, lHeight, graphics, lBmpHandle))
End Function
Public Function CreateFromHDC(ByVal lHdc As Long) As Long
CreateFromHDC = Execute(GdipCreateFromHDC(lHdc, graphics))
End Function
Public Function CreateFromHWND(ByVal lHwnd As Long) As Long
CreateFromHWND = Execute(GdipCreateFromHWND(lHwnd, graphics))
End Function
Public Property Get CurErr() As Long
CurErr = lCurErr
End Property
Public Sub Dispose()
GdipDeleteGraphics graphics
graphics = 0
End Sub
Public Function DrawImageI(ByVal lBmpHandle As Long, ByVal x As Long, ByVal y As Long) As Long
DrawImageI = Execute(GdipDrawImageI(graphics, lBmpHandle, x, y))
End Function
Public Function DrawImageRectI(ByVal lBmpHandle As Long, ByVal x As Long, ByVal y As Long, ByVal lWidth As Long, ByVal lHeight As Long) As Long
DrawImageRectI = Execute(GdipDrawImageRectI(graphics, lBmpHandle, x, y, lWidth, lHeight))
End Function
Private Function Execute(ByVal lReturn As Long) As Long
If lReturn Then
lCurErr = lReturn
RaiseEvent Error(lReturn, GdiErrorString(lReturn))
Else
lCurErr = 0
End If
Execute = lCurErr
End Function
Public Function GetDC() As Long
Execute GdipGetDC(graphics, lDC)
End Function
Public Function GdiErrorString(ByVal lError As Status) As String
Dim s As String
Select Case lError
Case GenericError: s = "Generic Error"
Case InvalidParameter: s = "Invalid Parameter"
Case OutOfMemory: s = "Out Of Memory"
Case ObjectBusy: s = "Object Busy"
Case InsufficientBuffer: s = "Insufficient Buffer"
Case NotImplemented: s = "Not Implemented"
Case Win32Error: s = "Win32 Error"
Case WrongState: s = "Wrong State"
Case Aborted: s = "Aborted"
Case FileNotFound: s = "File Not Found"
Case ValueOverflow: s = "Value Overflow"
Case AccessDenied: s = "Access Denied"
Case UnknownImageFormat: s = "Unknown Image Format"
Case FontFamilyNotFound: s = "FontFamily Not Found"
Case FontStyleNotFound: s = "FontStyle Not Found"
Case NotTrueTypeFont: s = "Not TrueType Font"
Case UnsupportedGdiplusVersion: s = "Unsupported Gdiplus Version"
Case GdiplusNotInitialized: s = "Gdiplus Not Initialized"
Case PropertyNotFound: s = "Property Not Found"
Case PropertyNotSupported: s = "Property Not Supported"
Case Else: s = "Unknown GDI+ Error"
End Select
GdiErrorString = s
End Function
Public Property Get Handle() As Long
Handle = graphics
End Property
Public Sub ReleaseDC()
Execute GdipReleaseDC(graphics, lDC)
lDC = 0
End Sub
Public Function ResetTransform() As Long
ResetTransform = Execute(GdipResetWorldTransform(graphics))
End Function
Public Function RotateTransform(ByVal sngAngle As Single, Optional ByVal eOrder As MatrixOrder = MatrixOrderPrepend) As Long
RotateTransform = Execute(GdipRotateWorldTransform(graphics, sngAngle, eOrder))
End Function
Public Function TranslateTransform(ByVal dx As Single, ByVal dy As Single, Optional ByVal eOrder As MatrixOrder = MatrixOrderPrepend) As Long
TranslateTransform = Execute(GdipTranslateWorldTransform(graphics, dx, dy, eOrder))
End Function
Private Sub Class_Terminate()
If graphics Then
If lDC Then ReleaseDC
Dispose
End If
End Sub
pronto galera depois dissu tudo faça o siguinte baixe esse arquivo aki abaixo e coloque no seu projeto ou no seu windows sytem32 depois de colocar o arquivo na pasta faça o siguinte va hein Project>>References>>GDI+ tlb By wpsrj1@syix.com
- Spoiler:
- Foto de como vai ficar
pronto galera agora FIM não esqueção de dar os credes por Tio Ian ^^
Download da Library
Projeto + Soucer
Creditos:Ian por fazer o sistema eo tutorial
Willian DOido por Cria a Library GDI+ para esse tutorial
OBS: fiz esse tutorial para voces utilizarem nas suas Guis graficos melhores do que os arquivos velhos e pesados ou ate se consiguir utilizar sprites hein PNG
Galera Qual quer Bug Pode Reportar
Ian- Membro Veterano
- Mensagens : 1238
Re: Utilizando PNG
por St4rk Sex 18 Fev 2011, 09:40
Aconcelho não utilizar isso fikdik/,mais se teu jogo usa muita imagem sem passar pelo DirectX, utilize com moderação (y).
St4rk- Membro de Honra
- Mensagens : 2251
-
Re: Utilizando PNG
por Ian Sex 18 Fev 2011, 09:52
Então a intensão desse tutorial e pra quem vai uzar Gui com alta qualidade não para deixar todo game com graficos PNG
Ian- Membro Veterano
- Mensagens : 1238
Re: Utilizando PNG
por megosarco Sex 18 Fev 2011, 10:26
Boa Ian, assim quem gosta de um pouco mais de "luxO" na GUI vai aproveitar.
Mas como o Zero falou... Eu não usaria png em um server que eu queira mais de 50 players on =D
Mas tem gente que quer, então +1 credito =D
Mas como o Zero falou... Eu não usaria png em um server que eu queira mais de 50 players on =D
Mas tem gente que quer, então +1 credito =D
megosarco- Membro Junior
- Mensagens : 95
Lucas Roberto- Membro Veterano
- Mensagens : 1794
-
Mortal- Novato
- Mensagens : 24
Re: Utilizando PNG
por Rick0800Suco Sex 18 Fev 2011, 13:53
Hm... bom tutorial, parabéns, vai ajudar muito, vou até usar!
+1 créd!
+1 créd!
Rick0800Suco- Membro Sênior
- Mensagens : 272
Re: Utilizando PNG
por Darkpeople196 Sáb 19 Fev 2011, 06:59
uma pergunta se eu usar isso a picturebox que eu colocar lá vai ficar transparente???/ pois tem algum modulos que achei na net e lá eles perdem a qualidade de png tipo fundo translúcido ou transparente
Darkpeople196- Membro Vitalicio
- Mensagens : 612
Re: Utilizando PNG
por Ian Sáb 19 Fev 2011, 10:11
Olha manolo e deixa trasparente sim agora tipo ele so vai deixar a IMG png trasparente a picture box vai ficar com a cor de fundo dela a ñ ser que voce faça igual eu fiz procura na net uma cor trasparente pra picture box e tipo uma mistura feita pelo alpha bleding na quele eo Do sait do robin tem a cor traslucida feita com alpha bleding e ñ perde a qualidade da PNG ^^
Ian- Membro Veterano
- Mensagens : 1238
Tópicos semelhantes» [ES/EE/EEB] Utilizando .PNG com DirectX7
» Utilizando o Event System
» [ALL]Auto Ataque utilizando Checkbox
» [ALL]Auto Magia utilizando Checkbox
» Como descobrir que programa está utilizando deteminada porta
» Utilizando o Event System
» [ALL]Auto Ataque utilizando Checkbox
» [ALL]Auto Magia utilizando Checkbox
» Como descobrir que programa está utilizando deteminada porta
Página 1 de 1
Permissões neste sub-fórum
Não podes responder a tópicos
» Ojkjeeeee
» Naruto Great Ninja Batle
» Recrutamento de um Designer para jogo de CDZ.
» Serviços de suporte maker( Programação , Design , PixelArt ) E Vendas de Jogos
» Serviços de suporte maker( Programação , Design , PixelArt ) E Vendas de Jogos
» Serviços de suporte maker( Programação , Design , PixelArt ) E Vendas de Jogos
» Projeto Dbz
» Avaliação - Sprites Naruto
» [Sprites] DBZ (Plix)
» Super Pack - Bleach V.2
» [PEDIDO][PROJETO][RECRUTAMENTO] DYNISTYGAMES
» [PEDIDO][PROJETO][RECRUTAMENTO] DYNISTYGAMES
» [PEDIDO][PROJETO][RECRUTAMENTO] DYNISTYGAMES
» [Pedido] Contador de resets na FrmMain
» [Recrutamento]
» Ajuda erro no Cliente e Servidor do EEB 2.6!
» Como criar tilesets para Eclipse Origins 3.0 (POKÉMON)
» Recursos Pokemons
» erro frm flash
» Pedido - Pack de star wars
» [Ajuda] Sobre como por o servidor on por ip fixo
» Illusion Dimension - O Misterio do ID: BETA TESTE ONLINE
» [NSME] Naruto Shinobi Maker Engine
» Script /base,/casa Igual DBZ Forces
» [Pedido]Colar Tsunade item sprite eclipse origin
» [Pedido] Elysium
» Naruto - Recruta
» [Avaliação] - Kirito from Sword Art Online; Red and Pikachu from Pokemon.
» [Avaliação] - Kenpachi Zaraki from Bleach; Libra Shiryu From Saint Seiya.
» Demonstração de Sprites (Á VENDA!)
» [Sistema de Reset]Para Eclipse .
» Cada Guild Nascer em Certo Mapa
» Dragon Ball z Fusion A Grande Volta
» Ajuda com Ip fixo
» Como Fazer um GUI no Eclipse Origins
» Shisui Susanoo
» Fantasy Art Online
» Ajuda !!
» como passar o usuário e senha para o MainMenu?
» Ru time ero 13 Type mismatch
» Jarvis 1.3 Download
» [Avaliação/Disponibilização]Árvore 64x64
» Mlk's Zikas Signatures
» Pedido de Sistemas
» [AjudaEEB]Gerador de EXP
» [Avaliar] Base, Humano e Goblin.
» Fabrica do Tio Cronos!
» [PixelArt] Minion - Meu malvado favorito
» [Avaliar] Goku Dragon Ball Z