کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

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

کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

به اشتراک گذاری اطلاعات کسب شده در اکسس از سایت آفیس و سایت های تخصصی خارجی

ListBox در InputBox




Vb Uses Unicode For Text String hence delcare SendMessageW instead Of SendMessageA****



: Important Notes

Use -----> LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS 

use -----> SendMessageW,   /   TextoutW

 To Add Item it is important to Use SendMessageA And Byval  "Item" you want to add like 

"SendMessageA hlist, &H180, 0, ByVal "FFF




case WM_DRAWITEM

Dim Buff As String * 255 ' important

GetClientRect pdis.hwndItem, pdis.rcItem

    r = pdis.rcItem

    l = SendMessageW(pdis.hwndItem, LB_GETTEXT, pdis.itemID, ByVal Buff

    SendMessageA pdis.hwndItem, LB_GETITEMRECT, pdis.itemID, r

    TextOutW pdis.hdc, r.Left, r.Top, ByVal Buff, l



"SendMessageA hlist, &H180, 0, ByVal "FFF

       "SendMessageA hlist, &H180, 0, ByVal "HHT

       "SendMessageA hlist, &H180, 0, ByVal "123E

       "سلام" SendMessageA hlist, &H180, 0, ByVal 

        "حاجی"SendMessageA hlist, &H180, 0, ByVal









if pdis.itemid mod 2=. then SetTextColor Else SetTextColor


If pdis.itemAction = ODA_SELECT Then

    ( l = SendMessageW(pdis.hwndItem, LB_GETTEXT, pdis.itemID, ByVal Buff

     SetWindowTextW hwnd, ByVal Buff

     End If










Static OldRect

If pdis.itemAction = ODA_SELECT Then

         ( l = SendMessageW(pdis.hwndItem, LB_GETTEXT, pdis.itemID, ByVal Buff

          SetWindowTextW hwnd, ByVal Buff

          r.Left = r.Left + 15

          (FillRect pdis.hdc, r, GetSysColorBrush(0

          InvalidateRect pdis.hwndItem, OldRect, 1

          OldRect = r

    End If







%WS_CHILD Or %LBS_OWNERDRAWFIXED Or %LBS_MULTICOLUMN Or %LBS_NOTIFY Or %WS_TABSTOP Or %WS_HSCROLL, %WS_EX_CLIENTEDGE