

Fitxer: m7p5a.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 2.00
Begin Form Form1
Caption = "Òptica geomètrica - Lent convergent - Lent divergent"
ClientHeight = 4740
ClientLeft = 825
ClientTop = 1830
ClientWidth = 8445
Height = 5430
Left = 765
LinkTopic = "Form1"
ScaleHeight = 316
ScaleMode = 3 'Pixel
ScaleWidth = 563
Top = 1200
Width = 8565
Begin Menu mnuOpcions
Caption = "&Opcions"
Begin Menu mnuTrama
Caption = "&Trama"
End
Begin Menu mnuFeixos
Caption = "&Feixos de llum"
Checked = -1 'True
End
Begin Menu mnuRes
Caption = "-"
End
Begin Menu mnuSortir
Caption = "&Sortir"
End
End
Begin Menu mnuTipus
Caption = "&Tipus de lent"
Begin Menu mnuConvergent
Caption = "&Convergent"
Checked = -1 'True
Enabled = 0 'False
End
Begin Menu mnuDivergent
Caption = "&Divergent"
End
End
Begin Menu mnuAjuda0
Caption = "&Ajuda"
Begin Menu mnuAjuda
Caption = "&Ajuda"
End
Begin Menu mnuRes2
Caption = "-"
End
Begin Menu mnuAboutBox
Caption = "&Parlant de..."
End
End
End
Codi del programa. Programació de respostes a events
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
'==============================================================
'==============================================================
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
mnuConvergent.Checked = True
mnuDivergent.Checked = False
mnuConvergent.Enabled = False
mnuDivergent.Enabled = True
End Sub
Sub Pintar ()
Dim r As Integer
'variables per la imatge de la lent divergent
Dim a1, b1, a2, b2 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)
If mnuConvergent.Checked = True Then
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)
Else
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)
End If
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
If mnuConvergent.Checked = True Then
Line (xL, yT - yO)-(1300, yT - yO + (1300 - xL) / F * yO), QBColor(2)
Else
Line (xL, yT - yO)-(1300, yT - yO - (1300 - xL) / F * yO), QBColor(2)
DrawStyle = 2
Line (xL, yT - yO)-(xL - F, yT), QBColor(2)
DrawStyle = 0
End If
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)
If mnuConvergent.Checked = True Then
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"
ForeColor = QBColor(2)
DrawStyle = 2
Line (xI, yI)-(xO, yT - yO)
Line (xI, yI)-(xL, yT - yO)
DrawStyle = 0
Else
Print "Imatge"
End If
End If
Else
If xL <> xO Then
a1 = -yO / (xL - xO)
b1 = yO - a1 * xO
a2 = yO / F
If a2 <> a1 Then
b2 = -a2 * (xL - F)
xI = (b1 - b2) / (a2 - a1)
yI = yT - (a1 * xI + b1)
Line (xI, yT)-(xI, yI)
If yI > yT Then r = 1 Else r = -1
Line (xI - 10 * r, yI - 10 * r)-(xI, yI)
Line (xI + 10 * r, yI - 10 * r)-(xI, yI)
End If
End If
End If
End If
If HiHaHint Then
ForeColor = QBColor(4)
CurrentX = HintX
CurrentY = HintY
Print "Prem butó esquerra i arrossega"
End If
End Sub
'==============================================================
'==============================================================
Sub Form_Load ()
iniciar
Form2.Show (1)
End Sub
Sub Form_Paint ()
Pintar
End Sub
'==============================================================
'==============================================================
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
HiHaHint = 0
End Sub
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
HiHaHint = 1
HintX = x + 10
HintY = y + 10
Pintar
ElseIf HiHaHint Then
HiHaHint = 0
Pintar
End If
End If
End Sub
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
'==============================================================
'==============================================================
Sub mnuFeixos_Click ()
mnuFeixos.Checked = Not mnuFeixos.Checked
Pintar
End Sub
Sub mnuTrama_Click ()
mnuTrama.Checked = Not mnuTrama.Checked
Pintar
End Sub
Sub mnuSortir_Click ()
End
End Sub
'==============================================================
'==============================================================
Sub mnuConvergent_Click ()
mnuConvergent.Checked = True
mnuDivergent.Checked = False
mnuConvergent.Enabled = False
mnuDivergent.Enabled = True
Pintar
End Sub
Sub mnuDivergent_Click ()
mnuConvergent.Checked = False
mnuDivergent.Checked = True
mnuConvergent.Enabled = True
mnuDivergent.Enabled = False
Pintar
End Sub
'==============================================================
'==============================================================
Sub mnuAboutBox_Click ()
Form2.Show (1)
End Sub
Sub mnuAjuda_Click ()
MsgBox "No Disponible"
End Sub
'==============================================================
'==============================================================
'==============================================================
'==============================================================
Fitxer: m7p5b.frm Quadre de diàleg de crèdits. Parlant de
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 2.00
Begin Form Form2
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "Parlant de..."
ClientHeight = 4575
ClientLeft = 1980
ClientTop = 1785
ClientWidth = 4560
ControlBox = 0 'False
Height = 4980
Left = 1920
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4575
ScaleWidth = 4560
Top = 1440
Width = 4680
Begin PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
DragMode = 1 'Automatic
Height = 1995
Left = 600
Picture = M7P5B.FRX:0000
ScaleHeight = 1965
ScaleWidth = 3390
TabIndex = 4
Top = 1680
Width = 3420
End
Begin CommandButton Command1
Caption = "D'&acord"
Height = 495
Left = 1560
TabIndex = 0
Top = 3840
Width = 1455
End
Begin Label Label3
Alignment = 2 'Center
BackColor = &H00C0C0C0&
Caption = "(C) Jordi Lagares Roset"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Times New Roman"
FontSize = 9
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 360
TabIndex = 3
Top = 1200
Width = 3975
End
Begin Label Label2
Alignment = 2 'Center
BackColor = &H00C0C0C0&
Caption = "Curs Visual Bàsic (Girona) 1997/98"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Times New Roman"
FontSize = 9
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 360
TabIndex = 2
Top = 840
Width = 3855
End
Begin Label Label1
Alignment = 2 'Center
BackColor = &H00C0C0C0&
Caption = "Òptica Geomètrica"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Times New Roman"
FontSize = 24
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H0000FFFF&
Height = 615
Left = 240
TabIndex = 1
Top = 120
Width = 4095
End
End
Codi del programa. Programació de respostes a events
Option Explicit
Sub Command1_Click ()
Unload Form2
End Sub