پرستو پارسایی
سه شنبه 25 شهریور 1399, 12:45 عصر
با سلام من در یک پروژه از این 3 Function استفاده میکنم و کاملا بی عیب کار میکنه ولی در ویژوال استودیو در قسمت Error List با ارور های در عکس روبرو میشم لطفا در صورت اطلاع راهنمایی بفرمایید.
در خط دوم این فانکشن زیر Exit Function خط سبز هست
Private Function DrawPic(ByVal ZoomX As Single, ByVal ZoomY As Single) As Boolean
If IsNothing(srcBitmap) Then Exit Function
If srcHDC.Equals(IntPtr.Zero) Then
srcHDC = CreateCompatibleDC(IntPtr.Zero)
HBitmapSrc = srcBitmap.GetHbitmap()
SelectObject(srcHDC, HBitmapSrc)
End If
If desHDC.Equals(IntPtr.Zero) Then
If IsNothing(Gr) Then
Gr = Host.CreateGraphics
End If
desHDC = Gr.GetHdc()
SetStretchBltMode(desHDC, 3)
End If
Xout = False
Yout = False
If Host.Width > srcBitmap.Width * Zfactor Then
Mrec.X = 0
Mrec.Width = srcBitmap.Width
Brec.X = (Host.Width - srcBitmap.Width * Zfactor) / 2
Brec.Width = srcBitmap.Width * Zfactor
BitBlt(desHDC, 0, 0, Brec.X, Host.Height, srcHDC, 0, 0, TernaryRasterOperations.BLACKNESS)
BitBlt(desHDC, Brec.Right, 0, Brec.X, Host.Height, srcHDC, 0, 0, TernaryRasterOperations.BLACKNESS)
Else
Mrec.X = Mrec.X + ((Host.Width / oldZfactor - Host.Width / Zfactor) / ((Host.Width + 0.001) / ZoomX))
Mrec.Width = Host.Width / Zfactor
Brec.X = 0
Brec.Width = Host.Width
End If
If Host.Height > srcBitmap.Height * Zfactor Then
Mrec.Y = 0
Mrec.Height = srcBitmap.Height
Brec.Y = (Host.Height - srcBitmap.Height * Zfactor) / 2
Brec.Height = srcBitmap.Height * Zfactor
BitBlt(desHDC, 0, 0, Host.Width, Brec.Y, srcHDC, 0, 0, TernaryRasterOperations.BLACKNESS)
BitBlt(desHDC, 0, Brec.Bottom, Host.Width, Brec.Y, srcHDC, 0, 0, TernaryRasterOperations.BLACKNESS)
Else
Mrec.Y = Mrec.Y + ((Host.Height / oldZfactor - Host.Height / Zfactor) / ((Host.Height + 0.001) / ZoomY))
Mrec.Height = Host.Height / Zfactor
Brec.Y = 0
Brec.Height = Host.Height
End If
oldZfactor = Zfactor
'-----------------------------------
If Mrec.Right > srcBitmap.Width Then
Xout = True
Mrec.X = (srcBitmap.Width - Mrec.Width)
End If
If Mrec.X < 0 Then
Xout = True
Mrec.X = 0
End If
If Mrec.Bottom > srcBitmap.Height Then
Yout = True
Mrec.Y = (srcBitmap.Height - Mrec.Height)
End If
If Mrec.Y < 0 Then
Yout = True
Mrec.Y = 0
End If
StretchBlt(desHDC, Brec.X, Brec.Y, Brec.Width, Brec.Height, _
srcHDC, Mrec.X, Mrec.Y, Mrec.Width, Mrec.Height, _
TernaryRasterOperations.SRCCOPY)
Gr.ReleaseHdc(desHDC)
desHDC = Nothing
End Function
در این کد در آخرین خط زیر End Function خط سبز هست
Public Function Dispose()
If Not IsNothing(srcBitmap) Then
srcBitmap.Dispose()
srcBitmap = Nothing
End If
If Not srcHDC.Equals(IntPtr.Zero) Then
DeleteDC(srcHDC)
srcHDC = Nothing
End If
If Not IsNothing(Gr) Then
Gr.Dispose()
Gr = Nothing
End If
GC.Collect()
End Function
در این کد در آخر خط در Returnl.Handle.ToInt64 زیر l خط سبز داره
Public Function lang_changer_selectable(ByVal lang As String) As Int64 'load the main form's lamguage Dim l As InputLanguage
Dim ll As InputLanguageCollection
Dim a As String
Try
ll = InputLanguage.InstalledInputLanguages
For Each l In ll
a = Microsoft.VisualBasic.Left(l.LayoutName, 1)
Select Case lang
Case "EN"
If a = "E" Or a = "e" Or a = "u" Or a = "U" Then
Application.CurrentInputLanguage = l
Exit For
End If
Case "FA"
If a = "F" Or a = "f" Or a = "P" Or a = "p" Then
Application.CurrentInputLanguage = l
Exit For
End If
Case "67699721" 'us
If l.Handle.ToString = lang Then
Application.CurrentInputLanguage = l
Exit For
End If
Case "69796905" 'fa
If l.Handle.ToString = lang Then
Application.CurrentInputLanguage = l
Exit For
End If
End Select
Next
FileClose(1)
Catch ex As Exception
End Try
Return l.Handle.ToInt64
End Function
سپاسگزارم
در خط دوم این فانکشن زیر Exit Function خط سبز هست
Private Function DrawPic(ByVal ZoomX As Single, ByVal ZoomY As Single) As Boolean
If IsNothing(srcBitmap) Then Exit Function
If srcHDC.Equals(IntPtr.Zero) Then
srcHDC = CreateCompatibleDC(IntPtr.Zero)
HBitmapSrc = srcBitmap.GetHbitmap()
SelectObject(srcHDC, HBitmapSrc)
End If
If desHDC.Equals(IntPtr.Zero) Then
If IsNothing(Gr) Then
Gr = Host.CreateGraphics
End If
desHDC = Gr.GetHdc()
SetStretchBltMode(desHDC, 3)
End If
Xout = False
Yout = False
If Host.Width > srcBitmap.Width * Zfactor Then
Mrec.X = 0
Mrec.Width = srcBitmap.Width
Brec.X = (Host.Width - srcBitmap.Width * Zfactor) / 2
Brec.Width = srcBitmap.Width * Zfactor
BitBlt(desHDC, 0, 0, Brec.X, Host.Height, srcHDC, 0, 0, TernaryRasterOperations.BLACKNESS)
BitBlt(desHDC, Brec.Right, 0, Brec.X, Host.Height, srcHDC, 0, 0, TernaryRasterOperations.BLACKNESS)
Else
Mrec.X = Mrec.X + ((Host.Width / oldZfactor - Host.Width / Zfactor) / ((Host.Width + 0.001) / ZoomX))
Mrec.Width = Host.Width / Zfactor
Brec.X = 0
Brec.Width = Host.Width
End If
If Host.Height > srcBitmap.Height * Zfactor Then
Mrec.Y = 0
Mrec.Height = srcBitmap.Height
Brec.Y = (Host.Height - srcBitmap.Height * Zfactor) / 2
Brec.Height = srcBitmap.Height * Zfactor
BitBlt(desHDC, 0, 0, Host.Width, Brec.Y, srcHDC, 0, 0, TernaryRasterOperations.BLACKNESS)
BitBlt(desHDC, 0, Brec.Bottom, Host.Width, Brec.Y, srcHDC, 0, 0, TernaryRasterOperations.BLACKNESS)
Else
Mrec.Y = Mrec.Y + ((Host.Height / oldZfactor - Host.Height / Zfactor) / ((Host.Height + 0.001) / ZoomY))
Mrec.Height = Host.Height / Zfactor
Brec.Y = 0
Brec.Height = Host.Height
End If
oldZfactor = Zfactor
'-----------------------------------
If Mrec.Right > srcBitmap.Width Then
Xout = True
Mrec.X = (srcBitmap.Width - Mrec.Width)
End If
If Mrec.X < 0 Then
Xout = True
Mrec.X = 0
End If
If Mrec.Bottom > srcBitmap.Height Then
Yout = True
Mrec.Y = (srcBitmap.Height - Mrec.Height)
End If
If Mrec.Y < 0 Then
Yout = True
Mrec.Y = 0
End If
StretchBlt(desHDC, Brec.X, Brec.Y, Brec.Width, Brec.Height, _
srcHDC, Mrec.X, Mrec.Y, Mrec.Width, Mrec.Height, _
TernaryRasterOperations.SRCCOPY)
Gr.ReleaseHdc(desHDC)
desHDC = Nothing
End Function
در این کد در آخرین خط زیر End Function خط سبز هست
Public Function Dispose()
If Not IsNothing(srcBitmap) Then
srcBitmap.Dispose()
srcBitmap = Nothing
End If
If Not srcHDC.Equals(IntPtr.Zero) Then
DeleteDC(srcHDC)
srcHDC = Nothing
End If
If Not IsNothing(Gr) Then
Gr.Dispose()
Gr = Nothing
End If
GC.Collect()
End Function
در این کد در آخر خط در Returnl.Handle.ToInt64 زیر l خط سبز داره
Public Function lang_changer_selectable(ByVal lang As String) As Int64 'load the main form's lamguage Dim l As InputLanguage
Dim ll As InputLanguageCollection
Dim a As String
Try
ll = InputLanguage.InstalledInputLanguages
For Each l In ll
a = Microsoft.VisualBasic.Left(l.LayoutName, 1)
Select Case lang
Case "EN"
If a = "E" Or a = "e" Or a = "u" Or a = "U" Then
Application.CurrentInputLanguage = l
Exit For
End If
Case "FA"
If a = "F" Or a = "f" Or a = "P" Or a = "p" Then
Application.CurrentInputLanguage = l
Exit For
End If
Case "67699721" 'us
If l.Handle.ToString = lang Then
Application.CurrentInputLanguage = l
Exit For
End If
Case "69796905" 'fa
If l.Handle.ToString = lang Then
Application.CurrentInputLanguage = l
Exit For
End If
End Select
Next
FileClose(1)
Catch ex As Exception
End Try
Return l.Handle.ToInt64
End Function
سپاسگزارم