Membuat Efek Blow pada Form

Membuat efek/animasi blow/explode pada sebuah form.

Option Explicit 
 
Type RECT 
  Left As Long 
  Top As Long 
  Right As Long 
  Bottom As Long 
End Type 
 
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long 
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long 
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long 
Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long 
Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 
Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long 
Declare Function SelectObject Lib "user32" (ByVal hdc As Long, ByVal hObject As Long) As Long 
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long 
 
Public Const   IMPLODE_EXPLODE_VALUE = 1500 'you can change the value 
 
Sub ExplodeForm(f As Form, Movement As Integer) 
    Dim myRect As RECT 
    Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy% 
    Dim TheScreen As Long 
  Dim Brush As Long 
  GetWindowRect f.hwnd, myRect 
    formWidth = (myRect.Right - myRect.Left) 
    formHeight = myRect.Bottom - myRect.Top 
      TheScreen = GetDC(0) 
    Brush = CreateSolidBrush(f.BackColor) 
    For i = 1 To Movement 
        Cx = formWidth * (i / Movement) 
        Cy = formHeight * (i / Movement) 
        X = myRect.Left + (formWidth - Cx) / 2 
        Y = myRect.Top + (formHeight - Cy) / 2 
        Rectangle TheScreen, X, Y, X + Cx, Y + Cy 
    Next i 
  X = ReleaseDC(0, TheScreen) 
    DeleteObject (Brush) 
End Sub 
 
Public Sub ImplodeForm(f As Form, Movement As Integer) 
    Dim myRect As RECT 
    Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy% 
    Dim TheScreen As Long 
    Dim Brush As Long 
    GetWindowRect f.hwnd, myRect 
    formWidth = (myRect.Right - myRect.Left) 
    formHeight = myRect.Bottom - myRect.Top 
    TheScreen = GetDC(0) 
    Brush = CreateSolidBrush(f.BackColor) 
    For i = Movement To 1 Step -1 
        Cx = formWidth * (i / Movement) 
        Cy = formHeight * (i / Movement) 
        X = myRect.Left + (formWidth - Cx)   / 2 
        Y = myRect.Top + (formHeight - Cy) / 2 
        Rectangle TheScreen, X, Y, X + Cx, Y + Cy 
    Next i 
    X = ReleaseDC(0, TheScreen) 
    DeleteObject (Brush) 
End Sub 

Contoh penggunaan membuat efek ledakan pada form

Private Sub Command1_Click() 
    Call ImplodeForm(Me, IMPLODE_EXPLODE_VALUE) 
    End 
    Set Form1 = Nothing 
End Sub 
   
Private Sub Form_Load() 
    Call ExplodeForm(Me, IMPLODE_EXPLODE_VALUE) 
End Sub 

READ MORE - Membuat Efek Blow pada Form

Membuat Text Area, Bagaimanakah Caranya?

Apa yang dimaksud dengan Text Area, perhatikan di bawah ini:

Ini merupakan text area, dalam text area Anda dapat menyimpan kode HTML, tulisan, dan sebagainya

Setelah Anda faham apa yang dimaksud dengan Text Area, sekarang tentu Anda bertanya bagaimanakah cara membuatnya? di bawah ini merupakan kode HTML untuk membuat Text Area di atas:

<p align="center">
<textarea name="code" rows="6" cols="40"> 
Ini merupakan text area, dalam text area Anda dapat menyimpan kode HTML, tulisan, dan sebagainya 
</textarea>
</p>

Penjelesan mengenai variable Text Area:

• align: posisi, dapat Anda pilih center (tengah), left (kiri), right (kanan)
• row: merupakan tinggi area
• col: merupakan lebar area

READ MORE - Membuat Text Area, Bagaimanakah Caranya?

Menampilkan Kata Yang Berada Di atas Pointer Mouse - VB6

Ini merupakan fungsi untuk menampilkan kata yang berada tepat di bawah pointer mouse. Fungsi ini hanya berjalan pada object RichTextBox. Bagaimana implementasi dari kodenya? bisa Anda perhatikan di bawah:

Option Explicit 
 
Private Const EM_CHARFROMPOS& = &HD7 
 
Private Type POINTAPI 
    x As Long 
    y As Long 
End Type 
 
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
 
