Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

Crop an image and save to SQL server

1966ponyguy1966ponyguy Member Posts: 1
I am new to the group, Hi everyone. I have been programming now for about 1 1/2 years. I am working on a project that requires me to be able to open an image (jpg) resize as needed, then crop a selection and save that cropped image to a sql file. I have the resize working and the save working but I cannot get only the cropped selection to save. HELP PLEASE. Thanks in advance:

Option Explicit

Dim sngScale As Single
Dim dblHeight As Double
Dim bDragImage As Boolean
Dim bMouseButton As Integer
Dim NewImage_Width As Double
Dim NewImage_Height As Double
Dim DragX As Double
Dim DragY As Double
Dim iEmpNumber As Long

' Used to move box on image
Dim iXPosition As Integer
Dim iYPosition As Integer
Dim bCropped As Boolean

Dim rs As ADODB.Recordset ' recordset for saving stream to database
Dim mStream As ADODB.Stream

Public Function Display(Emp As Long)

With Me
.ZOrder 0
.Show
End With

LoadImage
iEmpNumber = Emp

End Function

Private Sub cmdCrop_Click()

With frmInfo.picEmp
.ScaleMode = vbPixels
.PaintPicture pictZoom.Image, 0, 0, shapeCrop.Width, shapeCrop.Height, _
shapeCrop.Left / 16, shapeCrop.TOp / 16, shapeCrop.Width, _
shapeCrop.Height, vbSrcCopy

End With

cmdSave

Unload Me

End Sub

Private Sub cmdSave()

Dim itest As Integer

Set rs = New ADODB.Recordset
rs.Open "Select * FROM Employees WHERE Employee_Number = " & iEmpNumber & " ", cnSQLADO, adOpenKeyset, adLockOptimistic
itest = rs.RecordCount
Set mStream = New ADODB.Stream
mStream.Type = adTypeBinary
mStream.Open
mStream.LoadFromFile ("C:IDPics" & iEmpNumber & ".jpg")
rs.Fields("IDPic").Value = mStream.Read
rs.Update
rs.Close

End Sub


Private Sub HScroll_Change()

If bMouseButton = 0 Then MovePicture

End Sub

Private Sub HScroll_Scroll()

MovePicture

End Sub

Private Sub pictzoom_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

Select Case Button
Case 1

Case 2
DragX = x + HScroll.Value
DragY = y + VScroll.Value
End Select

bMouseButton = Button

End Sub

Private Sub pictzoom_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim H As Integer
Dim V As Integer

Select Case bMouseButton
Case 1
With shapeCrop
shapeCrop.Move x, y

If .Left <= 0 Then
.Move 1
End If
If .TOp <= 0 Then
.Move .Left, 1
End If
If .Left + .Width >= pictZoom.ScaleWidth Then
.Move pictZoom.ScaleWidth - (.Width - 1)
End If
If .TOp + .Height >= pictZoom.ScaleHeight Then
.Move .Left, pictZoom.ScaleHeight - (.Height)
End If
End With

With frmInfo.picEmp
.PaintPicture pictZoom.Image, 0, 0, shapeCrop.Width, shapeCrop.Height, _
shapeCrop.Left / 16, shapeCrop.TOp / 16, shapeCrop.Width, _
shapeCrop.Height, vbSrcCopy

.PaintPicture pictZoom.Image, 0, 0, shapeCrop.Width, shapeCrop.Height, shapeCrop.Left, _
shapeCrop.TOp, shapeCrop.Width, shapeCrop.Height, vbSrcCopy
End With

Case 2
'If bDragImage = False Then Exit Sub
H = Int(DragX - x)
V = Int(DragY - y)
If H < 0 Then H = 0 Else If H > HScroll.Max Then H = HScroll.Max
If V < 0 Then V = 0 Else If V > VScroll.Max Then V = VScroll.Max
HScroll.Value = H
VScroll.Value = V
MovePicture

End Select

End Sub

Private Sub pictzoom_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

bDragImage = False
bMouseButton = 0

End Sub

