

Fitxer: m7p3.frm
Definició dels objectes. Interfície d'usuari
Recordeu que això no ho podeu editar directament. Per fer-ho incorporeu nous objectes
de la paleta en el vostre formulari. I per canviar els valors seleccioneu l'objecte i
escolliu la propietat a canviar en la finestra Properties.
VERSION 5.00
Begin VB.Form Form1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Òptica geomètrica - Lent convergent"
ClientHeight = 4740
ClientLeft = 720
ClientTop = 1815
ClientWidth = 8445
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
LinkTopic = "Form1"
PaletteMode = 1 'UseZOrder
ScaleHeight = 316
ScaleMode = 3 'Pixel
ScaleWidth = 563
Begin VB.Menu mnuOpcions
Caption = "&Opcions"
Begin VB.Menu mnuTrama
Caption = "&Trama"
End
Begin VB.Menu mnuFeixos
Caption = "&Feixos de llum"
Checked = -1 'True
End
Begin VB.Menu mnuRes
Caption = "-"
End
Begin VB.Menu mnuSortir
Caption = "&Sortir"
End
End
End
Codi del programa. Programació de respostes a events
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim yT, xL, xO, yO, F, xI, yI As Integer
Dim CalMoureObjecte, CalCanviarTamanyObjecte, CalMoureLent, CalMoureFocus, CalMoureTerra As Integer
Dim HiHaHint, HintX, HintY As Integer
Private Sub Form_Load()
iniciar
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If x > xO - 5 And x < xO + 5 Then
If y > yT - yO - 5 And y < yT - yO + 5 Then
CalCanviarTamanyObjecte = 1
MousePointer = 7
Else
CalMoureObjecte = 1
MousePointer = 9
End If
ElseIf x > xL - 5 And x < xL + 5 Then
CalMoureLent = 1
MousePointer = 9
ElseIf x > xL + F - 5 And x < xL + F + 5 Then
CalMoureFocus = 1
MousePointer = 9
ElseIf y > yT - 5 And y < yT + 5 Then
CalMoureTerra = 1
MousePointer = 7
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
HiHaHint = 0
If CalCanviarTamanyObjecte = 1 Then
yO = yT - y
Pintar
ElseIf CalMoureObjecte = 1 Then
If x < xL - 1 Then
xO = x
Pintar
End If
ElseIf CalMoureLent = 1 Then
If x > xO + 1 Then
xL = x
Pintar
End If
ElseIf CalMoureFocus = 1 Then
If x > xL Then
F = x - xL
Pintar
End If
ElseIf CalMoureTerra = 1 Then
yT = y
Pintar
Else
MousePointer = 0
If x > xO - 5 And x < xO + 5 Then
If y > yT - yO - 5 And y < yT - yO + 5 Then
MousePointer = 7
Else
MousePointer = 9
End If
ElseIf x > xL - 5 And x < xL + 5 Then
MousePointer = 9
ElseIf x > xL + F - 5 And x < xL + F + 5 Then
MousePointer = 9
ElseIf y > yT - 5 And y < yT + 5 Then
MousePointer = 7
End If
If MousePointer <> 0 Then
HiHaHint = 1
HintX = x + 10
HintY = y + 10
Pintar
Else
HiHaHint = 0
Pintar
End If
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
CalCanviarTamanyObjecte = 0
CalMoureObjecte = 0
CalMoureLent = 0
CalMoureFocus = 0
CalMoureTerra = 0
MousePointer = 0
End Sub
Private Sub Form_Paint()
Pintar
End Sub
Private Sub iniciar()
yT = 175
xL = 300
xO = 100
yO = 50
F = 100
CalMoureObjecte = 0
CalMoureLent = 0
CalMoureFocus = 0
CalCanviarTamanyObjecte = 0
CalMoureTerra = 0
HiHaHint = 0
HintX = 0
HintY = 0
End Sub
Private Sub mnuFeixos_Click()
mnuFeixos.Checked = Not mnuFeixos.Checked
Pintar
End Sub
Private Sub mnuSortir_Click()
End
End Sub
Private Sub mnuTrama_Click()
mnuTrama.Checked = Not mnuTrama.Checked
Pintar
End Sub
Private Sub Pintar()
Dim r As Integer
Cls
'Trama
ForeColor = RGB(128, 128, 128)
If mnuTrama.Checked Then
r = 25
While r <= 480
Line (0, r)-(640, r)
r = r + 25
Wend
r = 25
While r <= 640
Line (r, 0)-(r, 480)
r = r + 25
Wend
End If
'Terra
ForeColor = QBColor(0)
Line (0, yT)-(1300, yT)
'Focus
Line (xL + F, yT - 5)-(xL + F, yT + 5)
Line (xL - F, yT - 5)-(xL - F, yT + 5)
CurrentX = xL + F
CurrentY = 20
Print "Focus"
'Lent
ForeColor = QBColor(6)
Line (xL, yT - 130)-(xL, yT + 130)
Line (xL - 10, yT - 130 + 10)-(xL, yT - 130)
Line (xL + 10, yT - 130 + 10)-(xL, yT - 130)
Line (xL - 10, yT + 130 - 10)-(xL, yT + 130)
Line (xL + 10, yT + 130 - 10)-(xL, yT + 130)
CurrentX = xL
CurrentY = 20
Print "Lent"
'Objecte
ForeColor = QBColor(1)
r = 1
If yO < 0 Then
r = -1
End If
Line (xO, yT)-(xO, yT - yO)
Line (xO, yT - yO)-(xO - 10 * r, yT - yO + 10 * r)
Line (xO, yT - yO)-(xO + 10 * r, yT - yO + 10 * r)
CurrentX = xO
CurrentY = 20
Print "Objecte"
'Feixos de llum
If mnuFeixos.Checked Then
'Feix de llum paral.lel al terra
If Abs(F) > 1 Then
Line (xO, yT - yO)-(xL, yT - yO), QBColor(2)
'Feix de llum que passa pel focus
Line (xL, yT - yO)-(1300, yT - yO + (1300 - xL) / F * yO), QBColor(2)
End If
'Feix de llum que passa pel centre de la lent
If xL <> xO Then
Line (xO, yT - yO)-(1300, yT - yO + (1300 - xO) / (xL - xO) * yO), QBColor(2)
End If
End If
'Imatge
If (xL - xO) <> F And xL <> xO Then
ForeColor = QBColor(4)
xI = (xO - xL * (xL - xO) / F) / (1 - (xL - xO) / F)
yI = yT - yO + (xI - xO) / (xL - xO) * yO
Line (xI, yT)-(xI, yI)
If (xO > xI) Then r = r * (-1)
Line (xI - 10 * r, yI - 10 * r)-(xI, yI)
Line (xI + 10 * r, yI - 10 * r)-(xI, yI)
If xI < 1300 And xI > 0 Then
CurrentX = xI
CurrentY = 20
If xI < xL Then
Print "Imatge virtual"
If mnuFeixos.Checked Then
ForeColor = QBColor(2)
DrawStyle = 2
Line (xI, yI)-(xO, yT - yO)
Line (xI, yI)-(xL, yT - yO)
DrawStyle = 0
End If
Else
Print "Imatge"
End If
End If
End If
If HiHaHint Then
ForeColor = QBColor(4)
CurrentX = HintX
CurrentY = HintY
Print "Prem botó esquerra i arrossega"
End If
End Sub