

Fitxer: m7p2.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 = 4515
ClientLeft = 345
ClientTop = 1635
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 = 301
ScaleMode = 3 'Pixel
ScaleWidth = 563
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
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)
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
ForeColor = QBColor(4)
CurrentX = 0
CurrentY = 0
Print "Prem botó esquerra i arrossega"
Else
ForeColor = QBColor(15)
CurrentX = 0
CurrentY = 0
Print "Prem botó esquerra i arrossega"
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 = 165
xL = 300
xO = 100
yO = 50
F = 100
CalMoureObjecte = 0
CalMoureLent = 0
CalMoureFocus = 0
CalCanviarTamanyObjecte = 0
CalMoureTerra = 0
End Sub
Private Sub Pintar()
Dim r As Integer
Cls
'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"
'Feix de llum paral.lel al terra
If Abs(F) > 1 Then
Line (xO, yT - yO)-(xL, yT - yO), QBColor(2)
Line (xL, yT - yO)-(1300, yT - yO + (1300 - xL) / F * yO), QBColor(2)
End If
'Feix de llum que passa pel focus
If xL <> xO Then
Line (xO, yT - yO)-(1300, yT - yO + (1300 - xO) / (xL - xO) * yO), QBColor(2)
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)
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"
Else
Print "Imatge"
End If
End If
End If
End Sub