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

Font

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

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)

'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

هوک کردن کلاس 32770# مسیج باکس HOOK WINDOW Custom MsgBox خامنه ای تامین اجتماعی کانون بازنشستگان تامین اجتماعی علم الهدی

پروفسور اکسس ایران پنج‌شنبه 30 دی 1400 ساعت 15:36

0 نظر

تابع SendInput

sendinput

mouse_event

input

'SendInput
Type INPUT_TYPE
Public dwType As Integer
Public xi As MOUSEINPUT
End Type

MOUSEEVENTF_LEFTDOWN = &H2
MOUSEEVENTF_LEFTUP = &H4
MOUSEEVENTF_MOVE=&H1
MOUSEEVENTF_RIGHTDOWN=&H8
MOUSEEVENTF_RIGHTUP=&H10

Dim inputEvents(0) As INPUT_TYPE

inputEvents(0).xi.dx = 0

inputEvents(0).xi.dy = 0

inputEvents(0).xi.mouseData = 0

inputEvents(0).xi.dwFlags = M_MOVE + M_LD + M_LU

inputEvents(0).xi.dwtime = 0

inputEvents(0).xi.dwExtraInfo = 0

inputEvents(0).dwType = INPUT_MOUSE

SendInput(1, inputEvents(0), Len(inputEvents(0)))

.

تابع SendInput SendInput Mouse Event رویداد ماوس رویداد Mouse

پروفسور اکسس ایران چهارشنبه 29 دی 1400 ساعت 22:52

0 نظر

تابع ShowWindow و GetWindow در API

showwindow

Dim IE As Object
    Set IE = CreateObject("internetexplorer.application")
    IE.Visible = True
    ShowWindow IE.hwnd, SW_SHOWMAXIMIZED
    IE.Navigate "http://www.google.com"    
    
    Do While IE.ReadyState <> 4: DoEvents: Loop
    Do While IE.Busy: DoEvents: Loop

' Close internet explorer

IE.Visible=True

ShowWindow IE.hwnd,3

Sleep 600

SendMessageA IE.hwnd,&H10,0,0

findwindow

getwindow

hWndP=FindWindow(vbNullString,vbNullString)
'PARENT WINDOW
Do While hWndP <> 0
hWndP=GetWindow(hWndP,GW_HWNDNEXT)
Loop

enumchildwindows

برای بدست آوردن کلاس پنجره از تابع GetWindowClassA و کپشن اگر Null نباشد از تابع GetWindowTextA استفاده می نمایند

ret=GetClassName(hwnd,Buffer_Variable,len_Buffer)

if Succeed ...ret=NumberOfCharacterSendToBufferVariableYouSpecified

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

Buff$=Space(80) ' Buffer

X=Left(Buff$,Len(Buff$))

X=Left(Buff$,Instr(Buff$,Chr(0))-1)

getsystemmenu

تابعی برای بدست آوردن هندل منوی سیستم ( همان دکمه هایی که بصورت max min close در TitleBar می بینید چه خود برنامه چه فرم یا گزارشات)

destroymenu

تابعی برای محو کردن منوی مشخص شده و آزاد کردن حافظه ای که منو اشغال کرده.

getwindowlongptra : extended-window-styles : window-styles

بازیابی اطلاع پنجره مشخص شده

window-styles :

WS_MAXIMIZEBOX

WS_MINIMIZEBOX

WS_SYSMENU

WS_TABSTOP

setwindowlongptra

تغییر ویژگی پنجره مشخص شده

lstyle=GetWindowLongPtrA(hwnd,GWL_STYLE)

lstyle=lstyle And Not WS_MINIMIZEBOX

SetWindowLongPtrA hwnd,GWL_STYLE,lstyle

setwindowpos

تغییر سایز و موقعیت برنامه در صفحه

Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

SetWindowPos hwnd, 0, tRect.Left, tRect.Top, tRect.Right - tRect.Left, tRect.Bottom - tRect.Top, SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED

Z-Order موقعیت پنجره را در دسته ای از پنجره های همپوشانی نشان می دهد.

پارامتر دوم ( hwndinsertafter ) :

هندلی به پنجره که از پنجره ای در z order پیشی گرفته.این پارامتر باید یا هندل پنجره یا یکی از مقادیر مثل زیر باشد.

HWND_TOP : قرار گرفتن پنجره در بالای زِد اُردِر

SetWindowPos Me.hWnd,HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE

گرفتن هندل پنجره ها ، البته با تابع EnumChildWindows اینکار راحت تر است و به تابع زیرآن نیازی نیست

EnumChildWindows hwnd,AddressOf EnumChildWnd,1

Function BrowseHandle(hwndParent As LongPtr)
Dim hwndChild As LongPtr
hwndChild = GetWindow(hwndParent, GW_CHILD)
Do While hwndChild
Debug.Print hwndChild & "... Class Name :" & GetClass(hwndChild) & "... Window Text : " & GetWinText(hwndChild)
BrowseHandle hwndChild
hwndChild = GetWindow(hwndChild, GW_HWNDNEXT)
If GetClass(hwndChild) = "Internet Explorer_Server" Then DD = hwndChild
Loop
End Function

984678... Class Name :OSUIBlank... Window Text :
525766... Class Name :OSUIBlank... Window Text :
1050060... Class Name :NUIScrollbar... Window Text : Horizontal
1246666... Class Name :NetUIHWND... Window Text :
656882... Class Name :OSUI... Window Text : SUI
656874... Class Name :NetUINativeHWNDHost... Window Text : RecNavHost
591334... Class Name :NetUIHWND... Window Text :
591330... Class Name :NetUICtrlNotifySink... Window Text :
591336... Class Name :RICHEDIT60W... Window Text : Search
591358... Class Name :NetUICtrlNotifySink... Window Text :
525792... Class Name :RICHEDIT60W... Window Text : 1 of 1
525774... Class Name :OSUIBlank... Window Text :
722376... Class Name :NUIScrollbar... Window Text : Vertical
919166... Class Name :NetUIHWND... Window Text :
919012... Class Name :OSUIBiDiBlank... Window Text :
656920... Class Name :OFormSub... Window Text :
591380... Class Name :OFormSub... Window Text :
657000... Class Name :OGrid... Window Text :
722518... Class Name :Shell Embedding... Window Text :
1115700... Class Name :Shell DocObject View... Window Text :
656938... Class Name :Internet Explorer_Server... Window Text :
656912... Class Name :OFEDT... Window Text :
1181188... Class Name :OKtRichTbx... Window Text :
1377904... Class Name :OKttbx... Window Text :
525842... Class Name :OFormSub... Window Text :

1. Finding a report window handle
Finding a page handle in the page number display area
3. Sending a page number rewrite message
Send an enter key push message

WindowHandle=FindWindow("OReportPopup", vbNullString)
WindowHandle=FindWindowEx(windowHandle, 0, "OSUI", vbNullString)
WindowHandle=FindWindowEx(windowHandle, 0, "NetUINativeHWNDHost", vbNullString)
WindowHandle=FindWindowEx(windowHandle, 0, "NetUIHWND", vbNullString)

WindowHandle=FindWindowEx(windowHandle,0, "NetUICtrlNotifySink", vbNullString)

Handle = 0
For i = 0 To 1 Step 1
Handle=FindWindowEx(windowHandle,Handle, "NetUICtrlNotifySink", vbNullString)
If Handle <> 0 Then
Dim pageNoHandle As LongPtr

pageNoHandle =FindWindowEx(Handle, 0, "RICHEDIT60W", vbNullString)

Dim pageNoCount As Integer

pageNoCount = GetWindowText(pageNoHandle, strWindowText, Len(strWindowText))

SetWindowText(pageNoHandle, "3")

???wrong PostMessage(pageNoHandle, WM_KEYDOWN, 13, lngTemp2)

Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_CHAR = &H102
Call SendMessageLong(x, WM_CHAR, 13, 0&)
Call PostMessage(x, WM_KEYDOWN, VK_RETURN, 0&)

'Click ‘Open’ menuitem
Private Const WM_COMMAND = &H111

Dim hwnd, hWndMenu, hWndSubMenu, MenuItem As Integer

hwnd = FindWindow(vbNullString, "Untitled - Notepad")

hWndMenu =GetMenu(hwnd)

hWndSubMenu =GetSubMenu(hWndMenu, 0)

MenuItem =GetMenuItemID(hWndSubMenu, 1)

SendMessage(hwnd, WM_COMMAND, MenuItem, vbNullString)

PostMessage hWnd, WM_KEYDOWN, VK_TAB, 0& works here. Thanks

Private Const WM_KEYDOWN = &H100

Private Const WM_KEYUP = &H101 Sub

hWind = FindWindow(vbNullString, "Untitled Notepad")

cWind = FindWindowEx(hWind, 0, 0, 0)

Debug.Print PostMessage(cWind, WM_KEYDOWN, vbKeyA, 0)

Debug.Print PostMessage(cWind, WM_KEYDOWN, vbKeyB, 0)

Debug.Print PostMessage(cWind, WM_KEYDOWN, vbKeyC, 0)

ShowWindow internet explorer CreateObject ماکزیمایز کردن اینترنت اکسپلورر

پروفسور اکسس ایران سه‌شنبه 28 دی 1400 ساعت 18:10

0 نظر

ذخیره کردن هر ویرایشی در Single Form

'Save any edits.
    If frm.Dirty Then
        frm.Dirty = False
    End If

ذخیره دیتا در فرم سینگل Dirty

پروفسور اکسس ایران شنبه 25 دی 1400 ساعت 16:10

0 نظر

نحوه ساخت ساعت آنالوگ ( ثانیه شمار ) با استفاده از کنترل Line

کل مطالب زیر استخراج شده است .

Line Control In Access :

The line control displays a horizontal, vertical, or diagonal line on a form or report.

کنترل Line ، یک خط افقی ، عمودی یا مورب را در فرم یا گزارش نشان می دهد.

You can use Border Width to change the line width. You can use Border Color to change the color of the border or make it transparent. You can change the line style (dots, dashes, and so on) of the border by using the BorderStyle property

می توان Border Width را برای تغییر عرض خط استفاده نمود. می توان Border Color را برای تغییر رنگ Border یا ایجاد شفافیت استفاده نمود.می توان با استفاده از ویژگی BorderStyle حالت مشاهده خط را تغییر داد مثل نقطه چین

Seconds :

دایره 360 درجه است و هر دقیقه 60 ثانیه پس زاویه بین آنها 6 درجه می شود.

360÷60=6 Degree

در لینک زیر ویژگیهای شئ بیان شده مثل Height ، Top و Width .

در دایره چهار ربع وجود دارد . ربع اول x و y مثبت است و ربع دوم x منفی است.

عرض : وتر در سینوس آلفا

Width in 6 =1×sin(6×6)=0.587785

طول : وتر در کسینوس آلفا

Hieght in 6 =1×cos(6×6)=0.809016

در بالا عرض و ارتفاع در ثانیه 6 بدست آمد ( طول خط یک در نظر گرفته شد و هر ثانیه 6 درجه است )

Function pi() As Double
    pi = 3.14159265358979
End Function

برای 0 تا 15 درجه ربع اول می توان آرایه ای انتخاب کرد که محاسبات در آن قرار گیرد.

Dim Length As Long

Dim Seconds(0 To 15,1 To 3)

Length=ControlName.Height

For t=0 To15

Seconds(t,1)=6×t ' Angle

Seconds(t,2)=Length × sin(6×t×Pi/180) ' width

Seconds(t,3)=Length × cos(6×t×Pi/180)' height

Next

عرض که مشخص شد ، زمان تغییر ابعاد Top و Height نیز تغییر می کنند.

For i=1 To 15

with ControlName

.Width = Second(t, 2)

.Top =.Top+(Second(t - 1, 3)-Second(t, 3))

.Height =.Height-(Second(t - 1, 3)-Second(t, 3))

End With

در چرخیدن کنترل Line در ربع اول ، به پراپرتی Top اضافه می شود و از پراپرتی Height کم میشود و پراپرتی Width هم حاصلضرب طول خط در سینوس زاویه است.

مقدار Top در بالای سکشن صفر است و هر چقدر به پائین تر بروید اضافه خواهد شد.

Line Control Property Value (Example)

Top=1.0417"

Height=0.7083"

Convert -inches-to-twips

1.0417"×1,440=1500 show textbox or label

Top :

Top=Top+Diff

1,500+(1,500×cos(6×0)−1,500×cos(6×1))=1508

1,500+(1,500×cos(6×1)−1,500×cos(6×2))=1524

1,500+(1,500×cos(6×2)−1,500×cos(6×3))=1540

1,500+(1,500×cos(6×14)−1,500×cos(6×15))=1656

Width :

Width Sec1 : 1,500×sin(6×1)=156 ' عرض در ثانیه یک

Width Sec10 : 1,500×sin(6×10)=1299 ' عرض در ثانیه ده

Width Sec15 : 1,500×sin(6×15)=1500 ' عرض در ثانیه پانزده

Height : 0.7083×1,440=1020

Height=Height-Diff

Height Sec 1 :

Diff Sec1 :1,500×cos(6×0)−1,500×cos(6×1)=8

Diff Sec10 :1,500×cos(6×9)−1,500×cos(6×10)=131

Diff Sec15 :1,500×cos(6×14)−1,500×cos(6×15)=156

Height Sec 1 : 1020-8=1012

Height Sec10 : 1020-131=889

Height Sec 15 : 1020-156=864

fabricatorguide.com

اختلاف بین Top نقطه قبلی و نقطه فعلی می شود چیزی که باید در ربع اول به Top اضافه و از Height کسر کرد.

Diff=length × Cos0-length × Cos 1

.Top=.Top+Diff

.Height=.Hekght-Diff

البته برای بدست آوردن سینوس یا کسینوس زاویه همانطور که در بالاتر قید شد استفاده بنمائید.

موقعیت یک کنترل ، فاصله ی بوردر چپ یا بالا به لبه ی چپ یا بالای سکشن حاوی کنترل است.تنظیم ویژگی Top به صفر ، لبه کنترل را در بالاترین جای سکشن قرار می دهد ( سکشن Detail یا Form header و ... ) . برای استفاده از واحد اندازه گیری متفاوت ، در دیالوگ باکس Regional Options در کنترل پنل ، واحد را مشخص کنید مانند cm یا in ( برای مثال 3cm یا 2in ).

مثال زیر بررسی تنظیم ویژگی Top برای گaزارش درجریان . اگر این مقدار کمتر از حداقل حاشیه شد ویژگیهای NextRecord و PrintSection به False تنظیم می شوند . سکشن به رکورد بعدی پیشروی نمی کند و سکشن بعدی نیز در صفحه مشاهده نمیشود.

The following example checks the Top property setting for the current report. If the value is less than the minimum margin setting, the NextRecord and PrintSection properties are set to False. The section doesn't advance to the next record, and the next section isn't printed.

Sub Detail1_Format(Cancel As Integer,FormatCount As Integer)
Const conTopMargin = 1880
' Don't advance to next record or print next section
' if Top property setting is less than 1880 twips.
    If Me.Top < conTopMargin Then
        Me.NextRecord = False
        Me.PrintSection = False
    End If
End Sub

لطفا در نظرسنجی شرکت فرمائید.

جدیدا کسانیکه واکسن زده اند دچار بیماریهای نادر و خطرناک نقص ایمنی می شوند پس مراقب باشید.

بیماری واسکولیت - وگنر :

( فردریک ونگنر)

کسانیکه ترشحات خونی یا چرک و خون دارند سریعا به پزشک روماتولوژی مراجعه نمایند ( بیماری نقص در خونرسانی و کاهش اکسیژن خون )

