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

BETA2

Alguem Que Me Ajude Plz

2 mensagens neste tópico

Alguem me pode explicar o codigo destes dois programas em Visual Basic?? É que vou ter que o explicar linha a linha num projecto para a escola e nao sei como..

Primeiro programa: (Jogo Solitaire)

Private Sub imgGoti_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)

If (imgGoti(Index).Picture <> 0) Or Abs(Source.Index - Index) <> 2 _

And Abs(Source.Index - Index) <> 20 Then Exit Sub

If (imgGoti(Source.Index - ((Source.Index - Index) / 2)).Picture = 0) Then Exit Sub

Source.Picture = LoadPicture

imgGoti(Source.Index - ((Source.Index - Index) / 2)).Picture = LoadPicture

imgGoti(Index).Picture = imgGotipic.Picture

End Sub

Segundo programa: (Zoom)

Option Explicit

Private lngWidth As Long, lngHeight As Long ' dimensões da imagem original

Private lngScaledWidth As Long, lngScaledHeight As Long ' dimensões em escala da imagem com Zoom

Private sngFatorZoom As Single ' factor actual de zoom

Private Const ZOOM_PASSO As Single = 0.25 ' quantidade de percentual para aumentar/diminiuir em cada zoom

Private Const ZOOM_NIVEL_MINIMO As Single = 0.25 ' nível minimo de zoom

Private Const ZOOM_NIVEL_MAXIMO As Single = 8# ' nível maximo de zoom

Private Const ZOOM_NIVEL_PADRAO As Single = 1# ' nível padrão de zoom

Private Const APP_TITULO As String = "Dando um Zoom" ' titulo da aplicação

Private Const APP_VERSAO As String = "1.0" ' versão da aplicação

' enumeração definindo os tipos de ZOOM

Private Enum ZOOM_TIPO

ZOOM_IN

ZOOM_OUT

End Enum

Private Function ObterValorScroll(lngScaledDimension As Long, lngHolderDimension As Long, _

lngScrollBarValue As Long) As Long

Dim dblScroll As Double, lngPos As Long

dblScroll = ((lngScaledDimension - lngHolderDimension) * lngScrollBarValue) / 100#

lngPos = Int(dblScroll)

ObterValorScroll = -dblScroll

End Function

Private Sub ScrollHorizontal()

picEdicao.Left = ObterValorScroll(lngScaledWidth, picHolder.ScaleWidth, hscScroll.Value)

End Sub

Private Sub ScrollVertical()

picEdicao.Top = ObterValorScroll(lngScaledHeight, picHolder.ScaleHeight, vscScroll.Value)

End Sub

Private Sub InicializaValores()

sngFatorZoom = ZOOM_NIVEL_PADRAO

lngWidth = Int(lblWidth.Caption)

lngHeight = Int(lblHeight.Caption)

End Sub

Private Sub InicializaJanela()

With picEdicao

.ScaleMode = vbPixels

.AutoRedraw = True

End With

picHolder.ScaleMode = vbPixels

picOriginal.ScaleMode = vbPixels

ScaleMode = vbPixels

lblMinLevel.Caption = Format(ZOOM_NIVEL_MINIMO, "0.00")

lblMaxLevel.Caption = Format(ZOOM_NIVEL_MAXIMO, "0.00")

lblLevel.Caption = Format(ZOOM_NIVEL_PADRAO, "0.00")

lblWidth.Caption = picOriginal.ScaleWidth - 2

lblHeight.Caption = picOriginal.ScaleHeight - 2

lblScaledWidth.Caption = Int(lblWidth.Caption * CSng(lblLevel.Caption))

lblScaledHeight.Caption = Int(lblHeight.Caption * CSng(lblLevel.Caption))

End Sub

Private Sub btnExit_Click()

Unload Me

End

End Sub

Private Sub btnZoomIn_Click()

Zoom ZOOM_IN

End Sub

Private Sub btnZoomOut_Click()

Zoom ZOOM_OUT

End Sub

Private Sub btnZoomTo50_Click()

ZoomToLevel 0.5

End Sub

Private Sub cmdImagem_Click()

Dim imagem As String

' define o titulo da janela

CommonDialog1.DialogTitle = "Selecionar Imagem"

' define a lista de arquivos a abrir

CommonDialog1.Filter = "Todos (*.gif*)|*.gif*|Imagens (*.bmp)|*.bmp"

' define quais arquivos são o padrão

CommonDialog1.FilterIndex = 1

' define flags - arquivo precisa existir

CommonDialog1.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly

' define a janela de erros se esta algo errado

CommonDialog1.CancelError = True

' permite o tratamento dos erros

On Error Resume Next

' exibe janela

CommonDialog1.ShowOpen

imagem = CommonDialog1.FileName

If Err Then

' se cancelar exibe mensagem

MsgBox "Cancelado"

Exit Sub

Else

If Not imagem = Empty Then

picOriginal.Picture = LoadPicture(imagem)

picEdicao.Picture = LoadPicture(imagem)

Else

picOriginal.Picture = LoadPicture("")

picEdicao.Picture = LoadPicture("")

End If

End If

End Sub

Private Sub Form_Load()

InicializaJanela

InicializaValores

RedesenhaImagem

End Sub

Private Sub hscScroll_Change()

ScrollHorizontal

End Sub

Private Sub RedesenhaImagem()

lngScaledWidth = Int(lngWidth * sngFatorZoom)

lngScaledHeight = Int(lngHeight * sngFatorZoom)

lblScaledWidth.Caption = lngScaledWidth

lblScaledHeight.Caption = lngScaledHeight

Set picEdicao.Picture = Nothing

picEdicao.Width = lngScaledWidth

picEdicao.Height = lngScaledHeight

picEdicao.PaintPicture picOriginal, 0, 0, lngScaledWidth, lngScaledHeight, 0, 0, lngWidth, lngHeight

MousePointer = vbDefault

hscScroll.Value = 0

vscScroll.Value = 0

hscScroll.Enabled = lngScaledWidth > picHolder.ScaleWidth

vscScroll.Enabled = lngScaledHeight > picHolder.ScaleHeight

End Sub

Private Sub Zoom(ztType As ZOOM_TIPO)

Dim sngZoom As Single

If ztType = ZOOM_IN Then

sngZoom = sngFatorZoom + ZOOM_PASSO

Else

sngZoom = sngFatorZoom - ZOOM_PASSO

End If

ZoomToLevel sngZoom

End Sub

Private Sub ZoomToLevel(sngZoom As Single)

If sngZoom < ZOOM_NIVEL_MINIMO Or sngZoom > ZOOM_NIVEL_MAXIMO Then Exit Sub

sngFatorZoom = sngZoom

lblLevel.Caption = Format(sngZoom, "0.00")

RedesenhaImagem

End Sub

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

If Button = 1 Then

Zoom ZOOM_IN

ElseIf Button = 2 Then

Zoom ZOOM_OUT

End If

End Sub

Private Sub vscScroll_Change()

ScrollVertical

End Sub

OBRIGADA mesmo  :P :-[

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

hum.....

o primeiro é bastante fácil, e o segundo já está comentado...o que é que queres mais??? :S

dúvidas é uma coisa, mas isto não são dúvidas...é um trabalho que vai contar para avaliação...cheira-me que copiaste este código e agora vais ter que comprovar que o fizeste ou que no mínimo o percebeste :P

mais vale ires consultar alguns sites sobre este assunto e aprenderes alguma coisa....acho que ninguém aqui vai fazer o trabalho por ti...

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