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

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

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

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

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

Msgbox در اکسس




A twip is defined as being 1⁄1440 of an inch (approximately 0.0176 mm)


(1÷1,440)×25.4=0.0176388889


1 Inch = 72 Point

1.047"×72=75.384 Point


کنترل های اکسس کنترل های استاندارد VB نیستند . و زمان اجرا در صفحه رسم می شوند.بر خلاف کنترل های VB ،  آنها هندل یونیک و واحدی ندارند. 


Access controls are not standard VB controls.  They're drawn on the screen at runtime. As such, unlike VB controls, they do not have a unique hWnd.



Private Declare Function apiGetFocus Lib "user32" _
Alias "GetFocus" _ () As Long
On Error Resume Next
Function fhWnd(ctl As Control) As Long
Else
ctl.SetFocus If Err Then fhWnd = 0
End Function
fhWnd = apiGetFocus End If
On Error GoTo 0
End Function


getdevicecaps  

const LOGPIXELSX = 88

const LOGPIXELSY = 90

bitmap-functions


loword =Clng(lparam And 255×257)

Hiword=Clng(lparam \ 255×257)

&FFFF(Hex)=65535(Decimal)

Hext (FFFF)To Dec

F=15

16^(3)×15+16^(2)×15+16^(1)×15+16^(0)×15=65535




FORM.WINDOWLEFT

Returns an Integer indicating the screen position in twips of the left edge of a form relative to the left edge of the Microsoft Access window. Read-only.

 یک عدد صحیح را بر می گرداند که موقعیت صفحه ( به twips ) از لبه چپ یک فرم نسبت به لبه چپ پنجره Microsoft Access نشان می دهد و فقط خواندنی است.


یک اینچ برابر 96 پیکسل است بنابراین 0.8 اینچ برابر 76.8 پیکسل است. (  96 × 0.8 )


در اکسس مقدار left یا Top و ... به واحد twips داده میشود برای تبدیل twips به pixle لازم است مقدار برگشتی در (1440÷96) ضرب گردد.فرضا اگر مقدار Top عدد 0.8 اینچ باشد در تکست باکس عددد 1440×0.8 یا 1152 مشاهده می گردد برای تبدیل به پیکسل عدد 1152 را در 1440÷96 ضرب می کنیم و می شود 76.8 پیکسل .


