Attribute VB_Name = "mod"
Option Explicit
Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFOHEADER, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long

Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
''--------------------------------------------------------------------------------

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long


Public PadBytes As Long
Public BytesPerScanLine As Long
Public m_hDIb As Long, m_hBmpOld As Long
Public m_hDC As Long, DIBPtr As Long
Public Type BrowseInfo
   hOwner           As Long
   pIDLRoot         As Long
   pszDisplayName   As String
   lpszTitle        As String
   ulFlags          As Long
   lpfn             As Long
   lParam           As Long
   iImage           As Long
End Type

Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const MAX_PATH = 260

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As Long

Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
'--end block--'
Public picWidth As Long, picHeight As Long
Public Function ayos(txt As Form)
Dim X
For Each X In txt
    If TypeOf X Is TextBox Then
        SendKeys "{end}"
        X.Text = StrConv(X.Text, vbProperCase)
    End If
Next X
End Function
Function msgdealer() As Boolean
If MsgBox("Are you sure you want to Exit Application?", vbQuestion + vbYesNo) = vbYes Then
End
End If
End Function
Public Function logout()
Dim Form
    For Each Form In Forms
        Unload Form
    Next Form
End Function
Function eww(Frm As Form)
Dim i
For Each i In Frm
    If TypeOf i Is TextBox Or TypeOf i Is ComboBox Then
        i.Text = ""
        frmcommittee.Label14.Caption = ""
            End If
Next i
End Function
Public Function loadcombo(obj As ComboBox, str As String, intex As Long)
Dim rs As New ADODB.Recordset
rs.Open str, con, 2, 3
While Not rs.EOF
    obj.AddItem rs.Fields(intex)
    rs.MoveNext
Wend
End Function
Function eraser(Frm As Form)
Dim mi
For Each mi In Frm
    If TypeOf mi Is TextBox Or TypeOf mi Is ComboBox Then
        mi.Text = ""
        End If
    Next mi
End Function
Public Sub SETBMI()
Dim SBI As BITMAPINFOHEADER
   With SBI
      .biSize = 40
      .biWidth = picWidth
      .biHeight = picHeight
      .biPlanes = 1
      .biBitCount = 32 '24
      .biCompression = 0
   
      BytesPerScanLine = (((.biWidth * .biBitCount) + 31) \ 32) * 4
      PadBytes = BytesPerScanLine - (((.biWidth * .biBitCount) + 7) \ 8)
      .biSizeImage = BytesPerScanLine * Abs(.biHeight)
      
      .biXPelsPerMeter = 0
      .biYPelsPerMeter = 0
      .biClrUsed = 0
      .biClrImportant = 0
   End With
   
   m_hDC = CreateCompatibleDC(0)
   m_hDIb = CreateDIBSection(m_hDC, SBI, 0, DIBPtr, 0, 0)
   m_hBmpOld = SelectObject(m_hDC, m_hDIb)
End Sub

Public Sub SAVEJPEG(FSpec As String, ByVal TheQuality As Long, APIC As PictureBox)
   ' Create DIB, get pointer & publics:-
    DoEvents
    
    APIC.Visible = False
    APIC.AutoRedraw = True
    APIC.AutoSize = True
    APIC.ScaleMode = vbPixels
    APIC.BorderStyle = 0 ' None
    
    picWidth = APIC.Width
    picHeight = APIC.Height
    
    DoEvents
   
   ' DIBPtr, m_hDC, m_hDIb, m_hBmpOld
   SETBMI
   ' Blit picture to DIB
   
   BitBlt m_hDC, 0, 0, picWidth, picHeight, APIC.hdc, 0, 0, vbSrcCopy
   
   DoEvents
   
   Dim pvGDI As GDIPlusJPGConvertor
   
   Set pvGDI = New GDIPlusJPGConvertor
   
   pvGDI.SaveDIB picWidth, picHeight, DIBPtr, FSpec$, TheQuality
 
   Set pvGDI = Nothing
    
   SelectObject m_hDC, m_hBmpOld
   DeleteObject m_hDIb
   DeleteDC m_hDC
   
   DoEvents
   'APIC.Visible = True

End Sub

