home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD100179202000.psc / MConstants.bas < prev    next >
Encoding:
BASIC Source File  |  2000-09-20  |  11.0 KB  |  292 lines
  1. Attribute VB_Name = "MConstants"
  2. Option Explicit
  3.  
  4. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  5. Private Const SW_SHOW = 5
  6. Declare Sub ReleaseCapture Lib "user32" ()
  7. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
  8. Public Declare Function tapiRequestMakeCall& Lib "TAPI32.DLL" (ByVal DestAddress$, ByVal AppName$, ByVal CalledParty$, ByVal Comment$)
  9. Private Const TAPIERR_NOREQUESTRECIPIENT = -2&
  10. Private Const TAPIERR_REQUESTQUEUEFULL = -3&
  11. Private Const TAPIERR_INVALDESTADDRESS = -4&
  12.  
  13. Public Sub ExportFilesToHTML(Optional Path As String, Optional Title As String)
  14.     If Path = "" Then Path = App.Path & "\"
  15.     If Right$(Path, 1) <> "\" Then
  16.         Path = Path & "\"
  17.     End If
  18.     If Title = "" Then Title = "My Contacts"
  19.     Set frmMain.ContactTable = frmMain.DB.OpenRecordset("SELECT * FROM CONTACTS ORDER BY LNAME ASC")
  20.     With frmMain.ContactTable
  21.         .MoveFirst
  22.         Open Path & "Index.htm" For Output As #1
  23.             Print #1, "<HTML>"
  24.             Print #1, "<HEAD>"
  25.             Print #1, "<TITLE>" & Title & "</TITLE>"
  26.             Print #1, "</HEAD>"
  27.             Print #1, "<BODY BGColor=""#FFFFFF"" Text=""#000000"">"
  28.             Print #1, "<H2>" & Title & "</H2>"
  29.             Print #1, "<UL>"
  30.             Do While Not .EOF
  31.                 Print #1, "<LI><A HREF=""" & !LName & !Fname & ".htm"">" & !LName & ", " & !Fname & "</A></LI>"
  32.                 .MoveNext
  33.             Loop
  34.             Print #1, "</UL>"
  35.             Print #1, "</BODY>"
  36.             Print #1, "</HTML>"
  37.         Close #1
  38.         .MoveFirst
  39.         frmHTML.PBar1.Min = 0
  40.         frmHTML.PBar1.Max = .RecordCount
  41.         frmHTML.PBar1.Value = 0
  42.         Do While Not .EOF
  43.             Open Path & !LName & !Fname & ".htm" For Output As #1
  44.                 On Error Resume Next
  45.                 Print #1, "<HTML>"
  46.                 Print #1, "<HEAD>"
  47.                 Print #1, "<TITLE>" & !LName & " " & !Fname & "</TITLE>"
  48.                 Print #1, "</HEAD>"
  49.                 Print #1, "<BODY BGColor=""#FFFFFF"" Text=""#000000"">"
  50.                 Print #1, "<H2>" & !LName & " " & !Fname & "</H2>"
  51.                 If !Address1 <> "" Then Print #1, !Address1 & "<BR>"
  52.                 If !Address2 <> "" Then Print #1, !Address2 & "<BR>"
  53.                 If Not (!State = "" And !City = "" And !Zip = "") Then
  54.                     Print #1, !City & ", " & !State & " " & !Zip & "<BR><BR>"
  55.                 End If
  56.                 If !Phone1 <> "" Then Print #1, "<B>Phone</B>: " & !Phone1 & "<BR>"
  57.                 If !Phone2 <> "" Then Print #1, "<B>Phone</B>: " & !Phone2 & "<BR>"
  58.                 If !Cell <> "" Then Print #1, "<B>Cell</B>: " & !Cell & "<BR>"
  59.                 If !fax <> "" Then Print #1, "<B>Fax</B>: " & !fax & "<BR>"
  60.                 Print #1, "<BR><B>Category</B>: " & frmContact.cmbCat.List(!Cat) & "<BR>"
  61.                 If !EMail <> "" Then Print #1, "<B>E-Mail</B>: " & "<A HREF=""mailto:" & !EMail & """>" & !EMail & "</A><BR>"
  62.                 If !URL <> "" Then Print #1, "<B>URL</B>: " & "<A HREF=""" & !URL & """>" & !URL & "</A><BR>"
  63.                 Print #1, "<B>Birthday</B>: " & Format(!BDayM, "00") & "/" & Format(!BDayD, "00") & "/" & Format(!BDayY, "00") & "<BR>"
  64.                 If !Notes <> "" Then
  65.                     Print #1, "<BR><B>Notes</B>:<BR>"
  66.                     Print #1, !Notes & "<BR>"
  67.                 End If
  68.                 Print #1, "<BR><A HREF=""Index.htm"">Back to Contacts</A>"
  69.                 Print #1, "</BODY>"
  70.                 Print #1, "</HTML>"
  71.                 frmHTML.PBar1.Value = frmHTML.PBar1.Value + 1
  72.             Close #1
  73.             .MoveNext
  74.         Loop
  75.     End With
  76.     Dim Answer As Integer
  77.       Answer = MsgBox("Export Done! Do you want to view now?", vbYesNo + vbQuestion, "Done.")
  78.       If Answer = vbYes Then
  79.           ShellExecute frmContact.hwnd, "open", Path & "Index.htm", vbNullString, vbNullString, SW_SHOW
  80.       End If
  81. End Sub
  82.  
  83. Public Sub Dial(Frm As Form, Num As String)
  84.   Dim buff As String
  85.   Dim nResult As Long
  86.     nResult = tapiRequestMakeCall&(Trim$(Num), CStr(Frm.Caption), Frm.txtLName & ", " & Frm.txtFName, "")
  87.     If nResult <> 0 Then
  88.         buff = "Error dialing number : "
  89.         Select Case nResult
  90.                Case TAPIERR_NOREQUESTRECIPIENT
  91.                     buff = buff & "No Windows Telephony dialing application is running and none could be started."
  92.                Case TAPIERR_REQUESTQUEUEFULL
  93.                     buff = buff & "The queue of pending Windows Telephony dialing requests is full."
  94.                Case TAPIERR_INVALDESTADDRESS
  95.                     buff = buff & "The phone number is Not valid."
  96.                Case Else
  97.                     buff = buff & "Unknown error."
  98.                End Select
  99.     End If
  100. End Sub
  101.  
  102.  
  103. Public Sub FormDrag(TheForm As Form)
  104.     ReleaseCapture
  105.     Call SendMessage(TheForm.hwnd, &HA1, 2, 0&)
  106. End Sub
  107.  
  108. Public Function FormatNumber(Text As String) As String
  109.   Dim X As Integer
  110.   Dim TempNum As String
  111.   Dim CurLet As String
  112.     For X = 1 To Len(Text)
  113.         CurLet = Mid(Text, X, 1)
  114.         If IsNumeric(CurLet) Then TempNum = TempNum & CurLet
  115.     Next X
  116.     FormatNumber = TempNum
  117. End Function
  118.  
  119. Public Sub OpenContact(Name As String)
  120.   Dim X As Integer
  121.   Dim Another As New frmContact
  122.   Dim YearDiff As Integer
  123.   
  124.     'Check if record is already open by searching the captions of all loaded forms.
  125.     For X = 0 To Forms.Count - 1
  126.         'If so, Exit sub
  127.         If Forms(X).Caption = "Contacts - " & Name Then Forms(X).SetFocus: Exit Sub
  128.     Next X
  129.     
  130.     
  131.     With frmMain.ContactTable
  132.         If .RecordCount = 0 Then Exit Sub
  133.         .MoveFirst
  134.         Do While Not .EOF
  135.             If !LName & ", " & !Fname = Name Then
  136.                 Exit Do
  137.             Else
  138.                 .MoveNext
  139.             End If
  140.         Loop
  141.         
  142.         Dim BDate As Date
  143.         On Error Resume Next
  144.         Another.Visible = False
  145.         Another.Width = 6570
  146.         Another.Height = 6780
  147.         Another.Caption = "Contacts - " & Name
  148.         Another.txtFName = !Fname
  149.         Another.txtLName = !LName
  150.         Another.txtPhone1 = !Phone1
  151.         Another.txtPhone2 = !Phone2
  152.         Another.txtCell = !Cell
  153.         Another.txtFax = !fax
  154.         Another.txtAdd1 = !Address1
  155.         Another.txtAdd2 = !Address2
  156.         Another.txtCity = !City
  157.         Another.txtState = UCase(!State)
  158.         Another.txtZip = !Zip
  159.         Another.txtNotes = !Notes
  160.         Another.txtNotes.TabIndex = 0
  161.         Another.txtEmail = !EMail
  162.         Another.txtPic = !pic
  163.         
  164.         Dim Filename As String
  165.         If Left(Another.txtPic, 1) = "~" Then
  166.             Filename = App.Path & "\" & Right(Another.txtPic, Len(Another.txtPic) - 1)
  167.         Else
  168.             Filename = Another.txtPic
  169.         End If
  170.  
  171.         If Filename = "" Or Dir(Filename) = "" Then
  172.             Another.lblPic.Visible = False
  173.         Else
  174.             Another.lblPic.Visible = True
  175.         End If
  176.         
  177.         Another.txtURL = !URL
  178.         Another.cmbBDayM.ListIndex = Val(!BDayM) - 1
  179.         Another.cmbBDayD.ListIndex = Val(!BDayD) - 1
  180.         YearDiff = Year(Date) - !BDayY
  181.         Another.cmbBDayY.ListIndex = Another.cmbBDayY.ListCount - (YearDiff + 1)
  182.         Another.Tag = Name
  183.         Another.cmbCat.ListIndex = !Cat
  184.         BDate = !BDayM & "/" & !BDayD & "/" & Year(Date)
  185.         Another.lblDays = "Days until BDay: " & GetDays(BDate)
  186.         Load Another
  187.         Another.Visible = True
  188.         Another.Changes = False
  189.         Another.SSTab1.Tab = 0
  190.         Another.Show
  191.     End With
  192.     Exit Sub
  193. End Sub
  194.  
  195. Public Function GetDays(BDate As Date) As Integer
  196.     If DateDiff("d", Date, BDate) < 1 Then
  197.         BDate = Month(BDate) & "/" & Day(BDate) & "/" & Year(BDate) + 1
  198.     End If
  199.     GetDays = DateDiff("d", Date, BDate)
  200. End Function
  201.  
  202.  
  203. Public Sub PrintRecord(Name As String)
  204.   Dim Found As Boolean
  205.     Found = False
  206.     With frmMain.ContactTable
  207.         If .RecordCount = 0 Then Exit Sub
  208.         .MoveFirst
  209.         Do While Not .EOF
  210.             If !LName & ", " & !Fname = Name Then
  211.                 Found = True
  212.                 Exit Do
  213.             Else
  214.                 .MoveNext
  215.                 Found = False
  216.             End If
  217.         Loop
  218.         
  219.         If Not (Found) Then MsgBox "Record not found", vbExclamation, "Error": Exit Sub
  220.         
  221.         Printer.ScaleMode = vbInches
  222.         Printer.CurrentX = 0
  223.         Printer.CurrentY = 0
  224.         Printer.FontSize = 18
  225.         Printer.Print Name
  226.         Printer.FontSize = 12
  227.         Printer.CurrentY = Printer.CurrentY + 0.5
  228.         Printer.CurrentX = 0
  229.         
  230.         If !Address1 <> "" Then
  231.             Printer.Print !Address1
  232.             Printer.CurrentY = Printer.CurrentY + 0.08
  233.             Printer.CurrentX = 0
  234.         End If
  235.         If !Address2 <> "" Then
  236.             Printer.Print !Address2
  237.             Printer.CurrentY = Printer.CurrentY + 0.08
  238.             Printer.CurrentX = 0
  239.         End If
  240.         If Not (!City = "" And !State = "" And !Zip = "") Then
  241.             Printer.Print !City & ", " & !State & " "; !Zip
  242.             Printer.CurrentY = Printer.CurrentY + 0.08
  243.             Printer.CurrentX = 0
  244.         End If
  245.         
  246.         If !Phone1 <> "" Then
  247.             Printer.Print "Phone 1: " & !Phone1
  248.             Printer.CurrentY = Printer.CurrentY + 0.08
  249.             Printer.CurrentX = 0
  250.         End If
  251.         If !Phone2 <> "" Then
  252.             Printer.Print "Phone 2: " & !Phone2
  253.             Printer.CurrentY = Printer.CurrentY + 0.08
  254.             Printer.CurrentX = 0
  255.         End If
  256.         If !Cell <> "" Then
  257.             Printer.Print "Cell: " & !Cell
  258.             Printer.CurrentY = Printer.CurrentY + 0.08
  259.             Printer.CurrentX = 0
  260.         End If
  261.         If !fax <> "" Then
  262.             Printer.Print "Fax: " & !fax
  263.             Printer.CurrentY = Printer.CurrentY + 0.08
  264.             Printer.CurrentX = 0
  265.         End If
  266.         If !EMail <> "" Then
  267.             Printer.Print "E-Mail: " & !EMail
  268.             Printer.CurrentY = Printer.CurrentY + 0.08
  269.             Printer.CurrentX = 0
  270.         End If
  271.         If !URL <> "" Then
  272.             Printer.Print "URL: " & !URL
  273.             Printer.CurrentY = Printer.CurrentY + 0.08
  274.             Printer.CurrentX = 0
  275.         End If
  276.         
  277.         Printer.Print "Category: " & frmContact.cmbCat.List(Val(!Cat))
  278.         Printer.CurrentY = Printer.CurrentY + 0.08
  279.         Printer.CurrentX = 0
  280.         
  281.         Printer.Print "Birthday: " & Format(!BDayM, "00") & "/" & Format(!BDayD, "00") & "/" & Format(!BDayY, "00")
  282.         Printer.CurrentY = Printer.CurrentY + 0.08
  283.         Printer.CurrentX = 0
  284.         
  285.         If !Notes <> "" Then
  286.             Printer.Print "Notes: " & !Notes
  287.         End If
  288.         
  289.         Printer.EndDoc
  290.     End With
  291. End Sub
  292.