الفرق بين تاريخين

Jun 04

الفرق بين تاريخين

11-Access 2010 VBA | DateDiff إيجاد فرق تاريخين | الفرق بين تاريخين.

فيديو الفرق بين تاريخين



Private Sub Form_Load() Me.Label1.Top = 0 End Sub Private Sub Timer1_Timer() a = Me.Height

قيّم هذا: في الخير share البريد الإلكتروني طباعة Telegram

المصدر : اتعلم اونلاين



مزيد من المعلومات حول الفرق بين تاريخين

قائمة البرمجة > لغة Visual Basic 6

بنك الاكواد للفيجوال بيسك Visual Basic 6 الكاتب: غير معروف

فتح الـ CD-ROM وإغلاقه

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Public Sub OpenCDDriveDoor(ByVal State As Boolean) If State = True Then Call mciSendString("Set CDAudio Door Open", 0&, 0&, 0&) Else Call mciSendString("Set CDAudio Door Closed", 0&, 0&, 0&) End If End Sub Private Sub Command1_Click() OpenCDDriveDoor (True) End Sub Private Sub Command2_Click() OpenCDDriveDoor (False) End Sub

إخفاء محتويات محرك الأقراص

Dim WSH As Object Set WSH = CreateObject("Wscript.Shell") WSH.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoViewOnDrive", 16, "REG_DWORD"

إخفاء محرك الأأقراص

Dim WSH As Object Set WSH = CreateObject("Wscript.Shell") WSH.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDrives", 4, "REG_DWORD"

إخفاء شريط المهام

Private Const SWP_HIDEWINDOW = &H80 Private Const SWP_SHOWWINDOW = &H40 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

' ضع هذا الكود في الفورم

Private Sub Command1_Click() Dim Task As Long Task = FindWindow("Shell_traywnd", "") Call SetWindowPos(Task, 0, 0, 0, 0, 0, SWP_HIDEWINDOW) End Sub Private Sub Command2_Click() Dim Task As Long Task = FindWindow("Shell_traywnd", "") Call SetWindowPos(Task, 0, 0, 0, 0, 0, SWP_SHOWWINDOW) End Sub

تشغيل ملف فيديو في Picture

Private Sub Form_Load() MMControl1.FileName = ("c:\FileName.dat") MMControl1.Command = "open" MMControl1.hWndDisplay = Picture1.hWnd End Sub

التقاط صورة للفورم في الحافظ

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Const VK_SNAPSHOT = &H2C Private Sub Command1_Click() keybd_event VK_SNAPSHOT, 1, 1, 1 End Sub

التقاط صورة للشاشة

Const RC_PALETTE As Long = &H100 Const SIZEPALETTE As Long = 104 Const RASTERCAPS As Long = 38 Private Type PALETTEENTRY peRed As Byte peGreen As Byte peBlue As Byte peFlags As Byte End Type Private Type LOGPALETTE palVersion As Integer palNumEntries As Integer palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors End Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID 'Fill GUID info With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With 'Fill picture info With Pic .Size = Len(Pic) ' Length of structure .Type = vbPicTypeBitmap ' Type of Picture (bitmap) .hBmp = hBmp ' Handle to bitmap .hPal = hPal ' Handle to palette (may be null) End With 'Create the picture R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) 'Return the new picture Set CreateBitmapPicture = IPic End Function Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE 'Create a compatible device context hDCMemory = CreateCompatibleDC(hDCSrc) 'Create a compatible bitmap hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc) 'Select the compatible bitmap into our compatible device context hBmpPrev = SelectObject(hDCMemory, hBmp) 'Raster capabilities? RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster 'Does our picture use a palette? HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette 'What's the size of that palette? PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of If HasPaletteScrn And (PaletteSizeScrn = 256) Then 'Set the palette version LogPal.palVersion = &H300 'Number of palette entries LogPal.palNumEntries = 256 'Retrieve the system palette entries R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0)) 'Create the palette hPal = CreatePalette(LogPal) 'Select the palette hPalPrev = SelectPalette(hDCMemory, hPal, 0) 'Realize the palette R = RealizePalette(hDCMemory) End If 'Copy the source image to our compatible device context R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy) 'Restore the old bitmap hBmp = SelectObject(hDCMemory, hBmpPrev) If HasPaletteScrn And (PaletteSizeScrn = 256) Then 'Select the palette hPal = SelectPalette(hDCMemory, hPalPrev, 0) End If 'Delete our memory DC R = DeleteDC(hDCMemory) Set hDCToPicture = CreateBitmapPicture(hBmp, hPal) End Function Private Sub Form_Load() 'Create a picture object from the screen Set Me.Picture = hDCToPicture(GetDC(0), 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY) End Sub

نسخ خلفية سطح المكتب إلى النموذج

Private Declare Function PaintDesktop Lib "user32" (ByVal hdc As Long) As Long Private Sub Command1_Click() PaintDesktop Form1.hdc End Sub

تشغيل ملف صوتي من نـramــوع Private Sub Command1_Click() RealAudio1.Source = "c:\AFR.ram" RealAudio1.DoPlay End Sub

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then Unload Me End Sub Private Sub Form_Load() Dim lngDC As Long Dim intWidth As Integer, intHeight As Integer Dim intX As Integer, intY As Integer lngDC = GetDC(0) intWidth = Screen.Width / Screen.TwipsPerPixelX intHeight = Screen.Height / Screen.TwipsPerPixelY form1.Width = intWidth * 15 form1.Height = intHeight * 15 Call BitBlt(hDC, 0, 0, intWidth, intHeight, lngDC, 0, 0, vbSrcCopy) form1.Visible = vbTrue Do intX = (intWidth - 128) * Rnd intY = (intHeight - 128) * Rnd Call BitBlt(lngDC, intX, intY + 1, 128, 128, lngDC, intX, intY, vbSrcCopy) DoEvents Loop End Sub Private Sub Form_Unload(Cancel As Integer) Set form1 = Nothing End End Sub

Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hwnd As Long, ByValcrKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Boolean Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Const LWA_ALPHA = 2 Const GWL_EXSTYLE = (-20) Const WS_EX_LAYERED = &H80000 Private Sub Form_Load() SetWindowLong hwnd, GWL_EXSTYLE, GetWindowLong(hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED SetLayeredWindowAttributes hwnd, 0, 128, LWA_ALPHA End Sub

Private Sub Form_Load() Dim Start, Finsh Form2.Show Start = Timer Finsh = Start + 3 Do Until Finsh <= Timer DoEvents Loop Unload Form2 Form1.Show End Sub

تحريك نص بطريقة مسلية

Private Sub Form_Load() Me.Label1.Top = 0 End Sub Private Sub Timer1_Timer() a = Me.Height

Source: http://www.boosla.com/showArticle.php?Sec=Programm&id=61


الفرق بين تاريخينالفرق بين تاريخين