Menentukan Objek Font Yang Dikirimkan Ke Printer

Contoh sederhana untuk menentukan name, underline, bold, italic, size (properties objek font) yang dikirimkan ke sebuah printer. Adapun contohnya sebagai berikut:

Private Sub Command1_Click() 
    With Printer 
        .FontName = "Arial" 
        .FontUnderline = False 
        .FontBold = False
        .FontItalic = True
        .FontSize = "30"
        .Print "Ini contoh objek font dalam printer" 
        .EndDoc 
    End With 
End Sub 

READ MORE - Menentukan Objek Font Yang Dikirimkan Ke Printer

Membuat About Box Dengan Memanfaatkan Default Windows

Mengenai cara menampilkan kotak dialog About default windows menggunakan Visual Basic 6 - Apabila kita malas membuat tampilan kotak dialog About, mungkin kode di bawah adalah alternatif yang tepat, selain itu ia memiliki tampilan (GUI) yang menarik, adapun cara menampilkan kotak dialog about default windows adalah sebagai berikut:

'simpan kode di bawah ini dalam module 
Option Explicit 
 
Public Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long 
 
Public Sub ShowAboutDialog(hwnd As Long, Caption As String, Txt As String, Icon As Long) 
    Call ShellAbout(hwnd, Caption, Txt, Icon) 
End Sub 

Contoh penggunaan kode untuk menampilkan kotak dialog about:

Private Sub cmdAbout_Click() 
    ShowAboutDialog Me.hwnd, "About My-Sofware", "Software Versi ke-1", Me.Icon 
End Sub 

READ MORE - Membuat About Box Dengan Memanfaatkan Default Windows

Animasi Copy Seperti Di Windows Explorer

Option Explicit 
 
Private Const FO_COPY = &H2& 
Private Const FO_DELETE = &H3& 
Private Const FO_MOVE = &H1& 
Private Const FO_RENAME = &H4& 
Private Const FOF_ALLOWUNDO = &H40& 
Private Const FOF_CONFIRMMOUSE = &H2& 
Private Const FOF_CREATEPROGRESSDLG = &H0& 
Private Const FOF_FILESONLY = &H80& 
Private Const FOF_MULTIDESTFILES = &H1& 
Private Const FOF_NOCONFIRMATION = &H10& 
Private Const FOF_NOCONFIRMMKDIR = &H200& 
Private Const FOF_RENAMEONCOLLISION = &H8& 
Private Const FOF_SILENT = &H4& 
Private Const FOF_SIMPLEPROGRESS = &H100& 
Private Const FOF_WANTMAPPINGHANDLE = &H20& 
 
Private Type SHFILEOPSTRUCT 
    hwnd As Long 
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As String
End Type 
 
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) 
Private Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As Any) As Long 
 
Private Sub cmdCopy_Click() 
    Dim result As Long 
    Dim lenFileop As Long
    Dim foBuf() As Byte
    Dim fileop As SHFILEOPSTRUCT
     
    lenFileop = LenB(fileop)
    ReDim foBuf(1 To lenFileop) 
     
    With fileop
        .hwnd = Me.hwnd 
        .wFunc = FO_COPY 
        .pFrom = App.Path & "\readme.html" & vbNullChar & App.Path & "\readme.doc" & vbNullChar & App.Path & "\readme.txt" & vbNullChar & vbNullChar 
        .pTo = "C:\" 
        .fFlags = FOF_CREATEPROGRESSDLG 
        .lpszProgressTitle = "VB HowTo Copy Example " & vbNullChar & vbNullChar 
    End With 
     
    Call CopyMemory(foBuf(1), fileop, lenFileop)
    Call CopyMemory(foBuf(19), foBuf(21), 12) 
     
    result = SHFileOperation(foBuf(1))
     
    If result <> 0 Then
        MsgBox Err.LastDllError
    Else 
        If fileop.fAnyOperationsAborted <> 0 Then
            MsgBox "Operation Failed"
        End If 
    End If
     
End Sub 

READ MORE - Animasi Copy Seperti Di Windows Explorer

Memutarkan huruf pada watermark, bagaimana caranya?

Mengenai cara memutarkan atau merotasi font pada watermark menggunakan VB6 (belajar Visual Basic 6 untuk pemula) - Posting ini merupakan kelanjutan dari posting yang telah ditulis terdahulu. Disini kita akan menambahkan beberapa kemampuan pada project watermark yang sedang kita buat. Perhatikan kode di bawah ini:

'--------------------------------------------------------------------------------------- 
' http://khoiriyyah.blogspot.com 
' coder: Administrator 
'--------------------------------------------------------------------------------------- 
Option Explicit 
 
Private Declare Sub InitCommonControls Lib "comctl32.dll" () 
 
Dim intCurrentX As Integer 'variabel untuk menyimpan koordinat X 
Dim intCurrentY As Integer 'variabel untuk menyimpan koordinat Y 
 
Private Sub Command1_Click() 
    'memanggil prosedur RotateFont 
    RotateFont Picture1, Val(txtSize), txtFontName, intCurrentX, intCurrentY, Val(txtDegree), txtWatermark 
    'menyimpan hasil gambar yang telah diberi teks 
    SavePicture Picture1.Image, App.Path & "\watermark_sample.bmp" 'and save  Exit Sub 
End Sub 
 
Private Sub Form_Initialize() 
    InitCommonControls 'XP style 
End Sub 
 
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 
    Label3 = "X: " & x 'menampilkan koordinat X ke dalam label 
    Label4 = "Y: " & y 'menampilkan koordinat Y ke dalam label 
    intCurrentX = x 'simpan koordinat x dalam variabel intCurrentX 
    intCurrentY = y 'simpan koordinat y dalam variabel intCurrentY 
    WaterMarkIt 'panggil prosedur WaterMarkIt 
End Sub 
 
Private Sub txtDegree_Change() 
    'apabila bukan angka, jadikan txtDegree.Text = 90 
  If Not IsNumeric(txtDegree.Text) Then txtDegree.Text = "90" 
End Sub 
 
Private Sub VScroll1_Scroll() 
    'panggil prosedur WaterMarkIt pada saat terjadi Scroll 
    WaterMarkIt 
End Sub 
 
Private Sub VScroll1_Change() 
    'panggil prosedur WaterMarkIt pada saat terjadi perubahan nilai 
    WaterMarkIt 
End Sub 
 
Private Sub VScroll2_Change() 
    WaterMarkIt 'panggil prosedur WaterMarkIt 
End Sub 
 
Private Sub VScroll2_Scroll() 
    WaterMarkIt 'panggil prosedur WaterMarkIt 
End Sub 
'-------------------------------------------------------------------- 
' Prosedur WaterMarkIt 
'-------------------------------------------------------------------- 
Private Sub WaterMarkIt() 
    Command1_Click 'panggil Command1_Click (Rotasi dan simpan image) 
    txtDegree.Text = VScroll1.Value 'txtDegree berdasarkan nilai VScroll1 
    txtSize.Text = VScroll2.Value 'txtSize berdasarkan nilai VScroll2 
End Sub 

Download Project

READ MORE - Memutarkan huruf pada watermark, bagaimana caranya?