home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / My_DLL(upd20886610272007.psc / EazyDtAcc+NewMsgBox / DLL / ClsMsg.cls < prev    next >
Text File  |  2007-10-03  |  4KB  |  183 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "MessageBox"
  10. Attribute VB_GlobalNameSpace = True
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. '%#########################################%'
  15. '%Author   : Tendri S (20)                 %'
  16. '%Date     : October 08, 2007              %'
  17. '%Location : Bekasi, Indonesia             %'
  18. '%Email    : mizz_daeng@plasa.com          %'
  19. '%Please Do Not Removes Any Copyrights and %'
  20. '%#########################################%'
  21.  
  22. Option Explicit
  23.  
  24. Private sMsg As String
  25.  
  26. Private WithEvents fMessage As frmMessage
  27. Attribute fMessage.VB_VarHelpID = -1
  28. 'Fungsi kyk msgboxnya vb
  29. 'Kelar jg nih.. ^^
  30. Public Function TendriMsg(Prompt As String, Optional Buttons As VbMsgBoxStyle, Optional Title As String)
  31. Dim TmblStr() As String
  32. Dim TmblClose() As Boolean
  33. Dim TipeTmbl As Long
  34. Dim TipeIcon As Long
  35.  
  36. Const PlusButtons  As Long = &H7
  37. Const PlusIcons As Long = &H71
  38.  
  39. Set fMessage = New frmMessage
  40.  
  41. With fMessage
  42.  .JudulMsg = Title
  43. End With
  44.     
  45. 'Teks yang akan ditampilkan pd tombol dan tombol u/ ngeclose msgbox(nandain doank-->true)
  46. TipeTmbl = (Buttons And PlusButtons) 'vbRetryCancel, vbYesNo, vbYesNoCancel, vbAbortRetryIgnore, vbOKCancel
  47. Select Case TipeTmbl
  48.  Case vbYesNo
  49.   ReDim TmblStr(1)
  50.   ReDim TmblClose(1)
  51.              
  52.   TmblStr(0) = "Yes"
  53.   TmblStr(1) = "No"
  54.   TmblClose(0) = True
  55.   TmblClose(1) = True
  56.   
  57.  Case vbOKCancel
  58.   ReDim TmblStr(1)
  59.   ReDim TmblClose(1)
  60.  
  61.   TmblStr(0) = "OK"
  62.   TmblStr(1) = "Cancel"
  63.   TmblClose(0) = True
  64.   TmblClose(1) = True
  65.   
  66.  Case vbRetryCancel
  67.   ReDim TmblStr(1)
  68.   ReDim TmblClose(1)
  69.             
  70.   TmblStr(0) = "Retry"
  71.   TmblStr(1) = "Cancel"
  72.   TmblClose(0) = True
  73.   TmblClose(1) = True
  74.  
  75.  Case vbYesNoCancel
  76.   ReDim TmblStr(2)
  77.   ReDim TmblClose(2)
  78.  
  79.   TmblStr(0) = "Yes"
  80.   TmblStr(1) = "No"
  81.   TmblStr(2) = "Cancel"
  82.   TmblClose(0) = True
  83.   TmblClose(1) = True
  84.   TmblClose(2) = True
  85.  
  86.  Case vbAbortRetryIgnore
  87.   ReDim TmblStr(2)
  88.   ReDim TmblClose(2)
  89.             
  90.   TmblStr(0) = "Abort"
  91.   TmblStr(1) = "Retry"
  92.   TmblStr(2) = "Ignore"
  93.   TmblClose(0) = True
  94.   TmblClose(1) = True
  95.   TmblClose(2) = True
  96.  
  97. Case Else
  98.  ReDim TmblStr(0)
  99.  ReDim TmblClose(0)
  100.  
  101.  TmblStr(0) = "OK"
  102.  TmblClose(0) = True
  103. End Select
  104.  
  105. sMsg = Prompt
  106.  
  107. With fMessage
  108.  .TeksTombol = TmblStr
  109.  .TmblTerminate = TmblClose
  110.                 
  111.  'Gambar Ikon
  112.  TipeIcon = (Buttons And PlusIcons)
  113.   Select Case TipeIcon
  114.    Case vbCritical
  115.     .IkonMsg = vbCritical
  116.    Case vbExclamation
  117.     .IkonMsg = vbExclamation
  118.    Case vbInformation
  119.     .IkonMsg = vbInformation
  120.    Case vbQuestion
  121.     .IkonMsg = vbQuestion
  122.    Case Else
  123.     .IkonMsg = Empty
  124.    End Select
  125.         
  126.    'allignnya jg bisa diset (vbmsgboxright)
  127.    If (Buttons And vbMsgBoxRight) Then
  128.     .lblPesan.Alignment = vbRightJustify
  129.    Else
  130.     .lblPesan.Alignment = vbLeftJustify
  131.    End If
  132.         
  133.    'Taro pesan ke form Msgbox
  134.    .TampilkanPsn Prompt
  135.       
  136.    'tentuin tombol yg dipake u/ nutup msgbox (diambil dr tombol yg diklik-lpressedbtn-)
  137.    Select Case .PressedBtn
  138.     Case 0
  139.     Select Case TipeTmbl
  140.      Case vbAbortRetryIgnore
  141.       TendriMsg = vbAbort
  142.      Case vbOKCancel
  143.       TendriMsg = vbOK
  144.      Case vbRetryCancel
  145.       TendriMsg = vbRetry
  146.      Case vbYesNo
  147.       TendriMsg = vbYes
  148.      Case vbYesNoCancel
  149.       TendriMsg = vbYes
  150.      Case Else
  151.       TendriMsg = vbOK
  152.     End Select
  153.                 
  154.     Case 1
  155.     Select Case TipeTmbl
  156.      Case vbAbortRetryIgnore
  157.       TendriMsg = vbRetry
  158.      Case vbOKCancel
  159.       TendriMsg = vbCancel
  160.      Case vbRetryCancel
  161.       TendriMsg = vbCancel
  162.      Case vbYesNo
  163.       TendriMsg = vbNo
  164.      Case vbYesNoCancel
  165.       TendriMsg = vbNo
  166.     End Select
  167.             
  168.     Case 2
  169.     Select Case TipeTmbl
  170.      Case vbAbortRetryIgnore
  171.       TendriMsg = vbIgnore
  172.      Case vbYesNoCancel
  173.       TendriMsg = vbCancel
  174.      End Select
  175.    End Select
  176.    
  177. End With
  178.     
  179. Set fMessage = Nothing
  180. End Function
  181.  
  182. '''PLEASE RATE'''''PLEASE RATE'''''PLEASE RATE'''
  183.