تست های خونی متداول افزایش مارکرهای غیر اختصاصی التهاب (ESR,CRP) رانشان می دهند. در گروه عمده ای از بیماران می توان نوعی پادتن بنام ANCA (Anti-Neutrophil Cytoplasmic Antibody را مشاهده نمود.

تصویر برداری از قفسه سینه , سی تی اسکن یا ام آر آی رگ های خونی و اندام های تحت تاثیر را بهتر نشان می دهد

بیوپسی , پزشک از طریق جراحی نمونه کوچکی از بافت آسیب دیده را برداشته و مورد بررسی قرار می دهد.

بیماری بسیار خطرناک وگنر

فائزه هاشمی رفسنجانی در واکنش به اظهارات ائمه جمعه و طرح های مجلس برای اجباری شدن معالجه زنان توسط پزشکان زن گفت: این از یک بُعدش درست است و از یک بّعدش اگر بخواهند در این سیاست بروند، غلط است،

رویداد ۲۴ نوشت : فائزه هاشمی گفت:این دقیقا آدم را یاد سیاست‌های همین الان طالبان می‌اندازد؛ مدام زن‌ها را محدود می‌کنند و زن‌ها را برای یک جاهای خاص گذاشته‌اند و سیستمشان را دارند مردانه می‌کنند.

آنالوگ Analog آسترازنکا

پروفسور اکسس ایران شنبه 25 دی 1400 ساعت 14:19

0 نظر

تابع FreeFile در دستور Open

یک عدد صحیح را برمی گرداند که نشان دهنده شماره فایل بعدی موجود برای استفاده توسط عبارت Open است.

FreeFile [ (rangenumber) ]

آرگومان اختیاری rangenumber متغیری است که محدوده از جائیکه شماره فایل آزادبعدی بازگشت داده می شود را مشخص می نماید. 0 را ( پیش فرض ) برای بازگشت شماره فایل در محدوده 1 و 255 ، 1را برای بازگشت شماره فایل در محدوده 256 و 511 مشخص کنید.

اجازه می دهد سیستم شماره ای برای فایل بعدی که باز میشود را رزرو نماید.( تحت Vba )

کد زیر در پنج فایل تکست لوپ میزند و رشته ی This is a sample را در هر کدام از آنها می نویسد.

Dim MyIndex, FileNumber

For MyIndex = 1 To 5 ' Loop 5 times.

FileNumber = FreeFile ' Get unused file' number.

Open "TEST" & MyIndex For Output As #FileNumber ' Create file name.

Write #FileNumber, "This is a sample." ' Output text.

Close #FileNumber ' Close file.

Next MyIndex

FreeFile Open OutPut تابع FreeFile

پروفسور اکسس ایران پنج‌شنبه 23 دی 1400 ساعت 21:21

0 نظر

Hook و UnHook کردن پنجره برای مدیریت پیام های ویندوزی

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

1- استفاده از تابع SetWindowsHookExA برای ویندوز 64 بیتی یا Vba7 این تابع 3 آرگومان دارد اولی یه ثابت است مثل WH_CBT=5 ( نصب یک رویه زنجیری که اعلان ها را دریافت می نماید CBTProc ) یا WH_MOUSE=7 ( نصب یک رویه که پیام های Mouse را مانیتور می کند MouseProc) دومین آرگومان یک تابع CallBack است وبا AddressOf و نام تابع مشخص میگردد ، سومی hmod که Null است و چهارمین آرگومان شناسه یک Thread است که تابع GetCurrentThreadId را در آن قرار می دهیم.( شناسه ی Thread یا رشته ای که با یک رویه Hook قرار است در ارتباط باشد.برای اپلیکیشن های دسکتاپ اگر این پارامتر صفر باشد رویه هوک مرتبط میشود با تمام Thread های در حال اجرا در دسکتاپ مشابه در زمان فراخوانی Thread )

2-درآمدن از زنجیره ی هوک با تابع UnHookWindowsHookEx که حتما باید انجام گیرد.

دقیقا توابع ویندوزی ( نوشتاری ) به حروف کوچک و بزرگ حساسند یا باید در کتابخانه مذکور موجود باشند.فرضا kernel32 باشد ولی user32 نوشته شود.اینها همه باعث خطا می شود.

Function HookWnd()

hhk=SetWindowsHookExA(WH_CBT,AddressOf CBTProc,0&,GetCurrentThreadId)

End Sub

Function CBTProc(Byval Msg As Long,Byval wParam As LongPtr,Byval lParam As LongPtr) As LongPtr

if Msg=5

'SetDlgItemTextA : Sets the title or text of a control in a dialog box.

UnHookWindowsHookEx hhk

End if

CBTProc=False

End Function

CallNextHookEx :

Passes the hook information to the next hook procedure in the current hook chain. A hook procedure can call this function either before or after processing the hook information.

LRESULT CallNextHookEx( [in, optional] HHOOK hhk, [in] int nCode, [in] WPARAM wParam, [in] LPARAM lParam );

Calling CallNextHookEx is optional, but it is highly recommended; otherwise, other applications that have installed hooks will not receive hook notifications and may behave incorrectly as a result. You should call CallNextHookEx unless you absolutely need to prevent the notification from being seen by other applications.

فراخوانی CallNextHookEx انتخابی است اما به شدت توصیه میشود ، در غیر اینصورت سایر برنامه هایی که hook یا قلاب ها را نصب کرده اند ( رویه های فرعی ) اعلان های hook را دریافت نخواهند کرد و ممکن است نتیجه نادرستی داشته باشند.بایستی این تابع فراخوانی شود ، مگر اینکه کاملا لازم باشد از مشاهده اعلان توسط سایر برنامه ها جلوگیری کنید.

'تغییر ویژگی پنجره مشخص شده

LONG_PTR SetWindowLongPtrA( [in] HWND hWnd, [in] int nIndex, [in] LONG_PTR dwNewLong );

'SubClass Window

Public PreWnd As LongPtr

Public IsSubclassed As Boolean

Function SubClassWnd()

PrevWnd=SetWindowLongPtrA (hWnd,GWLP_WNDPROC,AddressOf WNDProc)

End Function

Function UnSubClassWnd()

if Not IsSubClassed Then

SetWindowLongPtrA (hWnd,GWLP_WNDPROC,PrevWnd)

IsSubClassed=True

Me.Caption=SubClassed

Else

IsSubClassed=False

End If

End Function

گرفتن نام کلاس پنجره با تابع زیر

نام کلاس جعبه پیام ویندوزی 32770# است

int GetClassNameA( [in] HWND hWnd, [out] LPSTR lpClassName, [in] int nMaxCount );

lpClassName:

variable Buffer=String(35,vbNullChar)

nMaxCount:

Len(Buffer)

lRet=GetClassNameA(hWnd,Buffer,Len(Buffer)

If the function succeeds, the return value is the number of characters copied to the buffer, not including the terminating null character.

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

Char=Left(Buffer,lRet)

ارسال پیام به کنترل دیالوگ باکس :

SendDlgItemMessageA( [in] HWND hDlg, [in] int nIDDlgItem, [in] UINT Msg, [in] WPARAM wParam, [in] LPARAM lParam

HANDLE LoadImageA( [in, optional] HINSTANCE hInst, [in] LPCSTR name, [in] UINT type, [in] int cx, [in] int cy, [in] UINT fuLoad

fuLoad:LR_LOADFROMFILE=&H10

BM_SETIMAGE : &HF7 : 15×16+7=247

یک تصویر جدید ( icon یا bitmap ) را با باتن مرتبط می کند

wParam : IMAGE_BITMAP Or IMAGE_ICON

lParam : hBitmap Or hLoadImage Or HICON

h:Handle To

HICON LoadIconA( [in, optional] HINSTANCE hInstance, [in] LPCSTR lpIconName );

IDI_APPLICATION=32512
IDI_HAND=32513
IDI_QUESTION=32514
IDI_ASTERISK=32516

LoadIconA 0&,IDI_APPLICATION

USER32

Programs call functions from Windows USER to perform operations such as creating and managing windows, receiving window messages (which are mostly user input such as mouse and keyboard events, but also notifications from the operating system), displaying text in a window, and displaying message boxes.

برنامه ها توابع را از Windowse User برای اجرای عملیاتی مثل ایجاد یا مدیریت پنجره ها ، دریافت پیام های پنجره ( که کاربر وارد می کند مثل رویدادهای کیبورد و ماوس ، اما همچنین اعلان هایی از سیستم عملیاتی ) ، مشاهده متن در یک پنجره و مشاهده جعبه های پیام فراخوانی می نمایند.

UINT_PTR SetTimer( [in, optional] HWND hWnd, [in] UINT_PTR nIDEvent, [in] UINT uElapse, [in, optional] TIMERPROC lpTimerFunc );

BOOL KillTimer( [in, optional] HWND hWnd, [in] UINT_PTR uIDEvent );

Creating a Timer.

'no timer callback

Private IDT_TIMER1 As Long

Private IDT_TIMER2 As Long

Sub StopClock()
 
    KillTimer 0, lTimerID
    lTimerID = 0
 
End Sub

SetTimer hwnd,IDT_TIMER1,10000,NULL
SetTimer hwnd,IDT_TIMER2,300000,NULL

Select Case Msg

'DECIMAL :1×16^(2)+1×16^(1)+3×16^(0)=275

'HEXADECIMAL : &H113

case WM_TIMER '&H113
     Select Case wParam
         case IDT_TIMER1
            'process the 10-second timer
            'return 0
        case IDT_TIMER2
           'process the five-minute timer
           'return 0
End Select
End Select

hook hook window WH_CBT تایمر Timer SubClass

پروفسور اکسس ایران پنج‌شنبه 23 دی 1400 ساعت 10:24

0 نظر

تبدیل تاریخ میلادی شمسی - اختلاف روزهای شمسی از سال 1300 تا کنون

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

بررسی روش های تبدیل میلادی به شمسی و معایب آن بصورت کاملا تخصصی

بررسی اختلافِ روزها از سال 1300 تا تاریخ شمسی بزرگتر از این تاریخ

بررسی روزِ هفته یِ تاریخ شمسی مورد نظر و مروری بر تابع پربرکت WeekDay در اکسس

بررسی تابع بابرکت Choose در اکسس

بررسی سن فرد

با ما باشید حتی اگر Vba نمی دانید مباحث در انتها شیرین خواهد شد

دوستان گرامی لطفا پس از مطالعه در نظرسنجی شرکت کرده و در صورت لزوم زیر مطلب نظر دهید با تشکر

dDate : "2021/01/04" .... 1400/10/14

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

YY=Year(dDate)=2021

MM=Month(dDate)=1

DD=Day(dDate)=4

Every year that is exactly divisible by four is a leap year, except for years that are exactly divisible by 100, but these centurial years are leap years if they are exactly divisible by 400. For example, the years 1700, 1800, and 1900 are not leap years, but the years 1600 and 2000 are

هر سالی که دقیقا بر 4 بخش پذیر باشد ، سال کبیسه است ( Leap Year ) ، جز سال هایی که بر یک قرن که 100 سال است بخش پذیر باشد . اینها در صورتی کبیسه هستند که دقیقا بر 400 بخش پذیر باشند. مثلا سال های 1700 ، 1800 و 1900 کبیسه نیستند ولی 1600 و 2000 کبیسه هستند.

پس سال 2022 کبیسه نیست و ماه فوریه 28 روز است .

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

IsLeapYear(dDate As Date) As Boolean

Dim GetYear As Long

GetYear=Year(dDate)

IsLeapYear=?

'select iif(612 mod 100=0,iif(612 mod '400=0,True,False),iif(612 mod 4=0,True,False))

?IsLeapYear("2021/01/04"

False

Leap years within your range:1600~2004

1600, 1604, 1608, 1612, 1616, 1620, 1624, 1628, 1632, 1636, 1640, 1644, 1648, 1652, 1656, 1660, 1664, 1668, 1672, 1676, 1680, 1684, 1688, 1692, 1696, 1704, 1708, 1712, 1716, 1720, 1724, 1728, 1732, 1736, 1740, 1744, 1748, 1752, 1756, 1760, 1764, 1768, 1772, 1776, 1780, 1784, 1788, 1792, 1796, 1804, 1808, 1812, 1816, 1820, 1824, 1828, 1832, 1836, 1840, 1844, 1848, 1852, 1856, 1860, 1864, 1868, 1872, 1876, 1880, 1884, 1888, 1892, 1896, 1904, 1908, 1912, 1916, 1920, 1924, 1928, 1932, 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996, 2000, 2004

سرآغاز گاهشماری ایران روز جمعه «۱ فروردین سال ۱ هجری خورشیدی» (۲۹ شعبان ۱ سال پیش از هجرت)^[۷] برابر با ۱۹ مارس ۶۲۲ میلادی قدیم (یولیانی) و ۲۲ مارس ۶۲۲ میلادی جدید (گرگوری) است؛ یعنی، ۱۱۹ روز پیش از مبدأ گاه‌شماری هجری قمری و ۱۷۹ روز پیش از هجرت.^[۸]

کبیسه گیری گاه شمار رسمی ایران :

تقویم رسمی کنونی ایران معمولاً هر چهار سال یکبار کبیسه می‌شود و برای جبران کسر سال حقیقی، در آغاز هر دورهٔ ۲۹، ۳۳ یا ۳۷ساله، یک کبیسه پنج ساله وجود دارد. در یک فراز پنج هزارساله، ما به ازای هر دورهٔ ۳۷ساله، نزدیک به پنج دورهٔ ۲۹ساله و تقریباً ۲۰ دورهٔ ۳۳ساله وجود دارد. ترتیب و توالی کبیسه‌ها قاعده‌مند نیست. چنانچه لحظه تحویل سال خورشیدی بعد از ظهر ۳۶۶اُمین روز از سال باشد، آن سال کبیسه و روز بعد نوروز است.^[۱۴]

برای تشخیص سال‌های کبیسه در گاهشماری رسمی ایران شیوه کاملاً یکنواختی وجود ندارد. برای سال‌های ۱۲۴۴ تا ۱۳۴۲ چنانچه باقی‌ماندهٔ حاصل تقسیم سال مورد نظر بر عدد ۳۳، یکی از اعداد (۱، ۵، ۹، ۱۳، ۱۷، ۲۱، ۲۶ و ۳۰) باشد آن سال کبیسه خواهد بود.^[۷] و برای سال‌های اخیر (سال‌های ۱۳۴۳ تا ۱۴۷۲)، به‌جای ۲۱، باقی‌ماندهٔ ۲۲ ملاک خواهد بود

جدول اعداد تعیین‌کننده کبیسه «تقویم حسابی بهروز-بیرشک» تا سال ۳۲۹۳ هجری خورشیدی حسابی

۰ – ۴ – ۸ – ۱۲ – ۱۶ – ۲۰ – ۲۴ (۲۵) – ۲۹ – ۳۳ – ۳۷ – ۴۱ – ۴۵ – ۴۹ – ۵۳ – ۵۷ (۵۸) – ۶۲ – ۶۶ – ۷۰ – ۷۴ – ۷۸ – ۸۲ – ۸۶ – ۹۰ (۹۱) – ۹۵ – ۹۹ – ۱۰۳ – ۱۰۷ – ۱۱۱ – ۱۱۵ – ۱۱۹ (۱۲۰) – ۱۲۴

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

البته گفته شده چون در چند دوره 33 ساله قرار گرفته ایم مانده عدد تقسیم بر عدد 33 اگر اعدادی در بازه 1 ، 5 ، 9 ، 13 ، 17 ، 21 ، 26 ، 30 بود آن سال کبیسه است البته اگر عدد 22 شد کبیسه ۵ ساله می شود.

سال 1300، 1304 ، 1309 کبیسه هستند.

128 : 1,309−1,280=29

1,375−1,280=95

33 : 1,309−33×39=22 کبیسه پنج ساله

33 : 1,375−41×33=22 کبیسه پنج ساله

سالهای 1399 و 1403 کبیسه 4 ساله و سال 1408 کبیسه پنج ساله هستند چون مانده تقسیم 1408 بر 33 عدد 22 است.

1,408−42×33=22

1,408−11×128=0 طبق جدول

یک راه قرار دادی دیگر که رایانه ای است و سریع قابل محاسبه است نیز داده شده

(۱۳۹۱+۲۳۴۶)×(۰/۲۴۲۱۹۸۵۸۱۵۶) =۹۰۵/۰۹۶۰۹۹۲۹۱

اگر عدد اعشار که درمثال بالا 0.096099291 از عدد 0.24219858156 کمتر بود آن سال کبیسه است یا

(1,408+2,346)×0.2421985815=909.213474951

که عدد اعشاری کمتر از عدد اعشاری ضرب شده است و بنابراین سال کبیسه است البته تا 2346 اعتبار دارد.

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

تاریخ 1/1/1 برابر است با 22 مارس 622 میلادی ... برای بدست آوردن اختلاف روز میلادی در دو بازه این تاریخ و تاریخ میلادی مد نظر را بدست می آورید و بعد می توانید از یک Counter استفاده کنید که یکی یکی increment شود و به 1/1/1 اضافه شود واگر سالی کبیسه بود برج 12 آن 30 روزه در نظر گرفته شود.

Function IsShamsiLeapYears(y As Integer) As Boolean

Select Case y Mod 33

Case 1, 5, 9, 13, 17, 21,22, 26, 30 'No : 22 Leap 5

IsShamsiLeapYears = True

End Select

End Function

?IsShamsiLeapYears("1407")

False

?IsShamsiLeapYears("1408")

True

Function IsShamsiLeapYears1(y As Integer) As Boolean

Select Case y Mod 128 And (y <= 3293 or y>473)

Case 0, 4, 8, 12, 16, 20, 24, 29, 33, 37, 41, 45, 49, 53, 57, 62, 66, 70, 74, 78, 82, 86, 90, 95, 99, 103, 107, 111, 115, 119, 124

IsShamsiLeapYears1 = True

End Select

Select Case y Mod 128 And (y>1 Or y <= 473)

Case 25, 58, 91, 120

IsShamsiLeapYears1 = True

End Select

End Function

Function GetMiladiDays(M)

Select Case M

Case 1, 3, 5, 7, 8, 10, 12: DD = 31: Case 4, 6, 9, 11: DD = 30: Case 2: DD = 28

End Select

GetMiladiDays = DD

End Function

Function GetShamsiDays(M)

Select Case M: Case 1 To 6: DD = 31: Case 1 To 11: DD = 30: Case 12: DD = 29: End Select

GetShamsiDays = DD

End Function

غیر از روش Counter بالا که یکم کند ولی دقیق است ، راه دیگری پیشنهاد شده ولی می بایست در صحت و سقم آن کنکاش بیشتری نمود

روش به این ترتیب گفته شده که در حالتی که دو تاریخ کبیسه نیستند .تعداد روزها از اول فروردین تا 10 دی برای سال های غیر کبیسه میلادی که میشود

6×31+3×30+10=286

تعداد روزها از اول فروردین تا 11 دی برای سال های کبیسه میلادی که میشود

6×31+3×30+11=287

365-286=79

365-287=78

البته12 هم اول ژانویه میشود مثل سال 1293 میلادی پس در عملکرد مناسب ماژول زیر باید کنکاش بیشتری کرد.

در نتیجه چون دو سال 1293 میلادی و 671 شمسی کبیسه نیستند لذا اول ژانویه بایدبرابر 10 دی شود درحالیکه 12 دی شد پس محاسبه زیرین قطعا به مشکل برخواهد خورد .

فرضا میخواهید معادل شمسی تاریخ میلادی 1997/01/20 را بیابید مراحل زیر را طی کنید البته در بعضی موارد با اختلاف یک روز می دهد که بعدا شرح می دهیم

1-بدست آوردن روزهای سپری شده از ماه میلادی ، چون سال 1997 کبیسه است لذا ماه فوریه می بایست 29 در نظر گرفته شود. در اینجا 20 روز گذشته و به ماه فوریه که 2 میلادی است ربطی ندارد ولی حتما برای ماه های دیگر این نکته فراموش نشود.

Dim YY,MM,DD As single

Dim i As Integer

YY=Year(dDate)

MM=Month(dDate)

DD=Day(dDate)

For i=1 To MM

x=x+iif(i=MM And DD<GetMiladiDays(MM),DD,GetMiladiDays(MM))

2-برای تعیین سال شمسی اگر روزهای گذشته میلادی از 79 ( اختلاف اول ژانویه تا آخر اسفند در صورتیکه دو تا کبیسه نباشند ) کوچکتر بود سال میلادی را منهای 622 می نمائیم .در غیر اینصورت 621 و شاید حالات دیگر هم وجود داشته باشد می بایست چک شود. در اینجا چون کوچکتر است سال شمسی میشود 1375

if x<79 Then y=YY-622 Else y=YY-621

3-اگر سال شمسی کبیسه بود که در اینجا 1375 سال کبیسه است جمع روزهای سال شمسی 366 در نظر گرفته میشود ، در غیر اینصورت 365 .. درنهایت 79 را از آن کم کرده و به روزهای سپری شده میلادی می افزائیم در نتیجه عدد بدست آمده میشود 307=20+79-366

4-عدد 307 بدست آمده را باید در روزهای شمسی سرچ کنید که در کدام ماه می افتد در این مورد جمع ماه ها تا برج 10 عدد 306 است و تا برج 11 عدد 336 پس در ماه 11 قرار دارد ... لوپ زیر بدست آوردن ماه Simulate شده ( cc جمع ماه ها است و این لوپ به انداره مقدار ii برای تابع GetMiladiDays و شرط ادامه پیدا می کند ، شرط : تا زمانیکه جمع ترتیبی ماه های شمسی از یک تا ... کوچکتر از 307 باشد و باصطلاح False شود ) ff در اینجا 307 است.

307>306 ( 10 ) که می شود True و بعد 307> 336(11) و می شود False و در ii=11 این لوپ خاتمه می یابد.

اگر در یک Function استفاده می کنید چون i یکبار در بالا ذکر شده در این لوپ ii استفاده کنید یا i را برابر صفر قرار دهید ( اگر صفر نکنید همان مقدار i در بالا را نقطه شروع قرار میدهد.

Dim ii As Integer

ii = 0

Do While cc < ff '366<366 = False Exit Loop

ii = ii + 1

cc = cc + IIf(ii = 12 And IsShamsiLeaped = True, 30, GetShamsiDays(ii))

Loop

Debug.Print "Shamsi Month :" & ii

ff=307

ii=1 cc=31

ii=2 cc=62

.

ii=10 cc=306 cc<ff 306<307 True

ii=11 cc=336 cc<ff 336<307 False 'Exit Here

So ii=11 And cc=336

5-برای بدست آوردن روز باید روزهای ماه های شمسی را باهم جمع بزند تا به عددی برسد که اختلافش با عدد 307 مثبت باشد.

ff-cc>0 307-306>0 1 True

ff-cc>0 307-336>0 -29 False

?(307-306>0)

True

?(366-336>0)

True

?(366-366>0)

False

خب روش بالا خالی از شکال نیست چون 12 دی 1293 برابر 1 ژانویه است نه 10 یا 11 دیماه که در یکسری وبلاگ ها بیان شده ... پس 12 دی برابر اول ژانویه هم می تواند باشد که بود .... با با حساب می توانید چک کنید.

در تابع زیر تعداد کبیسه های میلادی همانطور که در مطالب بالا گفته شد ، بیان شده فرضا از 1 تا سال 622 میلادی 150 کبیسه وجود دارد که از آن برای محاسبات استفاده می نمایند.

Function NumberOfLeapYears(Year As Long)

For i = 1 To Val(Year) Step 1

c = c + (IIf(i Mod 100 = 0, IIf(i Mod 400 = 0, 1, 0), IIf(i Mod 4 = 0, 1, 0)))

End Function

?NumberOfLeapYears(622)

150

?NumberOfLeapYears(2022)

490

در روش دیگر می توانید مبنا را بگذارید بر تاریخ خاصی

سال های کبیسه شمسی بین 1300 تا 1441 :

1300,1304,1309,1313,1317,1321,1325,1329,

1333,1337,1342,1346,1350,1354,1358,1362,

1366,1370,1375,1379,1383,1387,1391,1395,

1399,1403,1408,1412,1416,1420,1424,1428,

1432,1436,1441

سال های 1309 ، 1342 ، 1375 ، 1408 و 1441 جزء کبیسه های 5 ساله اند که باقیمانده تقسیم آنها به 33 عدد 22 است.

Like : 1300/01/01=1921/03/21

با تابع DateDiff در اکسس اختلاف تا تاریخ روز میلادی فرضا 2022/01/06 گرفته شد و عدد 36816 بدست آمد :

?DateDiff("d","1921/03/21","2022/01/06")

36816

تعداد سال های کبیسه بین مبدا قراردادی ما یعنی از 1921 تا 2022 شد 25 سال :

?NumberOfLeapYearsRange(1921,2022)

25

?(36816-25*366+1)-((36816-25*366)\365+1)*365

292

OR

?(36816-25*366+1)-75*365

292

?292-6*31-3*30

16

1300+25+75=1400 ' سال

10 ' ماه

16 ' روز

1978/09/11 = 1357/06/20

?(20993-14*366+1)-((20993-14*366+1)\365)*365

175

?175-5*31 ' 5+1 =6 ماه

20 'روز

1300+14+43=1357 ' سال

1981/07/20=1360/04/29

?datediff("d","1921/03/21","1981/07/20")

22036 ' اختلاف روزهای میلادی

?NumberOfLeapYearsRange(1921,1981)

15 ' تعداد کبیسه های میلادی دو بازه 1921تا 1981

?(22036-15*366+1)-((22036-15*366+1)\365)*365

122

?(22036-15*366)\365

45

?122-3*31 ' 3+1=4 ماه شمسی

29 ' روز شمسی

1300+15+45=1360 ' سال شمسی

1996/03/20=1375/01/01

?dateDiff("d","1921/03/21","1996/03/20")

27393

?NumberOfLeapYearsRange(1921,1996)

19 ' تعداد کبیسه های میلادی بین 1921 تا 1996

?(27393-19*366+1)\365

56

?(27393-19*366+1)-((27393-19*366+1)\365)*365

0 ' چون صفر شد ماه یک و روز یک را درنظر می گیریم

?1300+19+56=1375 ' سال شمسی

2013/03/20=1391/12/30

?NumberOfLeapYearsRange(1921,2013)

23 ' تعداد سال های کبیسه 1921 تا 2013

?dateDiff("d","1921/03/21","2013/03/20")

33602 ' اختلاف دو تاریخ میلادی که 1921 مبدا قرار دادیم

?(33602-23*366+1)-((33602-23*366+1)\365)*365

0 ?????

?(33602-23*366+1)\365

69 ?????

?1300+23+69

1392 ?????

باز هم به بن بست خوردیم

یک راه دیگر : اختلاف دو بازه میلادی یعنی 1921/03/21 و تاریخ جاری رابدست می آوریم و تقسیم بر 364.25 می نمائیم که تعداد سالهایی که به عدد 1300 اضافه می کنیم بدست آید.

27393\365.24=75

1300+75=1375

27393-75×365.24=0

عدد صفر بدست آمد که ماه و روز را یک میگیریم

1996/03/26=1375/01/07

27,399÷365.24=75

1300+75=1375 ' سال شمسی

27399-75×365.24=6 '6+1 =7 روز شمسی

عدد 6 را با عدد یک جمع می کنیم میشود روز هفتم

33602/365.24=91.999

1300+91=1391 ' سال شمسی

33602-91×365.24=365.16

همانطور که گفته شد مبدا محاسبه ما برای اضافه کردن 1300/01/01 قرار گرفت ( یعنی تعداد اختلاف روزهای میلادی 1921/03/20 و تاریخ میلادی روز یا بزرگتر از 1921 را با DateDiff در اکسس بدست آورده و با Counter به 1300/01/01 اضافه می نمائیم )

20993/365.24=57.47

1300+57=1357 ' سال شمسی

20993-57×365.24=174.32 'int(174.32)=174

174+1=175 ' با روز یک سال 1300 جمع شد

175-5×31=20 ' روز شمسی

5+1=6 ' ماه شمسی

2016/10/31=1395/08/10
DateDiff : 34923 Days

34923/365.24=95.61

1300+95=1395 ' سال شمسی

34923-95×365.24=225.2 ' int(225.2)=225

225+1+6×31-1×30=10 ' روز شمسی

6+1+1=8 ' ماه شمسی

'همانطور که در بالا اشاره شد مبدا 1921/03/21

1992/09/30=???

'select 'datediff("d","1921/03/21","1992/09/30")

26126 ' اختلاف روزهای میلادی

26126/365.24=71.53

1300+71=1371 ' سال شمسی

26,126−365.24×71=193.96 'int(193.96)

193+1-6×31=8 ' روز شمسی

6+1=7 ' ماه شمسی

1921/03/21=?

'select 'datediff("d","1921/03/21","1921/03/21")

0

0\365.24=0

برای این موارد که صفر است هم باید در نظر گرفته شود که عدد بدست آمده باضافه یک شود و در لوپ جمع روزهای سال شمسی قرار بگیرد و ماه مورد نظر و روز را بدست آورد

Function ShamsiDate(dDate As Date)

Dim Miladi As Date, Shamsi

Dim DaysDiff As Long

Miladi = "1921/03/21"

Shamsi = "1300/01/01"

DaysDiff = DateDiff("d", Miladi, dDate)

debug.Print DaysDiff

?shamsiDate("2016/10/31")

34923

البته تابع بالا کامل نشده و فقط اعلام شده که DaysDiff که ازتابع DateDiff گرفته شده پرینت شود.همانطور که ملاحظه می فرمائید خروجی عدد 34923 بدست آمد و این عدد باید به 1300/01/01 اضافه شود.

جمع بندی برای محاسبه از طریق 365.24

34,923÷365.2421985815 =95.618

(34923+1)-95×365.2421985815=225.99

226 1395/08/10

22,036÷365.2421985815 =60 .33

(22036+1)-365.2421985815×60 =122.46

122 1360/04/29

27,393÷365.2421985815=74.99

(27,393+1)−365.2421985815×74=366.07

366 1375/01/01

33,602÷365.2421985815=91.99

(33,602+1)−365.2421985815×91=365.95

365 1391/12/30

20,993÷365.2421985815÷57.47

(20,993+1)−365.2421985815×57 =175. 19

175 1357/06/20

26,126÷365.2421985815=71.53

(26,126+1)-365.2421985815×71=194.80

194 1371/07/08

روش بالا هم بی اشکال نیست چون یک روز اختلاف در آن اجتناب ناپذیر است اگر روش شما تست نشود مثل تصویر زیر خواهد شد که اختلاف یکروز را منجر خواهد شد:

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

1921/03/21 'مبنای ما 1300/01/01

1996/03/20 ' تاریخی که باید تبدیل شود

DateDiff=27393

NumberOfLeapYearsInRange(1921,1996)=19

19-1=18

(27393-18×366)÷365=57

57-1=56

(27393-18×366)-56×365=365

365+1=366 'چون 1300 کبیسه بود

1300+18+56=1374

1374 ' کبیسه نیست و 365 روز دارد

چون عدد 366 بدست آمد به 1374 می افزائیم در نتیجه چون سال 74 کبیسه نیست پس 365 روز و معادل یکسال است در نتیجه سال 75 میشود و یک روز اینجا باقی میماند که میشود روز یکم فروردین

1375/01/01

2013/03/20

NumberOfLeapYearsInRange(1921,2013)=23

DateDiff=33602

23-1=22

(33602-22×366)÷365=70

70-1=69

(33602-22×366)-365×69=365

365+1=366

1300+22+69=1391 ' کبیسه است

چون 1391 کبیسه است لذا 366 روزه است و در نتیجه سال همان 1391 باقی می ماند و ماه سال میشود 12 و روز نیز میشود 30 اُم ...... پس تاریخ میلادی 2013/03/20 معادل 1391/12/30 شد.

2000/03/20 =????? 137901/01

1921/03/21~2000/03/20

DaysDiff=28854

NumberOfLeapYersInRange(1921,2000)=18

18-1=17

(28854-17×366)÷365=62.005

62-1=61

(28854-17×366)-365×61=367

1300+17+61=1378

خب باروش بالا هم به بن بست خوردیم

پس دقیق ترین روش استفاده از Counter است که تعداد اختلاف روزها را به 1300/01/01 اضافه کنیم و اینکار اگر بخواهد یک روز یک روز به این تاریخ اضافه کند یک مقدار زمانبر است ولی خب بسیار دقیق است البته کبیسه گیری شمسی نیز در این امر بسیار مهم است !!!

در مثال زیر تعداد کبیسه های شمسی از 1300 تا 1391 23 تاست که کبیسه اول ( چون اختلاف اول فروردین تا 30 اسفند 1300 ، 365 روز است ) و آخر ( سال 91 ) از آن کم شده که تا تقریبا یکسال قبلش بدست آید 91=70+21 ، سال 1391 و کبیسه است پس 366 روز میشود همان 12/30

71-1=70

(33,602−21×366)−70×365=366

(6,574−3×366)÷365=15

15-1=14

(6,574−3×366)-14×365=366

1300+3+14=1317 ' کبیسه است

1317/12/30

(6,575−3×366)−14×365=367

1300+3+14=1317 ' کبیسه است

366 '1317/12/30

1 '1318/01/01

نوشتن لوپ برای کم کردن 365 یا 366 روز از اختلاف روزهای میلادی

'1978/09/11=1357/06/20

ii=0

DaysDiff=DateDiff("d","1921/03/21","1978/09/11")

Diff=DaysDiff

Do

x=Diff-iif(IsLeapYears1(1300+i)=True,366,365)

Y=Year(dDate)+1 ' تابع Year("1978/09/11")=1978

YY=1300+i

ii=ii+1

Loop Until Y=Year(dDate)-1

Debug.Print x

Debug.Print YY

???? Maybe Use But Not Reliable

(6,575−4×366)−13×365=366 '1300+4+13=1317/12/30

از 1921 تا 2013 =92

Right Way '2013/03/20

(33,602+1−22×366)−69×365=366 '1300+22×69=1391/12/30

' Loop : To Get jalali leap years from 1300

t=1300+(2013-1)-(1921+1) '1390

For i = 1300 To t '1390

x = x + IIf(IsShamsiLeapYears1(i) = True, 1, 0)

DoEvents

Num=x

If IsShamsiLeapYears1((1390)) = True Then Num = x - 1

?ShamsiDate()

22

کابرد Doevents : اگر Loop نامناسبی نوشته شد که درجا بزند و انتهایی نداشته باشد دقیقا بعلت اشتباه غلط خودمون بتوانیم با Stop از لوپ خارج شویم وگرنه سیستم هنگ می کند چون لوپ بی نهیت میخواهد اجرا شود.

e = Int((DaysDiff+1 - Num * 366) / 365) - 1

Y=1300+e+Num '1300+22+69

Debug.Print "Contant :" & e

diff = (DaysDiff+1 - Num * 366) - e * 365

Debug.Print "Diff :" & diff

?ShamsiDate("1939/03/21")

DaysDiff :6574

Y :1317

Contant :14

Diff :366

از یک لوپ بعنوان کانتر می شود استفاده کرد که بین 1 تا عدد 366 یا بیشتر که بدست آمد یک Counter یا شمارنده ایجاد بنماید ( حالت افزایشی تکی ) .Increment مثل عبارت Counter استفاده شده در AutoNumber .

'Counter

Function ShamsiDateCounter(yy, diff)

Dim Y As Single

Dim MM, DD, i, a As Integer

For i = 1 To diff

DD = DD + 1

If DD > IIf(MM=12 And IsShamsiLeapYears1(yy) = True, 30, GetShamsiDays(MM)) Then MM = MM + 1: DD = 1

If MM > 12 Then yy = yy + 1: MM = 1

'CurrentDb.Execute ("delete from table2")

'CurrentDb.Execute ("insert into table2 (mah,rooz) values (" & MM & "," & DD & ")")

End Function

?ShamsiDateCounter(1378,36)

1378...2...6

?ShamsiDateCounter(1378,365)

1378...12...29

?ShamsiDateCounter(1378,366)

1379...1...1

?ShamsiDateCounter(1378,368)
1379...1...3
?ShamsiDateCounter(1378,396)
1379...2...1

از کانتر بالا نیز می توان برای چند ماه و چند روز از سال گذشته استفاده کرد . تاریخ شمسی طبق روز میلادی جاری بدست آمده و فقط یک پارامتر Optional به آن اضافه کنید ، اگر مقدارآن True بود تاریخ شمسی را بگیرد و سپس لوپ را تا آن ماه مشخص ادامه دهد.

برای وارد کردن صحیح ماه و روز در تکست باکس در زمان Data Entry یا زمان داده گیری ، می توان در رویداد OnExit خود تکست باکس نوشت در صورتیکه Dirty=True شد چک کند که ماه بین یک تا 12 باشد و روز هم طبق ماهی که وارد شده و کبیسه بودنش اگر نبود Undo کند و در BeforeUpdate فرم هم می توان نوشت که تکست باکس اگر خالی باشد Cance=True شود.

پس راه من درآوردی ما بدین شکل شد :

1-مبنای محاسبه را تاریخ 1921/03/21 معادل 1300/01/01 قرار دادیم.

2-بدست آوردن کبیسه های شمسی بین دو بازه تاریخ میلادی البته یک واحد از سال میلادی مورد نظر کم می کنیم و به مبنا اضافه ، فرضا سال میلادی تبدیلی 2013 است

2012-1922=90 ' 1300+90=1390

تعداد سال های کبیسه از 1300 تا 1390 طبق لیست کبیسه ها که در بالاتر ذکر شده 22 است.اگرسال آخر کبیسه بود یک واحد از تعداد کبیسه ها کم می کنیم.

3-اختلاف روزهای دوبازه تاریخی یعنی مبنا و تاریخ تبدیلی را با تابع بسیار پربرکت DateDiff بدست می آوریم و یک واحد بخاطر جبران سال 1300 مبنا که کبیسه است و اختلاف اول فروردین آن تا 30 اسفند آن 365 روز است ، اضافه می نمائیم . از سایت w3Schools نیز می توانید استفاده کنید اگر سیستم ندارید مثال :

DaysDiff=DateDiff("d","1921/03/21","2013/03/20")

پس طبق تصویر اختلاف روزهای دو تاریخ میلادی شد 33602 روز. و با یک جمع می کنید 33603

4-تعدادکبیسه در 366 را از روزهای بدست آمده کم می کنیم و بر 365 تقسیم می کنیم و عدد صحیح آنرا منهای یک می کنیم :

(33603-22×366)/365=70.0027

Int((33603-22×366)/365)=70

70-1=69

5- 69 را با تعداد کبیسه ها جمع می کنیم میشود 91

6- حاصل عدد 69 در 365 را از حاصل تفریق تعداد کبیسه در 366 و تعداد روزها + یک میشود مانده ی ما یا Diff

(33,603−22×366)−69×365=366

7-عدد حاصله را در یک تابع Counter گذاشتیم تا بگوید 366 روز بعد از سال 91 چه تاریخی خواهد شد .

چون 91 کبیسه است 366 اُمین روزش میشود 12/30 در نتیجه خروجی ما 1391/12/30 خواهد بود.

میشود از کانتر استفاده کرد و عدد 33602 باضافه یک را یکی یکی اضافه کرد تا بعد از 1300 را نشان دهد ولی خب کُندِس و حدود 5 ثانیه طول میکشد تا جواب بدهد.

مثال دیگر : 2022/01/08 ( مبنا 1921/03/21 )

DaysDiff=36818

2022-1-1922=99+1300=1399

Leaps Between 1300 ~ 1399=25

چون 1399 کبیسه است پس یک واحد از تعداد کبیسه کم کنیم.

int((36,818+1−24×366)÷365)=76.80

76-1=75

(36,818+1−24×366)-75×365=660

Y=1300+24+75=1399,Diff=660

چون 1399 کبیسه است 366 از 660 کم میشود و 294 می ماند 294 اُمین روز سال هم میشود 10/18 یا 294=18+30×3+31×6 .... کانتر محاسبه بعد از 1399 را انجام خواهد داد.

1921/03/21-1939/03/20:6573

1921/03/21-1939/03/21:6574

1921/03/21-1939/03/22:6575

اول اضافه کردن یک واحد به سال مبنا که 1921 است و کسر کردن یک واحد از سال تبدیلی که 1939 است

1300+(1,939−1)−(1,921+1)=1316

مورد اول تعداد کبیسه ها از 1300 تا 1316 ، عدد 4 است و خوشبختانه 1316 کبیسه نیست اگر بود از 4 یک واحد کسر می شد.

(6573+1-4×366)/365=14

14-1=13

(6,573+1−4×366)−13×365=365

1300+4+13=1317

سال 1317 کبیسه و 366 روزه است پس 365 اُمین روز آن 12/29 می شود 1317/12/29.

'6575

Diff=(6,575+1−4×366)−13×365=367

1300+4+13=1317 , 367

چون 1317 کبیسه است پس 366 از 367 کم شده و یکسال به سال اضافه میشود ( تابع کانتر را ملاحظه بفرمائید ) سال میشود 1318 و روز و ماه هم یک می شود.

1318/01/01

همانطور که شرح داده شد روش آخر اگر چه حدود دو ثانیه طول می کشد ولی Reliable است البته برای زیر 365 یا 366 نیز چاره ای بیاندیشید.

در مورد زیر :

1921/03/21~1922/03/22=366

1301/01/01

1300+1921+1-(1922-1)=1301

در 1300 تا 1301 یک کبیسه وجود دارد

(366+1-1×366)÷365=0.002

0

if 0 Then

Diff=DaysDiff+1 : Y=1300

End if

Counter (1300,367)

چون 1300 کبیسه است لذا 366 روزه است بعد از ارسال به کانتر باید جواب 1301/01/01 استخراج شود.

1921/03/21~1922/03/21=365

1300+(1921+1)-(1922-1)=1301

1 Leap Years ( jalali )

(365+1-1×366)=0

if 0 Then

Diff=365+1 : Y=1300

Counter(1300,365)

1300/12/30

1921/03/21~1922/06/13

DaysDiff(Use DateDiff)=449

1300+(1921+1)-(1922-1)=1301

(449+1-1×366)÷365=0

if 0 Then

Diff=449+1 : Y=1300

Counter(1300,450)

روش دیگری هم می توانید خلق کنید.

اگر روش های بالاتر را بکار ببرید اختلاف یکروز کاملا مشهود خواهد بود مثل تصویر زیر

ملاحظه کنید کدام یک از روشها بهتر است همان را اجرا بنمائید.البته با تحقیق بیشتر و محاسبات گوناگون !!!

لطفا پس ازاستفاده فاتحه ای برای پدر مرحومم قرائت فرمائید.

اختلاف روزهای شمسی از سال 1300 :

شرح محاسبات :

1-سال شمسی را از سال مبنا که در اینجا 1300 قرار دادیم کم میکنیم

2-تعداد کبیسه ها از 1300 تا یکسال قبل از سال شمسی مورد نظر را بدست آورده و منهای یک می کنیم

3-اختلاف بدست آمده در مرحله یک را در 365 ضرب و به تعداد مرحله 2 می افزائیم

4-تعداد روزهای سپری شده سال شمسی مورد نظر را بدست آورده به مرحله 3 می افزائیم . براحتی اختلاف از سال 1300بدست آمد بدون خطا ، موارد زیر نیز با DateDiff مقایسه گردید. کبیسه ها مهم هستند در محاسبات !!!

سال های کبیسه شمسی بین 1300 تا 1441 :

1300,1304,1309,1313,1317,1321,1325,1329,

1333,1337,1342,1346,1350,1354,1358,1362,

1366,1370,1375,1379,1383,1387,1391,1395,

1399,1403,1408,1412,1416,1420,1424,1428,

1432,1436,1441

2013/03/21=1392/01/01

'jalali leap year 1300-1391=23-1=22

92×365+22+1=33603

2013/03/20=1391/12/30

'jalali leap year 1300-1390=22-1=21

91×365+21+366=33602

چون تا 12/30 میشود 366 روز لذا اضافه شده

select datediff("d","1921/03/21","2022/01/09")

Equivalant :1400/10/19 - 2022/01/09

=36819

'jalali leap year 1300~1399=25-1=24

1400-1300=100

100×365+24=36524

36819-36524=295

295=6×31+3×30+19

100×365+24+6×31+3×30+19=36819

1357/06/20 '1978/09/11 یازدهم سپتامبر

1357-1300=57

'jalali leap year 1300~1356=14-1=13

57×365+13+(5×31+20)=20993

select datediff("d","1921/03/21","1978/09/11")

1378/10/10-1999/12/31

1378-1300=78

jalali leap years 1300~1377=19-1=18

78×365+18+(6×31+3×30+10)=28774

1378/10/11-2000/01/01

1378-1300=78

jalali leap years 1300~1377=19-1=18

78×365+18+(6×31+3×30+11)=28775

دو عدد بالا را با تصویر زیر مقایسه کنید اینهم اثبات روش

1300~1391 'کبیسه ۲۲ منهای یک

91×365+21+6×31+3×30+12=33524

کبیسه های میلادی از 1920 تا 2104 :

Leap years within your range:

1920, 1924, 1928, 1932, 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996, 2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, 2056, 2060, 2064, 2068, 2072, 2076, 2080, 2084, 2088, 2092, 2096, 2104

تبدیل شمسی البته بعد از سال 1300 به میلادی چون سال مبنا را 1300/01/01 معادل 1921/03/21 قراردادیم

1921+(1391-1300)=2012

'Leap Years 1921~2011

33,524+(31+28+21)−91×365−22=367

سال 2012 کبیسه است و 366 روزه در نتیجه چون عدد 367 بدست آمد یک واحد به سال 2012 اضافه و روز و ماه نیز یک میشود

2013/01/01

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

تعداد روزهای میلادی به ترتیب از سمت چپ :

31,28 or 29 31,30,31,30,31,31,30,31,30,31

1357/06/20 '1978/09/11 یازدهم سپتامبر

1357-1300=57

1921+(1357-1300)=1978

ShamsiDiff=20993

'1921/03/21=80 (31+28+31)

'Leap Years 1921~1977

20993+80-57×365-14=254

Or

20,993−365−56×365−14=174

174+80=254

1378/01/01

ShamsiDiff=28775(1300/01/01~1378/01/0)

1921+(1378-1300)=1999

'Leap Years 1921~1998=19

28775+80-78×365-19=366

سال 1999 کبیسه نیست و 365 روز دارد پس 366 اُمین روز میشود 2000/01/01

مبحث شیرینی بود پس در تبدیل ها ما 1300/01/01 را برای شمسی و معادلش 1921/03/21 را مبنا قرار دادیم و برای تبدیل شمسی به میلادی از تابعی استفاده شود که طبق معادلات قبل تر اختلاف دقیق تاریخ شمسی مد نظر با مبنا را بگیرد و در معادله بالا قرار داده شود.

بررسی تابع Weekday در اکسس

In MS Access, The weekday() function returns the weekday number for a given date.

این تابع شماره روز هفته تاریخی را بر می گرداند که از یک یعنی یکشنبه شروع میشود و به 7 یعنی شنبه ختم میشود .در نتیجه شماره 6 میشود روز جمعه برای تاریخ میلادی مناسب است .

برای اینکه بدانیم تاریخ شمسی بدست آمده چه روزی است کافیست یک شماره به روز مبنا بدهیم ( در اینجا تاریخ میلادی مبنا روز دوشنبه 21 مارس 1921 قرار گرفت ) در تابع WeekDay که رفرنس است عدد دوشنبه 2 می باشد پس هر عددی که بدست آوردیم را باضافه این عدد می کنیم و تابعی می نویسیم که روز هفته را به فارسی بر گرداند . در تابع WeekDay عدد یکشنبه 1 است میتوان با همان تابع عدد را در متغیری ذخیره کرد .

DaysNo=Weekday(#1921/03/21#)=2

'SELECT Weekday(#1921/03/21#)

WeekDay(#1921/03/21#)=2 ' دوشنبه

جمع این عدد با مانده تقسیم اختلاف روزها بر 7

DaysDiff=20993 '1921/03/21~1978/09/11

2+20993 Mod 7=2+0=2 ' دوشنبه

DaysDiff=22766 '1921/03/21~1983/07/20

2+22766 Mod 7=2+2=4 ' چهارشنبه

DaysDiff=33524 '1921/03/21~2013/01/01

2+33524 Mod 7=2+1=3 ' سه شنبه

DaysDiff=31309 '1921/03/21~2006/12/09

2+31309 Mod 7=2+5=7 ' شنبه

Var1=2+DaysDiff Mod 7

Choose(Var1,"Yek","Do","3eh","4ar","5anj","jom","Shan")

از تابع Choose نیز می توان استفاده نمود : index از یک شروع می شود.

برای بدست آوردن سن به سال ، ماه و روز می توان اختلاف تاریخ سن و تاریخ جاری را بدست آورد و تقسیم بر 365.24 کرد و مانده را نیز تقسیم بر 30.437 نمود.

1334/03/28~1400/10/18

ShamsiDiff=24312

'jalali leap years 16

24312÷365.24=66.56 'int(66.56)=66 ' سال

24312-365.24×66=206.16

206.16÷30.437=6.64 'int(6.64)=6 ' ماه

206.16-6×30.437=23.538 'int(23.538)=23 ' روز

البته محاسبه با این روش نیز اختلاف یک یا دو روز مشهود است

محاسبه تصویر بالا برای مشخص کردن سن بدین شکل است :

(ShamsiDiff-jalaliLeapYears)÷365=ExtractYear

(ShamsiDiff-jalaliLeapYears)-365×int(ExtractYear)=Remain

سال مشخص شد منظور ExtractYear است . و ملاک محاسبه ماه و روز ، ماه تولد است یعنی اگر ماه تولد 4 باشد ماه 4 و 5 ، 31 روزه محاسبه میشود و 6 و ... ، 30 روزه . یا اگر متولد برج 7 باشید ببعد 30 روزه کم میشود می بینید باز هم احتیاج به ساخت تابع جدیدی است.یا اگر متولد فروردین باشید 1 تا 6 ، 31 روزه در نظر گرفته خواهد شد.

اختلاف روزهای شمسی و میلادی :

1921/03/21:

1,920×365+(31+28+21)+480:1920÷4=701360

1300/01/01

1299×365+1+324:1299÷4=474460

701,360−474,460=226900

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

این فعال مدنی پیشتر نیز به‌دلیل کمک به خانواده قربانیان اعتراضات ضد نظام و برخی اظهارات انتقادآمیز از شرایط کشور چندین بار توسط نهادهای امنیتی فراخوانده و بازداشت شده بود.

ایسنا نوشت:بر اساس گزارشی، یک سری ایمیل‌های افشا شده نشان می‌دهد چندین دانشمند آمریکایی و انگلیسی بر این باور بوده‌اند که ویروس کرونا به صورت تصادفی از یک آزمایشگاه ووهان به بیرون نشت کرده اما این نگرانی را داشتند که بحث بیشتر بر سر این مساله، به مبحث علم در چین آسیب وارد کند.

قبیله موسو در چین

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

چند شوهری

این قبیله در دامنه‌های هیمالیا وجود دارد و توسط زنان اداره می‌شود و مردان آن به کلی به حاشیه رانده شده‌اند. در واقع نظام کمونیستی نتوانست تنوع فرهنگی این مردم را بر طبق اهداف کمونیستی، یکسان ساز کند. در این قبیله بسیاری از کارهای مهم توسط زنان انجام می‌شود اما شکار و ماهیگیری را همچنان مردان انجام می‌دهند.

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

خانه بهروز وثوقی :

امام جمعه رفسنجان عنوان کرد: جمعیت عظیمی از شهدای بسیج داریم که به‌دلیل غیرت دینی خود در صحنه به شهادت رسیدند. دشمنان دنبال این هستند که غیرت دینی را در جامعه کمرنگ کنند، اگر به جایگاه رهبری و ولایت فقیه توهین شود، برای کمرنگ‌کردن غیرت دینی است. اگر مسأله بدحجابی یا بی‌حجابی را در جامعه ترویج می‌کنند یا یک خانم را از سر بی‌دینی و نفهمی تشویق می‌کنند که دوچرخه‌سواری کند، با اینکه دوچرخه‌سواری بانوان در انظار عموم حرام است، دنبال خدشه‌دار کردن غیرت دینی مردم هستند.

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

سیداحمد میرعلایی، تهیه‌کننده پیشکسوت سینما و مدیر فرهنگی در مراسم بزرگداشت جمال شورجه گفت آن‌ها که می‌گفتند بچه‌مذهبی‌ها می‌خورند و می‌چاپند زندگی جمال شورجه را مطالعه کنند و ببینند که چگونه زندگی می‌کند.

لطفا نظر سنجی فراموش نشود

آیا میدانید پیامک های دارای لینک اینترنتی عمدتا به منظور کلاهبرداری و سرقت اطلاعات بصورت فیشینگ مورد استفاده قرار گرفته و سازمان ها و سایت های رسمی (مانند ثنا، عدل ایران، یارانه، واکسن و کارت سوخت) بدون اطلاع و درخواست کاربر، پیامکی دارای لینک ارسال نمی کنند؟

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

تبدیل میلادی به شمسی تبدیل تاریخ میلادی به شمسی تبدیل تاریخ میلادی شمسی وام نهضت ملی مسکن ملی طرح مسکن ملی کرونا

پروفسور اکسس ایران سه‌شنبه 14 دی 1400 ساعت 19:46

0 نظر

تابع ویندوزی Mouse_Event برای Right Click در صفحه

Right-Click در سنتر :

right-click the "center" of your webbrowser

mouse_event

void mouse_event( [in] DWORD dwFlags, [in] DWORD dx, [in] DWORD dy, [in] DWORD dwData, [in] ULONG_PTR dwExtraInfo );

dwFlags :

MOUSEEVENTF_RIGHTDOWN=&H8

MOUSEEVENTF_RIGHTUP=&H10

تنظیم موقعیت کرسر در وسط صفحه :

SetCursorPos(CInt(WebBrowser1.Width / 2), CInt(WebBrowser1.Height / 2))

انجام کلیک راست در مختصات x و y

mouse_event(MOUSEEVENTF_RIGHTDOWN, CInt(WebBrowser1.Width / 2), CInt(WebBrowser1.Height / 2), 0, 0)

mouse_event(MOUSEEVENTF_RIGHTUP, CInt(WebBrowser1.Width / 2), CInt(WebBrowser1.Height / 2), 0, 0)

SendInput Function : "User32.Dll"

Private Declare PtrSafe Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As
LongPtr)

Private Declare PtrSafe Function SendInput Lib "user32" (ByVal nInputs As LongPtr, pInputs As Any, ByVal cbSize As LongPtr) As LongPtr

UINT SendInput(

[in] UINT cInputs,

[in] int cbSize

[in] LPINPUT pInputs,

mouseinput

typedef struct tagMOUSEINPUT {
  LONG      dx;
  LONG      dy;
  DWORD     mouseData;
  DWORD     dwFlags;
  DWORD     time;
  ULONG_PTR dwExtraInfo;
} MOUSEINPUT, *PMOUSEINPUT, *LPMOUSEINPUT;

If dwFlags contains MOUSEEVENTF_WHEEL, then mouseData specifies the amount of wheel movement. A positive value indicates that the wheel was rotated forward, away from the user; a negative value indicates that the wheel was rotated backward, toward the user. One wheel click is defined as WHEEL_DELTA, which is 120.

اگر Flag حاوی MOUSEEVENTF_WHEEL باشد ، mouseData مقدار جابجایی غلطک را مشخص می نماید. مقدار مثبت نمایانگر چرخیدن یا رولیدن به سمت جلو است و مقدار منفی برگشت به عقب .

Type pt As POINTAPI

X As Long

Y As Long

End Type

Type MOUSEINPUT

X As Long

Y As Long

MouseData As Long

dwFlags As Long

dwExtractInfo As LongLong

End Type

Type inputt As INPUT

type As Long

cc(0 to 20) As Byte

'mi As MOUSEINPUT

'ki As KEYBOARDINPUT

End Type

Type : INPUT_MOUSE=0

Type : INPUT_KEYBOARD=1

رایت کلیک در اکسس کلیک راست در صفحه ماوس رویداد ماوس Mouse_Event API MOUSE_EVENT

پروفسور اکسس ایران سه‌شنبه 14 دی 1400 ساعت 12:23

0 نظر

Open StateMent

Maybe Comm=FreeFile Used

Open "COMFILE" For Binary Access Read Write As #1

receiveBuff="@@@@@@@@@@"

Sleep 100

Debug.Print "Looking For incoming Msg"

On Error Resume Next

Do While True

receive = receiveBuff

Input #1, receive

If receive= receiveBuff Then Exit Do

Debug.Print receive

Loop

On Error GoTo 0

Debug.Print "Looking again...."

On Error Resume Next

Do While True

receive= receiveBuff

Input #1, receive

If receive= receiveBuff Then Exit Do

Debug.Print receive

Loop

On Error GoTo 0

Debug.Print "Finished...Close ComFile"

Close #1

Open Statement Com Port Com File

پروفسور اکسس ایران دوشنبه 13 دی 1400 ساعت 21:53

0 نظر

پیمایش با غلطک ماوس در رکوردهای فرم

Occurs when the user rolls the mouse wheel in Form view, Split Form view, Datasheet view, Layout view, PivotChart view, or PivotTable view.

زمانی اتفاق می افتد که کاربر غلطک ماوس را می گرداند در حالت نمایش فرم هایی که قید کرده.

Syntax ( نوشتاری )

expression.MouseWheel (Page, Count)

برای پیمایش در رکوردها در فرم با غلطک ماوس از پارامتر Count این رویداد و اکشن GotoRecord استفاده کنید برای تحت فشار قراردادن کاربر برای ذخیره کردن دیتا قبل از پیمایش از not Me.Dirty استفاده کنید.

پارامتر Count شماره لیست های که در Scroll view می بینید ( یعنی 200 رکورد در فرم کانتینیوس دارید ولی هر بار که غلطک را می گردانید آن تعداد که قابل view ی شما است را برمی گرداند فرضا شما در کنترل Scroll بعد از رولیدن یا چرخاندن 20 رکورد می بینید Count را 20 به شما می دهد و پارامتر Page هم Page Number ).

استفاده از پارامتر Count و اکشن GotoRecord

If (Count < 0) And (Me.CurrentRecord > 1) Then

DoCmd.GoToRecord , , acPrevious

End If

استفاده از پارامتر Page : مثال زیر چنانچه به Page بعد انتقال پیدا کردید پیامی را در مسیج باکس نمایش می دهد

Private Sub Form_MouseWheel( _ ByVal Page As Boolean, ByVal Count As Long)

If Page = True Then MsgBox "You've moved to another page."

End If

End Sub

برای جلوگیری از پیمایش در رکوردها در فرم توسط MouseWheel : ( یک Dll است که با Vb6 نوشته شده و یا حتی نسخ بالاتر ، یک کلاس ماژول و یک استاندارد ماژول دارد که با WithEvents دسترسی به Event آبجکت فراهم می شود..... Hook کردن پنجره فرم و ارسال پیام ویندوزی WM_MOUSEWHEEL برای کنسل کردن پیمایش یا رولیدن.

access/forms/wheel

تمام موارد گفته شده در داکیومنت آفیس وجود دارد و بر گرفته از آنجاست ، غیر از Hook کردن پنجره برای ارسال پیام ها به Parent آنها که مایکروسافت آفیس این کار را هرگز توصیه نکرده و نخواهد کرد شما هم سعی در انجام اینکار بعلت Conflict ها و از بین بردن دیتابیستون نداشته باشید.

لطفا در نظر سنجی شرکت کنید

پیمایش با غلطک ماوس پیمایش در رکوردها

پروفسور اکسس ایران دوشنبه 13 دی 1400 ساعت 18:18

0 نظر

تعدادی از توابع ویندوزی در VBA7

Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long

Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr

Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr

Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long

Private Declare PtrSafe Function ReleaseCapture Lib "user32" () As Long

Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

'Some Constants

Private Const WS_EX_MDICHILD = &H40
Private Const GWL_EXSTYLE = (-20)
Private Const SWP_NOSIZE = &H1
Private Const SWP_SHOWWINDOW = &H40
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1

xlDesk

Excel7

Form_Activate

  
OHwnd = FindWindowEx(Application.hwnd, 0, "OMain", vbNullString)
GetWindowRect hWndForm, tRect
   tPt.X = tRect.Left
   tPt.Y = tRect.Top
   SetParent hWndForm, OHwnd
   ScreenToClient OHwnd, tPt
   SetWindowLong(hWndForm, GWL_EXSTYLE, GetWindowLong(WbHwnd, GWL_EXSTYLE) Or WS_EX_MDICHILD)
   SetWindowPos(hWndForm, 0, tPt.X, tPt.Y, 0, 0, SWP_SHOWWINDOW Or SWP_NOSIZE)

Form_MOUSEMOVE

If Button = 1 Then
    ReleaseCapture
    SendMessage hWndForm, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If

CB_SETDROPPEDWIDTH=&H160

hWndXl = ApphWnd ---> ("XLMAIN")
hWndFormulaBar = FindWindowEx(hWndXl, 0, _
          "EXCEL;", vbNullString)
hWndNameCombo = FindWindowEx(hWndFormulaBar, 0, _
         "combobox", vbNullString)

https://docs.microsoft.com/en-us/windows/win32/controls/cb-getdroppedwidth

'CB_GETDROPPEDWIDTH message
'Parameters
'wParam : Not used; must be zero.
'lParam   : Not used; must be zero.
'Return value :
'If the message succeeds, the return value is the width, in pixels.
'drop down width
 SendMessage hWndNameCombo,CB_SETDROPPEDWIDTH, 200, 0



CB_SETEDITSEL message  :

Parameters

wParam :This parameter is not used

lParam [in]

The LOWORD of lParam specifies the starting position. If the LOWORD is -1, the selection, if any, is removed.

The HIWORD of lParam specifies the ending position. If the HIWORD is -1, all text from the starting position to the last character in the edit control is selected.

Return value : در صورت موفقیت عدد غیر صفر بر می گرداند

If the message succeeds, the return value is TRUE. If the message is sent to a combo box with the CBS_DROPDOWNLIST style, it is CB_ERR.

Remarks : موقعیت اولین کارکتر در کنترل ویرایش صفراست

The positions are zero-based. The first character of the edit control is in the zero position. The first character after the last selected character is in the ending position. For example, to select the first four characters of the edit control, use a starting position of 0 and an ending position of 4

پروفسور اکسس ایران شنبه 11 دی 1400 ساعت 23:37

0 نظر

آبجکت WebBrowserControl

IEXPLORE

WebControl_members

WebElement_properties

webbrowser-open-office-document-in-visual-basic

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

The WebBrowser control has several properties, methods, and events that you can use to implement controls found in Internet Explorer. For example, you can use the Navigate method to implement an address bar, and the GoBack , GoForward , Stop , and Refresh methods to implement navigation buttons on a toolbar

objects_and_controls

Obj.ContextMenu = TRUE 'Boolean Type

در لینک زیر رویداد های یک اکتیو ایکس کنترل Webbrowser نشان داده

vba/api/access.webbrowsercontrol

برای نمایش یک سایت در کنترل webbrowser که در اینجا نام کنترل WebBrowser0 است :

Me.WebBrowser0.Navigate "www.Blogsky.com"

فقط صفحات Html در این Browser قابل مشاهده هستند پس در این کنترل نمی توانید فایل Pdf یا Word باز کنید.

برای Disable کردن اجرای عملیات در webbrowser یا باصطلاح خودمون عدم نمایش ، رویداد BeforeNavigate2 را مطالعه نمائید در تابع آرگومان آخر از نوع Boolean تعریف شده که می توانید آنرا False کنید.

برای استفاده از کلاس ماژول هایی که Microsoft HTML DOCUMENT دارد در Refrence محیط VBE آنرا تیک بزنید همانطور که گفته شد WithEvents متغیری را تعریف می کند که می توانید به رویدادها دسترسی پیدا کنید البته آن متغیر تعریف شده را باید در تابع WebBrowser0_DocumentComplete به پراپرتی Document این کنترل تنظیم کنید.

Private WithEvents HDoc As HTMLDocument

در DocumentComplete که دو آرگومان دارد اولی بعنوان آبجکت و دومی url از نوع Variant بنویسید

Set HDoc=WebBrowser0.Document

از نحوه نوشتاری رویه هایی که در HTMLDocunent وجود دارد اطلاعی ندارم و تنها چیزی که پیدا شد رویداد OnClick است

Private Function Hdoc_OnClick() As Boolean

Msgbox " Clicked Me !!!)

End Function

در رویه بالا اگر شما Boolean را بکار نبرید خطا دریافت خواهید کرد. و حتما باید آنرا بکاربرد

غیر فعال کردن Scroll :

Me.WebBrowser0.Document.Body.Scroll="No"

Event : NavigationStateChanged

دو تا آرگومان دارد و مقدار Boolean دارند یکی CanGoBack و دیگری CanGorward

powerscript_reference/mouseMove_event

WithEvents

Specifies that one or more declared member variables refer to an instance of a class that can raise events.

برای استفاده از عناصر مربوطه در Refrence تیک Microsoft Html library را حتما تیک بزنید البته بدون تیک هم می توان کارهایی انجام داد که مجبور به تیک این آپشن نباشیم البته اگر فایل مربوطه در system32 نباشد دیگر هیچ کاری نمی توان انجام داد.

Public WithEvents ObjHtmlDoc As HTMLDocument

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)

Set objHtmlDoc = WebBrowser1.Document

End Sub

OnMouseMove Event :

زمانیکه ماوس را روی کنترل webbrowser می گیرید مختصات x و y را برمی گرداند

First Tick "Microsoft HTML Object Library" Form VBA Refrences

Important :in Upper Sub Procedures Declared Private WithEvents Doc Ass HTMLDocument ( To use Event )

Important : Set Variable Doc In Sub WebBrowser_DocumentComplete(Byval pDisp as Object,url As Varaint)

Doc_OnMouseMove

Me.text3=Me.Text3 = "X : " & dc.parentWindow.event.clientX & _

"Y : " & dc.parentWindow.event.clientX

Doc_OnMouseMove

OnMouseUp Event

برای Scroll کردن در اکتیو ایکس WebBrowser به سمت پائین و انتهای body روش زیر پیشنهاد شده

To scroll to a specific location, you can use WebBrowser.Document.Window.ScrollTo(x,y) method. For example to scroll down to the end of body:

private void webBrowser1_DocumentCompleted(object sender, 
                                           WebBrowserDocumentCompletedEventArgs e)
{
    webBrowser1.Document.Window.ScrollTo(0, webBrowser1.Document.Window.Size.Height);
}

WebBrowser Events

DocumentComlete Event :

زمانی فعال می شود که یک سند به طول کامل بارگیری و مقدار دهی اولیه شود ( "Object.Navigate="url )

نوشتاری :

Private Sub WebBrowser0_DocumentComplete(ByVal iDisp As Object ,url As Variant)

WindowSetTop Event :

زمانی فعال می شود که شئ موقعیت Top اش را تغییر دهد

نوشتاری :

Private Sub object_WindowSetTop(ByVal nTop As Long)

Zoom Method : زوم کردن

طبق عبارت زیر می توانید صفحه را با درصد انتخابی Zoom in یا Zoom Out کنید.

Me.WebBrowser0.Document.body.Style.zoom = "220%"

Scroll Height : ارتفاع اسکرول در صفحه

برای بدست آوردن ارتفاع اسکرول طبق زیر عمل کنید

To Get Scroll Height Of Body ( Object Must Be Set )

Dim HtmlBody As HtmlBody

Set HtmlBody = Me.WebBrowser0.Document.body

MsgBox HtmlBody.scrollHeight

Click Button : کلیک روی باتن

کلیک روی باتن طبق تصویر زیر و باز شدن منو با کلیک اول منو بازشد و کلیک دوم به حالت قبل برگشت.

HTMLElement . متد Click یک کلیک ماوس روی عنصری را شبیه سازی می کند عنگامی که Click با عناصر پشتیبانی شده مانند <input> استفاده می شود ، رویداد کلیک عنصر را فعال می کند . این رویداد سپس به عناصر بالاتر در شاخه سند ( یا زنجیره رویداد ) تبدیل می شود و رویداد کلیک آنها را فعال می نماید.

در تصویر Gif زیر کامند سمت چپ داکیومنت را در کنترل راهبری می کند و کامند سمت راست منو رو باز میکند البته در حالتی که کنترل وب براوزر را بازتر کنیم آن حالت راهبری بصورت Toggle از بین می رود و در form-header سه دکمه مثل "ورود به سیستم" نمایان می شود وعملا این کد خاصیتی ندارد. برای کلیک کردن روی سه باتن loging یا Signup می توانید ....... لوپ زدن در element ها و چک کردن id یا href یا هر چیز دیگری و Ele.Click

شامل header و content و footer است.

.Document.GetElementsByTagName("Button")(0)

.innerText="Toggle Navigation"

getElementsByName و getElementsByClassName یک آرایه را باز می گردانند بنابراین باید ایندکس آیتم آرایه در براکت ها مشخص شود.

مطلب زیر هم جالبه برای انتخاب تمام کلاس ها با getElementsByClassName و Click

Select all class's with getElementsByClassName and click

var el = document.getElementsByClassName('node closed');

for (var i=0;i<el.length; i++) {

el[i].click();

}

' Input the userid and password
    ie.Document.getElementById("uid").Value = "testID"
    ie.Document.getElementById("password").Value = "testPW"
' Click the "Search" button
    ie.Document.getElementById("enter").Click

Link

Set HTMLdoc = appIE.HTMLDocument
    Set link = Nothing
    i = 0
    While i < HTMLdoc.Links.Length And link Is Nothing
        If HTMLdoc.Links(i).innerText = "Favorites" Then Set link = HTMLdoc.Links(i)
        i = i + 1
    Wend
    If Not link Is Nothing Then
        link.Focus
        link.Click
    End If

برای کلیک کردن ، حتما متغیر که اینجا myLinks است باید تنظیم شود

Dim myLinks As Object
Set myLinks = Document.getElementsByTagName("a")

Add List the Link to ListBox

Private Sub Form_Load()
WebBrowser1.Navigate "www.vbforums.com"
End Sub

Dim HTMLdoc As HTMLDocument
Dim HTMLlinks As HTMLAnchorElement
Dim STRtxt As String
' List the links.
On Error Resume Next
Set HTMLdoc =WebBrowser1.Document
For Each HTMLlinks In HTMLdoc.links
List1.AddItem HTMLlinks.href
STRtxt = STRtxt & HTMLlinks.href & vbCrLf
Next HTMLlinks
'Append means add data to end
Open "C:\Documents and Settings\joe\Desktop\linklog.txt" For Append As #1
Print #1, STRtxt
Close #1
End Sub

CommandStateChange Event :

زمانی ر خ می دهد که حالت فعال یک فرمان یا Command تغییر نماید

Private Sub object_CommandStateChange (ByVal Command As Long,

ByVal Enable As Boolean)

Cmmand :
CSC_NAVIGATEFORWARD ( Value : 1)
The enabled state of the Forward button has changed.
CSC_NAVIGATEBACK ( Value : 3 )

If Command = 2 Then Me.Command5.Enabled = Enable

CommandStateChangeConstants enumeration

How To Hide Or Show WebBrowser Control

Me.WebBrowser0.Visible = False

The enabled statebutton has http:// changed.

باتنی می توان در فرم تعبیه کرد و از GoBack برای برگشتن به عقب استفاده کرد البته باتن Back د ر کیبورد همین کار را انجام میدهد

On Error Resume Next

Me.WebBrowser0.GoBack

وقتی صفحه وب کاملا Load شد اگر از Goback استفاده کنید ( در رویه یک باتن بنویسید ) با خطا مواجه می شوید چون صفحه قبلی وجود ندارد که شما را به آن بازگرداند ولی اگر از دکمه کیبورد ( Back ) استفاده کنید خطا دریافت نمی کنید ... کد اول بخاطر همین نوشته شد.

Print

WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER

'you can change OLECMDEXECOPT_DONTPROMPTUSER to OLECMDEXECOPT_PROMPTUSER if you wish

بجای استفاده از DONTPROMPTUSER می توانید از PROMPTUSER بهره ببرید برای اینکه به کاربر اعلام نماید و Dialog Box را نمایش دهد. از Shell هم می توان استفاده کرد .

Shell "rundll32.exe C:\WINDOWS\SYSTEM\MSHTML.DLL,PrintHTML " & _ "http://www.developerfusion.com" , vbMinimizedFocus

با SendKeys هم می توان کنترل + P را فرستاد راه های رسیدن به پرینت صفحه.

To Fill Edit Box :

WebBrowser1.document.all("username").Value = "Name"
WebBrowser1.document.all("password").Value = "passwort"
WebBrowser1.document.all("Submit").Click

OnMouseDown()

Private Declare Ptrsafe Function GetAsyncKeyState Lib "user32" (ByVal VKey As Long) As Integer

For Key = 1 To 5 '255
If GetAsyncKeyState(Key) Then 'WebBrowser1_MouseDown VKey
Exit For
End If
Next

If Key = 2 Then
Me.Label1 ="Right MouseDown"
End If

استفاده از تابع ویندوری ShellExecute برای اجرای فایل

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
'Declare arguments
(ByVal hWnd As Long, ByVal lpszOp As String, _
ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal LpszDir As String, ByVal FsShowCmd As Long) _
As Long

'Used to display a window
Const SW_SHOWNORMAL = 1

'Open pdf occurs on button click
Private Sub cmdPDF_Click()
Dim strPath, strParam As String

strPath = "C:\Example.pdf"
strParam = " /A " & Chr(34) & "page=14" & Chr(34) & strPath

Call ShellExecute(0&, "open", "AcroRd32.exe", strParam, "", SW_SHOWNORMAL)
End Sub

Remove Open\Save Dialog
------------------------------------------------------
Windows Registry Editor Version 5.00
[-HKEY_CLASSES_ROOT\AcroPDF.FDF.1]
[HKEY_CLASSES_ROOT\AcroPDF.PDF.1]
"EditFlags"=hex:00,00,01,00
------------------------------------------------------
Add Open\Save Dialog
------------------------------------------------------
Windows Registry Editor Version 5.00
[HKEY_CLASSES_ROOT\AcroPDF.FDF.1]
"EditFlags"=hex:00,00,00,00
[HKEY_CLASSES_ROOT\AcroPDF.PDF.1]
"EditFlags"=hex:00,00,00,00

لطفا بعد از مطالعه و استفاده فاتحه ای برای پدر مرحومم قرائت فرمائید .... دوستان عزیز لطفا در نظر سنجی شرکت کنید در ضمن مطالب زیر ربطی به اکسس ندارد و فقط برای مطالعه است

صرفا جهت مطالعه ، مطالب زیر ربطی به کنترل بالا ندارد . موارد جدید مربوط به webbrowser اگر یافت شد به بالا اضافه خواهد شد.

WM_NCHITTEST=132

WM_SETCURSOR=32

WM_MOUSEMOVE=512

پیام ویندوزی ارسال به پنجره

WM_MOUSEMOVE :

Private Type POINTAPI
x As Long
y As Long
End Type

Contains information about a mouse event passed to a WH_MOUSE hook procedure, MouseProc.

Private Type MOUSEHOOKSTRUCT

pt As POINTAPI

hwnd As Long

wHitTestCode As Long

dwExtraInfo As Long

End Type

'Constants

Public Const WH_MOUSE = 7

Public Const WM_MOUSEMOVE = &H200

Public Const WM_LBUTTONDOWN=&H201
Public Const WM_LBUTTONUP=&H202
Public Const WM_LBUTTONDOWNDBLCLK=&H203
Public Const WM_RBUTTONDOWN=&H204
Public Const WM_RBUTTONUP=&H205
Public Const WM_RBUTTONUPDBLCLK=&H206

Private OldWndProc As Long

Private IsHooked As Boolean

Public Function MouseProc(ByVal uCode As Long, ByVal wParam As LongPtr, lParam As MOUSEHOOKSTRUCT) As Long

If uCode < 0 Then

MouseProc = CallNextHookEx(lpPrevWndProc, uCode, wParam, lParam)

Else

Select Case wParam

Case WM_MOUSEMOVE

'here is your mouse move event

Debug.Print "Mouse Move: " & lParam.pt.x & lParam.pt.y

End Select

MouseProc = CallNextHookEx(OldWndProc, uCode, wParam, lParam)

End If

End Function

Public Sub SetMouseHook()
If Not IsHooked Then
OldWndProc = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, 0, GetCureantThreadID)
IsHooked = True
End If
End Sub

Public Sub RemoveMouseHook()
UnhookWindowsHookEx OldWndProc
IsHooked = False
End Sub

SubClass Window

Public Declare PtrSafe Function SetWindowLongPtrA Lib "user32" (ByVal Hwnd As LongPtr, _

ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

Public Declare PtrSafe Function CallWindowProcA Lib "user32.dll (ByVal lpPrevWndFunc As LongPtr, _

ByVal Hwnd As LongPtr, ByVal Msg As Long, _

ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Public OldWndProc As LongPtr

Public IsHooked As Boolean

Public cCount As LongLong

Public Sub SubClass()

If Not IsHooked Then

OldWndProc = SetWindowLongPtrA(Hwnd, GWLP_WNDPROC, AddressOf NewWndProc)

IsHooked = True

End If

End Sub

Public Sub UnSubClass()

SetWindowLongPtrA Hwnd, GWLP_WNDPROC, OldWndProc

IsHooked = False

End Sub

Public Function NewWndProc (ByVal Hwnd As LongPtr,ByVal Msg As Long,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As LongPtr

Select Case Msg

Case &H201

Debug.Print "&H201"

Case &H202

Debug.Print "&H202"

Case Else

NewWndProc=0

End Select

NewWndProc=CallWindowProcA(OldWndProc,Hwnd,Msg,wParam,lParam)

End Function

WM_MOUSE :

هنگامی که مکان نما حرکت می کند به یک پنجره ارسال می شود. اگر ماوس گرفته نشود، پیام به پنجره ای که مکان نما را در خود دارد ارسال می شود. در غیر این صورت، پیام به پنجره ای که ماوس را گرفته ارسال می شود.

پنجره این پیام را از طریق تابع WindowProc خودش دریافت می کند.

WM_MOUSEMOVE=&H200
wParam : are Down virtual keys or not
1-The left mouse button is down.
2-The right mouse button is down
4- The SHIFT key is down.
8-The CTRL key is down.
10-The middle mouse button is down.
20- The first X button is down.
40- The second X button is down.
lParam : مختصات کرسر

If Msg=&H200 And wParam=2 Then

Debug.Print cCount=cCount+1

WindowProc=False Or True ( To Be Tested)

End If

WM_CONTEXTMENU :

اطلاع میدهد به پنجره ای که کاربر مایل است یک منوی زمینه ظاهر شود. کاربر ممکن است در پنجره با ماوس right-click کرده باشد ، Shift+F10 را فشرده باشد یا از کلیدهای برنامه استفاده کند

WM_CONTEXTMENU=&H7B
wParam :

هندلی است به پنجره ای که کرسر با ماوس right-click شده . می تواند یک زیرپنجره برای پنجره ای باشد که پیام دریافت می کند.

lParam :

قسمت low-order موقعیت افقی کرسر را تعیین می کند ، در مختصات صفحه ، در زمان ماوس کلیک

Clng(lparam And 255×257)

قسمت high-order موقعیت عمودی کرسر را مشخص می کند ، در مختصات صفحه ، در زمان کلیک کردن روی ماوس

Clng(lparam \ 255×257)

Public Declare PtrSafe Function PtInRect Lib "user32.dll" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long

Public Type Pt As POINTAPI

x As Long

y As Long

End

Public rc As Rect

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Immediate Window :

HTMLDOCUMENT webbrowser WM_MOUSEMOVE MOUSEPROC

پروفسور اکسس ایران جمعه 10 دی 1400 ساعت 23:39

0 نظر

نوشتن کلاس ماژول و استاندارد ماژول در اکسس

Class Module Name : clsmMouseWheel

Private frm As Object

Private intCancel As Integer

Public Event MouseWheel(Cancel As Integer)

' Because Form is object use set

Public Property Set Form(frmm As Object)

Set frm=frmm

End Property

Public Property Get MouseWheelCancel() As Integer

MouseWheelCancel=intCancel

End Property

Public Sub RaiseMouseWheel()

RaiseEvent MouseWheel(intCancel)

End Sub

در استاندارد ماژول ، متغیری به صورت Public تعریف می شود که در تمام رویه ها بتوان استفاده کرد حتی در سایر استاندارد ماژول ها ( یعنی در تمام رویدادهای فرم و گزارش می توان از این متغیر استفاده کرد حتی در کنترل تکست باکس یا قسمت تکست باکس کنترل کمبو باکس مثل ایجاد TempVars .... و این متغیر به کلاس ماژول ساخته شده متصل می شود.نام استاندارد ماژول را MouseWheel می نامیم

Public cMouse As clsmMouseWheel

در قسمت ویژوال فرم مورد نظر عبارت زیر نوشته می شود.بالاتر از هر تعداد Event که در رویه وجود دارد.

Private WithEvents clsMouseWheel As MouseWheel.clsmMouseWheel

باید متغیر های WithEvents را بعنوان متغیرهای آبجکت اعلام کنید تا بتوانند نمونه های کلاس را پذیرش کنند . با این حال نمی توان آنها را بعنوان Object اعلام کرد . باید آنها را به عنوان کلاس خاصی که می تواند رویدادها را مطرح کند ، اظهار نمائید.

شئ هایی که از روی کلاس ساخته می‌شوند را یک نمونه (Instance) از آن کلاس می‌نامند.

WithEvents مشخص میکند که یک یا چند متغیر عضو اعلام شده به نمونه ای از یک کلاس اشاره می کند که می تواند رویدادها را افزایش دهد.

فرضا می خواهید رویدادهایی ( رویدادها را می دانید ) که برای کنترل webbrowser وجود دارد را اجرا کنید با WithEvents متغیری را تعریف می کنید که به آن کلاس ماژول متصل شود و بعد یک رویه می نویسید.

در رویداد لود فرم باید متغیر تعریف شده بالا را به کلاس ماژول نوشته شده تنظیم کرد

Set clsMouseWheel=New MouseWheel.clsmMouseWheel

Set clsMouseWheel.Form=Me

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

clsMouseWheel.SubMsgForm

در رویداد کلوز فرم :

فرضا اجرای تابعی از استاندارد ماژول مثلا برای قطع زنجیره ارتباطی

Set clsMouseWheel.Form=nothing

Set clsMouseWheel=Nothing

Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)

Msgbox " Hello"

Cancel=True

End Sub

hook کردن یا به زنجیر کشیدن پنجره برای ارسال پیام های ویندوزی

برای hook کردن پنجره از تابع SetWindowLongPtrA استفاده کنید

HookForm :

SetWindowLongPtrA

oldWndProc

frm.hwnd GWL_WNDPROC AddressOf WndProc

Set Mouse=Me

برای قطع اتصال به پنجره باید Unhook کرد با استفاده از همان تابع ( البته از توابع SetWindowsHookA برای تنظیم این زنجیره و قطع آن با UnHookWindowsHookEx استفاده می کنند.) که در پارامتر lparam تابع oldWndProc جایگزین می شود.

تابعی هم برای پارامتر دوم تابع SetWindowLongPtrA می نویسید که اینجا wndProc نامیده شده یا می توانید نام آنرا WindowsHook بگذارید . که شامل چهار آرگومان hwnd Msg wParam lParam است.اولی هندل پنجره را مشخص میکند که دیتاتایپ آن در ویندوز 64 بیت LongPtr است

Public Function WndHookProc(ByVal hWnd As LongPtr,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As Long

Select Case Msg

Case WM_MOUSEWHEEL

WndHookProc=CallWindowProc(oldWndProc,hWnd,Msg,wParam,lParam)

Case Else

WndHookProc=CallWindowProc(oldWndProc,hWnd,Msg,wParam,lParam)

End Select

End Function

MouseWheel ( Page , Count ) در اکسس

MouseWheel ClassModule WithEvents Standard Module Class Module

پروفسور اکسس ایران جمعه 10 دی 1400 ساعت 19:35

0 نظر

جستجوی فایل با تابع ویندوزی SearchTreeForFile

Dll : Dbghelp

BOOL IMAGEAPI SearchTreeForFile( [in] PCSTR RootPath, [in] PCSTR InputPathName, [out] PSTR OutputPathBuffer );

جواب تابع اگر Fail ندهد True است به Bool که در اول آمده دقت کنید ( Boolean ) دیتا تایپ تمام آرگومان ها از نوع رشته ای است.

این تابع فایلی را که توسط پارامتر InputPathName مشخص شده است ، از مسیرمشخص شده در پارامتر RootPath جستجو میکند.حداکثر عمق مسیری که در RootPath مجاز است 32 فهرست است. هنگامی که تابع فایل را در شاخه دایرکتوری پیدا می کند ، مسیر کامل فایل را در بافر مشخص شده توسط پارامتر OutputPathBuffer قرار می دهد.

RootPath="C:"

InputPatName="txt1.txt"

OutputPathBuffer=Buffer

VbNullChar را می توانید در متغیر تعریف شده با نام Buffer از نوع رشته ای با تابع String پر کنید. ( OutputPathBuffer یک نشانگر است به Buffer )

بعد برای گرفتن مقدار نوشته شده در متغیر Buffer با تابع یاد شده ، از توابع Instr ( برای یافتن تعداد کارکتر نوشته شده در بافر که در پشت اولین NullChar است ) و Left ( برای گرفتن کاراکتر از سمت چپ با طول مشخص ( با instr ) ) استفاده بنمائید.

لطفا نظرسنجی فراموش نشود

جستجو ی فایل در root جستجوی فایل

پروفسور اکسس ایران جمعه 10 دی 1400 ساعت 15:03

0 نظر

گرفتن هندل Webbrowser

Public Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" ( _ ByVal hwnd As LongPtr, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long

Public Declare PtrSafe Function EnumChildWindows Lib "user32" ( _ ByVal hWndParent As LongPtr, _ ByVal lpEnumFunc As LongPtr, _ ByVal lParam As LongPtr) As Long

برای گرفتن نام کلاس زیر پنجره ها یا Child Window که درون Parent Window هستند از تابع GetClassNameA استفاده می شود ( فرضا در پنجره ویندوزی 32770# باتن ها یک Child Window هستند ) در ویدوز 64 بیت یک ptrsafe قبل از عبارت Function نیاز است و دقیقا نام تابع به حروف کوچک و بزرگ حساس هستند یعنی اگر بنویسید getClassNameA با خطا مواجه خواهید شد.

در تابع ویندوزی زیر hWnd میشود Form.hWnd که خوشبختانه اکسس این پراپرتی رو تعبیه کرده و WNDENUMPROC هم بدین شکل اعلام میشود AddressOf CallBackEnumWindowsProc.

BOOL EnumChildWindows( [in, optional] HWND hWndParent, [in] WNDENUMPROC lpEnumFunc, [in] LPARAM lParam );

تابع EnumWindowsProc اگر برابر یک باشد در پنجره ها لوپ می زند و hWnd آنرا ارائه می نماید اگر در تابع صفر بگذارید متوقف میشود و لوپ تعطیل میشود

BOOL CALLBACK EnumWindowsProc( _In_ HWND hwnd, _In_ LPARAM lParam );

EnumWindowsProc=1

در این تابع که یک CallBack است با GetClassNameA نام کلاس پنجره را میگیرید. این تابع را ملاحظه کنید ، آرگومان دوم lpClassName از نوع رشته ای است پس شما یک متغیر با نام Buffer بسازید و در آن vbNullChar یا هر کارکتر دیگری بنویسید مثل (Buffer$=String(255,vbNullChar و جای آن آرگومان می گذارید که نام کلاس درون این بافر قرار داده می شود شما می توانید طول رشته را بجای 255 مثلا 64 بگذارید . زمان اجرای GetClassName داخل بافر نام کلاس درج می گردد شما 255 بایت یا کاراکتر( Null ) ایجاد کردید قطعا نام کلاس خیلی کمتر از 255 بایت است و بقیه همان NullChar است پس با تابع Instr دنبال NullChar می گردید که بعد از نام کلاس قرار گرفته و تعداد کارکتر پشت اولین NullChar یافته شده را با این تابع میگیرید منهای یک می کنید که تعداد کاراکتر کلاس بدون آن کاراکتر Null بدست آید سپس با تابع Left آنرا از $Buffer استخراج می کنید .

کنترل webbrowser که یک اکتیو ایکس است برای باز کردن internet explorer در آن پس نام کلاس هم برگرفته از آن است.

کنترل WebBrowser یک Wrapper یا پوشش است با نام Shell Embedding و حاوی internet Explorer_Server . می توان با فراخوانی توابع Api با نام FindWindowEx از کتابخانه user32 هندل ویندو یا hwnd آنرا دریافت کنید و برای هندل interner Explorer_Server که یک ClassName است باید در پنجره های Child این پوشش لوپ بزنید.

نحوه اظهار توابع API در ویندوز 32 و 64 بیت متفاوت هست یک خطا در اظهار یا حتی مغایرت در دیتا تایپ باعث هنگ کردن خواهد شد.

تابع SetDlgItemTexA

عنوان یا تکست یک کنترل در دیالوگ باکس را تنظیم می کند فرضا کنترل باتن به نام Yes یا هر Caption دیگری که دارد.

سه آرگومان دارد اولی هندلی به دیالوگ باکس که حاوی کنترل است ، دومی ID دیتا تایپ int و سومی از نوع String که حاوی text است که می خواهید به پنجره کنترل بفرستید که Caption آن تغییر نماید.

webbrowser GetClassName

پروفسور اکسس ایران جمعه 10 دی 1400 ساعت 13:18

0 نظر

ولایت فقید

Islamic Resistance

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

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

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

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

ولایت فقیر ولایت فقید خامنه ای ۲۲ بهمن دهه فجر دهه زجر گرانی طرح جهش مسکن ملی ۹ دی

پروفسور اکسس ایران جمعه 10 دی 1400 ساعت 10:14

0 نظر

#32770

DO

h=FindWindow("#32770","Choose file")

DOEvents

Loop Until h

editbox=FindWindowEx(x,0&,"ComboBoxEx32",VbNullString).

SendMessage by string

handle windows msg:WM_SETTEXT 0& maybe ByVal Text

برای Hook کردن پنجره :

در Form_Load

Public Function WindowProc(ByVal hwnd As Long, _ ByVal uMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Select Case uMsg

Case WM_LBUTTONDOWN

If ............ Then

WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)

End If

Case Else

WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)

End Select

End Function

WM_SETTEXT پیدا کردن هندل ویندو #32770 پنجره ویندوزی

پروفسور اکسس ایران پنج‌شنبه 9 دی 1400 ساعت 23:40

0 نظر

عبارت Put و Get در VBA

Writes data from a variable to a disk file.

نوشتن داده از یک متغیر یه یک فایل

نوشتاری عبارت Put :

Put [ # ] filenumber, [ recnumber ], varname

طبق نوشتار بالا این عبارت سه قسمت دارد که شماره فایل ( 1 تا 255 ) و نام متغیر ضروری هستند و فقط شماره رکورد Optional یا می تواند خالی رها شود.

دیتا نوشته شده با Put معمولا با Get خوانده می شود

رکورد یا بایت اول در یک فایل در موقعیت 1 ، رکورد یا بایت دوم در پوزیشن 2 و .... است . اگر recnumber را نادیده بگیرید( omit ) ، رکورد یا بایت بعدی بعد از آخرین عبارت یا دستور Get یا Put ، یا با آخرین تابع Seek اشاره شده ، نوشته می شود. باید در جداکننده کاما قرار گیرند مثال :

Put #1,,FileBuffer

برای فایل هایی که در حالت تصادفی یا Random Mode باز ( Open ) می شوند قوائد زیر اعمال می گردد :

اگر طول دیتای در حال نوشتن کمتر از طول مشخص شده در عبارت Len دستور Open باشد ، Put رکوردهای بعدی را روی مرزهای طول رکورد می نویسد فضای بین پایان رکورد و ابتدای رکورد بعدی با محتویات موجود در بافر پر می شود. از آنجاییکه مقدار data padding را نمی توان با قطعیت پیدا کرد ، بطور کلی ایده خوبی است که طول رکورد با طول داده های نوشته شده مطابقت داشته باشد.اگر طول داده های نوشته شده بیشتر ازطول مشخص شده در عبارت Len دستور Open باشد ، خطائی رخ می دهد. اگر متغیری که نوشته می شود یک رشته بت طول متغیر باشد ، Put یک توصیفگر 2 بایتی می نویسد که شامل طول رشته و سپس متغیر است . طول رکورد مشخص شده توسط Len در دستور Open باید حداقل 2 بایت بیشتر از طول واقعی رشته باشد.... هر کاراکتر یک بایت است ( شامل ۷ یا ۸ بیت ).

اگرمتغیری ( Variable ) که نوشته می شود یک Variant از نوع عددی باشد ( وقتی بعنوان واریانت مشخص می کنید تمام دیتا تایپ ها راشامل میشود حتی یک Variant نال هم می تواند باشد ولی آبجکت خیر ) Put دو بایت می نویسد ( هرکاراکتر یک بایت ) که VarType را مشخص میکند و سپس متغیر را می نویسد. بعنوان مثال هنگام نوشتن یک Variant از VarType 3 دستور Put شش بایت می نویسد : دو بایت که با آن متغیر شناسایی می شود و چهار بایت حاوی داده ( Long ) . طول رکورد مشخص شده توسط Len دستور Open باید حداقل دو بایت بیشتر از تعداد واقعی بایت های مورد نیاز برای ذخیره متغیر باشد.

اگر متغیری که نوشته می شود یک Variant از VarType 8 یا String باشد ، Put دو بایت می نویسد که VarType را مشخص میکند ، دو بایت که طول رشته را مشخص میکند و سپس دیتا رشته ای را می نویسد. طول رکورد مشخص شده در Len دستور Open باید حداقل چهار بایت بیشتر از طول واقعی رشته باشد. ( VarType یا Variable Type که یک تابع است برای فهمیدن نوع داده متغیر )

برای فایل های باز شده در حالت باینری مثل اتصال به دستگاه از طریق USB ( باز کردن پورت مثل COM1 تا COMn) ، تمام قوائد Random اعمال می شود جز :

بند Len در دستور یا عبارت Open هیچ تاثیری ندارد.Put تمام متغیرها را بطور پیوسته روی دیسک می نویسد بدون Padding بین رکوردها. برای هر آرایه ای غیر از آرایه در یک نوع user-defined ( توسط کاربر مشخص شده ) Put فقط دیتا را می نویسد . هیچ توصیفی نوشته نمی شود. Put رشته هایی با طول-متغیر که جزئی از انواع user-defined نیست را بدون 2 بایت طول توصیفگر می نویسد. تعداد بایت های نوشته شده برابر تعداد کاراکترها در رشته است . برای مثال عبارتهای زیر 10 بایت به فایل شماره یک می نویسد.

VarString$ = String$(10," ")

Put #1,,VarString$

می توان از دستورات AT COMMAND در PUT برای ارسال به PORT استفاده کرد

Get [ # ] filenumber, [ recnumber ], varname

Reads data from an open disk file into a variable.

خواندن دیتا از یک فایل باز به یک متغیر

VarString = String(10," ")
Get #1,,VarString

عبارت # Input برای خواندن دیتا :

varlist

Required. Comma-delimited list of variables that are assigned values read from the file—can't be an array or object variable. However, variables that describe an element of an array or user-defined type may be used.

شامل دو پارت است اولی نام فایل معتبر و دومی فهرست متغیرها که با کاما جدا می شوند( نمی تواند یک متغیر آرایه یا آبجکت باشد) البته متغیرهایی که اجزا یک آرایه یا یک نوع که توسط کاربر تعیین شده را توصیف میکند می تواند استفاده شود.

مثال زیر از عبارت # Input برای خواندن داده ها از یک فایل به دو متغیر استفاده می کند.این مثال فرض میکند که TESTFILE یا فایل با چند خط داده است که با استفاده از عبارت # Write روی آن نوشته شده است . یعنی هر خط شامل یک رشته داخل کوتیشن ها و یک عدد است که با کاما از هم جدا شده اند.بعنوان مثال 234 , "Hello" .

'تعریف متغیر

Dim MyString, MyNumber

'باز کردن فایل برای گرفتن ورودی
Open "TESTFILE" For Input As #1

'لوپ زدن تا انتهای فایل
Do While Not EOF(1)

'خواندن داده در دو متغیر
Input #1, MyString, MyNumber

'نمایش در محیط وی بی، کنترل جی را بزنید

Debug.Print MyString, MyNumber
'بستن فایل
Loop Close #1

مثالی دیگر از کاربرد دستور Put برای نوشتن در حالت Binary و دستور input برای دریافت

Open File in Binary Mode :
cmnd$ = cmnd$ + Chr(13)
Put #1, , cmnd$
answer = ""
char = Input(1, #1) 'get first char
While (char <> Chr(13))

DoEvents
If (char > Chr(31)) Then
answer = answer + char
Else
'Do what ever you like
End If
char = Input(1, #1) 'get the next character
Wend
Close #1
Cells(1, 1) = answer

کامند بالا تست نشده ولی به احتمال زیاد درست عمل میکند.

برای گرفتن دسیمال یونیکدها از AscW استفاده کنید و بعد به هگزا تبدیل کنید . تابع Oct هم که دسیمال را به اکتال می دهد. اگر Vba را تایپ کنید و بعد نقطه را وارد کنید لیست توابع را خواهید دید اگر زمانی اسم تابع فراموش شد کمکی به شما خواهد بود.

لطفا در نظر سنجی شرکت کنید

Put GET INPUT SMS AT COMMAND

پروفسور اکسس ایران پنج‌شنبه 9 دی 1400 ساعت 18:40

0 نظر

برقراری تماس از طریق مودم GSM با دستورات AT COMMAND یا فایل HYPER TERMINAL و حتی ارسال پیام ( به فرمت PDU )

ارسال پیام به مودم برقراری تماس شماره گیری AT COMMAND

پروفسور اکسس ایران پنج‌شنبه 9 دی 1400 ساعت 13:55

0 نظر

SubClass A Window

برای ساب کلاس کردن پنجره در 32 بیت :

Constants used with Windows APIs

Private Const GWL_WNDPROC = -4

Private mHwnd As LongPtr

Public mOldWndProc As LongPtr

Private Sub Comman4_Click()

mHwnd = FindWindowA(vbNullString, Me.Caption)

SetHook

End Sub

Private Sub Form1_Close()

RemoveHook

End Sub

Private Sub SetHook()

mOldWndProc = SetWindowLongPtrA(mHwnd, GWL_WNDPROC, VBA.CLngPtr(AddressOf NewWndProc))

End Sub

Private Sub RemoveHook()

SetWindowLongPtrA mHwnd, GWL_WNDPROC, mOldWndProc

End Sub

Public Function NewWndProc(ByVal hwnd As LongPtr, _
ByVal uMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr

'On Error Resume Next

NewWndProc = CallWindowProcA(mOldWndProc, hwnd, uMsg, wParam, lParam)
End Function

Unfortunately, you cannot rotate text in a WinForms label. If you really want to do it, you have to handle the Paint event and write code to rotate the text.

برای چرخش متن در گزارش از اکتیوایکس ها استفاده می شود ( و دارای Property ها یا Event هااست البته اگر سازنده تعبیه کرده باشد ) که بصورت کنترل acCustomControl است بنابراین بدون کمک از آنها نمی توان تکست را به درجه ای که می خواهید بچرخانید اکسس فقط چرخش در حالت ۹۰ درجه Vertical دارد..... پس کنترل اکتیو ایکس رو در گزارشات می بایست اضافه کنید بجای لیبل و از پراپرتی های آن استفاده نمائید

WM_PAINT :

Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public Type PAINTSTRUCT
hDc As Long
fErase As Boolean
rcPaint As RECT
End Type

WindowProc(hwnd,uMsg,wParam,lParam)

Dim ps As PAINTSTRUCT

Dim hDC,hBrushAs LongPtr

Select Case uMsg
case WM_DESTROY
PostQuitMessage(0)

SelectObject hDC,hOldBrush

DeleteObject hBrush

WindowProc=0 ' False
case WM_PAINT
hdc = BeginPaint(hwnd, &ps)

hBrush=CreateSolidBrush(Rgb)

hOldBrush=SelectObject(hDC,hBrush)

FillRect(hdc, &ps.rcPaint, hBrush)

EndPaint hwnd, &ps
WindowProc=0

End Select
WindowProc=DefWindowProc(hwnd, uMsg, wParam, lParam)

توابع API به حروف بزرگ و کوچک حساسند پس اگر فرضا تابع CreateCompatibleDc ارور Not Find در DLL مربوطه دریافت خواهید کرد چرا ؟ چون DC است نه Dc

Subclassing

پروفسور اکسس ایران یکشنبه 5 دی 1400 ساعت 16:48

0 نظر

دستورات AT در ارسال پیام به دستگاه

مجموعه ای ارزنده از دستورات ارتباطی گرد آوری شده از سایت ها

Communications

A tool to provide a visual means to send and receive data through serial ports

terminal_online_installer.exe

serial-port-terminal1.software

hyperterminal.software

Split then Conant Concatenated_SMS

issues-with-concatenated-sms-pdu

"ATD+98913.....;"+Chr(13) ' Dial

ATD (Dial), ATA (Answer), ATH (Hook control) and ATO (Return to online data state), AT+CMGS (Send SMS message), AT+CMSS (Send SMS message from storage), AT+CMGL (List SMS messages) and AT+CMGR (Read SMS messages).

AT commands are instructions used to control a modem. AT is the abbreviation of ATtention. Every command line starts with "AT" or "at". That's why modem commands are called AT commands.

دستورالعمل هایی هستند که برای کنترل مودم استفاده می شوند . AT اختصار ATtention است. هر خط با AT یا at شروع می شود یعنی دستورات مودم AT commands نامیده می شوند.

sms/atCommandsIntro

Cell Phone Book Find :

AT+CPBF command is used to find the entries of the phone book

Cell Phone Book Read :

AT+CPBR command is used to read entries of the phone book

Cell Phone Book Storage :

AT+CPBS command is used to choose the storage of phone book memory

Cell Phone Book Write :

AT+CPBW command is used to write phone book entry

The commands used for SMS text mode mainly include the following.

دستورات استفاده شده برای حالت ارسال تکست که عموما شامل :

AT+CSMS command is used to select message service

برای انتخاب سرویس پیام

AT+CMGF command is used to format message

برای فرمت پیام

AT+CMGR command is used to read the message

برای خواندن پیام

AT+CMGD command is used to delete the message

برای حذف پیام

AT+CMGS command is used to send message

برای ارسال پیام

AT+CMGW command is used to write a message to memory

برای نوشتن پیام به حافظه

howToSendSMSFromPC

AT
OK
AT+CMGF=1
OK
AT+CMGW="+85291234567"
> A simple demo of SMS text messaging.
+CMGW: 1

OK
AT+CMSS=1
+CMSS: 20

OK

CMGW : Write To Storage

CMSS : Send message from storage

HyperTerminal

Contact Phone Book Read
AT+CPBR=1

</a>”>AT+CPBR=?
+CPBR: (1-100),40,25
OK

کتابچه تلفن تا 100 ورودی را پشتیبانی می کند ، حداکثر طول ورودی متن 40 و حداکثر طول شماره تلفن 25 است

جستجو کردن برای ورودی دفترچه تلفن :

AT+CPBF="Ali"

smspdu

sms-at-commands

Chr(26) : Ctrl+Z

OpenSerialPort

dim StrInput as string * 11

Open "Com1:9600,n,8,1" for binary Access Read Write as #1

Put #1,,Chr(2)+"Hello World"+Chr(13)+Chr(26)
Sleep 100

Do While True

Input #1,strInput

Debug.print Left(strInput,256)

Loop

Close #1

ATD : Dial

ATH0

ATM0

D : Dial

H : Hang

L : Redials last number dialed

P : Pulse dial

T : Tone Dial

M0 : Speaker off

M1 : Speaker is on until a carrier detect

M2 : Speaker is always on

M3 : Speaker is on during answering only

M و اعداد مقابلش برای خاموش کردن ، روشن تا زمان اتصال ، روشن کردن بلندگو یا روشن بودن فقط زمان پاسخگویی

بین هر دستور AT باید یک فاصله زمانی کوتاه باشد تا Ok را برگرداند.اگر fail دهد انجام نخواهد شد.

Example :

StringCmd="ATDT" & PhoneNumber & vbCrLf

Sleep 100

StringCmd="ATM1" & vbCrLf

Sleep 100

StringCmd="ATH0" & vbCrLf

ATDT = attention dial tone
ATH1 = attention pickup handset (you should hear a dial tone)
ATH0 = attention hang up
ATM1L3 = m is for speaker, l is for volume

ATM1L3 ، که در بالا گفته شد M برای بلندگو و L برای حجم صدا

DT : Tone dial

DP : Palse Dial

L0 : Volume Off

L1 : Volume low

L2 : Volume medium

L3 : Volume High

ATH0 : Hang Up ( go on-hook)
ATH1 : Pick Up ( go off-hook )

AT+CPOWD=

n -> 0 Power off urgently

1 Normal poweroff

AT+CMGW: Used to store a message in the SIM. After the execution of the command, the ‘>’ sign appears in the next line where the message can be entered.

برای ذخیره پیام در SIM استفاده می شود.بعد از اجرای دستور ، علامت < در خط بعد ظاهر می شود که پیام آنجا وارد می گردد.یعنی اول شماره موبایل نوشته می شود بعد اینتر یا (Chr(13 یا vbcrlf و زمانیکه علامت بزرگتر ظاهر شده پیام Write می شود و بعد Crtl+Z یا (26)Chr ارسال می شود ، پس بین ارسال خط اول و نوشتن پیام باید یک فاصله کوتاه زمانی باشد اگر علامت < پیدا یا مشاهده نشد یعنی قادر به Write نیستید. نوشتار آن به روش زیر بیان شده

SYNTAX: AT+CMGW=” Phone number”> Message to be stored Ctrl+z

مطلب از سایت داخلی :

AT+CMGF فعال کردن مد TEXT یا PDU برای ارسال پیام کوتاه

Example:AT+CMGF=1 TEX MODE & AT+CMGF=0 PDU MODE

AT+CMGS ارسال پیام کوتاه

Example: AT+CMGS="0913222222"

AT+CMGR خواندن پیام کوتاه های ذخیره شده

Example:AT+CMGR=1 خواندن اولین پیام

AT+CNUM نمایش شماره تماس گیرنده

AT+GSMBUSY رد تماس دریافتی

purgecomm

PurgeComm empties the buffer without transmission or reception (its a delete basically)

پس ما داده را می بایست به بافری ( بافر حافظه ای در Ram برای ذخیره اطلاعات : موقت ) انتقال بدهیم ، این تابع Api بافر را بدون انتقال یا پذیرشی خالی می کند

flushfilebuffers

بافرهای یک فایل مشخص را Flush می کند و باعث می شود تمام داده های بافر در یک فایل نوشته شوند.

A buffer flush is the transfer of computer data from a temporary storage area to the computer's permanent memory

Lib "Kernel32"

ارسال داده های محدوده انتخابی به تکست فایل :

Set rng=Selection

Open myFile For Output As #1

For i = 1 To rng.Rows.Count

For j = 1 To rng.Columns.Count

cellValue = rng.Cells(i, j).Value

If j = rng.Columns.Count Then

Write #1, cellValue

Else

Write #1, cellValue,

End If

Close #1

VISCAcommands

"C:\Program Files (x86)\Webcam Surveyor\WebcamSurveyor.exe /capture"

/imgclose : take a snapshot img and close app

SMS PDU ( POCKET DATA UNIT ) :

Introduction to SMS PDU Mode. The PDU mode offers to send binary information in 7 bit or 8 bit format. ... The SMS message, as specified by the Etsi organization (documents GSM 03.40 and GSM 03.38), can be up to 160 characters long, where each character is 7 bits according to the 7-bit default alphabet.

معرفی : حالت PDU ارسال اطلاعات باینری را در قالب ۷ یا ۸ بیتی ارائه می دهد.. پیامک همانطور که توسط سازمان Etsi مشخص شده می تواند تا 160 کاراکتر طول داشته باشد ، هر کاراکتر ۷ بیت است طبق الفبای پیش فرض ۷ بیتی.

1 byte= 8 bits

پس هر کاراکتر ۷ یا 8 بیت یا یک بایت است

مطلب زیر هم جالبه در Encoding و Concat کردن ، در پیام های یونیکد ( منظور اینجا فارسی ) که طول رشته بیشتر از 67 است ( utf+16 ) و ماکزیمم ارسال در هر پارت 67 کاراکتر است البته جز تک پارت که 70 کاراکتر می شود ارسال کرد حداکثر 256×256 کاراکتر. کدینگ GSM ، جایگزینی را برای Ascii بسط داده و جدولش رو هم ذکر کرده و در حالت سنگل 160 کاراکتر می توان ارسال کرد برای چند پارتی 153 کاراکتر در هر پارت.

messaging-services/character-sets/

این Encoding شامل قسمت های مختلفی است

مرحله اول مشخص کردن مرکز پیام :

اول شماره موبایل بصورت دو رقم جدا شده اگر عددی فرد افتاد به آن F اضافه می شود و هر کدام برعکس می شود .اگر در اول شماره + ( بیانگر شماره بین المللی ) باشد 91 بجای مثبت جایگزین می شود در غیر اینصورت 81 ، بعد از جدا کردن و معکوس کردن هر دو رقم ، شمرده می شوند که نتیجه به اول عبارت اضافه نی شود مثال :

+98930=919830=91 8903=03 91 89 03=03918903

تابع می نویسید یا پراپرتی در نظر می گیرید که شماره رو بگیره یا چون مرکز پیام در گوشی مشخص است 001100 را بکار ببرید بجای اعمال شماره موبایل sender

قسمت دوم گزارش پیام :

عدد 31 برای موافق بودن و 11 برای عدم تمایل که به مرکز پیام اضافه می شود

قسمت رفرنس پیام :

فرضا پیام ذخیره ای شده ای را می خواهید بفرستید و چون ندارید اینکس 0 است و ندارید از 00 استفاده کنید.

قسمت شماره مقصد :

اگر مثبت جلوش باشه ( شماره بین المللی ) عدد 91 و در غیر اینصورت عدد 81 و اول ارقام بصورت تکی شمارش میشه ( مثل مرکز پیام نیست که دورقم جدا میشه و بعد شمارش ) یعنی اگر شماره شما معمولی باشد مثل 780 ... 0939 و تعداد کاراکتر آن 11 باشد میشود در نتیجه اول عدد هگزادسیمال قرار میگیرد ( شمارش کاراکتر ) و بعد عدد 81 و بعد اعداد موبایل که دو تا دوتا جدا شد برعکس می شود اگر عدد فردی در آخر ماند با F0 جمع می شود.مثلا اگر موبایل ورودی 09390000018 باشد چون معمولی است ( نقیشون ) عدد 81 را در نظر بگیرید فعلا ... تعداد کاراکتر موبایل 11 رقم است در نتیجه شمارهِ هگزادسیمال آن می شود B که چون باید دو رقم ذکر شود یک صفر قبل از آن می گذاریم و می شود 0B اگر دوازده رقم بود میشد 0C

09-39-00-00-01-8

0C819093000010F8

قسمت بعدی 00 قرار داده شود

قسمت بعد کاراکترها قرار می گیرند و طول در اول آن قرار می گیرد

09300000016 :

81-09-30-00-00-01-6

L : 07

81 90 03 00 00 10 F0+6

81 90 03 00 00 10 F6

مثال زیر از یونیکد 8 برای ارسال تکست استفاده کرده و CMGF یا فرمت باید تنظیم شود. 001100 از خود آن دستگاه که سیم نصب است ارسال می کند احتیاج به قید شماره سیم دستگاه نیست.

00

11

00

Reciever Number Len =0C (09390000018)

National = 81

Number =9093000010F8

PID=00

DCS ( Data Coding Scheme ) =08 Unicode 16 utf+16

Validity Period=AA : 4 Days , 2 Hours

UDL(Data Len)=08

06450648062F0628

0011000C819093000010F80008AA0806450648062F0628

حاوی ارسال کلمه مودب البته فقط 70 کاراکتر همراا با Space می فرستد که برای بیشتر از آن باید پارت پارت شود و هر کدام index ترتیبی میگیرد فرضا 01 و ....

online-sms-pdu-decoder/ < ----چک کنید

AT+CMGF=0 'Set PDU mode

AT+CSMS=0 'Check if modem supports SMS commands
AT+CMGS=23 'Send message, 23 octets (excluding the two initial zeros) '

>0011000B916407281553F80000AA0AE8329BFD4697D9EC37
Ctrl+Z Or Chr(26)

Character to Hex :

h ... Ascii code=104

104/16=6.5 ..... خارج قسمت برابر 6

mod(104,16)=8 ....(104-16×6)=8 ( باقیمانده تقسیم )

ascii(104) to Hexadecimal=68

hex(68) to ascii = 6×16^(1)+8×16^(0)=104

decimal number

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

hexa decimal number

1 2 3 4 5 6 7 8 9 A B C D E F

HEX(459) : تبدیل دسیمال به هگزادسیمال

459÷256=1 خارج قسمت

459-1×256=203

203÷16=12 خارج قسمت C

203-12×16=11 باقیمانده B

Decimal 459 = 1CB Hexadecimal

البته خود اکسس اینکار رو انجام میده احتیاجی به محاسبات یا نوشتن تابع نیست.

برای ارسال یونیکدها از utf+16 بهره می بریم و Dcs یا دیتا کد آن می شود 08 و می بایست دسیمال آن به هگزادسیمال تبدیل شود پس داریم :

HTML DECIMAL : حرف م عربی

6×16^(2)+4×16^(1)+5×16^(0)=1605

HTML HEX : 645

1605÷256=6 خارج قسمت

1605-6×256=69 مانده

69÷16=4 خارج قسمت

69-4×16=5 مانده

HTML DEC 1605 = HTML HEX 645

در ارسال دیتا حتما 645 به 0645 تبدیل شود

پس طبق فرمول بالا متوجه شدید که چطور می شود دسیمال را به هگزا و برعکس تبدیل کرد، فرضا در خواندن دیتا اگر هگز 0645 را دریافت کردید متوجه می شوید که اول صفر آن برداشته میشود و بعد از سمت راست عدد شروع به توان گذاری ترتیبی عدد 16 از صفر می کنید و در عدد مربوطه ضرب می شود.

0645=645=6×16^2+4×16^1+5×16^0=1605

Chrw(1605)=م

بازم احتیاج به نوشتن کد برای تبدیل هگزا 0645 به دسیمال 1605 نیست خود اکسس اینکار را انجام میدهد.کافیست قبلش "H&" بگذارید و ......

online-sms-pdu-decoder

0011000B916407281553F80008AA0406450646

003100 شماره مرکز پیام

LEN=0B طول شماره ارسالی

National=81

Number Reverse 2 Digits=9003000010F7

(ارسال به شماره 09300000017 )

0B تعداد رقم ها می شود 12 و به هگزا

PID=00

DCS=08 Data Coding Unicode utf+16

Validity=AA اعتبار ۴ روز

UDL=02 طول دیتا

UD=0645

برای حالت ارسال در زمان و تاریخ خاص است که از time stamp می شود استفاده کرد.در لینک هایی که گذاشته شده مشخص است چک کنید.

AT+CMGS=15 ( از بعد از شماره مرکز شمارش دوتایی شروع می شود )

0691891901500001000B819003000010F70008020633

LEN=06

918919015000 : SMC +98110050

01

00

Len reciever=0B

Number=819003000010F7 : 9300000017

PID=00

DCS=08 کدینگ Utf+16

UDL=02 طول داده در زیر

UD=0633 س

AT+CMGS=16

With Validity : دو رقم بعد از 08 کدینگ

0691891901500011000B819003000010F700080B020633

PDU TYPE : SMS-SUBMIT

rednaxela

0031000B819003000010F700080B020633

0031000B819003000010F70008BB020633

مثالی دیگر از کد کردن برای ارسال :

برای ارسال حتما باید شماره ارقام دوتایی ارسال شود قبل از ارسال کدینگ که در پائین ترش آمده این شمارش دوتایی از همان 11 شروع می شود

AT+CMGS=38

06918919015000 حاوی شماره مرکز پیام

1100

0B819073000010F7 حاوی شماره گیرنده

00

08 کدینگ

0B مدت اعتبار پیامک

زیرین دو رقم اول حاوی طول رشته به کد ( هگزا ) ... طول خود رشته 12 است چون از کد html استفاده کردیم 12 را در 2 ضرب کردیم ( 0645 دورقم شمارش میشود 2 بیت ) شد 24 و خارج قسمت 24 به 16 و باقیمانده را کنار هم گذاردیم شد 18 و بعد از 18 هگزای هر کارکاتر به html بیان شده یعنی decimal هر کاراکتر به هگزادسیمال تبدیل شده.

1806330644062706450020062F06480633062A002006450646

سلام دوست من

SMSC#+9891100500 مرکز پیام

Receipient:09370000017 ارسال به موبایل

Validity:Rel 1h مدت یکساعت

TP_PID:00

TP_DCS:08 کدینگ

TP_DCS-popis:Uncompressed Text

No class

Alphabet:UCS2(16)bit

سلام دوست مم

Length:12 طول رشته بانضمام فاصله ها

حداکثر تا 70 کاراکتر در این حالت قابل ارسال است

AT+CMGS=46
0031000B819003000010F700080B20
06370631062D0020062C0647063400200645063306A9064600200645064406CC

Receipt requested
SMSC#
Receipient:09300000017
Validity:Rel 1h
TP_PID:00
TP_DCS:08
TP_DCS-popis:Uncompressed Text
No class
Alphabet:UCS2(16)bit

طرح جهش مسکن ملی
Length:16

کدینگ زیر برای ارسال متن یونیکد در تاریخ 29 دسامبر 2021 با درخواست تحویل پیام ( 24 )

0691891901500024

0B91893900000071

0008122192115030110406450646

Receipt requested

SMSC#+9891100500

Sender:+989300000017

TimeStamp:29/12/21 11:05:03 GMT ?

TP_PID:00

TP_DCS:08

TP_DCS-popis:Uncompressed Text

No class

Alphabet:UCS2(16)bit

من

Length:2

فرمت PDU :

حروف الفبا ممکن است متفاوت باشند و چندین گزینه رمزگذاری هنگام نمایش پیامک وجود دارد رایج ترین آنها PCDN و PCCP437 و IRA و GSM و 8859-1 است . وقتی پیامکی را در یک برنامه رایانه ای می خوانید ، توسط دستور AT+CSCS تنظیم می شوند

ارسال پیامک در زمان موردنظر :

06918919015000240DD0E474D81C0EBB01000812218251000000020645

06918919015000000B819003000010F000812218251000000020645

Octal Number To Decimal

Oct : 150

1×8^(2)+5×8^(1)+0×8^(0)=104

ادغام پیامک ها ( بیشتر از 70 کاراکتر در یونیکدها :

0041000B819003000010F7

PID=00

DCD=08

LEN=08

050003000301 : 1/3

DATA=0645

Example of the UDH for an sms split into two parts:

UDH : DATA HEADER

CC : یک رفرنس است می توانید خودتان 00 یا 01 بگذارید

05 00 03 CC 01 02

05 00 03 CC 02 02

یک از دو و دو از دو تعداد در آخر آمده فرضا اگر در یونیکد تعداد کاراکتر بیش از 70 بود باید در دو پارت با رفرنس یکسان که CC نامگذاری شده ارسال گردد ولی زمان تحویل اینها Concatenate می شوند

05 00 03 CC 01 01 :UDH FOR SINGLE PART

در لینک زیر کاملا توضیح داده شده :

Concatenated_SMS

06918919015000

240B819003000010F7

0008122192515151000406450646

To: 380933522620

Message: Hello! Test SMS in GSM-7

Encoded PDU string:

0001000C81839033256202000018C8329B FD0E81A8E5391D346D4E416937E8386DB6 6E1A

Details about PDU string:

1. 00 - skipped SMSC

2. 01 - PDU-Type

3. 00 - TP-MR

4. 0C - length of To number.

5. 81 - type of number (unknown, also tried 0x91 which is international)

6. 83 90 33 25 62 02 - To number

7. 00 - TP-PID

8. 00 - TP-DCS (GSM 7bit, default SMS class)

9. 18 - TP-UD (24 letters)

10. C8 32 ... B6 6E - packed message

11. 1A - ctrl+z

برای ارسال پیام به صورت دوپارتی :

"AT+CMGF=0"+Chr(13) ' Enter ...<CR>

"AT+CMGS=21"+Chr(13)

"0041000B819003000010F7000808050003CC02010645"+Chr(26) ' Ctrl+Z

"AT+CMGF=0"+Chr(13) ' Enter ...<CR>

"AT+CMGS=21"+Chr(13)

"0041000B819003000010F7000808050003CC02020646"+Chr(26) ' Ctrl+Z

در کد کردن بالا پیام به دو پارت تقسیم شد حرف م و ن را ارسال میکند البته در قالب یک پیامک از 004100 حتما استفاده شود در CMGS طول نوشته می شود بصورت دوتایی از 41 تا آخر که در اینجا 21 است

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

در Encoding اسپلیت شده 004100 ثابت است و همینطور 050003 ( فقط باید یک رفرنس برای پیام مشخص کنید فرضا از 00 تا FF و برای هر پارت یکی باشد شماره موبایل عوض شد تغییر کند بالا CC فرض شد) و بعد تعداد کل پارت و شماره پارت تغییر می کند . شماره موبایل گیرنده را کد کنید . کاراکترها را 67 تا 67 تا جدا کنید ، فرضا تعداد کاراکترهای فارسی و غیره به انضمام Space هایی که بین حروف است 230 باشد پس می شود 4 پارت یعنی 3 پارت با طول 67 و یک پارت باطول 29 .... در 67 کاراکتر پارت اول لوپ بزنید و هگزادسیمال آنرا با تابع $Hex بگیرید همانطور که گفته شد باید به فرمت 0000 باشد( حتما اگر هگز 645 بود باید به فرمت 0645 در آید می توانید از تابع $ Format استفاده کنید ) بعد از اتمام طول آنرا بانضمام هدر آن که 01 03 00 03 00 05 ( بالا توضیح دادیم بعد از 03 عدد 00 رفرنس این چهار پارت است که در چهارپارت باید همین باشد و بعدی تعداد پارت ها و 01 نیز شماره پارت که یک است )

خلاصه مطلب بالا ، ابتدا طول رشته ی ارسالی با تابع Len گرفته می شود( برای پیام فارسی حداکثر طول رشته در هر پارت 67 است ) و سپس تعداد پارت های ارسالی مشخص میشود بعد در هر پارت لوپ زده میشود که هگزادسیمال آن بدست آید با فرمت 0000 و در نهایت به هدر که توضیج داده شده حاوی تعداد کل و شماره پارت است متصل شده و طول کل آن ( دوتا دوتا ) در اول آن قرار می گیرد و در نهایت به کدشده شماره گیرنده و ثابت 004100 می پیوندد و تعداد کل از 41 تا آخر بصورت دوتایی در CMGS قرار داده میشود. به ترتیب ارسال می شوند CMGS ، ارسال اینتر ، ارسال کدینگ انجام گرفته برای پارت اول ، ارسال کنترل + Z .... اگر طول رشته کمتر از 70 بید در هدر بجای تعداد کل 01 و بجای شماره پارت 01 لحاظ میشود 01 01 00 03 00 05 ، عدد 05 در اینجا طول هدر است .

تصویر زیر نمایی از استخراج Phone Book با دستور AT+CPBR=1,99 است ، 99 منظور تعداد است ممکن است در دفترچه شما 150 شماره موجود باشد لذا باید بجای 99 از 150 استفاده بنمائید

To Get Phone Book Data with Open Statement

AT+CMGL=ALL ' Message List

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

نکنید

دستورات ارسال پیام AT Commands ارسال به تکست فایل AT+CPBR=1 99

پروفسور اکسس ایران یکشنبه 5 دی 1400 ساعت 12:48

0 نظر

کد نویسی در اکسس

کد نویسی در اکسس با دریافت مبلغ مربوطه فقط کدهای اکسسی نه script نویسی ، پروژه پذیرفته نمی شود و فقط در حد رفع مشکل. لطفا زیر همین پست مشکل در کد نویسی جهت رفع قرار داده شود شاید سایر دوستان نیز در رفع آن کمک بنمایند.

لطفا نظرسنجی فراموش نشود.

برنامه نویسی در اکسس کد نویسی اکسس Access پروژه اکسس

پروفسور اکسس ایران یکشنبه 5 دی 1400 ساعت 11:44

0 نظر

متن آهنگ قهرمان

There's a hero

If you look inside your heart

You don't have to be afraid

Of what you are

There's an answer

If you reach into your soul

And the sorrow that you know

Will melt away

And then a hero comes along

With the strength to carry on

And you cast your fears aside

And you know you can survive

So when you feel like hope is gone

Look inside you and be strong

And you'll finally see the truth

That a hero lies in you

It's a long road

When you face the world alone

No one reaches out a hand

For you to hold

You can find love

If you search within yourself

And that emptiness you felt

Will disappear

And then a hero comes along

With the strength to carry on

And you cast your fears aside

And you know you can survive

So when you feel like hope is gone

Look inside you and be strong

And you'll finally see the truth

That a hero lies in you, oh, oh

Lord knows

Dreams are hard to follow

But don't let anyone

Tear them away, hey yeah

Hold on

There will be tomorrow

In time you'll find the way

And then a hero comes along

With the strength to carry on

And you cast your fears aside

And you know you can survive

So when you feel like hope is gone

Look inside you and be strong

And you'll finally see the truth

That a hero lies in you

Mmm, that a hero lies in you

hero قهرمان حاج

پروفسور اکسس ایران شنبه 4 دی 1400 ساعت 20:48

0 نظر

قیرپاشی مزار روح الله زم

یا بسیجی ها بودند یا عناصر خودفروخته جهت تفرقه افکنی

ریاست محترم سازمان بهشت زهرا (ع)
جناب آقای غضنفری
با سلام

احتراماً از اقدامِ به‌جا و دستور خردمندانه جنابعالی در پاک‌سازی آلودگی‌های ناشی از قیرپاشیِ عوامل ناشناخته! بر سنگ مزار زنده‌یاد روح‌الله زم سپاسگزاری می‌گردد.

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

بی‌شک برای پیشگیری از این خطاها می‌توانید دوربین‌های مشرف بر این مزار را کنترل و عوامل خطاکار را شناسایی کنید و برای تبری سازمان متبوع خود، آنان را به مردم و مبادی ذیربط معرفی نمایید.

کار ناپسندیده ای است و متاسفانه دله دزدی و اهانت به مزار متوفی در بهشت زهرا داره مرسوم میشه و با اینهمه پولی که از مردم می گیرن ( قبرهای سه طبقه با مبلغ ۸۰ میلیون تومان ) و شهرداری ، هنوز هم این قبیل خلاف ها انجام میشه . حتی دستگاه قضا هم ورود نکرده ، اینهمه سرباز گمنام در ایران وجود داره که می تونن روح الله زم رو دستگیر کنن با تور اطلاعاتی ولی از پس یه مشت یاغی و معتاد بر نمیان البته گرانی و قیمت سنگ ها هم وسوسه کنندست!!!

قیرپاشی مزار روح الله زم روح الله زم بهشت زهرا شهدا تهران

پروفسور اکسس ایران شنبه 4 دی 1400 ساعت 19:42

0 نظر

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

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

درباره من

نظرسنجی

تقویم

Msgbox در اکسس

تابع SendInput

تابع ShowWindow و GetWindow در API

ذخیره کردن هر ویرایشی در Single Form

نحوه ساخت ساعت آنالوگ ( ثانیه شمار ) با استفاده از کنترل Line

تابع FreeFile در دستور Open

Hook و UnHook کردن پنجره برای مدیریت پیام های ویندوزی

تبدیل تاریخ میلادی شمسی - اختلاف روزهای شمسی از سال 1300 تا کنون

تابع ویندوزی Mouse_Event برای Right Click در صفحه

Open StateMent

پیمایش با غلطک ماوس در رکوردهای فرم

Syntax ( نوشتاری )

تعدادی از توابع ویندوزی در VBA7

CB_SETEDITSEL message :

Parameters

Return value : در صورت موفقیت عدد غیر صفر بر می گرداند

Remarks : موقعیت اولین کارکتر در کنترل ویرایش صفراست

آبجکت WebBrowserControl

WindowSetTop Event :

CommandStateChangeConstants enumeration

نوشتن کلاس ماژول و استاندارد ماژول در اکسس

جستجوی فایل با تابع ویندوزی SearchTreeForFile

گرفتن هندل Webbrowser

ولایت فقید

#32770

عبارت Put و Get در VBA

خواندن دیتا از یک فایل باز به یک متغیر

برقراری تماس از طریق مودم GSM با دستورات AT COMMAND یا فایل HYPER TERMINAL و حتی ارسال پیام ( به فرمت PDU )

SubClass A Window

دستورات AT در ارسال پیام به دستگاه

کد نویسی در اکسس

متن آهنگ قهرمان

قیرپاشی مزار روح الله زم

Cmmand :
CSC_NAVIGATEFORWARD ( Value : 1) The enabled state of the Forward button has changed. CSC_NAVIGATEBACK ( Value : 3 ) If Command = 2 Then Me.Command5.Enabled = Enable CommandStateChangeConstants enumeration How To Hide Or Show WebBrowser Control Me.WebBrowser0.Visible = False		The enabled statebutton has http:// changed.

درباره من

نظرسنجی

روزانه‌ها

پیوندها

AcceeVba

جدیدترین یادداشت‌ها

بایگانی

تقویم

جستجو

Syntax ( نوشتاری )

CB_SETEDITSEL message :

Parameters

Return value : در صورت موفقیت عدد غیر صفر بر می گرداند

Remarks : موقعیت اولین کارکتر در کنترل ویرایش صفراست

WindowSetTop Event :

خواندن دیتا از یک فایل باز به یک متغیر