• Home
 · 
• Graphics
 · 
• Produce a scatter plot which refreshes on resizing the form. Can be modified to accommodate any num

Produce a scatter plot which refreshes on resizing the form. Can be modified to accommodate any num

Produce a scatter plot which refreshes on resizing the form. Can be modified to accommodate any number of series. Options can be added.

Rate Produce a scatter plot which refreshes on resizing the form. Can be modified to accommodate any num

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3180
   ClientLeft      =   60
   ClientTop       =   360
   ClientWidth     =   4680
   BeginProperty Font 
      Name            =   "Courier"
      Size            =   12
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   3180
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim offsetX As Integer
Dim offsetY As Integer

Dim x() As Single, y() As Single
Dim NPT As Integer
Private Type LOGFONT
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As Byte
  lfUnderline As Byte
  lfStrikeOut As Byte
  lfCharSet As Byte
  lfOutPrecision As Byte
  lfClipPrecision As Byte
  lfQuality As Byte
  lfPitchAndFamily As Byte
' lfFaceName(LF_FACESIZE) As Byte 'THIS WAS DEFINED IN API-CHANGES MY OWN
  lfFacename As String * 33
End Type

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub CheckVals()
 ' Command1.Enabled = ((Val(txtDegree.Text) < 360) And Val(txtSize.Text) > 7)
End Sub

Private Sub FontStuff()
  'On Error GoTo GetOut
  Dim F As LOGFONT, hPrevFont As Long, hFont As Long, FontName As String
  Dim FONTSIZE As Integer
  FONTSIZE = 11 'Val(txtSize.Text)

  F.lfEscapement = 900 '10 * Val(txtDegree.Text) 'rotation angle, in tenths
  FontName = "Courier" + Chr$(0) 'null terminated
  F.lfFacename = "Courier" 'FontName
  F.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
  hFont = CreateFontIndirect(F)
  hPrevFont = SelectObject(Me.hdc, hFont)
  CurrentX = offsetX / 8
  CurrentY = Height / 2 + TextWidth("Y-value") / 2
  Print "Y-value"
  
Rem  Clean up, restore original font
  hFont = SelectObject(Me.hdc, hPrevFont)
  DeleteObject hFont
    End Sub

Private Sub Form_Load()
NPT = 30
ReDim x(NPT) As Single, y(NPT) As Single
'Randomize (5)
For i = 1 To NPT
x(i) = i
y(i) = i * i
Next
For i = 1 To NPT
For j = i To NPT
If x(i) < x(j) Then
tmp = x(i)
x(i) = x(j)
x(j) = tmp
 tmp = y(i)
y(i) = y(j)
y(j) = tmp
End If
Next
Next
Cls
CurrentX = 100
CurrentY = 200

End Sub
Private Sub Form_Paint()
Cls
Dim ya(20), xa(20)
'npt = 20
offsetX = 0.1 * ScaleWidth
offsetY = 0.1 * ScaleHeight

9930   NXL = offsetX
9940   NXh = ScaleWidth - offsetX
9950   NyL = offsetY
9960   NyH = ScaleHeight - offsetY
CurrentX = offsetX
CurrentY = ScaleHeight - offsetY
Line -(ScaleWidth - offsetX, CurrentY)
Line (offsetX, offsetY)-(offsetX, ScaleHeight - offsetY)

10060 NXDIV = 10
10070 NYDIV = 10
'10080 MV = NVAR + 1
10460 For i = 1 To NXDIV
10470   xa(i) = XLOW + (i - 1) * (XHIGH - XLOW) / (NXDIV - 1)
10480 Next i
10490 For i = 1 To NYDIV
10500   ya(i) = YLOW + (i - 1) * (YHIGH - YLOW) / (NYDIV - 1)
10510 Next i
10650 For i = 1 To NYDIV
10660   IT = NyH - ((i - 1) * (NyH - NyL) / (NYDIV - 1))
10670   For j = 0 To 5
10680     PSet (NXL + j, IT)
10690     PSet (NXh - j, IT)
Line (NXL + j, IT)-(NXh - j, IT)
10700   Next j
10710 Next i
10720 For i = 1 To NXDIV
10730   IT = NXL + (i - 1) * (NXh - NXL) / (NXDIV - 1)
10740   For j = 0 To 5
10750     PSet (IT, NyH - j)
10760     PSet (IT, NyL + j)
        Line (IT, NyL + j)-(IT, NyH - j)
10770   Next j
10780 Next i
          
          XLOW = x(NPT): XHIGH = x(1)
          YLOW = y(1): YHIGH = y(NPT)
          For i = 1 To NPT
          For j = i To NPT
          If XLOW > x(j) Then XLOW = x(j)
          If XHIGH < x(j) Then XHIGH = x(j)
          If YLOW > y(j) Then YLOW = y(j)
          If YHIGH < y(j) Then YHIGH = y(j)
          Next
          Next
          'sort x(),y()
          For i = 1 To NPT
          For j = i To NPT
          If x(i) > x(j) Then
          swap x(i), x(j)
          swap y(i), y(j)
          End If
          Next
          Next
          
ix = NXL + (x(1) - XLOW) / (XHIGH - XLOW) * (NXh - NXL)
iy = NyH - ((y(1) - YLOW) / (YHIGH - YLOW) * (NyH - NyL))
10790 For i = 1 To NPT
10800   ixp = NXL + (x(i) - XLOW) / (XHIGH - XLOW) * (NXh - NXL)
10810   iyp = NyH - ((y(i) - YLOW) / (YHIGH - YLOW) * (NyH - NyL))

10820   'PSet (ixp, iyp), QBColor(12)
10830  Circle (ixp, iyp), 20, QBColor(9)
         Line (ix, iy)-(ixp, iyp), QBColor(12)
         swap ix, ixp: swap iy, iyp
        For K = 1 To 10000 Step 0.1
       Next

10840 Next i
xtitle = "Independent Variable"
CurrentX = (ScaleWidth - TextWidth(xtitle)) / 2
CurrentY = ScaleHeight - 0.8 * offsetY
Print xtitle
'print chart title
ChartTitLe = "Graph of x vs Y"
CurrentX = (Width - TextWidth(ChartTitLe)) / 2
CurrentY = offsetY / 5 'ScaleHeight / 10
Print ChartTitLe
FontStuff 'for rotated font
Exit Sub
CurrentX = offset
CurrentY = ScaleHeight - offset
Line -(ScaleWidth - offset, CurrentY)
Line (offset, offset)-(offset, ScaleHeight - offset)
For i = 1 To NPT
xpt = offset + (ScaleWidth - 2 * offset) * x(i) / ScaleWidth
ypt = ScaleHeight - offset - (Scalescale - 2 * offset) * x(i) / ScaleHeight
PSet (xpt, ypt)
Next
'Form_Click
End Sub
Sub swap(a, b)
tmp = a
a = b
b = tmp
End Sub

Private Sub Form_Resize()
Form_Paint
End Sub