بازیابی یا گرفتن متن داخل کنترل Edit در جعبه InputBox ( کلاس 32770# )

لطفا در صورتِ "استفاده" حتما در نظر سنجی شرکت و فاتحه ای برای پدر مرحومم قرائت بفرمائید.

فروش مطالب ارزنده زیر به غیر ممنوع و اشکال شرعی دارد ( پیوند دادن منعی ندارد ) لطفا رعایت نمائید !!!

مطالب زیر صرفا به اشتراک گذاشتنِ تجربیات ، و در سایت های خارجی نیز کم و بیش بدان اشاره شده است.(گردآوری از سایت های خارجی جهت مطالعه عموم )

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);


creating-a-hyperlink

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 بهمن : علیرضا مرندی وزیر پیشین بهداش، درمان و آموزش پزشکی در یک برنامه تلویزیونی در شبکه سلامت ضمن دعوت از مردم برای دریافت دزهای واکسن کرونا، از دریافت دُز سوم واکسن کرونا توسط رهبر انقلاب خبر داد و گفت: همانطور که مقام معظم رهبری سه نوبت واکسن‌شان را تزریق کرده‌اند و واکسن ایرانی و برکت هم زدند، ما هم باید همین‌کار را بکنیم، آن‌هایی که واکسن نزدند عجله کنند.