یکی از بندهای بیمه تکمیلی بازنشستگان تامین اشتباهی : توجه:در صورتیکه یکی از بیمه شدگان فوت نماید و اولین قسط حق بیمه بعد از تاریخ فوت از حقوق مستمری بگیر کسر شده باشد امکان پرداخت خسارت بیمه عمر مقدور نمیباشد.دقیقا باید به میت گفت زمانیکه قسط پرداخت شد وفات نماید یا یک قسط توسط تامین  اجتماعی جلوتر از حقوق کسر گردد ... نظام مسخره بیمه ایرانی ... من عذر میخوام بیمه مرکزی هم اطلاع نداره یعنی مسئولی در کشور نیست.( راهکارش 



به برکت متخصیصن کشوری و لشگری مدیر طراحی مرکز توسعه محصولات ایران خودرو گفت: باز شدن کیسه هوا (ایربگ) در هنگام تصادف خودرو، بستگی به شدت ضربه، میزان سرعت و زاویه‌ای دارد که ضربه وارد می‌شود. فرضا در تصادف ضربدری ایربگ مطمئنا عمل نخواهد کرد خخخخ


به برکت نظام مقدس : به منظور تسهیل در خرید مسکن و کاهش آورده متقاضیان، انجمن خانه عمران پیشنهاد ساخت ۳۰ درصد از واحد‌های نهضت ملی مسکن در قالب واحد کوچک متراژ را داده است.سفره ایرانی هر سال کوچکتر از دیروز!!!


امام جمعه قم با اشاره به اقامه نماز رییس جمهوری اسلامی ایران در کاخ کرملین گفت: احتمال این وجود دارد که رییس جمهور ما در کاخ سفید هم نماز بخواند زیرا این نمازی که در کاخ کرملین خوانده شد پیام های مهمی در پی داشت.


خبرگزاری فارس با انتشار ویدیویی هفت دقیقه‌ای«چینش تاریخی اقتدار ایرانی» به تحلیل دیدار رئیسی و پوتین و زبان بدن رئیس جمهوری روسیه پرداخت و مدعی شد: حرکات بدن پوتین می‌گوید او در حین گفتگو با رئیسی دچار استرس بوده و به همین دلیل کراوات خود را دو بار منظم کرده است.



مطالب زیر تکرار مکررات است 



نمونه ای از هوک کردن ساده پنجره Msgbox با کلاس 32770# که در سایر سایت های خارجی قرارداده و پاس داده می شود مثل بنده ، تست شده و عمل میکند البته توابع دیگری هم دارد که آنها ذکر نشده مثل GetClass که از تابع GetClassNameA کتابحانه user32.Dll  استفاده شده ( کارِ این تابعِ API ، پرکردنِ بافری است که مشخص کرده اید و جواب این تابع ، تعداد کاراکترهایی است که در بافر پر کرده.) برای گرفتن Text مربوط به Button یا هر کنترل دیگر در تابع زیر از GetWinText استفاده شده  و در این تابع یا Function از این کتابخانه و تابع با نام GetWindowTextA بهره برده ایم و عملکرد این تابع مثل GetClassNameA می باشد.یکسری ثابت ها در زیر بیان شده مثل GW_CHILD و GW_HWNDNEXT که به ترتیب 2 و 5 هستند و ثابت WH_CBT نیز (4-) است.



MsgboxGrailly "www.accessvba.blogsky.com", vbYesNo, "Salam"






Subclass کردن پنجره Msgbox  با تابع ساختگی تصویر بالا و  ارسال تکست  "WM_RBUTTONDOWN"به ناحیه Caption  زمان RightClick  : تماماً از سایت های بیگانه استخراج شده ولی با مطالعه و تست موفق طبق تصویر زیر


ناحیه Static ارتفاعش زیاد نیست بنابراین نمی توان بیش از حدود 30 تا 36 درجه چرخش داد و یه مشکل وجود دارد اگر سایز فونت ( در ارسال پیام به پنجره با LOGFONT ) بیشتر شود طول پنجره زمان نمایش بیشتر نخواهد شد مگر اینکه قبل از ارسال عرض متن مشخص شود و با تابع MoveWindow یا SetWindowPos تنظیم گردد.




Case &H2 'WM_DESTROY

        DeleteObject hFont

        SetWindowLongPtr hWnd, GWL_WNDPROC, lOrigWinProc

        Exit Function



Public Const WM_SETFONT = &H30
Dim lf As LOGFONT
Dim hFont
 lf.lfHeight = 16
 lf.lfEscapement = 3
If GetClass(hwndChild) = "Static" Then
                hFont = CreateFontIndirect(lf)
                SendMessageA hwndChild, WM_SETFONT, hFont, 1
End If



bitmap

stm-setimage  ' Static ارسال آیکون به ناحیه 

senddlgitemmessagea 'ارسال آیکون

ms940367(v=msdn.10)

wm-nextdlgctl 'set the keyboard focus to a different control in the dialog box.

تنظیم فوکس کیبورد به یک کنترل متفاوت در جعبه دیالوگ مثل Msgbox 

getdlgitem ' If the function succeeds, the return value is the window handle of the specified control.

تابع بالا هندل کنترل مشخص شده را بر می گرداند البته اگر درست عمل کند و موفقیت آمیز باشد.


WM_USER=&H400
BM_SETIMAGE = &HF7
STM_SETICON = &H170
STM_GETICON = &H171
STM_SETIMAGE = &H172

dm-getdefid  ''the low-order word contains the control identifier 'lparam & wparam must be zero

loword(clng(SendMessage wparam,DM_GETDEFID,0,0))

از clng استفاده شد تا خطا ندهد ( عدد بزرگ است ) . مسیج بالا قسمت low word آن البته اگر باتن فشاری نباشد حاوی نشانگر کنترل است و در آرگومان دوم تابع getdlgitem هم می توان استفاده نمود.

DM_GETDEFID = (WM_USER + 0)

DM_SETDEFID = (WM_USER + 1) 



مطالعه کنید و لذت ببرید 


To create a SysLink, call the CreateWindow or CreateWindowEx function, specifying the WC_LINK window class. 95741118

wm-notify

commctrl-nmlink

commctrl-litem

nm-click-syslink

Type NMHDR
hwndFrom As LongPtr
idFrom As Long
uCode As Lonh
End Type


Type LITEM
mask As Long
iLink As Integer
state As Long
stateMask As Long
szID As String
szUrl As String
End Type

Type NMLINK
hdr As NMHDR
item As LITEM
End Type


hWndBtn = CreateWindowEx(0, "Button", "MyButton", WS_CHILD Or WS_VISIBLE, 32, 32, 64, 64, hwnd, 0, 0, 0)

hWndEdit = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", "MyEdit", WS_CHILD Or WS_VISIBLE, 200, 10, 100, 100, hwnd, 0, 0, 0)

hWndBtn = CreateWindowEx(WS_EX_CLIENTEDGE, "Static", "MyLabel", WS_CHILD Or WS_VISIBLE, 10, 100, 100, 40, hwnd, 0, 0, 0)



Public Function WindProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

     If wMsg = WM_COMMAND Then

          If lParam = hWnd_Btn Then MsgBox "Button was clicked!"

    End If

   WindProc = CallWindowProc(WndProcOld&, hwnd&, wMsg&, wParam&, lParam&)

    End Function


Private Function loword(DWord As Long) As Integer

    If DWord And &H8000& Then

        loword = DWord Or &HFFFF0000

    Else

        loword = DWord And &HFFFF&

    End If

End Function


'Create SysLink (HyperLink) Control


Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Const WC_LINK = "SysLink"
Const ICC_LINK_CLASS = &H8000&
Dim hwnd As Long, hSysLink As Long Dim tIccex As InitCommonControlsEx Dim sCaption As String
With tIccex
.Size = LenB(tIccex)
.ICC = ICC_LINK_CLASS
End With
If InitCommonControlsEx(tIccex) Then sCaption = "<a href=" & Chr(34) & "www.google.com" & Chr(34) & ">click here</a>"
hSysLink = CreateWindowEx(0, StrPtr(WC_LINK),StrPtr(sCaption), WS_CHILD + WS_VISIBLE, _ 20, 20, 300, 20, hwnd, 0,vbNullString, 0)
End If
End Sub





createfontindirecta  'GDI32.DLL

getdevicecaps 'GDI32.DLL

getdc 'USER32.DLL


Dim PixelsPerInch As Long
PixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSY)
Private Const LOGPIXELSY As Long =90
-((PointSize * PixelsPerInch) \ 72)



