PROGRAMACIÓ D'APLICACIONS EDUCATIVES AMB VISUAL BASICMÒDUL 7

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