' This is the first line of this program
' rector.vb Visual Basic mouse click
' event very tiny example program
'Copyright C 2011 By Eric Matteson. Permission
' is granted to copy this source code file
' rector.vb and to publish it on the Internet
' and to use it at least for non-profit use.
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Collections
' unsupported Imports System.Windows.Forms
' unsupported Imports System.Drawing
' -----------------------------------------------------
' Visual Basic probramming example written by Eric Matteson
' Classes seperator ----------
' re.wwidth=4
' re.wbase=10
' zz=re.ris(8501)
Public Class rebug
Public Shared wwidth As Integer
Public Shared wbase As Integer
' -----
Public Shared ixrstart As Integer
Public Shared ixrwidth As Integer
Public Shared ixrbase As Integer
Public Shared ixrmode As Integer
'-------Shared---------------------------
Public Shared moux As Integer
Public Shared mouy As Integer
Public Shared mouk As Integer
' --
Public Shared Function ris(wda As integer) As String
'vbb programing example by Eric Matteson
' wwi As Width to wwidth
' wba As base to wbase
' wda As data
Dim wdhold(100) As Integer
Dim wrctr As Integer
Dim wrdig As Integer
Dim wdt As Integer
Dim wdn As Integer
Dim wdf As Integer
Dim wpr As Integer
Dim tbb As Byte
Dim tbc As Char
Dim srs As String
wdn=0
wdt=wda
If wda < 0 Then wdt=0-(wda+1)
If wda < 0 Then wdn=1
wrctr=rebug.wwidth-1
While (wrctr >= 0)
wrdig=0-1
wdf=wdt/rebug.wbase
While (wrdig < 0)
wpr=wdf*rebug.wbase
wrdig=wdt-wpr
If wrdig < 0 Then wdf = wdf - 1
End While
wdt=wdf
If wdn > 0 Then wrdig=(rebug.wbase-1)-wrdig
If wrdig < 10 Then wdhold(wrctr)=wrdig+48
If wrdig > 9 Then wdhold(wrctr)=wrdig+87
wrctr=wrctr-1
End While
srs=""
wrctr=0
While (wrctr < rebug.wwidth)
wdf=wdhold(wrctr)
tbb=Convert.ToByte(wdf)
tbc=Convert.ToChar(tbb)
srs=srs+System.Convert.ToString(tbc)
wrctr=wrctr+1
End While
ris=srs
End Function
Public Shared Function imids(ims As String, _
ipo As Integer) As Integer
Dim imt As String
Dim imh As Char
Dim imb As Byte
Dim imi As Integer
imt=ims.Substring(ipo,1)
imh=Convert.ToChar(imt)
imb=Convert.ToByte(imh)
imi=Convert.ToInt32(imb)
imids=imi
End Function
Public Shared Function iidgit(iraw As Integer) As Integer
Dim ido As Integer
ido=117
If iraw > 47 And iraw < 58 Then ido=iraw-48
If iraw > 64 And iraw < 71 Then ido=iraw-55
If iraw > 96 And iraw < 103 Then ido=iraw-87
iidgit=ido
End Function
Public Shared Function ixread(ixs As String) As Integer
Dim ipxsub As Integer
Dim ipxctr As Integer
Dim ipxa As Integer
Dim ipxd As Integer
Dim ipxrz As Integer
ipxctr=0
ipxrz=0
ipxa=1
While(ipxa > 0)
ipxsub=ipxctr+rebug.ixrstart
ipxd=iidgit(imids(ixs,ipxsub))
If ipxd < rebug.ixrbase Then ipxa=0
If ipxa > 0 Then ipxctr=ipxctr+1
If ipxctr >= rebug.ixrwidth Then ipxa=0
End While
ipxa=0
If ipxctr < rebug.ixrwidth Then ipxa = 1
While(ipxa > 0)
ipxsub=ipxctr+rebug.ixrstart
ipxd=iidgit(imids(ixs,ipxsub))
If ipxd >= rebug.ixrbase Then ipxa=0
If ipxa > 0 Then
ipxrz=ipxrz*rebug.ixrbase
ipxrz=ipxrz+ipxd
ipxctr=ipxctr+1
If ipxctr >= rebug.ixrwidth Then ipxa=0
End If
End While
ipxsub=ipxctr+rebug.ixrstart
If rebug.ixrmode > 0 Then ipxrz=ipxsub+1
ixread=ipxrz
End Function
End Class
Partial Public Class rector
Inherits System.Windows.Forms.Form
Protected Overrides Sub OnMouseDown( _
ByVal mvu As System.Windows.Forms.MouseEventArgs)
rebug.moux=mvu.X
rebug.mouy=mvu.Y
rebug.mouk=0-1
Me.Invalidate()
' ?? OnMouseDown=True
End Sub
Protected Overrides Sub OnKeyDown( _
ByVal kjp As System.Windows.Forms.KeyEventArgs)
Dim tk As Integer
tk=Convert.ToInt32(kjp.KeyData)
rebug.mouk=tk
Me.Invalidate()
End Sub
Protected Overrides Sub OnPaint( _
ByVal vp As System.Windows.Forms.PaintEventArgs)
Dim oa As String
Dim od As Integer
Dim oe As Integer
' remove Dim rrc As System.Drawing.Graphics
' ? MyBase.OnPaint(vp)
od=rebug.moux+10
oe=rebug.mouy+5
oa=".. "
If rebug.mouk < 0 Then
oa=oa+rebug.ris(rebug.moux)
oa=oa+" "
oa=oa+rebug.ris(rebug.mouy)
End If
If rebug.mouk >= 0 Then
oa=oa+" "+rebug.ris(rebug.mouk)
od=20
oe=18
oa=oa+" Everybody (At Microsoft) \n Hates Chris And Eric."
End If
' Ingnored System.Diagnostics.Debug.WriteLine(oa)
' too few arguments vp.DrawString(oa)
Dim sbepb As New System.Drawing.SolidBrush( _
System.Drawing.Color.Blue)
Dim sbepr As New System.Drawing.SolidBrush( _
System.Drawing.Color.Red)
Dim sbepd As New System.Drawing.SolidBrush( _
System.Drawing.Color.Black)
' ----------
vp.Graphics.FillRectangle(sbepb,8,8,35,12)
vp.Graphics.FillRectangle(sbepr,od,8,25,8)
' ?? Dim fonzfam As New System.Drawing.FontFamily("Arial")
' *** Error *** Fonts including Arial are not avalable on all
' available Dot.NET s. Removing feature.
' ?? Dim fonzt As New System.Drawing.Font(fonzfam, _
' ?? 16,System.Drawing.FontStyle.Bold, _
' ?? System.Drawing.GraphicsUnit.Pixel)
' ?? vp.Graphics.DrawString(oa,fonzt,sbepd,od,oe)
' ?? OnPaint=True
End Sub
Overloads Function OnFormLoad( _
ByVal aaao As Object) As Integer
Me.Name="name."
Me.Text=".Line of Text.."
Dim sbini As New System.Drawing.SolidBrush( _
System.Drawing.Color.Red)
aaao.FillRectangle(sbini,4,4,45,15)
OnFormLoad=True
End Function
Shared Sub Main()
' move Dim rr As New rebug
Dim rs As String
Dim ri As Integer
rebug.moux=0-1
rebug.mouy=0-1
rebug.wbase=10
rebug.wwidth=4
rebug.ixrstart=0
rebug.ixrwidth=4
rebug.ixrbase=10
rebug.ixrmode=0
ri=rebug.ixread("4501@")
ri=ri+rebug.ixread("4000@")
rs=rebug.ris(ri)
System.Windows.Forms.Application.Run(New rector)
End Sub
End Class
' End of rector.vb
' This is the LAST LINE of this program
|
|