لطفا در صورتِ "استفاده" حتما در نظر سنجی شرکت و فاتحه ای برای پدر مرحومم قرائت بفرمائید.
فروش مطالب ارزنده زیر به غیر ممنوع و اشکال شرعی دارد ( پیوند دادن منعی ندارد ) لطفا رعایت نمائید !!!
مطالب زیر صرفا به اشتراک گذاشتنِ تجربیات ، و در سایت های خارجی نیز کم و بیش بدان اشاره شده است.(گردآوری از سایت های خارجی جهت مطالعه عموم )
Case WM_NCLBUTTONDBLCLK '&HA3 Client درمنظقه بیرون
SetWindowTextA hWnd, "Dbl Clicked"
WM_NCRBUTTONDOWN 'constant : &HA4 Client درمنطقه بیرون
Using SetWindowTextA
EXIT FUNCTION
تبدیل متن فارسی به کدهای یونیکد برای استفاده ، در پیوندها با عنوان "کاراکتر فارسی" قرار داده شده که می توانید از آن بهره ببرید.البته کد Space را نمی دهد و کد آن 0020 است.
edit-controls
تنظیم و بازیابی تکست درتکست باکس ادیت کنترل :
با تابع SetWindowText می توان متنی به کنترل ویرایش ارسال کرد
یک برنامه می تواند متن کنترل ویرایش را با استفاده از توابع SetWindowText یا SetDlgItemText و یا با ارسال پیام WM_SETTEXT ، تنظیم نماید. طبق این گفته با SetWindowText می توان متن به کنترل ویرایش ارسال نمود.
SetWindowTextA wparam(hwnd),"Hi Mr/Mrs"
An application installs the hook procedure by specifying the WH_CBT hook type and a pointer to the hook procedure in a call to the SetWindowsHookEx function.
برای بازیابی تمام متن داخل کنترل ویرایش اول از تابع GetWindowTextLength یا پیام WM_GETTEXTLENGTH برای تعیین اندازه بافر مورد نیاز برای نگهداری تکست استفاده بنمائید.بعد با استفاده از تابع GetWindowText یا GetDlgItemText یا پیام WM_GETTEXT برای گرفتن یا بازیابی متن اقدام نمائید.
EM_GETTEXT :
Rich Edit: If the text to be copied exceeds 64K, use either the EM_STREAMOUT or EM_GETSELTEXT message
تغییر فونت مورد استفاده در کنترل ویرایش ( Edit ) :
یک برنامه توانایی تغییر فونت را با استفاده از ارسال پیام WM_SETFONT دارد.اکثر برنامه ها این کار را در زمان فرآیند پیام WM_INITDIALOG انجام می دهند.تغییر فونت اندازه کنترل ویراش را عوض نمی کند ؛
محدودیت کاربر در ورود متن :
بعنوان مثالی از کاربرد EM_SETLIMITTEX (Edit Message) و ( EN_MACTEXT ( Edit Notification ، فرض کنید برنامه بایستی کاربر را به ورود بیشتر از 4 کاراکتر در کنترل ویرایش محدود کند . برنامه از EM_SETLIMITTEXT برای مشخص نمودن محدودیت 4 کاراکتر استفاده می نماید.اگر کاربر سعی به وارد کردن پنجمین کاراکتر نماید دستگاه کد اعلان EM_MAXTEXT را به برنامه ارسال می نماید.
پیمایش متن در کنترل ویرایش :
ایجاد Style مورد نظر یعنی WS_VSCROLL با حذف کنترل ویرایش با استفاده از DestroyWindow و جایگزینی آن با ایجاد این کنترل در مختصات قبلی ( CreateWindowEx )
Dim p1,p2 As POINTAPI
Dim EditRect As Rect
hFont=SendMessageA(hEdit,WM_GETFONT,0,0)
GetWindowRect hEdit,EditRect
DestroyWindow hEdit
With EditRect
p1.x=.Left : p1.y=.Top
p2.x=.Right :p2.y=.Bottom
ScreenToClient EditRect,p1
ScreenToClient EditRect,p2
.Left=p1.x : .Top=p1.y
.Rigth=p2.x : .Botton=p2.y
End With ' Edit Control Types and Style
برای اضافه کردن Scroll bar افقی از استایل WS_HSCROLL و اسکرول بار عمودی از WS_VSCROLL استفاده بنمائید.یک کنترل ویرایش با اسکرول بارها پیام های اسکرول بار خودش را انجام می دهد یا پروسس می کند.
Scroll Bars
سیستم سه پیام که برنامه می تواند به کنترل ویر ایش دارای Scroll bar ها ارسال کند را فراهم می نماید.پیام EM_LINESCROLL می تواند بصورت هم افقی و هم عمودی در کنترل ویرایش چند خطه ( MUTILINE ) پیمایش کند ( در خطوط جابجا شود ) . پارامتر lParam شماره تعداد؟ خطوط برای پیمایش عمودی که از خط جاری شروع می شود را مشخص می کند و پارامتر wParam تعداد کاراکترها برای پیمایش افقی ، شروع از کاراکتر جاری را مشخص می نماید. کنترل ادیت پیام دانش تشخیص پیمایش افقی ، اگر استایل EM_CENTER یا EM_RIGHT داشته باشد را ندارد.
پیام EM_LINESCROLL فقط در کنترهای ویرایش چند خطه کاربرد دارد.
پیام EM_SCROLL کنترل ادیت را عمودی پیمایش می کند.پارامتر wParam عمل پیمایش را مشخص می نماید.پیام EM_SCROLL فقط در کنترهای ادیت چند خطه کاربرد دارد. EM_SCROLL همان اثر پیام WM_VSCROLL دارد.
پیام EM_SCROLLCARET چیست ؟
SendMessage RichEdit1.handle, WM_VSCROLL, SB_BOTTOM, 0
تغییر مستطیل قالب بندی Formatting Rectangle :
قابلیت روئت متن کنترل ویرایش توسط ابعاد مستطیل پنجره و مستطیل قالب بندی خودش کنترل می شود. مستطیل پنجره ، .... حاوی کنترل ویرایش است . مستطیل قالب بندی ساختاری است که توسط سیستم برای قالب بندی مان نمایش داده شده در مستطیل پنجره نگهداری می شود.هنگامی که یک کنترل ویرایش برای اولین بار نمایش داده می شود ، دو مستطیل روی صفحه یکسان هستند.یک برنامه می تواند مستطیل قالب بندی را بزرگتر از مستطیل پنجره کند ( در نتیجه دید متن کنترل ویرایش را محدود می کند ) یا کوچک ت از مستطیل پنجره ( درنتیجه فضای سفید اضافی در اطراف متن ایجاد می نماید.)
یک برنامه می تواند مختصات مستطیل قالب بندی کنترل ویرایش را با ارسال پیام EM_SETRECT تنظیم بنماید. پیام EM_SETRECT همچنین بطور خودجوش متن کنترل ویرایش را دوباره ترسیم می نماید.برای تعیین مختصات مستطیل قالب بندی بدون ترسیم مجدد متن کنترل ، یک برنامه می تواند یک پیام EM_SETRECTNP برای کنترل ارسال نماید.برای بازیابی یا گرفتن مختصات مستطیل قالب بندی ، یک برنامه می تواند یک پیام EM_GETRECT به کنترل ارسال نماید. این پیام ها فقط برای کنترل های ویرایش چند خطی کاربرد دارد.
EM_GETLINE :
یک خط از متن کنترل ویرایش را کپی کرده و داخل بافر مشخص شده قرار می دهد. پارامتر wParam درکنترل ویرایش چندخطه یا MultiLine ایندکس لاین است که Zero Base است یعنی ایندکس اولین خط صفر است و اعداد ترتیبی است و برای خط تکی یا SingleL ine از این پارامتر صرفنظر می شود و صفر را قرار می دهید . پارامتر lParam یک بافر است ، برای سیستم Ansi تعداد به Byte نمایش داده میشود و برای unicode تعداد کاراکترهای کپی شده.
برای تنظیم رنگ BackGround برای یک کنترل ویرایش از پیام EM_SETBKGNDCOLOR استفاده بنمائید.
EM_SETCUEBANNER : '&H1501
تنظیم یک تکست محوشو در ادیت کنترل.
نشانه متنی یا Tip که توسط کنترل ویرایش نمایش داده می شود را تنظیم می نماید تا از کاربر اطلاعاتی را درخواست بنماید. در wparam یکی از دو کلمه False یا True استفاده می شود و در پارامتر lparam یک String .
در پارامتر wParam اگر True قرار دهید banner یا نشانه هر وقت که کنترلِ ویرایش فوکس میگیرد می بایست نمایش داده شود.False پیش فرض است و زمانیکه کاربر در کنترل کلیک میکند محو می شود. البته از SendMessageW فقط استفاده کنید چون unicode string هم ارسال می کند مثلا کاراکترهای فارسی که می بایست از Chrw و کد Html مربوطه هر کاراکتر استفاده کنید و حتما داخل StrPtr برای ارسال کدهای Unicode مثل زبان شیرین فارسی !!!
StrPtr : This is often used when passing in UNICODE strings.
EM_LIMITTEXT : '&HC5 محدودیت دروارد کردن کاراکتر
SendMessageA hEdit, &HC5, 5, 0 'lparam not be used
EM_SETPASSWORDCHAR : ' &HCC 'تنظیم نمایش کاراکتردلخواه بجای کاراکترورودی
'Password InputBox
SendMessageA hEdit, &HCC, Asc("*"), 0 'EM_SETPASSWORDCHAR
تغییر رنگ کنترل Static یا Prompt پنجره با کلاس 32770# :( در اکسس 2016 )
در Caption یا Title پنجره متنی حاوی Num و Typing را ملاحظه می نمائید . با SubClass کردن کنترل ویرایش و استفاده از پیغام با کد دسیمال 258 یا WM_CHAR و با استفاده از تابع SetWindowTextA اینکار صورت گرفته.جلوی Num جواب پیام WM_GETTEXT است که با تابع SendMessageA ارسال شده ( تعداد کاراکترهای کپی شده به متغیر بافر ) و جلوی Typing نیز کد اسکی کاراکتر که wparam است قید می شود البته در اینجا از ((Chr(Clng(wparam استفاده شده برای مشخص کردن کاراکتر، الیته یونیکد را پشتیبانی نمی کند.
Case WM_CTLCOLORSTATIC ',WM_CTLCOLORDLG
'Set the Colors
SetBkMode wParam, 1
SetTextColor wParam, RGB(255, 10, 100)
Dim lfont
lfont = CreateFont(22, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "Time New Roman")
SelectObject wParam, lfont
InputBoxProcEx = CreateSolidBrush(RGB(80, 0, 180))
Exit Function
پس با توابع API می توان کاراکترها در کنترل Edit که ماسک شده اند ( یا پوشیده شده زیر کاراکتر دیگر مثل " * ") را گرفته یا بازیابی کرد. "هک"
تغییر رنگ در کنترل ویرایش :
Case WM_CREATE
hBrush=CreateSolidBrush(RGB(255,255,255))
CASE &H133 'WM_CTLCOLOREDIT 307
SetTextColor wParam,cl ' RGB(100,0,250)
InputBoxProc=hBrush
Exit Function ' It Needs
Case WM_DESTROY
DeleteObject hBrush
Sample : InputBoxEx "Hi am here to do somthing !!!","Title",vbRed,"Arial"
CHARFORMATA Structure :
حاوی اطلاعات درباره قالب بندی کاراکتر در یک کنترل rich edit
Type CHARFORMATA
cbSize As Long
dwMask As Long
yHeight As Long
yOffset As Long
crTextColor As Long
End Type
SendMessageA hEdit, EM_SETSEL, start_pos, end_pos
Dim cf As CHARFORMATA
With cf
.cbSize=LenB(cf)
.dwMask=CFM_COLOR
.crTextColor=RGB(255,0,0)
End With
SendMessageA hEdit , EM_SETCHARFORMAT, SCF_SELECTION, cf
yHeight : Character height, in twips (1/1440 of an inch or 1/20 of a printer's point).
wm-command
طبق جدول لینک بالا ، پارامتر lParam در کنترل هندلی است به پنجره آن البته نوتیفیکیشن یا اعلان نیز می فرستد چه زمان فوکس گرفتن ، تغییر و به روز رسانی ، در EN_CHANGE پیام هایی که دریافت شده را ملاحظه بفرمائید.
' If lparam=hRichEdit Then
'1398/07/15
SendMessageA hEdit, EM_GETCHARFORMAT,SCF_SELECTION,cf_old
cf_old.dwMask=CFM_COLOR
SendMessageA hEdit,EM_SETSEL, -1, -1
SendMessageA hEdit,EM_SETCHARFORMAT, SCF_SELECTION,cf)
SendMessageA hEdit,EM_REPLACESEL, FALSE,text
SendMessageA hEdit,EM_SETSEL, -1, -1
SendMessageA hEdit, EM_SETCHARFORMAT,SCF_SELECTION,cf_old
Debug.Print SendMessageA(lParam, 177, 0, 1) '1
Debug.Print SendMessageA(lParam, 176, 0, 0) '65536=1 اگر دو کاراکترانتخاب شده باشد عدد *2 می شود
?196608/3 =65536 'سه کاراکتر انتخاب شده
: CHARFORMAT2
Contains information about character formatting in a rich edit control. CHARFORMAT2 is a Microsoft Rich Edit 2.0 extension of the CHARFORMAT structure. Microsoft Rich Edit 2.0 allows you to use either structure with the EM_GETCHARFORMAT and EM_SETCHARFORMAT messages.
BALLOONTIP : em-showballoontip
Type EDITBALLOONTIP
cbStruct As Long 'LenB
pszTitle As String
pszText As String
ttiIcon As Long
END TYPE
EN_CHANGE & EN_UPDATE : &H300,&H400
wParam : قسمت loword حاوی شناسه کنترل ویرایش است و قسمت hiword آن مشخص کننده کد اعلان یا notification code است.
lParam : هندلی به کنترل ویرایش
پیام EN_CHANGE زمان استفاده از استایل ES_MULTILINE ارسال نمی شود و متن از طریق پیام WM_SETTEXT ارسال می گردد.
پیام EN_UPDATE زمانی ارسال می شود که کنترل ویرایش میخواد خودش را Redraw یا ترسیم بنماید . این کد اعلان بعد از اینکه کنترل متن را قالب بندی یا Formatted کرد ، اما قبل از نمایش متن ارسال می گردد. این امکان تغییر اندازه پنجره کنترل ویرایش را در صورت لزوم فراهم می کند. پنجره والدِ ( Parent Window ) کنترل ویرایش این کد اعلان را از طریق یک پیام WM_COMMAND دریافت می نماید
Select Case uMsg
Case WM_COMMAND
If Hiword(wParam)=EN_CHANGE Then 'Hex(wparam \ &H10000)
SetWindowTextA hwnd,"EN_CHANGE"
End If
End Select
در زیر کدهای اعلان کنترل ویرایش با شناسه 4900 گرفته شده که در نهایت باتن ok فشرده شده و صفر یعنی بسته شدن پنجره
4900...100 ' const EN_SETFOCUS = &H100
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...501 'const EN_MAXTEXT = &H501
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
4900...400
4900...300
1...0 'Push Ok Button
4900...200 ' const EN_KillFOCUS = &H200
بعنوان پیش فرض تابع DefWindowProc رنگ های پیش فرض سیستم را برای کنترل ویرایش انتخاب می کند. کنترل های ویرایش فقط خواندنی یا غیرفعال پیام WM_CTLCOLOREDIT را ارسال نمی نمایند بجای آن ، آنها پیام WM_CTLCOLORSTATIC را ارسال می نمایند.
WM_COMMAND
Case WM_INITDIALOG
m_redcolor=RGB(255,0,0) 'red m_bluecolor=RGB(0,0,255) 'blue m_textcolor=RGB(255,255,255) 'white text m_redbrush=CreateSolidBrush(m_redcolor)'red background m_bluebrush=CreateSolidBrush(m_bluecolor) 'blue background
Case CTLCOLOR_EDIT, CTLCOLOR_MSGBOX
Select Case GetDlgCtrlID(hWnd)
Case 4900 'Edit
SetBkColor hDC,bluecolor
SetTextColor hDC,textcolor
hbr=m_bluebrush
Exit Function
End Select
RED RGB(127, 0, 0)
GREEN RGB( 0,127, 0)
BLUE RGB( 0, 0,127)
LIGHTRED RGB(255, 0, 0)
LIGHTGREEN RGB( 0,255, 0)
LIGHTBLUE RGB( 0, 0,255)
BLACK RGB( 0, 0, 0)
WHITE RGB(255,255,255)
GRAY RGB(192,192,192)
ارسال پیام به کنترل ویرایش در subClass کردن پنجره InputBox و قرار دادن در WM_SETCURSOR پارامتر wParam هندلی است به کنترل
Case WM_SETCURSOR '32
SetWindowLongPtr wStatic, GWL_STYLE, GetWindowLongPtr(wStatic, GWL_STYLE) And WS_TABSTOP
'id=4900 is for Edit Control in window Calss #32770 .... use StrPtr To Transfer Unidoe string
If wParam = OkBtn Then 'Use GetDlgIten
SendMessageA hEdit,WM_SETTEXT, 0, ByVal StrPtr() 'lParam as any WM_TEXT:&HC
ElseIf wParam = CancelBtn Then
SendMessageA hEdit, WM_SETTEXT, 0, ByVal 'lParam as any
ElseIf wParam = wStatic Then
SendMessageA hEdit,WM_SETTEXT, 0, ByVal 'lParam as any
Else
SendMessageA hEdit,WM_SETTEXT, 0, ByVal 'lParam as any
End If
When you move or click the mouse over a static child window, the child window traps the WM_NCHITTEST message and returns a value of HTTRANSPARENT to Windows
WindowFromPoint :
The return value is a handle to the window that contains the point. If no window exists at the given point, the return value is NULL. If the point is over a static text control, the return value is a handle to the window under the static text control.
if you change any of the frame styles, you must call SetWindowPos with the SWP_FRAMECHANGED flag for the cache to be updated properly
موقعیت باتن Cancel در Screen :
GetWindowRect hhcl, btnr
With btnr
p1.x = .Left: p1.y = .Top
p2.x = .Right: p2.y = .Bottom
ScreenToClient hhwnd, p1
ScreenToClient hhwnd, p2
.Left = p1.x: .Right = p2.x
.Top = p1.y: .Bottom = p2.y
padding = (.Bottom - .Top) + 5
End With
ساخت لینک در ناحیه Static :
بدست آوردن موقعیت ناحیه Static با ID 4901 ( طبق روش بالا ) و تخریب پنجره با DestroyWindow و سپس ساخت کنترل جدید با نام SysLink و ID جدید
syslink-control-reference-structures
طبق داکیومنت دو پیام اعلان با کنترل SysLink در ارتباطند یکی برای Mouse با کد 2- و دیگری برای KeyBoard با کد 4- یعنی NM_RETURN
There are two notification messages associated with the SysLink control—one for the mouse (NM_CLICK (syslink)), and one for the keyboard (NM_RETURN).
طبق داکیومنت ساختار NMLINK حاوی اطلاعات اعلان یا نوتیفیکیشن است . این ساختار را با پیام های NM_CLICK یا NM_RETURN ارسال کنید.
The NMLINK Contains notification information. Send this structure with the NM_CLICK or NM_RETURN messages.
HTNML Code :
StrLink="<a href="https://www.w3schools.com/">Visit W3Schools.com!</a>"
<a href="https://www.qries.com/"><img alt="Qries" src="https://www.qries.com/images/banne _logo.png" width=150" height="70"></a>
Static Style
WM_NOTIFY
توسط یک Common Control به پنجره والدش زمانیکه رویدادی رخ می دهد ارسال می شود.
Sent by a common control to its parent window when an event has occurred or the control requires some information.
قسمت lParam به ساختار NMHDR اشاره می کند که شامل کد اعلان است.
EN_LINK Notification Code
Dim el As NMLINK
CopyMemory el, ByVal lParam, LenB(el)
Select Case el.hdr.nCode
Case (-2)
SetWindowTextA hWnd, el.item.iLink
End Select
CopyMemory lParam,ByVal el, LenB(lParam)
If el.item.iLink = 0 Then ShellExecute 0, "Open", "D:\pik.png", 0, 0, 4
use-syslink-notifications
در لینک بالا استفاده از اعلان های SysLink بیان شده در تصویر زیر نیز nCode استراکچر NMHDR در پنجره immediate window VBE چاپ شده و تصویر زیرین آن از کد 2- استفاده شده وقتی روی هر کدام از لینک ها کلیک می شود کد index ( ساختار LITEM ) مربوطه در Caption و کنترل Edit نمایش داده می شود . ( با موفقیت تست شده با تصویر ارائه گردید.)
Const NM_CLICK = -2
Const NM_DBLCLK = -3
Const NM_RETURN = -4
Const NM_SETFOCUS = -7
Const NM_SETCURSOR = -17
Const NM_CUSTOMDRAW = -12
Const NM_HOVER = -13
Const NM_LDOWN = -20
Const NM_RDOWN = -21
COMCTL
Free Memory
CopyMemory lParam, ByVal nmh, LenB(lParam)
CopyMemory lParam, ByVal nml, LenB(lParam)
CopyMemory nml.item, ByVal tItem, LenB(nml.item)
WM_NOTIFY'
Case (-1249)
SetWindowTextA hWnd, nmh.idFrom
End Select
تغییر رنگ تمام HyperLink ها در WM_NOTIFY و استفاده از ساختار NMCUSTOMDRAW
lhittestinfo
lm-hittest :
If the LM_HITTEST message succeeds, the system fills in LITEM.iLink and LITEM.szID. If the LM_HITTEST message fails, do not assume that any information in LITEM is valid
about-rich-edit-controls
LITEM item{};
item.mask = LIF_ITEMINDEX | LIF_ITEMID | LIF_URL | LIF_STATE;
item.state = LIS_ENABLED | LIS_FOCUSED | LIS_HOTTRACK;
item.stateMask = LIS_ENABLED | LIS_FOCUSED | LIS_HOTTRACK;
'StringcChCopyA
wcscpy_s(item.szUrl, L_MAX_URL_LENGTH, L"http://www.google.com");
SendMessage(syslink_handle, LM_SETITEM, 0, (LPARAM)&item);
SendMessagewParam,WM_NEXTDLGCTL,
GetDlgItem(wParam,loword(CLng(SendMessage(wParam, DM_GETDEFID, 0, 0)))), True
WM_NEXTDLGCTL :
ارسال می شود به پروسیجور دیالوگ باکس برای تنظیم فوکس
کیبوردبه کنترل متفاوت در دیالوگ باکس
DM_GETDEFID : &H400
پیام ویندوزی : بازیابی شناسه کنترل باتن فشاری پیش فرض
برای دیالوگ باکس ،
wParam و lParam در اینجا استفاده نمی شود.
اگر موفقیت آمیز باشد قسمت loword حاوی شناسه کنترل است
GetDlgItem :
تابعی برای بدست آوردن هندل کنترل دو آرگومان دارد
اولی هندلی به دیالوگ باکس حاوی کنترل و دومی شناسه
کنترل مثلا در InputBox آیدی کنترل Ok یک و Cancel
دو می باشد
add-a-hyperlink-to-a-dialog
ساخت Popup Menu :
Type CHARRANGE
cpMin As Long,cpMax As Long
End Type
Type FORMATRANGE
hdc As LongPtr
hdcTarget As LongPtr
rc As RECT
rcPage As RECT
chrg As CHARRANGE
End Type
Type NMHDR
hwndFrom As Longptr
idFrom As Longptr
nCode As Long 'notification code
End Type
Type ELINK
nmh As NMHDR
Msg As Long
wParam As LongPtr,lParam As LongPtr
chrg As CHARRANGE
End Type
Dim lNMH As NMHDR
Dim lLink As ENLINK
Case WM_NOTIFY
CopyMemory lNMH,ByVal lParam,Len(lNMH)
Select Case lNMH.code
Case EN_MSGFILTER
CopyMemorylLink, ByVal lParam, Len(lLink)
If (lLink.Msg = WM_RBUTTONDOWN) Then
lhMenu=CreatePopupMenu()
AppendMenu lhMenu, MF_STRING, 1, "&Action1"
AppendMenu lhMenu, MF_STRING, 2, "&Action2"
GetCursorPos lPt
lResult=TrackPopupMenuEx(lhMenu, TPM_LEFTALIGN Or TPM_RETURNCMD _ Or TPM_RIGHTBUTTON,lPt.x, lPt.Y,hwnd, ByVal 0&)
DestroyMenu lhMenu
Select Case lResult
Case 1
Case 2
End Select
End If
Case EN_LINK
CopyMemoru lLink,Byval lParam,LenB(lLink)
if lLink.Msg=WM_LBUTTONUP) Then
lText=GetPlainText(hwnd)
ltext=Mid(ltext,lLink.chrg.cpMin + 1, lLink.chrg.cpMax - lLink.chrg.cpMin) ShellE
ShellExecute ...
End If
End Select
Case WM_PAINT
تابع تبدیل Twips به PixelX :
Private Function TwipsToPixelX(pTwipsX As Long) As Long
Static Mult As Long
Dim hdc
If Mult = 0 Then
hdc = GetDC(0)
Mult = 1440 / GetDeviceCaps(hdc, LOGPIXELSX)
ReleaseDC 0, hdc
End If
TwipsToPixelX=CLng(pTwipsX / Mult)
End Function
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim ps As PAINTSTRUCT
Dim hdc As Long
Dim strMessage As String
strMessage = "Hello, Win32 GUI(VBA) World!"
Select Case uMsg
Case WM_PAINT
hdc = BeginPaint(hwnd, ps)
TextOut hdc, 0, 0, strMessage, Len(strMessage)
EndPaint hwnd, ps
Case WM_DESTROY
Call PostQuitMessage(0)
Case Else
WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
Exit Function
End Select
WindowProc = 0
End Function
shell_notifyicona :
Public Const NIS_HIDDEN = &H1
Public Const NIS_SHAREDICON = &H2
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const MAX_TOOLTIP As Integer = 64 '128
Public Const GWL_WNDPROC = (-4)
'loadiconmetric
Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
dwState As Long
dwStateMask As Long
szInfo As String * 256
uTimeout As Long
szInfoTitle As String * 64
dwInfoFlags As Long
End Type
Public nfIconData As NOTIFYICONDATA
' list the icon types for the balloon message..
Public Const vbNone = 0
Public Const vbInformation = 1
Public Const vbExclamation = 2
Public Const vbCritical = 3
Public Sub RemoveIconFromTray()
Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub
Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, Tip As String)
With nfIconData
.hWnd = MeHwnd
.uID = MeIcon
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
.uCallbackMessage = WM_RBUTTONUP
.dwState = NIS_SHAREDICON
.hIcon = MeIconHandle
.szTip = Tip & Chr$(0)
.cbSize = NOTIFYICONDATA_V3_SIZE
End With
Shell_NotifyIcon NIM_ADD, nfIconData
End Sub
Public Sub BalloonPopUp()
' ok, create a balloon popup..
With nfIconData
.dwInfoFlags = vbInformation
.uFlags = NIF_INFO
.szInfoTitle = "ToolTip" & vbNullChar
.szInfo = "Message" & vbNullChar
End With
' ok, write it to the system tray icon
Shell_NotifyIcon NIM_MODIFY, nfIconData
End Sub
NIF_INFO (0x00000010) :
0x00000010. Display a balloon notification. The szInfo, szInfoTitle, dwInfoFlags, and uTimeout members are valid. Note that uTimeout is valid only in Windows 2000 and Windows XP.
برای نمایش اعلان بالن NIF_INFO و متن را در szInfo مشخص نمائید.
برای حذف اعلان بالن ، NIF_INFO و رشته خالی را در szInfo مشخص نمائید.
برای اضافه نمودن آیکون ناحیه اعلان بدون نمایش اعلان پرچم یا نشانه NIF_INFO را تنظیم ننمائید.
TTM_ADDTOOLW (Unicode) and TTM_ADDTOOLA (ANSI)
Private Sub AddToolTip()
Dim tCaretPos As POINTAP
RemoveToolTip
if IsWindow(hToolTip)=0 Then
InitCommonControls
hToolTip = CreateWindowEx(0, "tooltips_class32", 0, WS_POPUP Or TTS_BALLOON,0, 0,0,0, 0, 0, GetModuleHandle(vbNullString), 0)
If hToolTip Then 'False
With tToolInfo 'Structure
.cbSize = LenB(tToolInfo)
GetWindowRect(GetFocus, .cRect) ' گرفتن ابعاد مستطیل پنجره
.hWnd = GetFocus ' گرفتن هندل کنترل
.uFlags = TTF_TRACK 'Or TTF_ABSOLUTE
.uId = GetFocus
.lpszText = "Balloon Text "
SendMessageA hToolTip, TTM_SETTITLEA, lBallonIcon, ByVal sBallonTitle)
End With
SendMessageA hToolTip, TTM_ADDTOOL, 0, tToolInfo
ClientToScreen GetFocus, tCaretPos
GetCaretPos(tCaretPos)
With tCaretPos
.y = .y + 10
SendMessageA hToolTip, TTM_TRACKACTIVATE, True, tToolInfo
SendMessageA hToolTip, TTM_TRACKPOSITION, ByVal 0&,
End With
'SetTimer Application.hWndAccessApp,0,,0,AddressOf MonitorInputBoxPos)
End If
End If
End Sub
Private Sub RemoveToolTip()
' bInputBoxInactive = False
' KillTimer Application.hWndAccessApp, 0
DestroyWindow hToolTip
End Sub
Private hHook A Long
Function CallWndProc(ByVal nCode As Long, ByVal wParam As Long, lParam As CWPSTRUCT) As Long
If lParam.uMsg=WM_CREATE Then Debug.Print "The handle is: " & lParam.hWnd
End If
CallWndProc=CallNextHookEx(hHook, nCode, wParam, lParam)
End Function
'As Per MSDN Documentary
Function NewWindow(ByVal lngCode As Long,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As Long
if lngCode<0 Then
NewWindow=CallNextHook(hHook,lngCode,wParam,lParam)
Exit Function
End If
CallNextHook hHook,lngCode,wParam,lParam
End Function
switch (message) 'ownerdraw button
{
case WM_MOUSELEAVE:
SetWindowText(hwnd, "Leave!");
break;
case WM_MOUSEMOVE:
SetWindowText(hwnd, "Move!");
tme.cbSize = sizeof(TRACKMOUSEEVENT);
tme.dwFlags = TME_HOVER+TME_LEAVE
tme.dwHoverTime = 1;
tme.hwndTrack = hwnd;
TrackMouseEvent(&tme);
break;
case WM_MOUSEHOVER:
SetWindowText(hwnd, "Over!");
break;
خبر فوری : رهبر انقلاب فرمودند: دشمن میگوید هدفش علی خامنهای است؛ ولی دروغ میگوید؛ هدف دشمن، ملت ایران است.راست میگه اگه سید علی هم نباشه بالاخره سپاه هست که امورات رو بدست بگیره بنده خدا سید علی اون دنیا هم بره مظلوم واقع میشه.
عبداله محمدی : هشدار یک امام جمعه درباره افزایش قیمت برنج ایرانی تا کیلویی یک میلیون ریال / گرانی افسار گسیخته و مشکلات معیشتی مردم را در رنج و مشقت قرار داده است ( دهم بهمن 1400 )
کیومرث اشتریان استاد علوم سیاسی دانشگاه تهران در روزنامه شرق نوشت:«هرچه به غرب نزدیک شوید از ما دور میشوید». این منطق روسیه است که به نظر میآید در فاصله معنادار «میز روسی»، در ملاقات اخیر «سران» دو کشور، هویدا شده است؛ یعنی چهرهای دیگر از سیاست خارجی روسیه و تحکیم پیوند روسی-اسرائیلی در مواجهه با ایران.
بنظرم کیفیت رو باید ببرند بالا حتی اگر متریال خوب با قیمت بالا استفاده شود و آنوقت ببینیم آقا چه تدبیری خواهند نمود.به قول معروف هر چقدر پول بدهی آش میخوری !!! ( یا فراموش کرده یا .... )
ده بهمن 1400 : برخی از رسانههای داخل ایران اعلام کردند که تزریق واکسن آسترازنکا در مشهد ممنوع شده است که به دلیل یک مورد فوتی پس از تزریق این واکسن بوده است. اما روابط عمومی دانشگاه علوم پزشکی مشهد اعلام کرد که شایعات درباره آسیبزا بودن واکسن آسترازنکا واقعیت ندارد و توقف موقت تزریق آسترازنکا در مشهد به دلیل عدم موجودی مقطعی آن است.....یکی از عوارض نادر التهاب در ستون فقرات است !!!
یازده بهمن 1400 : محمد هاشمی در صفحه توییترش نوشت:« واکسن آسترازنکا از جمله واکسنهای موثر علیه بیماری کرونا است که صدها میلیون دوز آن در دنیا و حدود ۱۱ میلیون دوز در ایران استفاده شده است. از ابتدا وزارت بهداشت اعلام کرده بود که به دلیل برخی عوارض نادر، در گروه سنی زیر ۵۰ سال سایر واکسنها ارجح هستند.»
بعد از ممنوعالکاری ، من اقدامی نکردم و حتی ارشاد هم نرفتم که ببینم اصلا چرا ممنوع شدم یا درخواست بدهم ممنوعالکاریام را لغو کنند. حتی کسی به من خبر نداد ممنوعالکار شدهام. آن موقع کارگردانها و تهیهکنندهها لیست بازیگرانشان را میبردند ارشاد و به آنها میگفتند هاشمپور فعلا نمیتواند کار کند. دلیل خاصی نداشتند فقط گفتند ایشان خیلی دارد پرواز می کند و مطرح میشود»
11 بهمن 1400 : سرپرست شرکت عمران شهرهای جدید با بیان اینکه طبق بررسیها قیمت ساخت واحدهای نهضت ملی مسکن ۴ میلیون و ۷۰۰ هزار تومان در هر متر مربع تعیین شده است گفت: اولویت ما در اجرای پروژه، سازندگان داخلی هستند ولی به منظور ارتقای تکنولوژی ساخت و کاهش سرعت اجرا مذاکراتی با شرکتهای چینی و ترکیهای داشتهایم.
11 بهمن 1400 : محمدرضا خباز در گفتگویی درباره ادعای انقلابیگری برخی وزرا گفت: از رفتار برخی وزرا احساس می شود، آنها نه انقلابی هستند، نه حق الناس سرشان می شود و نه حقوق مردم برای آنها ارزش دارد. چندی پیش همسر یکی از وزرای دولت سیزدهم که خیلی ادعایش نیز بالاست، برای زایمان به یکی از بیمارستان های خصوصی تهران رفت
وی افزود: نوزاد متولد شده آقای وزیر چون زودتر از موعد به دنیا آمد، تا مدت ها در دستگاه بود بنابراین هزینه بیمارستان زیاد شد. نخست انتظار داشتیم که اگر وزرای دولت سیزدهم انقلابی هستند خود و بستگانشان به بیمارستان های دولتی مراجعه کنند، نه به بیمارستان خصوصی پرهزینه. ثانیا با وجود تخفیف فراوان، بیمارستان نهایتا فاکتور ۲۸۰ میلیون تومانی برای آقای وزیر صادر کرد که او باید این مبلغ را پرداخت می کرد اما آقای وزیر فقط با پرداخت یک میلیون تومان، نوزاد را ترخیص کرد.
ملت چه پول هایی که ندارند ماشالله کدوم بیمه است که سقف زایمانش 280 میلیونه یا هزینه بیمارستانیش ؟؟؟؟ و مشخصه به بیمارستان دولتی اعتقادی ندارند چرا چون همه آموزشی اند دکتر باسواد و باتجربه در بیمارستان دولتی یا جراحی نمی کنه یا بعنوان نمادین و دریافا تسهیلات دولتی مجبور به این کاره !!!
12 بهمن 1400 : روز گذشته خبر رسید که یک نفر ۳۰۰۰ واحد مسکن مهر در اختیار دارد؛ این در حالی است که ارزش این تعداد واحد در اوایل دهه ۹۰ به کمتر از ۸۰ میلیارد تومان میرسید، حالا اما به دلیل برخورداری مالک این تعداد واحد از زیرساختها و امکانات دولتی، صاحب حدود ۳۰۰۰ میلیارد تومان سرمایه است. احمدی نژاد و روحانی انقلابی مبارک باد دهه زجر!!!
14 بهمن 1400 : این در حالی بود که امروز بنا به درخواست رئیس جمهور، سیدحسن خمینی قبل از وی به ایراد سخن پرداخت اما در همین هنگام شبکه خبر ضمن قطع برنامه زنده، به پخش ادامه برنامههای عادی پرداخت و پس از شروع سخنان رئیسجمهور، مجددا پخش زنده را از سر گرفت!
14 بهمن 1400 : فرزندان شهید سلیمانی به عیادت محمد کاسبی بازیگر پیشکسوت سینما و تلویزیون رفتند و انگشتر سردار دلها را به این هنرمند اهدا کردند.
بهمن 1400 : احمدی نژاد در دیدار با جمعی از فرهنگیان که پنجشنبه گذشته، هفتم بهمن انجام شد، اخراج برخی اساتید دانشگاه را به شدت مورد انتقاد قرار داد
بهمن 1400 : حمله یکی از اراذل و اوباش در شیراز به یک مامور پلیس و بریدن شاهرگ او، در فضای مجازی بسیار پربحث شده است. انتشار فیلم تکاندهنده این حادثه، این سوال را برای مخاطبان ایجاد کرده است که واقعا چرا سروان علیاکبر رنجبر با وجود اینکه اسلحه در دست داشت، به سمت مهاجم مسلح شلیک نکرد؟ پیش از این اتفاق نیز اخبار متعدد از گرفتاری بسیاری از محیطبانها بدلیل شلیک به سمت شکارچیان غیرمجاز، این گزاره را پررنگتر میکند که اساسا محافظان محیط زیست سلاح دارند ولی گویی نباید از آن استفاده کنند.
۱۷ بهمن 1400 : با وجود سیر نزولی قیمت دلار، نرخ خرده فروشی انواع برنج خارجی در بازار مصرف همچنان در حال افزایش است بهنحوی که قیمت برنج هندی و پاکستانی به مرز ۳۳تا ۳۵هزار تومان رسیده است. پیش از این نرخ برخی انواع برنج مرغوب ایرانی از ۹۵هزار تومان عبور کرده بود.
18 بهمن : علیرضا مرندی وزیر پیشین بهداش، درمان و آموزش پزشکی در یک برنامه تلویزیونی در شبکه سلامت ضمن دعوت از مردم برای دریافت دزهای واکسن کرونا، از دریافت دُز سوم واکسن کرونا توسط رهبر انقلاب خبر داد و گفت: همانطور که مقام معظم رهبری سه نوبت واکسنشان را تزریق کردهاند و واکسن ایرانی و برکت هم زدند، ما هم باید همینکار را بکنیم، آنهایی که واکسن نزدند عجله کنند.