Sunday, June 17, 2012

Alternatif Lain Menulis Kode Pada Posting Menggunakan Tag [P

Pernahkah Anda menulis kode dengan menggunakan tag <PRE> di blogspot. Jika belum, mungkin ini saatnya. Mengapa tag <PRE>? bukankah lebih baik menggunakan syntax highlighter? Tag <PRE> dalam kode HTML digunakan khusus untuk menuliskan kode. Dengan menggunakan tag <PRE> maka sebuah postingan akan memelihara indent dari kode tersebut, ini sangatlah penting. Penggunaan tag <PRE>: <PRE> code HTML, VB, C++, CSS, dll </PRE> Contoh kode CSS yang menggunakan tag <pre>:
<b:includable id='feedLinks'>
<b:if cond='data:blog.pageType != "item"'>
<!-- Blog feed links -->
<b:if cond='data:feedLinks'>
<div class='blog-feeds'>
<b:include data='feedLinks' name='feedLinksBody' />
</div>
</b:if>
<b:else />
<!--Post feed links -->
<div class='post-feeds'>
<b:loop values='data:posts' var='post'>
<b:if cond='data:post.allowComments'>
<b:if cond='data:post.feedLinks'>
<b:include data='post.feedLinks'
name='feedLinksBody' />
</b:if>
</b:if>
</b:loop>
</div>
</b:if>
</b:includable>
Bandingkan dengan kode di bawah:
<b:includable id='feedLinks'>
<b:if cond='data:blog.pageType != &quot;item&quot;'> <!-- Blog feed links -->
<b:if cond='data:feedLinks'>
<div class='blog-feeds'>
<b:include data='feedLinks' name='feedLinksBody'/>
</div>
</b:if>

<b:else/> <!--Post feed links -->
<div class='post-feeds'>
<b:loop values='data:posts' var='post'>
<b:if cond='data:post.allowComments'>
<b:if cond='data:post.feedLinks'>
<b:include data='post.feedLinks' name='feedLinksBody'/>
</b:if>
</b:if>
</b:loop>
</div>
</b:if>
</b:includable>
Kode VB6.0 di bawah ini menggunakan tag <PRE>:
'Automatic select listbox when mouse over
Option Explicit

Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function LBItemFromPt Lib "COMCTL32.DLL" (ByVal hLB As Long, ByVal ptX As Long, ByVal ptY As Long, ByVal bAutoScroll As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

Private Const LB_SETCURSEL = &H186
Private Const LB_GETCURSEL = &H188

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Sub HightLightListBox(ByVal hwndLB As Long, ByVal X As Single, ByVal Y As Single)

Dim IndexItem As Long
Dim Point As POINTAPI

Point.X = X \ Screen.TwipsPerPixelX
Point.Y = Y \ Screen.TwipsPerPixelY

Call ClientToScreen(hwndLB, Point)

IndexItem = LBItemFromPt(hwndLB, Point.X, Point.Y, False)

If IndexItem <> SendMessage(hwndLB, LB_GETCURSEL, 0, 0) Then
Call SendMessage(hwndLB, LB_SETCURSEL, IndexItem, 0)
End If

End Sub

Private Sub Form_Load()
Dim i As Long
For i = 0 To 100
List1.AddItem 1234567 + i
Next
End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
HightLightListBox List1.hwnd, X, Y
End Sub
Bandingkan dengan yang di bawah:
'Automatic select listbox when mouse over
Option Explicit

Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function LBItemFromPt Lib "COMCTL32.DLL" (ByVal hLB As Long, ByVal ptX As Long, ByVal ptY As Long, ByVal bAutoScroll As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

Private Const LB_SETCURSEL = &H186
Private Const LB_GETCURSEL = &H188

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Sub HightLightListBox(ByVal hwndLB As Long, ByVal X As Single, ByVal Y As Single)

Dim IndexItem As Long
Dim Point As POINTAPI

Point.X = X \ Screen.TwipsPerPixelX
Point.Y = Y \ Screen.TwipsPerPixelY

Call ClientToScreen(hwndLB, Point)

IndexItem = LBItemFromPt(hwndLB, Point.X, Point.Y, False)

If IndexItem <> SendMessage(hwndLB, LB_GETCURSEL, 0, 0) Then
Call SendMessage(hwndLB, LB_SETCURSEL, IndexItem, 0)
End If

End Sub

Private Sub Form_Load()
Dim i As Long
For i = 0 To 100
List1.AddItem 1234567 + i
Next
End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
HightLightListBox List1.hwnd, X, Y
End Sub
READ MORE - Alternatif Lain Menulis Kode Pada Posting Menggunakan Tag [P

Menutup Sebuah Aplikasi Secara Paksa (Force Terminate)

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "Kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_TERMINATE As Long = &H1

Public Sub terminateApp(ByVal sWindowTitle As String, ByVal fSilent As Boolean)


Dim lHwnd As Long
Dim lProc As Long
Dim lProcHnd As Long

On Error GoTo ErrHandler

sWindowTitle = "Inbox - Thunderbird"
sWindowTitle = "Test"

lHwnd = FindWindow(vbNullString, sWindowTitle)
If lHwnd = 0 Then
If fSilent Then
Exit Sub
Else
Err.Raise 1, , "Can"
End If
End If

GetWindowThreadProcessId lHwnd, lProc
If lProc = 0 Then
If fSilent Then
Exit Sub
Else
Err.Raise 1, , "Can"
End If
End If

lProcHnd = OpenProcess(SYNCHRONIZE Or PROCESS_TERMINATE, 0, lProc)
If lProcHnd = 0 Then
If fSilent Then
Exit Sub
Else
Err.Raise 1, , "Can"
End If
End If

If TerminateProcess(lProcHnd, 0&) <> 0 Then
If Not fSilent Then
Err.Raise 1, , "Failed to terminate process"
End If
End If

CloseHandle lProcHnd

Exit Sub

ErrHandler:

Err.Raise Err.Number, , Err.Description

End Sub
READ MORE - Menutup Sebuah Aplikasi Secara Paksa (Force Terminate)

Menutup Sebuah Aplikasi Secara Request

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_CLOSE As Long = &H10

Public Sub closeApp(ByVal sWindowTitle As String, Optional ByVal fSilent As Boolean = False)
Dim lHwnd As Long
On Error GoTo ErrHandler

lHwnd = FindWindow(vbNullString, sWindowTitle)

If lHwnd = 0 Then
If Not fSilent Then
Err.Raise 1, , "Can"
End If
Else
PostMessage lHwnd, WM_CLOSE, 0, 0
End If

Exit Sub

ErrHandler:
Err.Raise Err.Number, , Err.Description
End Sub
READ MORE - Menutup Sebuah Aplikasi Secara Request

Aplikasi Untuk Melihat Warna Yang Ada Di bawah Pointer

'simpan kode di bawah pada module
Option Explicit

Private Declare Function CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any)
Private Declare Function DeleteDC& Lib "gdi32" (ByVal hdc As Long)
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'simpan kode di bawah pada form
'Timer.Interval = 1
'Picture1.AutoRedraw = True

'Option Explicit

Dim pt As POINTAPI

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer1.Enabled = True
Picture1.MousePointer = vbCrosshair
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer1.Enabled = False
Picture1.MousePointer = vbDefault
End Sub

Private Sub Timer1_Timer()
Dim screendc As Long
GetCursorPos pt
screendc = CreateDC("DISPLAY", "", "", 0&)
Picture1.BackColor = GetPixel(screendc, pt.X, pt.Y)
Text1.Text = "#" & Hex(GetPixel(screendc, pt.X, pt.Y))
DeleteDC (screendc)
End Sub
READ MORE - Aplikasi Untuk Melihat Warna Yang Ada Di bawah Pointer