+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم أسئلة واستفسارات الأعضاء - المنتدى القديم (http://vb4arb.com/vb/forumdisplay.php?fid=94)
+--- قسم : قسم Visual Basic 6 وما قبله (http://vb4arb.com/vb/forumdisplay.php?fid=167)
+--- الموضوع : الجزء الثاني من حزمة الاكواد (/showthread.php?tid=9709)
الجزء الثاني من حزمة الاكواد - derbaliammar - 21-07-13
كيفية تفعيل و تعطيل زر الإغلاق في النوافذ بالكود
في قسم التصريحات العامة
PHP كود :
private declare function getsystemmenu lib "user32" (byval hwnd _
as long, byval brevert as boolean) as long
private declare function getmenuitemcount lib "user32" (byval _
hmenu as long) as long
private declare function removemenu lib "user32" (byval _
hmenu as long, byval nposition as long, byval wflags as long) _
as long
private declare function drawmenubar lib "user32" (byval hwnd as long) as long
private const mf_byposition = &h400&
private const mf_remove = &h1000&
public sub disableclose(frm as form, optional _
disable as boolean = true)
'setting disable to false disables the 'x',
'otherwise, its reset
dim hmenu as long
dim ncount as long
if disable then
hmenu = getsystemmenu(frm.hwnd, false)
ncount = getmenuitemcount(hmenu)
call removemenu(hmenu, ncount - 1, mf_remove or _
mf_byposition)
call removemenu(hmenu, ncount - 2, mf_remove or _
mf_byposition)
drawmenubar frm.hwnd
else
getsystemmenu frm.hwnd, true
drawmenubar frm.hwnd
end if
end sub
أما في زر التفعيل
PHP كود :
call disableclose(me, false)
و في زر التعطيل
PHP كود :
call disableclose(me, true)
كــٍوٍدٍ لوضع الموقع في المفـضـله
PHP كود :
في المديـل
private declare function shgetspecialfolderlocation _
lib "****l32.dll" (byval hwndowner as long, _
byval nfolder as special****lfolderids, _
pidl as long) as long
private declare function shgetpathfromidlist _
lib "****l32.dll" alias "shgetpathfromidlista" _
(byval pidl as long, _
byval pszpath as string) as long
private declare sub cotaskmemfree lib "ole32.dll" _
(byval pv as long)
public enum special****lfolderids
csidl_desktop = &h0
csidl_internet = &h1
csidl_programs = &h2
csidl_controls = &h3
csidl_printers = &h4
csidl_personal = &h5
csidl_favorites = &h6
csidl_startup = &h7
csidl_recent = &h8
csidl_sendto = &h9
csidl_bitbucket = &ha
csidl_startmenu = &hb
csidl_desktopdirectory = &h10
csidl_drives = &h11
csidl_network = &h12
csidl_nethood = &h13
csidl_fonts = &h14
csidl_templates = &h15
csidl_common_startmenu = &h16
csidl_common_programs = &h17
csidl_common_startup = &h18
csidl_common_desktopdirectory = &h19
csidl_appdata = &h1a
csidl_printhood = &h1b
csidl_altstartup = &h1d
csidl_common_altstartup = &h1e
csidl_common_favorites = &h1f
csidl_internet_cache = &h20
csidl_******s = &h21
csidl_history = &h22
end enum
public sub addfavorite(sitename as string, url as string)
dim pidl as long
dim intfile as integer
dim strfullpath as string
on error goto goodbye
intfile = freefile
strfullpath = space(255)
if shgetspecialfolderlocation(0, csidl_favorites, pidl) = 0 then
if pidl then
if shgetpathfromidlist(pidl, strfullpath) then
if instr(1, strfullpath, chr(0)) then
strfullpath = mid(strfullpath, 1, _
instr(1, strfullpath, chr(0)) - 1)
end if
if right(strfullpath, 1) <> "\" then
strfullpath = strfullpath & "\"
end if
strfullpath = strfullpath & sitename & ".url"
open strfullpath for output as #intfile
print #intfile, "[internetshortcut]"
print #intfile, "url=" & url
close #intfile
end if
cotaskmemfree pidl
end if
end if
goodbye:
End sub
في الزر
private sub command1_click()
addfavorite "منتدى فجوال بيزيك لكل العرب", "http://vb4arb.com/vb/forum.php"
end sub
يجب تغيير النجوم بكلمة s h e l l 32
الجزء الثاني من حزمة الاكواد - samee119485r - 21-07-13
جزاك الله خير
وبارك الله فيك