by Serdar YUKSEL (4 Submissions)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 2nd August 2009
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
APIS INDEXES 1.0 This utilty calculate hantel, cubital index and discoidal shifts from Apis sp. forewings image. This software can be use
API Declarations
MsgBox "Author: Serdar Yüksel, Mail : [email protected], [email protected]"
End Sub
VBcoders
Text43.Text = 0
Picture1.Picture = LoadPicture(CommonDialog1.FileName)
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
Text15.Text = ""
Text16.Text = ""
Text17.Text = ""
Text18.Text = ""
Text19.Text = ""
Picture2.Cls
End Sub
Private Sub Command10_Click()
On Error Resume Next
Picture2.Width = Picture1.Width * 0.8
Picture2.Height = Picture1.Height * 0.8
Dim file_name As String
' Resize the picture.
Picture2.AutoRedraw = True
Picture2.PaintPicture Picture1.Picture, _
Picture2.ScaleLeft, Picture2.ScaleTop, Picture2.ScaleWidth, Picture2.ScaleHeight, _
Picture1.ScaleLeft, Picture1.ScaleTop, Picture1.ScaleWidth, Picture1.ScaleHeight
Picture2.Picture = Picture2.Image
' Save the result.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
SavePicture Picture2.Picture, file_name & "specimens.bmp"
End Sub
Private Sub Command11_Click()
On Error Resume Next
Picture2.Width = Picture1.Width * 0.2
Picture2.Height = Picture1.Height * 0.2
Dim file_name As String
' Resize the picture.
Picture2.AutoRedraw = True
Picture2.PaintPicture Picture1.Picture, _
Picture2.ScaleLeft, Picture2.ScaleTop, Picture2.ScaleWidth, Picture2.ScaleHeight, _
Picture1.ScaleLeft, Picture1.ScaleTop, Picture1.ScaleWidth, Picture1.ScaleHeight
Picture2.Picture = Picture2.Image
' Save the result.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
SavePicture Picture2.Picture, file_name & "specimens.bmp"
End Sub
Private Sub Command12_Click()
On Error Resume Next
Picture2.Width = Picture1.Width * 0.1
Picture2.Height = Picture1.Height * 0.1
Dim file_name As String
' Resize the picture.
Picture2.AutoRedraw = True
Picture2.PaintPicture Picture1.Picture, _
Picture2.ScaleLeft, Picture2.ScaleTop, Picture2.ScaleWidth, Picture2.ScaleHeight, _
Picture1.ScaleLeft, Picture1.ScaleTop, Picture1.ScaleWidth, Picture1.ScaleHeight
Picture2.Picture = Picture2.Image
' Save the result.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
SavePicture Picture2.Picture, file_name & "specimens.bmp"
End Sub
Private Sub Command13_Click()
On Error Resume Next
Picture2.Width = Picture1.Width * 3
Picture2.Height = Picture1.Height * 3
Dim file_name As String
' Resize the picture.
Picture2.AutoRedraw = True
Picture2.PaintPicture Picture1.Picture, _
Picture2.ScaleLeft, Picture2.ScaleTop, Picture2.ScaleWidth, Picture2.ScaleHeight, _
Picture1.ScaleLeft, Picture1.ScaleTop, Picture1.ScaleWidth, Picture1.ScaleHeight
Picture2.Picture = Picture2.Image
' Save the result.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
SavePicture Picture2.Picture, file_name & "specimens.bmp"
End Sub
Private Sub Command3_Click()
On Error Resume Next
Dim ab, bc, disk
ab = Sqr(((Val(Text11) - Val(Text9)) ^ 2) + ((Val(Text12) - Val(Text10)) ^ 2))
bc = Sqr(((Val(Text13) - Val(Text11)) ^ 2) + ((Val(Text14) - Val(Text12)) ^ 2))
disk = Round(ab / bc, 3)
Text17.Text = disk
Dim hab, hbc, hant
hab = Sqr(((Val(Text7) - Val(Text5)) ^ 2) + ((Val(Text8) - Val(Text6)) ^ 2))
hbc = Sqr(((Val(Text13) - Val(Text9)) ^ 2) + ((Val(Text14) - Val(Text10)) ^ 2))
hant = Round(hbc / hab, 3)
Text18.Text = hant
Dim ma, mb, Shift, tanq, ta, tb, tc, td, te, tf, tg, th As Single
Dim PI As Integer
PI = 3.14159265358979
ta = Val(Text1)
tb = Val(Text2)
tc = Val(Text3)
td = Val(Text4)
te = Val(Text5)
tf = Val(Text6)
tg = Val(Text15)
th = Val(Text16)
ma = (td - tb) / (tc - ta)
mb = (th - tf) / (tg - te)
tanq = (mb - ma) / (ma * mb + 1)
Shift = Round(Atn(tanq) * 180 / PI, 2)
If Shift > 0 Then
Text19.Text = Shift - 90
End If
If Shift < 0 Then
Text19.Text = 90 + Shift
End If
If Shift = 0 Then
Text19.Text = 0
End If
List1.AddItem "Cubital index"
List1.AddItem Text17.Text
List1.AddItem "Hental index"
List1.AddItem Text18.Text
List1.AddItem "Discoidal Shift Angle"
List1.AddItem Text19.Text
List1.AddItem "Project file name"
List1.AddItem CommonDialog1.FileName
End Sub
Private Sub Command5_Click()
On Error Resume Next
Picture2.Width = Picture1.Width * 1.2
Picture2.Height = Picture1.Height * 1.2
Dim file_name As String
' Resize the picture.
Picture2.AutoRedraw = True
Picture2.PaintPicture Picture1.Picture, _
Picture2.ScaleLeft, Picture2.ScaleTop, Picture2.ScaleWidth, Picture2.ScaleHeight, _
Picture1.ScaleLeft, Picture1.ScaleTop, Picture1.ScaleWidth, Picture1.ScaleHeight
Picture2.Picture = Picture2.Image
' Save the result.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
SavePicture Picture2.Picture, file_name & "specimens.bmp"
End Sub
Private Sub Command6_Click()
On Error Resume Next
Picture2.Width = Picture1.Width * 1.8
Picture2.Height = Picture1.Height * 1.8
Dim file_name As String
' Resize the picture.
Picture2.AutoRedraw = True
Picture2.PaintPicture Picture1.Picture, _
Picture2.ScaleLeft, Picture2.ScaleTop, Picture2.ScaleWidth, Picture2.ScaleHeight, _
Picture1.ScaleLeft, Picture1.ScaleTop, Picture1.ScaleWidth, Picture1.ScaleHeight
Picture2.Picture = Picture2.Image
' Save the result.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
SavePicture Picture2.Picture, file_name & "specimens.bmp"
End Sub
Private Sub Command7_Click()
On Error Resume Next
Picture2.Width = Picture1.Width * 2.4
Picture2.Height = Picture1.Height * 2.4
Dim file_name As String
' Resize the picture.
Picture2.AutoRedraw = True
Picture2.PaintPicture Picture1.Picture, _
Picture2.ScaleLeft, Picture2.ScaleTop, Picture2.ScaleWidth, Picture2.ScaleHeight, _
Picture1.ScaleLeft, Picture1.ScaleTop, Picture1.ScaleWidth, Picture1.ScaleHeight
Picture2.Picture = Picture2.Image
' Save the result.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
SavePicture Picture2.Picture, file_name & "specimens.bmp"
End Sub
Private Sub Command8_Click()
On Error Resume Next
Picture2.Width = Picture1.Width * 1
Picture2.Height = Picture1.Height * 1
Dim file_name As String
' Resize the picture.
Picture2.AutoRedraw = True
Picture2.PaintPicture Picture1.Picture, _
Picture2.ScaleLeft, Picture2.ScaleTop, Picture2.ScaleWidth, Picture2.ScaleHeight, _
Picture1.ScaleLeft, Picture1.ScaleTop, Picture1.ScaleWidth, Picture1.ScaleHeight
Picture2.Picture = Picture2.Image
' Save the result.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
SavePicture Picture2.Picture, file_name & "specimens.bmp"
End Sub
Private Sub Command9_Click()
On Error Resume Next
Picture2.Width = Picture1.Width * 0.5
Picture2.Height = Picture1.Height * 0.5
Dim file_name As String
' Resize the picture.
Picture2.AutoRedraw = True
Picture2.PaintPicture Picture1.Picture, _
Picture2.ScaleLeft, Picture2.ScaleTop, Picture2.ScaleWidth, Picture2.ScaleHeight, _
Picture1.ScaleLeft, Picture1.ScaleTop, Picture1.ScaleWidth, Picture1.ScaleHeight
Picture2.Picture = Picture2.Image
' Save the result.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
SavePicture Picture2.Picture, file_name & "specimens.bmp"
End Sub
Private Sub ext_Click()
Unload Me
End Sub
Private Sub Check1_Click()
If Check1.Value = 1 Then
Image1.Visible = True
End If
If Check1.Value = 0 Then
Image1.Visible = False
End If
End Sub
Private Sub Form_Load()
List1.AddItem " Apis Indexes Result"
List1.AddItem ""
List1.AddItem "Landmarks (X;Y)"
End Sub
Private Sub Image2_Click()
Command3_Click
End Sub
Private Sub Image3_Click()
savelandmark_Click
End Sub
Private Sub Image4_Click()
oimage_Click
End Sub
Private Sub Image5_Click()
Command1_Click
End Sub
Private Sub oimage_Click()
CommonDialog1.Filter = "JPG files (*.JPG)|*.jpg|BMP files(*.bmp)|*.bmp|JPE files(*.jpe)|*.jpe|GIF files(*.gif)|*.gif|wmf files(*.wmf)|*.wmf|All files(*.*)|*.*|"
CommonDialog1.ShowOpen
On Error Resume Next
Picture1.Picture = LoadPicture(CommonDialog1.FileName)
land.Caption = CommonDialog1.FileName
Command8_Click
End Sub
Private Sub picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim hg
Text44.Text = X
Text45.Text = Y
hg = Picture2.Height / 15.39893
List1.AddItem Text44.Text + ";" + Text45.Text
Text43.Text = Text43.Text + 1
Picture2.Circle (X, Y), 2, vbBlue
If Text43.Text = 1 Then
Text1.Text = X
Text2 = Round(hg - Y)
End If
If Text43.Text = 2 Then
Text3.Text = X
Text4 = Round(hg - Y)
End If
If Text43.Text = 3 Then
Text5.Text = X
Text6.Text = Round(hg - Y)
End If
If Text43.Text = 4 Then
Text7.Text = X
Text8.Text = Round(hg - Y)
End If
If Text43.Text = 5 Then
Text9.Text = X
Text10.Text = Round(hg - Y)
End If
If Text43.Text = 6 Then
Text11.Text = X
Text12.Text = Round(hg - Y)
End If
If Text43.Text = 7 Then
Text13.Text = X
Text14.Text = Round(hg - Y)
End If
If Text43.Text = 8 Then
Text15.Text = X
Text16.Text = Round(hg - Y)
End If
End Sub
Private Sub Picture3_Click()
End Sub
Private Sub savelandmark_Click()
Dim a As String
For X = 0 To List1.ListCount - 1
a = a & List1.List(X) & vbTab & vbCrLf
Next X
Text44.Text = Text44.Text + a
CommonDialog2.Filter = "text files(*.TXT)|*.txt|"
CommonDialog2.ShowSave 'display Save dialog
If CommonDialog2.FileName <> "" Then
Open CommonDialog2.FileName For Output As #1
Print #1, Text44.Text 'save string to file
Close #1 'close file
End If
End Sub
No comments have been posted about APIS INDEXES 1.0 This utilty calculate hantel, cubital index and discoidal shifts from Apis sp. for. Why not be the first to post a comment about APIS INDEXES 1.0 This utilty calculate hantel, cubital index and discoidal shifts from Apis sp. for.
