[Tutorial] Cara membuat form transparant dgn VB6 [Part2] desain sesuka hatimu dgn berbagai bentuk

Diposting oleh Alfianto Nandya Prakoso on Senin, 08 Agustus 2011

berikut saya akan menjelaskan bagaimana membuat form menjadi berbentuk / transparant
mungkin karena bosan dengan bentuk form yg selalu kotak ..
nah buat anda yang ingin mencoba nya silahkan mencoba >>

gambar >>


Spoiler
Posted ImagePosted ImagePosted Image

tambahkan sebuah module di project anda
dan sisipkan code berikut :
Spoiler

private declare function getwindowlong lib "user32" alias "getwindowlonga" (byval hwnd as long, byval nindex as long) as long
private declare function setwindowlong lib "user32" alias "setwindowlonga" (byval hwnd as long, byval nindex as long, byval dwnewlong as long) as long
private declare function setlayeredwindowattributes lib "user32" (byval hwnd as long, byval crkey as long, byval bdefaut as byte, byval dwflags as long) as long

private const gwl_exstyle       as long = (-20)
private const lwa_colorkey      as long = &h1
private const lwa_defaut                as long = &h2
private const ws_ex_layered     as long = &h80000
'
public function transparency(byval hwnd as long, optional byval col as long = vbblack, _
        optional byval pctransp as byte = 255, optional byval trmode as boolean = true) as boolean
' return : true if there is no error.
' hwnd   : hwnd of the window to make transparent
' col : color to make transparent if trmode=false' pctransp  : 0 ã  255 >> 0 = transparent  -:- 255 = opaque
dim displaystyle as long
  
        voirstyle = getwindowlong(hwnd, gwl_exstyle)
        if displaystyle <> (displaystyle or ws_ex_layered) then
        displaystyle = (displaystyle or ws_ex_layered)
        call setwindowlong(hwnd, gwl_exstyle, displaystyle)
        end if
        transparency = (setlayeredwindowattributes(hwnd, col, pctransp, iif(trmode, lwa_colorkey or lwa_defaut, lwa_colorkey)) <> 0)
        

        if not err.number = 0 then err.clear
end function

public sub activetransparency(m as form, d as boolean, f as boolean, _
        t_transparency as integer, optional color as long)
dim b as boolean
        if d and f then
        'makes color (here the background color of the shape) transparent
        'upon value of t_transparency
                b = transparency(m.hwnd, color, t_transparency, false)
        elseif d then
                'makes form, including all components, transparent
                'upon value of t_transparency
                b = transparency(m.hwnd, 0, t_transparency, true)
        else
                'restores the form opaque.
                b = transparency(m.hwnd, , 255, true)
        end if
end sub


kemudian untuk form nya . tambahkan code berikut :
Spoiler

private noc as integer
private str1 as string
private str2 as string
private str3 as string
private strmessage as string

        option explicit

        


        const ws_ex_layered = &h80000
        const gwl_exstyle = (-20)
        const lwa_alpha = &h2'**************************************
' name: make a transparent area (any size) in your form' description:this function create a transparent area of dirrent shape (such as rectangle, circle)

' by: sapta_agunk'
'this code is copyrighted and has' limited warranties.please see http://www.nstars.net/
'1, declararion' this should be in the form's general declaration area. if you declare in a modeule,
' you need to omit the word "private"
private declare function createroundrectrgn lib "gdi32" (byval x1 as long, byval y1 as long, byval x2 as long, byval y2 as long, byval x3 as long, byval y3 as long) as long
private declare function createrectrgn lib "gdi32" (byval x1 as long, byval y1 as long, byval x2 as long, byval y2 as long) as long
private declare function createellipticrgn lib "gdi32" (byval x1 as long, byval y1 as long, byval x2 as long, byval y2 as long) as long
private declare function combinergn lib "gdi32" (byval hdestrgn as long, byval hsrcrgn1 as long, byval hsrcrgn2 as long, byval ncombinemode as long) as long
private declare function setwindowrgn lib "user32" (byval hwnd as long, byval hrgn as long, byval bredraw as long) as long


'2 the function
' this should be in the form's code.
private function fmakeatransparea(areatype as string, pcordinate() as long) as boolean'name: fmakeatranparea
'author: sapta_agunk'date: 15-11-2010
'purpose: create a transprarent area in a form so that you can see through'input: areatype : a string indicate what kind of hole shape it would like to make
' pcordinate : the cordinate area needed for create the shape:
' example: x1, y1, x2, y2 for rectangle
'output: a boolean
const rgn_diff = 4
dim loriginalform as long
dim lthehole as long
dim lnewform as long
dim lfwidth as single
dim lfheight as single
dim lborder_width as single
dim ltitle_height as single
 on error goto trap
 lfwidth = scalex(width, vbtwips, vbpixels)
 lfheight = scaley(height, vbtwips, vbpixels)
 loriginalform = createrectrgn(0, 0, lfwidth, lfheight)

 lborder_width = (lfheight - scalewidth) / 2
 ltitle_height = lfheight - lborder_width - scaleheightselect case areatype

 case "elliptic"

 lthehole = createellipticrgn(pcordinate(1), pcordinate(2), pcordinate(3), pcordinate(4))
 case "rectangle"

 lthehole = createrectrgn(pcordinate(1), pcordinate(2), pcordinate(3), pcordinate(4))

 case "roundrect"

 lthehole = createroundrectrgn(pcordinate(1), pcordinate(2), pcordinate(3), pcordinate(4), pcordinate(5), pcordinate(6))
 case "circle"
 lthehole = createroundrectrgn(pcordinate(1), pcordinate(2), pcordinate(3), pcordinate(4), pcordinate(3), pcordinate(4))

 case else
 msgbox "unknown shape!!"
 exit function
 end select
 lnewform = createrectrgn(0, 0, 0, 0)
 combinergn lnewform, loriginalform, _
 lthehole, rgn_diff

 setwindowrgn hwnd, lnewform, true
 me.refresh
 fmakeatransparea = trueexit function
trap:
 msgbox "error occurred. error # " & err.number & ", " & err.descriptionend function





        private sub form_load()
        str1 = "transparant form  --  edited by sapta_agunk thx to mbah google .. ^^v                   " 'contoh text yg akan berjalan
        dim i as integer
        'ex: all transparent at ratio 140/255
        'activetransparency me, true, false, 140, me.backcolor
        'ex: form transparent, visible component at ratio 140/255
        'activetransparency me, true, true, 140, me.backcolor
        
        'example display the form transparency degradation
        activetransparency me, true, false, 0
        me.show
        for i = 0 to 255 step 3
        activetransparency me, true, false, i
        me.refresh
        next iend sub


untuk finishing desain sesuka hati anda
dengan bentuk2 yang menarik

nb : coding hanya membaca semua warna / color yang berhubungan dengan hitam
sehingga , aplikasi nya >> semua yang berwarna hitam akan menjadi transparant <<

lihat gambar :
Spoiler
Posted Image



- Ask questions in the thread and do not PM me
- Try before asking
- Error is something we will study further

{ 0 komentar... read them below or add one }

Posting Komentar