home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Polar_Plot2084539242007.psc / PolarPlotter / Frmmain.frm next >
Text File  |  2006-11-10  |  15KB  |  479 lines
  1. VERSION 5.00
  2. Object = "{0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}#1.0#0"; "msscript.ocx"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Begin VB.Form Form1 
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "Pattern"
  7.    ClientHeight    =   9345
  8.    ClientLeft      =   45
  9.    ClientTop       =   735
  10.    ClientWidth     =   9900
  11.    Icon            =   "Frmmain.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    ScaleHeight     =   9345
  15.    ScaleWidth      =   9900
  16.    StartUpPosition =   2  'CenterScreen
  17.    Begin VB.Frame Frame2 
  18.       Caption         =   " Drawing Option"
  19.       Height          =   1170
  20.       Left            =   3990
  21.       TabIndex        =   7
  22.       Top             =   8085
  23.       Width           =   3795
  24.       Begin VB.CheckBox Check3 
  25.          Caption         =   "Clear pad for new drawing"
  26.          Height          =   225
  27.          Left            =   210
  28.          TabIndex        =   17
  29.          Top             =   840
  30.          Value           =   1  'Checked
  31.          Width           =   3480
  32.       End
  33.       Begin VB.CheckBox Check2 
  34.          Caption         =   "Show Axis"
  35.          Height          =   225
  36.          Left            =   1785
  37.          TabIndex        =   16
  38.          Top             =   525
  39.          Value           =   1  'Checked
  40.          Width           =   1590
  41.       End
  42.       Begin VB.CheckBox Check1 
  43.          Caption         =   "Show Grid"
  44.          Height          =   225
  45.          Left            =   210
  46.          TabIndex        =   15
  47.          Top             =   525
  48.          Value           =   1  'Checked
  49.          Width           =   2010
  50.       End
  51.    End
  52.    Begin VB.Frame Frame1 
  53.       Caption         =   " Options "
  54.       Height          =   1170
  55.       Left            =   105
  56.       TabIndex        =   6
  57.       Top             =   8085
  58.       Width           =   3795
  59.       Begin VB.TextBox txtx 
  60.          Height          =   285
  61.          Left            =   525
  62.          TabIndex        =   12
  63.          Text            =   "-4"
  64.          Top             =   735
  65.          Width           =   540
  66.       End
  67.       Begin VB.TextBox txtx2 
  68.          Enabled         =   0   'False
  69.          Height          =   285
  70.          Left            =   1470
  71.          TabIndex        =   11
  72.          Text            =   "4"
  73.          Top             =   735
  74.          Width           =   540
  75.       End
  76.       Begin VB.TextBox txtt 
  77.          Height          =   285
  78.          Left            =   945
  79.          TabIndex        =   9
  80.          Text            =   "2"
  81.          Top             =   315
  82.          Width           =   540
  83.       End
  84.       Begin VB.Label Label4 
  85.          AutoSize        =   -1  'True
  86.          Caption         =   "x = "
  87.          BeginProperty Font 
  88.             Name            =   "MS Sans Serif"
  89.             Size            =   8.25
  90.             Charset         =   0
  91.             Weight          =   700
  92.             Underline       =   0   'False
  93.             Italic          =   0   'False
  94.             Strikethrough   =   0   'False
  95.          EndProperty
  96.          Height          =   195
  97.          Left            =   210
  98.          TabIndex        =   14
  99.          Top             =   735
  100.          Width           =   315
  101.       End
  102.       Begin VB.Label Label5 
  103.          AutoSize        =   -1  'True
  104.          Caption         =   "to"
  105.          BeginProperty Font 
  106.             Name            =   "MS Sans Serif"
  107.             Size            =   8.25
  108.             Charset         =   0
  109.             Weight          =   700
  110.             Underline       =   0   'False
  111.             Italic          =   0   'False
  112.             Strikethrough   =   0   'False
  113.          EndProperty
  114.          Height          =   195
  115.          Left            =   1155
  116.          TabIndex        =   13
  117.          Top             =   735
  118.          Width           =   165
  119.       End
  120.       Begin VB.Label Label3 
  121.          Caption         =   "PI"
  122.          BeginProperty Font 
  123.             Name            =   "MS Sans Serif"
  124.             Size            =   8.25
  125.             Charset         =   0
  126.             Weight          =   700
  127.             Underline       =   0   'False
  128.             Italic          =   0   'False
  129.             Strikethrough   =   0   'False
  130.          EndProperty
  131.          Height          =   225
  132.          Left            =   1575
  133.          TabIndex        =   10
  134.          Top             =   315
  135.          Width           =   645
  136.       End
  137.       Begin VB.Label Label2 
  138.          Caption         =   "t = 0 to "
  139.          BeginProperty Font 
  140.             Name            =   "MS Sans Serif"
  141.             Size            =   8.25
  142.             Charset         =   0
  143.             Weight          =   700
  144.             Underline       =   0   'False
  145.             Italic          =   0   'False
  146.             Strikethrough   =   0   'False
  147.          EndProperty
  148.          Height          =   330
  149.          Left            =   210
  150.          TabIndex        =   8
  151.          Top             =   315
  152.          Width           =   1065
  153.       End
  154.    End
  155.    Begin VB.TextBox txtr 
  156.       Height          =   330
  157.       Left            =   630
  158.       TabIndex        =   5
  159.       Text            =   "2*Sin(3*t)"
  160.       Top             =   7665
  161.       Width           =   7155
  162.    End
  163.    Begin VB.CommandButton Command3 
  164.       Caption         =   "Save As ..."
  165.       Height          =   330
  166.       Left            =   7875
  167.       TabIndex        =   3
  168.       Top             =   8925
  169.       Width           =   1905
  170.    End
  171.    Begin VB.CommandButton Command2 
  172.       Caption         =   "Clear"
  173.       Height          =   330
  174.       Left            =   7875
  175.       TabIndex        =   2
  176.       Top             =   8505
  177.       Width           =   1905
  178.    End
  179.    Begin VB.CommandButton Command1 
  180.       Caption         =   "Start Graph"
  181.       Height          =   330
  182.       Left            =   7875
  183.       TabIndex        =   1
  184.       Top             =   7665
  185.       Width           =   1905
  186.    End
  187.    Begin VB.PictureBox Pad 
  188.       Appearance      =   0  'Flat
  189.       AutoRedraw      =   -1  'True
  190.       BackColor       =   &H80000005&
  191.       ForeColor       =   &H80000008&
  192.       Height          =   7260
  193.       Left            =   105
  194.       ScaleHeight     =   7230
  195.       ScaleWidth      =   9645
  196.       TabIndex        =   0
  197.       Top             =   105
  198.       Width           =   9675
  199.       Begin MSComDlg.CommonDialog cd1 
  200.          Left            =   2940
  201.          Top             =   1785
  202.          _ExtentX        =   847
  203.          _ExtentY        =   847
  204.          _Version        =   393216
  205.          CancelError     =   -1  'True
  206.       End
  207.       Begin VB.Line Line1 
  208.          Visible         =   0   'False
  209.          X1              =   1890
  210.          X2              =   4620
  211.          Y1              =   3360
  212.          Y2              =   4515
  213.       End
  214.    End
  215.    Begin MSScriptControlCtl.ScriptControl SC1 
  216.       Left            =   6090
  217.       Top             =   4200
  218.       _ExtentX        =   1005
  219.       _ExtentY        =   1005
  220.    End
  221.    Begin VB.Shape Shape1 
  222.       BorderColor     =   &H00FF0000&
  223.       FillColor       =   &H00FF0000&
  224.       FillStyle       =   0  'Solid
  225.       Height          =   120
  226.       Left            =   105
  227.       Top             =   7455
  228.       Visible         =   0   'False
  229.       Width           =   9675
  230.    End
  231.    Begin VB.Label Label1 
  232.       AutoSize        =   -1  'True
  233.       Caption         =   "R(t) = "
  234.       BeginProperty Font 
  235.          Name            =   "MS Sans Serif"
  236.          Size            =   8.25
  237.          Charset         =   0
  238.          Weight          =   700
  239.          Underline       =   0   'False
  240.          Italic          =   0   'False
  241.          Strikethrough   =   0   'False
  242.       EndProperty
  243.       Height          =   195
  244.       Left            =   105
  245.       TabIndex        =   4
  246.       Top             =   7770
  247.       Width           =   540
  248.    End
  249.    Begin VB.Menu mnufile 
  250.       Caption         =   "&File"
  251.       Begin VB.Menu mnufileexit 
  252.          Caption         =   "Exit"
  253.          Shortcut        =   ^X
  254.       End
  255.    End
  256.    Begin VB.Menu mnuhelp 
  257.       Caption         =   "&Help"
  258.       Begin VB.Menu mnuhelpabout 
  259.          Caption         =   "About"
  260.          Shortcut        =   ^{F1}
  261.       End
  262.    End
  263. End
  264. Attribute VB_Name = "Form1"
  265. Attribute VB_GlobalNameSpace = False
  266. Attribute VB_Creatable = False
  267. Attribute VB_PredeclaredId = True
  268. Attribute VB_Exposed = False
  269. Private Declare Function InitCommonControls Lib "comctl32.dll" () As Long
  270.  
  271. '------------------- DIMS --------------------
  272. Dim Zarib As Double
  273.  
  274. Private Sub Check1_Click()
  275.     Call Command2_Click
  276. End Sub
  277.  
  278. Private Sub Check2_Click()
  279.     Pad.Cls
  280.     Call Command2_Click
  281. End Sub
  282.  
  283. Private Sub Command1_Click()
  284.     pi = 4 * Atn(1)
  285.     If Check3.Value = 1 Then
  286.         Pad.Cls
  287.         Call Command2_Click
  288.     End If
  289.     If Trim(txtr.Text) = "" Then
  290.         MsgBox "You first must enter a function ! ", vbCritical, "Error"
  291.         Exit Sub
  292.     End If
  293.     On Error GoTo errorhere
  294.     txtr.Enabled = False
  295.     Frame1.Enabled = False
  296.     Frame2.Enabled = False
  297.     Command1.Enabled = False
  298.     Command2.Enabled = False
  299.     Command3.Enabled = False
  300.     Dim Zarib2 As Double
  301.     Shape1.Visible = True
  302.     Zarib2 = 9675 / Abs(Val(txtt.Text) * pi)
  303.        
  304.     Zarib = Pad.Width / Abs((Val(Trim(txtx.Text)) * 2))
  305.     Shape1.Width = 0.01
  306.     Dim xx, yy As Double
  307.     Dim r As Double
  308.     Dim Lastx, Lasty, Lastr As Double
  309.     Dim t As Double
  310.     
  311.     t = 0.01
  312.     SC1.ExecuteStatement ("t=" & t)
  313.     Lastr = SC1.Eval(txtr.Text)
  314.     Lastx = (Pad.Width / 2) + (Zarib * (Lastr * Cos(t)))
  315.     Lasty = (Pad.Height / 2) - (Zarib * (Lastr * Sin(t)))
  316.     For t = 0.01 To Val(txtt.Text) * pi Step 0.01
  317.         SC1.ExecuteStatement ("t=" & t)
  318.         r = SC1.Eval(txtr.Text)
  319.         xx = (Pad.Width / 2) + (Zarib * (r * Cos(t)))
  320.         yy = (Pad.Height / 2) - (Zarib * (r * Sin(t)))
  321.         Pad.Line (Lastx, Lasty)-(xx, yy), vbBlue
  322.         Lastx = xx
  323.         Lasty = yy
  324.         Shape1.Width = t * Zarib2
  325.         DoEvents
  326.         
  327.     Next t
  328.     txtr.Enabled = True
  329.     Frame1.Enabled = True
  330.     Frame2.Enabled = True
  331.     Command1.Enabled = True
  332.     Command2.Enabled = True
  333.     Command3.Enabled = True
  334.     Shape1.Visible = False
  335.     Exit Sub
  336. errorhere:
  337.     MsgBox "An error has been occurred !" & vbCrLf & "Error number : " & Err.Number & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error"
  338.     txtr.Enabled = True
  339.     Frame1.Enabled = True
  340.     Frame2.Enabled = True
  341.     Command1.Enabled = True
  342.     Command2.Enabled = True
  343.     Command3.Enabled = True
  344.     Shape1.Visible = False
  345. End Sub
  346.  
  347. Private Sub Command2_Click()
  348.     InitialPad
  349. End Sub
  350.  
  351. Private Sub Command3_Click()
  352.     On Error GoTo errorhere
  353.     cd1.Filter = "Bitmap Image(*.bmp)|*.Bmp"
  354.     cd1.ShowSave
  355.     SavePicture Pad.Image, cd1.FileName
  356. errorhere:
  357. End Sub
  358.  
  359. Private Sub Form_Activate()
  360.     InitialPad
  361. End Sub
  362.  
  363. Private Sub Form_Initialize()
  364.     InitCommonControls
  365. End Sub
  366.  
  367. Private Sub Form_Load()
  368.     On Error GoTo errhand
  369.     Dim Apppath As String
  370.     Apppath = App.Path
  371.     If Left(Apppath, 1) <> 1 Then Apppath = Apppath & "\"
  372.     Open Apppath & "init.txt" For Input As #1
  373.         Dim str, strinit As String
  374.         While Not EOF(1)
  375.             Line Input #1, str
  376.             strinit = strinit & vbCrLf & str
  377.         Wend
  378.      Close #1
  379.     SC1.Language = "VBScript"
  380.     SC1.AddCode (strinit)
  381.     Exit Sub
  382. errhand:
  383.     MsgBox "An error has been occured!" & vbCrLf & "Error number : " & Err.Number & vbCrLf & Err.Description, vbCritical, "Error"
  384. End Sub
  385.  
  386. 'InitialPad
  387. Private Sub InitialPad()
  388.     Pad.Cls
  389.     Zarib = Pad.Width / Abs((Val(Trim(txtx.Text)) * 2))
  390.     If Check1.Value = 1 Then
  391.     Dim i As Double
  392.     For i = Pad.Width / 2 To Pad.Width Step Zarib
  393.         Pad.Line (i, 0)-(i, Pad.Width), RGB(230, 230, 230)
  394.     Next i
  395.     For i = Pad.Width / 2 To 0 Step -1 * Zarib
  396.         Pad.Line (i, 0)-(i, Pad.Width), RGB(230, 230, 230)
  397.     Next i
  398.     For i = Pad.Height / 2 To Pad.Height Step Zarib
  399.         Pad.Line (0, i)-(Pad.Width, i), RGB(230, 230, 230)
  400.     Next i
  401.     For i = Pad.Height / 2 To 0 Step -1 * Zarib
  402.         Pad.Line (0, i)-(Pad.Width, i), RGB(230, 230, 230)
  403.     Next
  404.     End If
  405.     If Check2.Value = 1 Then
  406.     Pad.Line (Pad.Width / 2, 0)-(Pad.Width / 2, Pad.Height), RGB(180, 180, 180)
  407.     Pad.Line (0, Pad.Height / 2)-(Pad.Width, Pad.Height / 2), RGB(180, 180, 180)
  408.     End If
  409. End Sub
  410.  
  411.  
  412. Private Sub Form_Unload(Cancel As Integer)
  413.     End
  414. End Sub
  415.  
  416. Private Sub mnufileexit_Click()
  417.     ans = MsgBox("Are you really want to exit?", vbQuestion + vbDefaultButton3 + vbYesNoCancel, "Exit")
  418.     If ans = vbYes Then End
  419. End Sub
  420.  
  421. Private Sub mnuhelpabout_Click()
  422.     MsgBox "PolarPlotter" & vbCrLf & vbCrLf & "Programmer : Mahdi Eghbalahmadi" & vbCrLf & vbCrLf & "Air Univercity - Tehran-Iran", vbInformation, "About"
  423. End Sub
  424.  
  425. Private Sub txtr_KeyDown(KeyCode As Integer, Shift As Integer)
  426.     If KeyCode = 13 Then Call Command1_Click
  427. End Sub
  428.  
  429. Private Sub txtt_KeyPress(KeyAscii As Integer)
  430.     validstr = "01234567890"
  431.     If KeyAscii > 26 Then
  432.         If InStr(validstr, Chr(KeyAscii)) = 0 Then
  433.             KeyAscii = 0
  434.             Beep
  435.         End If
  436.     End If
  437. End Sub
  438.  
  439. Private Sub txtt_LostFocus()
  440.     If IsNumeric((txtt.Text)) Then
  441.         Ignore = Ignore + 1
  442.     Else
  443.         MsgBox "You must enter a number for t ! ", vbCritical, "Error"
  444.         txtt.SetFocus
  445.         Exit Sub
  446.     End If
  447.   End Sub
  448.  
  449. Private Sub txtx_Change()
  450.     If Trim(txtx.Text) <> "-" Then
  451.         If Val(txtx.Text) >= 0 Then
  452.             MsgBox "First number must be negative !", vbCritical, "Error"
  453.             Exit Sub
  454.         End If
  455.     End If
  456.     txtx2.Text = -1 * Val(txtx.Text)
  457.     
  458. End Sub
  459.  
  460. Private Sub txtx_KeyPress(KeyAscii As Integer)
  461.     validstr = "01234567890.-+"
  462.     If KeyAscii > 26 Then
  463.         If InStr(validstr, Chr(KeyAscii)) = 0 Then
  464.             KeyAscii = 0
  465.             Beep
  466.         End If
  467.     End If
  468. End Sub
  469.  
  470. Private Sub txtx_LostFocus()
  471.     If IsNumeric((txtx.Text)) Then
  472.         Ignore = Ignore + 1
  473.         Call Command2_Click
  474.     Else
  475.         MsgBox "You must enter a number for x ! ", vbCritical, "Error"
  476.         txtx.SetFocus
  477.     End If
  478. End Sub
  479.