alphablend



taskdialogindirect



جمیله علم‌الهدی، همسر رئیسی : از من خواستند مشابه کتاب میشل اوباما را بنویسم ، همسرم هم تایید کرد / مرز اصلی جنگ نرم ، عفاف و حجاب است



SendDlgItemMessage(hwnd,ID_BTN,BM_CLICK,0,0)





Type NMHDR
hwndFrom As LongPtr
idFrom As Long
uCode As Long
End Type

Type LITEM
mask As Long
iLink As Integer
state As Long
stateMask As Long
szID As String
szUrl As String
End Type

Type NMLINK
hdr As NMHDR
item As LITEM
End Type

اطلاعات در lparam است لذا برای کپی اطلاعات به حافظه و استفاده از اطلاعاتی که نیاز داریم از تابع RtlCopyMemory استفاده می نمائیم که در اینجا با نام استعار CopyMemory اظهار شده.با آرگومانهای زیر 

CopyMemory Destination,Source,Length

'Be aware that the last parameter, Length, is the number 'of bytes to copy into Destination, not the size of 'the Destination.

'use the CopyMemory API to Get a Copy into the 'Variable we setup

Select Case uMsg
       Case WM_NOTIFY
             Dim nmh As NMHDR
             CopyMemory nmh, ByVal lParam, Len(nmh)
                     Select Case lParam.uCode
                          Case NM_CLICK
                         Case NM_RETURN
                             Dim nml As NMLINK
                            CopyMemory nml,ByVal lParam,Len(nml)

                   End Select