Private Sub Slider1_Change()

PictureUpdate

End Sub

Private Sub Slider1_Click()
PictureUpdate
End Sub

Private Sub Slider1_Scroll()

PictureUpdate

End Sub

Private Sub MovePicture()

Dim iScale As Double

iScale = (Slider1.Value / 100)
pictZoom.PaintPicture pictOriginal, 0, 0, pictZoom.Width, pictZoom.Height, (HScroll.Value / iScale), VScroll.Value / iScale, pictZoom.Width / iScale, pictZoom.Height / iScale, vbSrcCopy

End Sub

Private Sub ScrollAdjust()

HScroll.Enabled = True
HScroll.LargeChange = pictZoom.Width / 10
HScroll.Value = 0

VScroll.Enabled = True
VScroll.LargeChange = pictZoom.Height / 10

End Sub

Private Sub VScroll_Change()

If bDragImage = False Then MovePicture
Debug.Print VScroll.Value

End Sub

Private Sub VScroll_Scroll()

MovePicture

End Sub

Private Sub PictureUpdate()

Dim WWW As Double
Dim HHH As Double

WWW = NewImage_Width * (Slider1.Value / 100)
If WWW > (VScroll.Left - pictZoom.Left) Then pictZoom.Width = (VScroll.Left - pictZoom.Left) Else pictZoom.Width = WWW

HHH = NewImage_Height * (Slider1.Value / 100)
If HHH > (HScroll.TOp - pictZoom.TOp) Then pictZoom.Height = (HScroll.TOp - pictZoom.TOp) Else pictZoom.Height = HHH

HScroll.Max = WWW - pictZoom.Width
VScroll.Max = HHH - pictZoom.Height

ScrollAdjust

pictZoom.PaintPicture pictOriginal, 0, 0, WWW, HHH, 0, 0, NewImage_Width, NewImage_Height, vbSrcCopy

With shapeCrop
If (.Left + .Width) >= pictZoom.Width And pictZoom.ScaleWidth - (.Width - 1) >= 0 Then
.Move pictZoom.ScaleWidth - (.Width - 1)
End If
If (.TOp + .Height) >= pictZoom.ScaleHeight And (pictZoom.ScaleY(.TOp, 1, 3) - 1) > 1 Then
.Move .Left, pictZoom.ScaleHeight - (.Height - 1)
End If
If .TOp < 1 Then
.Move .Left, 1
End If
If .Left < 1 Then
.Move 1
End If
End With

End Sub

Private Function LoadImage()

Dim iMin As Integer

With CDialog
.Filter = "JPEG (*.jpg)|*.jpg|Graphic Interchange Format (*.gif)|*.gif|Windows Bitmap (*.bmp)|*.bmp"
.ShowOpen
If Len(Trim(.Filename)) > 0 Then
pictOriginal.Picture = LoadPicture(.Filename)
Me.Caption = Me.Caption & " " & .Filename
Else
Unload Me
Exit Function
End If
End With

pictZoom.Visible = True
pictZoom.Picture = pictOriginal.Picture
NewImage_Width = pictZoom.Width
NewImage_Height = pictZoom.Height
Slider1.Value = 100
Slider1.Max = 500

If NewImage_Width * (Slider1.Max / 100) > 32000 Then Slider1.Max = (32000 / NewImage_Width) * 100
If NewImage_Height * (Slider1.Max / 100) > 32000 Then Slider1.Max = (32000 / NewImage_Height) * 100

iMin = (shapeCrop.Height / Round((pictOriginal.Height)) * 100) + 1

If iMin < (shapeCrop.Width / Round((pictOriginal.Width)) * 100) + 1 Then
iMin = (shapeCrop.Width / Round((pictOriginal.Width)) * 100) + 1
End If

If iMin > Slider1.Max Then
Slider1.Max = iMin * 2
Else
Slider1.Max = iMin * 20
End If

Slider1.Min = iMin

'pictZoom.Cls
PictureUpdate
ScrollAdjust
cmdCrop.Enabled = True

End Function

Sign In or Register to comment.