by R. C. Sharma (4 Submissions)
Category: Graphics
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Mon 21st May 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Produce a scatter plot which refreshes on resizing the form. Can be modified to accommodate any number of series. Options can be added.
VBcoders
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
No comments have been posted about Produce a scatter plot which refreshes on resizing the form. Can be modified to accommodate any num. Why not be the first to post a comment about Produce a scatter plot which refreshes on resizing the form. Can be modified to accommodate any num.