End Select




using-window-procedures






اِفاضات در 2بهمنِ1400









ایرنا نوشت: معاون پارلمانی رئیس جمهور گفت: برخی هیاهو می‌کنند که داریم کشور را به چین و روسیه می‌فروشیم در صورتی که اصلاً این گونه نیست و هیچ‌گاه این اتفاق نخواهد افتاد.... ( در ساخت پالایشگاه اراک چینی ها هم سهیم بودند و مردان و زنان چینی هم در پروژه کار می کردند سال های 88 تا 93 ) 


نفرت جاده ای دو طرفه است و وقتی نسبت به افرادی نفرت پراکنی می شود، آنها و اطرافیان شان نیز نفرت متقابل ایجاد می کنند. چند روز قبل، حجه الاسلام محمدرضا زائری فاش ساخت که به خاطر لباس روحانیتی که بر تن دارد، مدام به او در خیابان توهین می شود و اخیراً نیز فیلمی از آزار یک روحانی در فضای مجازی پخش شد. قطعا توهین به هر انسانی و از جمله روحانیون ناروا و محکوم است اما آیا دستکم بخشی از این رفتارها، ریشه در همین نفرت افکنی هایی ندارد که متاسفانه برخی خطیبان مرتکب اش می شوند؟ البته توهین ها بخاطر عملکرد بد مسئولین نظام هست مثل فروش اجباری بیمه عمر به درمان تکمیلی بازنشستگان که در بالا ذکر شد.



فاضل میبدی گفت: فقط صدای یک طیفی در مقام تعریف از دولت و مجلس شنیده می‌شود، باید کسانی که مخالف لایحه بودجه و یا  سفر رئیس‌جمهور هستند و نقد دارند در صداوسیما آزادانه بنشینند و نقد کنند اگر این اتفاقات بیفتد و گفت‌وگو صورت بگیرد، مشکلات ما خیلی کمتر خواهد بود، اما متاسفانه صدا و سیما در دست یک جریان خاصی است و هر چیزی را که امروز در کشور است، تبلیغ و توجیه می‌کنند و هیچ راه و سخنی برای هیچ مقام مخالفی نگذاشته است که این کشور ما را به سمت و سویی می‌برد که نباید برود


در کد زیر که در تایمر فرم اصلی قرار داده شده ، پنجره با کلاس 32770# ( پنجره ویندوزی ) و کپشن Security را پیدا میکند سپس در این دایالوگ باکس ، هندل باتن با کپشن Ok را گرفته و پیام کلیک روی آن را ارسال می کند در ضمن اگر کپشنِ ویندو ، Choose File بود هندل کلاس باتن با کپشن Open را گرفته و تکستی را با پیام WM_SETTEXT به کنترل EditBox کلاس ComboBoxEx32 که کلاس ویندوزی است ارسال می نماید و در آحر پیام فشردن کلید را به باتن Open ارسال می نماید.


Private Sub Timer1_Timer()
Dim x As Long, editx As Long
Dim Button As Long

x = FindWindow("#32770", "Security Alert")
If X Then
    Button = FindWindowEx(x, 0&, "Button", "&Yes")
    If Button Then
        Call SendMessageLong(Button, WM_KEYDOWN, VK_SPACE, 0&)
        Call SendMessageLong(Button, WM_KEYUP, VK_SPACE, 0&)
    End If
Else
    x = FindWindow("#32770", "Choose file")
    If X Then
        editx = FindWindowEx(x, 0&, "ComboBoxEx32", vbNullString)
        If editx Then 
            Button = FindWindowEx(x, 0&, "Button", "&Open")
            If Button Then
                Call SendMessageByString(editx, WM_SETTEXT, 0&, Text5)
                Call SendMessageLong(Button, WM_KEYDOWN, VK_SPACE, 0&)
                Call SendMessageLong(Button, WM_KEYUP, VK_SPACE, 0&)
                Command3_Click ' < whatever this does?
            End If
        End If
    End If
End If
End Sub



تذکر مهم : اگر کدها کار نکرد یا سیستم دچار هنگ یا Crash شد به این دلیل است که یا نحوه اظهار تابع اشتباه است یا کتابخانه که بعد از "Lib" ذکر شده Wrong است و در win64 یا vb7 هستید ولی کدهای شما مربوط به win32 است یا ByVal نگذاشته اید در ابتدای پارامترها و یا دیتا تایپ شما در جایی که نباید Long باشد از Long استفاده شده در حالیکه شما در سیستم 64بیتی هستید پس نحوه اظهار کردن توابع API در WIN32 و WIN64 متفاوت هستند و دیتا تایپ ها نیز مهم هستند لذا اگر سیستم هنگ کرد باید تابع را از اول تا آخر بررسی کنید هم نام تابع و هم آرگومانهای داخلش ، اگر در تابعی فقط آرگومان اول برای شما مهم است و بقیه را احتیاج ندارید باید از کلمه Optional استفاده کنید و اگر پارامترهایی بعد از این نیز دارید باید همه Optional شوند. مثل  ( در ویندوز 32 بیتی )  : 


Public Declare Function FindWindowExA Lib "user32" (ByVal hwnd As Long,Optional ByVal hwndAfter As Long,Optional ByVal sClass As String,Optional ByVal sCaption As String)

اگر بصورت Pivate یا خصوصی بجای Public اظهار شود فقط در همان رویه ( Procedure ) یا استاندارد ماژول( STD Module ) می شود استفاده کرد و دسترسی به این تابع در جای دیگر محیط VBE را به شما نخواهد داد. نحوه اظهار تابع بالا درVB7 یا WIN64 بدین صورت است که کلمه PtrSafe قبل از Function قرار می گیرد و دو پارامتر hwnd اول دیتا تایپ LongPtr بجای Long می گیرند.( اساتید تازه کار بین کلمات حتما فاصله یا Space باشد !!!)



<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="figure" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="SetLayeredWindowAttributes">
          <button id="ShowFormButton" label="sfbtn" keytip="S"
                  supertip="xxxxx" onAction="onAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>


Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Const LWA_COLORKEY = &H1
Private Const LOGPIXELSX = 88 ' Logical pixels / inch in X
Private Const LOGPIXELSY = 90 ' Logical pixels / inch in Y
hDC = GetDC(hWnd)
  XPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
  YPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSY)
  ReleaseDC hWnd, hDC
Image1.BackColor = vbRed 
BackColor = Image1.BackColor
ExStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
  ExStyle = ExStyle Or WS_EX_LAYERED
  Call SetWindowLong(hWnd, GWL_EXSTYLE, ExStyle)
  Call SetLayeredWindowAttributes(hWnd, BackColor, 0, LWA_COLORKEY)


Private rbRibbonUI As IRibbonUI  

Sub onLoad(ribbon As IRibbonUI)
  Set rbRibbonUI = ribbon 
  rbRibbonUI.Invalidate 
End Sub

Sub onAction(control As IRibbonControl)
 On Error Resume Next
  
  Select Case control.ID
    Case "ShowFormButton"
      
    Case Else
      Beep 
      MsgBox Prompt:=control.ID & "rrrr", Buttons:=vbCritical + vbSystemModal, Title:="eee"
      Exit Sub
  End Select
    Exit Sub


سایز فونت در DC 


Type FNTSIZE
Cx As Long
Cy As Long
End Type

Dim textSize As FNTSIZE

'The GetTextExtentPoint32 function 'computes the width and height of the 'specified string of text.

GetTextExtentPoint32 tempDC, StrPtr(xText), Len(xText), textSize 

When the character orientation and the print orientation are 90 degrees apart for the same string, this function returns the dimensions of the string in the SIZE structure as { cx : 18, cy : 116 }.


LOGPIXELSX = 88     ' horizontal DPI (assumed by Windows)
    LOGPIXELSY = 90     ' vertical DPI (assumed by Windows)


گرفتن ابعاد صفحه با تابع getsystemmetrics

Declare Function GetSystemMetrics32 Lib "User32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN=0
Const SM_CYSCREEN=1
Sub ScreenRes()
Dim w As Long, h As Long
w = GetSystemMetrics32(0) ' width in points
h = GetSystemMetrics32(1) ' height in points
End Sub


lngExStyle=WS_EX_STATICEDGE '&H20000

lngExStyle=lngExStyle+WS_EX_WINDOWEDGE '&H100

lngExStyle=lngExStyle+WS_EX_TRANSPARENT '&H20


hStatic = CreateWindowEx(lngExStyle,"STATIC", "Text" , WS_VISIBLE +WS_CHILD + SS_BITMAP,
100, 100, 200, 200, hWnd, (HMENU)10000, Application.hwndAccessApp, 0&)

SetWindowLongPtr hWndCreate,GWL_EXSTYLE,GetWindowLongPtr(hWnd,GWL_EXSTYLE) Or WS_EX_LAYERED


'SetLayeredWindowAttributes hWndCreate, 0, (255 * 20) /100,LWA_ALPHA)
'load bitmap into static

SendMessage hStatic,STM_SETIMAGE, (WPARAM)IMAGE_BITMAP, (LPARAM)hBitmap

'destroy bitmap when it is not required any more

DeleteObject hBitmap





درگ فایل داخل فرم و گرفتن آدرس آن : 


Declare Sub DragAcceptFiles Lib "shell32.dll" _
        (ByVal hWnd As Long, _
        ByVal fAccept As Long)

Declare Sub DragFinish Lib "shell32.dll" _
        (ByVal hDrop As Long)

Declare Function DragQueryFile Lib "shell32.dll" _
        Alias "DragQueryFileA" (ByVal hDrop As Long, _
                                ByVal lFile As Long, _
                                ByVal lpFileName As String, _
                                ByVal cbLen As Long) As Long

'SubClass Window & UnSubClass 

'Call DragAcceptFiles + Subclass win

Sub SubClassHookForm()
DragAcceptFiles(frm.hWnd, 1)
lpPrevWndProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub
'Remove Hook And Cancel Drag Files
Sub SubClassUnHookForm()
SetWindowLong(frm.hWnd, GWL_WNDPROC, lpPrevWndProc)
DragAcceptFiles(frm.hWnd, 0)
End Sub

dragqueryfilew

Const GetNumOfFiles=&HFFFF

Case WM_DROPFILES

