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

black

Guardar a imagem do Form

48 mensagens neste tópico

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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"

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

ajuda!!!!!!!!!

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

nao percebi muito bem :eek:  ....

em 1º lugar todos  aqueles privates onde sao inseridos???? :hmm:

(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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Semttulo.jpg

basicamente e isto...

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

esta tudo um pouco confuso... :wallbash:

será que poderias inserir todo o código necessário aqui??? :hmm: 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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

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

:eek:

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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!!! :hmm:

:hmm:

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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"

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

tenho!!!!

no teu da????

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

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora