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

black

Guardar a imagem do Form

Recommended Posts

black

o assunto e o seguinte:

ora bem caros amigos, eu fiz uma espécie de paint no visual BASIC e gostaria de saber se e possivel guardar a imagem que desenhei para um ficheiro de imagem. tudo o que desenhei encontra-se no formulario do projecto.(form load)

' Declaração de algumas variáveis logo no inicio da aplicação:
Public InicialX, InicialY, Lapis, Linha, Rectangular, Circulo

' Rotina associada ao botão para limpar o formulário:
Private Sub cmdApaga_Click()
Cls
End Sub

' Rotina associada a um dos botões de acção disponíveis:
Private Sub cmdLinha_Click()
Lapis = False
Linha = True
Rectangular = False
Circulo = False
MousePointer = 2
End Sub

' Rotina de carregamento do formulário, e preparação do ambiente de trabalho:
Private Sub Form_Load()
Lapis = True
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
InicialX = X
InicialY = Y
CurrentX = X
CurrentY = Y
End If
End Sub

' Rotinas gerais para controle do rato e das acções com coordenadas:
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (Button = 1) Then
If Lapis Then
Line -(X, Y)
End If
If Linha Then
ForeColor = BackColor
DrawMode = 7
Line (InicialX, InicialY)-(CurrentX, CurrentY)
Line (InicialX, InicialY)-(X, Y)
End If
If Rectangular Then
ForeColor = BackColor
DrawMode = 7
Line (InicialX, InicialY)-(CurrentX, CurrentY), , B
Line (InicialX, InicialY)-(X, Y), , B
End If
Current = X
Current = Y
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Circulo Then
ForeColor = BackColor
DrawMode = 7
radius! = Sqr((InicialX - CurrentX) ^ 2 + (InicialY - CurrentY) ^ 2)
Circle (InicialX, InicialY), radius!
radius! = Sqr((InicialX - X) ^ 2 + (InicialY - Y) ^ 2)
Circle (InicialX, InicialY), radius!
End If
End Sub

gostaria de saber quais são as alterações a fazer apenas para poder guardar o k desenhei....

agradecia que me respondessem com a maior urgência.....e se me pudessem arranjar o código seria mt bom


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
jpaulino

Olá,

Podes copiar a imagem para o clipboard (utilizando ALT+PrintScreen para copiar apenas a janela) e depois gravar para o disco.

Exemplo:

API's

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Const VK_MENU = &H12
Private Const VK_SNAPSHOT = &H2C
Private Const KEYEVENTF_KEYUP = &H2

No botão

   Dim alt_key As Long

   ' Copia a imagem para o clipboard
   alt_key = MapVirtualKey(VK_MENU, 0)
   keybd_event VK_MENU, alt_key, 0, 0
   DoEvents
   keybd_event VK_SNAPSHOT, 1, 0, 0

   ' Liberta a tecla ALT
   keybd_event VK_MENU, alt_key, KEYEVENTF_KEYUP, 0
   DoEvents

   ' Grava no ficheiro
   SavePicture Clipboard.GetData(vbCFBitmap), "c:\form.bmp"

Share this post


Link to post
Share on other sites
jpaulino

Coloquei também um titulo mais sugestivo para esta questão. Tenta fazer isso para a próxima e não utilizar titulos genéricos.

Share this post


Link to post
Share on other sites
black

o nosso objectivo e no form inserir um botão que ao carregar ele guarde a imagem...

ajuda!!!!!!!!!


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
black

nao percebi muito bem 😲  ....

em 1º lugar todos  aqueles privates onde sao inseridos???? 🤔

(Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

Private Const VK_MENU = &H12

Private Const VK_SNAPSHOT = &H2C

Private Const KEYEVENTF_KEYUP = &H2)

em 2º lugar o codigo posterior e inserido num botao criado para o efeito???

( Dim alt_key As Long

  ' Copia a imagem para o clipboard

  alt_key = MapVirtualKey(VK_MENU, 0)

  keybd_event VK_MENU, alt_key, 0, 0

  DoEvents

  keybd_event VK_SNAPSHOT, 1, 0, 0

  ' Liberta a tecla ALT

  keybd_event VK_MENU, alt_key, KEYEVENTF_KEYUP, 0

  DoEvents

  ' Grava no ficheiro

  SavePicture Clipboard.GetData(vbCFBitmap), "c:\form.bmp")