'Get the number of dropped files
NumOfFiles = DragQueryFile(hDrop, GetNumOfFiles, 0&, 0)
For i=0 To NumOfFiles
l=DragQueryFile(hDrop:wParam,i,txt,len(txt)
s=s &;Left(Buff$,l)

Next





Write in WindowProc :

'Win MSG

Dim rcClient As RECT
Dim ptClientUL As POINTAPI
Dim ptClientLR As POINTAPI
static ptsBegin As PONITAPI

static ptsEnd As POINTAPI
static ptsPrevEnd As POINTAPI
??static fPrevLine As Boolean= FALSE



Select Case uMsg


case WM_LBUTTONDOWN
SetCapture hwndMain

GetClientRect hwndMain,rcClient 

ptClientUL.x = rcClient.left

ptClientUL.y = rcClient.top
ptClientLR.x = rcClient.right + 1

ptClientLR.y = rcClient.bottom + 1


ClientToScreen hwndMain,ptClientUL

ClientToScreen hwndMain,ptClientLR


SetRect rcClient, ptClientUL.x,ptClientUL.y, ptClientLR.x, ptClientLR.y

ClipCursor rcClient

ptsBegin = MAKEPOINTS(lParam)

'lparam And &HFFFF

'lparamOr & HFFFF


Exit Function



Case WM_MOUSEMOVE


case WM_MOUSEMOVE
  Select Case wParam
       Case MK_LBUTTON  ' 1 wm-lbuttondown
          hdc = GetDC(hwnd)

'wingdi-setrop2  ... gdi32.setrop2

     SetROP2 hdc, R2_NOTXORPEN ' 10
if  fPrevLine Then
MoveToEx hdc, ptsBegin.x, ptsBegin.y,0&)
LineTo hdc, ptsPrevEnd.x,ptsPrevEnd.y
End if 

ptsEnd = MAKEPOINTS(lParam) 'Get loword & Hiword
MoveToEx hdc, ptsBegin.x, ptsBegin.y,0&
LineTo hdc, ptsEnd.x, ptsEnd.y

fPrevLine = TRUE
ptsPrevEnd =ptsEnd
ReleaseDC hwnd, hdc


End Select

Exit Function



Case WM_LBUTTONDOWN

ClipCursor Null

ReleaseCapture

Exit Function


End Select

























ولایت فقید


Islamic Resistance



نماینده، ولی فقیه در سپاه پاسداران گفت: ۹ دی به همه پیام داد، اما زیباترین پیام آن به رهبری انقلاب بود که در خروش مردم در روز ۹ دی ۸۸ فریاد زده شد و دو جمله آن مهم‌تر بود که یکی از آن خشم و تبری و مقاومت و ایستادگی در برابر دشمنان بود و دیگری این بود که "ما اهل کوفه نیستیم"؛ و یافزود: پیام مردم ما بعد از ۱۲ سال هم خطاب به رهبر انقلاب این است که ما ایستاده ایم و ما فرزندان شماییم و ما حاج قاسم‌هایی داریم که همه چیز خود را می‌دهند که انقلاب آسیب نبیند.

حجت الاسلام والمسلمین عبداله حاجی صادقی خطاب به رهبر انقلاب گفت: ما دیگر اجازه نمی‌دهیم که شما در نماز جمعه مظلومانه با امام زمان عج درد دل کنید و فریاد" این عمار" بزنید.وی گفت: امروز زنان ما در مکتب حضرت زهرا بصیرت، صراحت، شجاعت، پشت دشمن شکستن و فرزند دادن در راه انقلاب را آموخته

اند و هر چند دشمن تحریم و تهدید می‌کند، فریاد ملت ما هیهات من الذله است.


منظور ایشان از زنان بابصیرت همانانیست که با موی بیرون ریخته از زیر شال ( قطعا روسری پو ش نیستند ) در راهپیمایی ۲۲ بهمن شرکت می کنند و پیروزی انقلاب اسلامی را جشن می گیرند امید که در ۲۲ بهمن شاهد خیل عظیم این بابصیرت ها باشیم که امام زمان هم خشنود بشوند و ایشان فریاد این عمار بر جهانیان بکشند.