' Return the word the mouse is over. 
Public Function RichWordOver(rch As   RichTextBox, x As Single, y As Single) As String 
 
    Dim pt As POINTAPI 
    Dim Pos As Integer 
    Dim start_pos As Integer 
    Dim end_pos As Integer 
    Dim ch As String 
    Dim txt As String 
    Dim txtlen As Integer 
 
    ' Convert the position to pixels. 
    pt.x = x \ Screen.TwipsPerPixelX 
    pt.y = y \ Screen.TwipsPerPixelY 
 
    ' Get the character number 
    Pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&,   pt) 
    If Pos <= 0 Then Exit Function 
 
    ' Find the start of the word. 
    txt = rch.Text 
    For start_pos = Pos To 1 Step -1 
        ch = Mid$(rch.Text, start_pos, 1) 
        ' Allow digits, letters, and underscores. 
        If Not  _ 
            ch >= "0" And ch <= "9") Or _ 
            ch >= "a" And ch <= "z") Or _ 
            ch   >= "A" And ch <= "Z") Or _ 
            ch = "_" _ 
            ) Then Exit For 
    Next start_pos 
    start_pos = start_pos + 1 
 
    ' Find the end of the word. 
    txtlen = Len(txt) 
    For end_pos = Pos To txtlen 
        ch = Mid$(txt, end_pos, 1) 
        ' Allow digits, letters, and underscores. 
        If Not  _ 
              ch >= "0" And ch <= "9") Or _ 
            ch >= "a" And ch <= "z") Or _ 
            ch >= "A" And ch <= "Z") Or _ 
            ch = "_" _ 
        ) Then Exit For 
    Next end_pos 
    end_pos = end_pos - 1 
 
    If start_pos <= end_pos Then RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1)   
End Function 

Contoh penggunaanya:

Option Explicit 
 
Dim strWordOver As String 
 
Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 
    strWordOver = RichWordOver(RichTextBox1, x, y) 
    If Trim(strWordOver) = "" Then Exit Sub 
    If Text1.Text <> strWordOver Then 
        Text1.Text = strWordOver 
    End If 
End Sub 

READ MORE - Menampilkan Kata Yang Berada Di atas Pointer Mouse - VB6

Mengirim Email Lewat VB6.0 Menggunakan Vbsendmail.dll

Di bawah ini merupakan contoh kode untuk mengirim email lewat VB6.0 menggunakan bantuan ActiveX (vbSendMail.dll). VB SendMail merupakan ActiveX yang digunakan untuk mengirim email, terdokumentasi dengan baik dan lengkap. Anda dapat memperoleh komponen tersebut di freevbsource.com silakan Anda kunjungi situsnya.

Option Explicit

Private WithEvents poSendMail As vbSendMail.clsSendMail
Private bSendFailed As Boolean

Private Sub Command1_Click()
  Dim lCount As Long
  Dim lCtr As Long
  Dim t!

  Command1.Enabled = False
  bSendFailed = False
  lstStatus.Clear
  lblTime.Caption = ""
  Screen.MousePointer = vbHourglass

  With poSendMail
      .SMTPHost = "smtp.telkom.net"
      .From = txtSender.Text
      .FromDisplayName = txtName.Text
      .Message = txtMsg.Text
      .AsHTML = True
      t! = Timer
      .Recipient = txtRecipient.Text
       RecipientDisplayName = txtRecName.Text
      .Subject = txtSubject.Text
      lblTime = "Sending message " & Str(lCtr)
      .Send
  End With

  If Not bSendFailed Then lblTime.Caption = Str(lCount) & " Messages sent in " & Format$(Timer - t!, "#,##0.0") & " seconds."
  Screen.MousePointer = vbDefault
  Command1.Enabled = True
End Sub

Private Sub Form_Load()
  Set poSendMail = New clsSendMail
End Sub

Private Sub poSendMail_Progress(lPercentCompete As Long)
  lblProgress = lPercentCompete & "% complete"
End Sub

Private Sub poSendMail_SendFailed(Explanation As String)
  MsgBox ("Your attempt to send mail failed for the following reason(s): " & vbCrLf & Explanation)
  bSendFailed = True
  lblProgress = ""
  lblTime = ""
End Sub

Private Sub poSendMail_SendSuccesful()
  lblProgress = "Send Successful!"
End Sub

Private Sub poSendMail_Status(Status As String)
   lstStatus.AddItem Status
  lstStatus.ListIndex = lstStatus.ListCount - 1
  lstStatus.ListIndex = -1
End Sub

Download: Source Code

READ MORE - Mengirim Email Lewat VB6.0 Menggunakan Vbsendmail.dll