o objectivo e simples... tenho o meu formulário com um botão para pincel outro para fazer quadrados outro rectas... etc. depois de desenhar tudo no form_load queria carregar num botão xamado guardar e em seguida ficar tudo que desenhei ficar guardado


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
black

Semttulo.jpg

basicamente e isto...

ao carregar nesse botão "guardar" grava o respectivo desenho.


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
jpaulino

Só a imagem ou tudo, o form todo ?

Deves colocar as API's no inicio do código e o resto (com inicio em Dim alt_key As Long) dentro do código do botão.

Share this post


Link to post
Share on other sites
black

e podes me arranjar as api's????

preciso mesmo... rapido :fartnew2:


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
black

arranja-me os api's... 

por favor....

rapido

urgente 


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
black

esta tudo um pouco confuso... :wallbash:

será que poderias inserir todo o código necessário aqui??? 🤔 numa nova resposta... :cheesygrin:

Preciso mesmo disto urgentemente... ao colocar aqui poem o que e para colocar no botão e se for para colocar algo noutro sitio explica... pf


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
jpaulino

Qual é a confusão ? Adicionas um botão e no evento click colocas o código que está para o botão. No inicio do código colocas as as declarações às AIP's.

Tenta lá e mostra como ficou ...

Share this post


Link to post
Share on other sites
black

Já fiz tudo o que me disse porem ao clicar no botão "guardar" não acontece nada, mesmo nada 🤔

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

Private Const VK_MENU = &H12

Private Const VK_SNAPSHOT = &H2C

Private Const KEYEVENTF_KEYUP = &H2

Public InicialX, InicialY, Lapis, Linha, Rectangular, Circulo

Private Sub CMDAPAGAR_Click()

Cls

End Sub

Private Sub cmdcirculo_Click()

Lapis = False

Linha = False

Rectangular = False

Circulo = True

MousePointer = 2

End Sub

Private Sub CMDLINHA_Click()

Lapis = False

Linha = True

Rectangular = False

Circulo = False

MousePointer = 2

End Sub

Private Sub CMDQUADRADO_Click()

Lapis = False

Linha = False

Rectangular = True

Circulo = False

MousePointer = 2

End Sub

Private Sub Command1_Click()

' Copia a imagem para o clipboard

   alt_key = MapVirtualKey(VK_MENU, 0)

   keybd_event VK_MENU, alt_key, 0, 0

   DoEvents

   keybd_event VK_SNAPSHOT, 1, 0, 0

   ' Liberta a tecla ALT

   keybd_event VK_MENU, alt_key, KEYEVENTF_KEYUP, 0

   DoEvents

   ' Grava no ficheiro

   SavePicture Clipboard.GetData(vbCFBitmap), "C:\Users\Sérgio Almeida\VB"

End Sub

Private Sub Form_Click()

Lapis = True

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then

InicialX = X

InicialY = Y

CurrentX = X

CurrentY = Y

End If

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If (Button = 1) Then

If Lapis Then

Line -(X, Y)

End If

If Linha Then

ForeColor = BackColor

DrawMode = 7

Line (InicialX, InicialY)-(CurrentX, CurrentY)

Line (InicialX, InicialY)-(X, Y)

End If

If Rectangular Then

ForeColor = BackColor

DrawMode = 7

Line (InicialX, InicialY)-(CurrentX, CurrentY), , B

Line (InicialX, InicialY)-(X, Y), , B

End If

Current = X

Current = Y

End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Circulo Then

ForeColor = BackColor

DrawMode = 7

radius! = Sqr((InicialX - CurrentX) ^ 2 + (InicialY - CurrentY) ^ 2)

Circle (InicialX, InicialY), radius!

radius! = Sqr((InicialX - X) ^ 2 + (InicialY - Y) ^ 2)

Circle (InicialX, InicialY), radius!

End If

End Sub

Para que tudo fique mais simplificado vou inserir também algumas imagens!!!

2.jpg

4.jpg

3.jpg

Repito que o problema é que quando faço guardar não faz nada...

aguardo a resposta com a maior urgência... obrigado

😲


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
jpaulino

>> aguardo a resposta com a maior urgência... obrigado

Tens de ter calma ...

O que eu coloquei não era iso:

SavePicture Clipboard.GetData(vbCFBitmap), "C:\Users\Sérgio Almeida\VB"

Mas sim isto:

SavePicture Clipboard.GetData(vbCFBitmap), "C:\Users\Sérgio Almeida\VB\imagem.bmp"

Share this post


Link to post
Share on other sites
black

desculpe estar sempre a pedir urgência, porem tenho que realizar este programa o mais rápido possível.

ja fiz o que disse...

mas continua a acontecer a mesma coisa... faço guardar e não acontece nada. A imagem não fica guardada!!! 🤔

🤔


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
black

nao da erro nenhum, mas carrego em guardar e não fax nada...


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
jpaulino

nao da erro nenhum, mas carrego em guardar e não fax nada...

Foste ver se o ficheiro foi criado em  "C:\Users\Sérgio Almeida\VB\imagem.bmp" ?

Share this post


Link to post
Share on other sites
black

fui claro... mas não esta nada... será pode correr o código no teu vb e ver se consegue por a dar??? é mesmo importante para o meu trabalho


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
jpaulino

fui claro... mas não esta nada... será pode correr o código no teu vb e ver se consegue por a dar??? é mesmo importante para o meu trabalho

Tenta alterar para:

SavePicture Clipboard.GetData(vbCFBitmap), "C:\imagem.bmp"

Share this post


Link to post
Share on other sites
black

não dá... não guarda nada em C:\imagem.bmp....

neste momento o meu código é este:

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

Private Const VK_MENU = &H12

Private Const VK_SNAPSHOT = &H2C

Private Const KEYEVENTF_KEYUP = &H2

Public InicialX, InicialY, Lapis, Linha, Rectangular, Circulo

Private Sub CMDAPAGAR_Click()

Cls

End Sub

Private Sub cmdcirculo_Click()

Lapis = False

Linha = False

Rectangular = False

Circulo = True

MousePointer = 2

End Sub

Private Sub CMDLINHA_Click()

Lapis = False

Linha = True

Rectangular = False

Circulo = False

MousePointer = 2

End Sub

Private Sub CMDQUADRADO_Click()

Lapis = False

Linha = False

Rectangular = True

Circulo = False

MousePointer = 2

End Sub

Private Sub Command1_Click()

' Copia a imagem para o clipboard

  alt_key = MapVirtualKey(VK_MENU, 0)

  keybd_event VK_MENU, alt_key, 0, 0

  DoEvents

  keybd_event VK_SNAPSHOT, 1, 0, 0

  ' Liberta a tecla ALT

  keybd_event VK_MENU, alt_key, KEYEVENTF_KEYUP, 0

  DoEvents

  ' Grava no ficheiro

  SavePicture Clipboard.GetData(vbCFBitmap), "C:\imagem.bmp"

End Sub

Private Sub Form_Click()

Lapis = True

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then

InicialX = X

InicialY = Y

CurrentX = X

CurrentY = Y

End If

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If (Button = 1) Then

If Lapis Then

Line -(X, Y)

End If

If Linha Then

ForeColor = BackColor

DrawMode = 7

Line (InicialX, InicialY)-(CurrentX, CurrentY)

Line (InicialX, InicialY)-(X, Y)

End If

If Rectangular Then

ForeColor = BackColor

DrawMode = 7

Line (InicialX, InicialY)-(CurrentX, CurrentY), , B

Line (InicialX, InicialY)-(X, Y), , B

End If

Current = X

Current = Y

End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Circulo Then

ForeColor = BackColor

DrawMode = 7

radius! = Sqr((InicialX - CurrentX) ^ 2 + (InicialY - CurrentY) ^ 2)

Circle (InicialX, InicialY), radius!

radius! = Sqr((InicialX - X) ^ 2 + (InicialY - Y) ^ 2)

Circle (InicialX, InicialY), radius!

End If

End Sub


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites
black

tenho!!!!

no teu da????

simplesmente carregas no botão e ja esta??? guarda logo???

envia-me umas imagens do teu a guardar....


.:: C ::. .::Haskell::. .::VB::. .::PHP::.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.