سورس کدهای vb + سوال بپرس (حرفه ای)

آقا بلاخره برای آپلود یه جای خوب پیدا کردم ...
اولین سورس کد :
یک سورتر عدد نسبتا ساده

" [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ] "

من برنامه اي براي تشخيص متن زير موس مي خوام
يك نمونه پيدا كردم اما بايد فايلهاش رجيستر بشه
نمونه اي شما سراغ داريد؟

نقل قول:

---

نوشته شده توسط parselearn [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

من برنامه اي براي تشخيص متن زير موس مي خوام
يك نمونه پيدا كردم اما بايد فايلهاش رجيستر بشه
نمونه اي شما سراغ داريد؟

---

سلام!چيزي كه شما نياز داريد OCR نام داره كه تو هشتاد درصد موارد درست عمل ميكنه.
به نظر من بهتره به جاي OCR از اين روش استفاده كنيد كه Handle قسمت يا كنترلي كه موس روي اونه رو بدست بياريد و با استفاده از اون متن روي كنترل رو تشخيص بديد،كاري كه Babylon انجام مي ده.

من هم با نظر آقا مجید موافقم .
سورس کد OCR ها خیلی پیچیده است و به نظر من بهترین راهش هم همون کاریه که گفتن ، یعنی handle اون رو میگیره و متن رو بر میگردونه ...
در ضمن فکر کنم سورسشو داشته باشم ... اگه داشتم براتون میزارم .

سلام ؛ تو این پست یه سورس از یه کتابخانه دیجیتال ساده میزارم که خیلی ساده هستش ولی برای آموزش کار با فایل های متنی خوبه ...
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

سلام به همه ؛
یه سورس کد برای کمرنگ کردن فرم :

کد:

---


Option Explicit
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Declare Function GetWindowLong Lib "user32" _
  Alias "GetWindowLongA" (ByVal hWnd As Long, _
  ByVal nIndex As Long) As Long
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 SetLayeredWindowAttributes Lib _
    "user32" (ByVal hWnd As Long, ByVal crKey As Long, _
    ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
 
 
Public Function TranslucentForm(frm As Form, TranslucenceLevel As Byte) As Boolean
SetWindowLong frm.hWnd, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes frm.hWnd, 0, TranslucenceLevel, LWA_ALPHA
TranslucentForm = Err.LastDllError = 0
End Function
 
 
Private Sub Form_Load()
TranslucentForm Me, 128
End Sub

---

این عدد آخری که 128 هست میتونه از 0 تا 255 باشه که هرچی بیشتر باشه فرم پر رنگ تره ...

سلام ؛
یه سورس برای تغییر عکس دسکتاپ (wall paper)

کد:

---

Private Declare Function SystemParametersInfo Lib "user32" Alias _
    "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
    ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_SENDWININICHANGE = &H2
Const SPIF_UPDATEINIFILE = &H1
 
Function SetWallpaper(Optional ByVal FileName As String) As Boolean
    If SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, ByVal FileName, _
        SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE)Then
        SetWallpaper = True
    End If
End Function

---

اگر عکس عوض شود تابع مقدار true را بر میگرداند ...

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

کد:

---

Public Function m_to_sh(input_date As Date, xxx As Integer) As String
Dim calendar As calender
Dim today, today_sh, this_month, this_year, this_year_sh As Integer
Dim this_month_sh As String
Dim today_sh_text, mm As String
Dim m As Integer
today = Day(input_date)
this_month = Month(input_date)
this_year = Year(input_date)

If (this_year Mod 4) = 0 Then

Select Case this_month
Case 1
m = "01"
calender.start = 11
calender.last = 30
calender.p_month = "دي"
calender.s_month = "بهمن"
  '----------------------------'
Case 2
m = "02"
calender.start = 12
calender.last = 30
calender.p_month = "بهمن"
calender.s_month = "اسفند"
  '----------------------------'
Case 3
m = "03"

calender.start = 11
calender.last = 29

calender.p_month = "اسفند"
calender.s_month = "فروردين"
  '----------------------------'
Case 4
m = "04"
calender.start = 13
calender.last = 31
calender.p_month = "فروردين"
calender.s_month = "ارديبهشت"
  '----------------------------'
Case 5
m = "05"
calender.start = 12
calender.last = 31
calender.p_month = "ارديبهشت"
calender.s_month = "خرداد"
  '----------------------------'
Case 6
m = "06"
calender.start = 12
calender.last = 31
calender.p_month = "خرداد"
calender.s_month = "تير"
  '----------------------------'
Case 7
m = "07"
calender.start = 11
calender.last = 31
calender.p_month = "تير"
calender.s_month = "مرداد"
  '----------------------------'

Case 8
m = "08"
calender.start = 11
calender.last = 31
calender.p_month = "مرداد"
calender.s_month = "شهريور"
  '----------------------------'

Case 9
m = "09"
calender.start = 11
calender.last = 31
calender.p_month = "شهريور"
calender.s_month = "مهر"
  '----------------------------'
Case 10
m = "10"
calender.start = 10
calender.last = 30
calender.p_month = "مهر"
calender.s_month = "آبان"
  '----------------------------'
Case 11
m = "11"
calender.start = 11
calender.last = 30
calender.p_month = "آبان"
calender.s_month = "آذر"
  '----------------------------'
Case 12
m = "12"
calender.start = 11
calender.last = 30
calender.p_month = "آذر"
calender.s_month = "دي"
End Select
'----------------------------'
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&'
 '----------------------------'
Else
Select Case this_month
Case 1
m = "01"
calender.start = 12
calender.last = 30
calender.p_month = "دي"
calender.s_month = "بهمن"
  '----------------------------'
Case 2
m = "02"
calender.start = 13
calender.last = 30
calender.p_month = "بهمن"
calender.s_month = "اسفند"
  '----------------------------'
Case 3
m = "03"
calender.start = 11
If ((this_year - 1) Mod 4 = 0) Then
calender.last = 30
Else
calender.last = 29
End If
calender.p_month = "اسفند"
calender.s_month = "فروردين"
  '----------------------------'
Case 4
m = "04"
calender.start = 12
calender.last = 31
calender.p_month = "فروردين"
calender.s_month = "ارديبهشت"
  '----------------------------'
Case 5
m = "05"
calender.start = 11
calender.last = 31
calender.p_month = "ارديبهشت"
calender.s_month = "خرداد"
  '----------------------------'
Case 6
m = "06"
calender.start = 11
calender.last = 31
calender.p_month = "خرداد"
calender.s_month = "تير"
  '----------------------------'
Case 7
m = "07"
calender.start = 10
calender.last = 31
calender.p_month = "تير"
calender.s_month = "مرداد"
  '----------------------------'

Case 8
m = "08"
calender.start = 10
calender.last = 31
calender.p_month = "مرداد"
calender.s_month = "شهريور"
'----------------------------'

Case 9
m = "09"
calender.start = 10
calender.last = 31
calender.p_month = "شهريور"
calender.s_month = "مهر"
  '----------------------------'
Case 10
m = "10"
calender.start = 9
calender.last = 30
calender.p_month = "مهر"
calender.s_month = "آبان"
  '----------------------------'
Case 11
m = "11"
calender.start = 10
calender.last = 30
calender.p_month = "آبان"
calender.s_month = "آذر"
  '----------------------------'
Case 12
m = "12"
calender.start = 10
calender.last = 30
calender.p_month = "آذر"
calender.s_month = "دي"

End Select
End If

If (this_month > 3) Or (this_month = 3 And today > 19) Then
this_year_sh = (this_year - 622) + 1 + (4 * xxx)
Else
this_year_sh = (this_year - 622) + (4 * xxx)
End If

today_sh = calender.start + today - 1
If today_sh <= calender.last Then
this_month_sh = calender.p_month
Else
this_month_sh = calender.s_month
m = m + 1
today_sh = today_sh - calender.last
End If

If today_sh < 10 Then
today_sh_text = "0" & today_sh
Else
today_sh_text = today_sh
End If

If m < 10 Then
mm = "0" & m
Else
mm = m
End If
m_to_sh = today_sh_text & "," & this_month_sh & "," & this_year_sh
End Function

---

آنتی ویروس
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

کد:

---

http://www.megaupload.com/?d=J92B2C10

---

[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

کد:

---

http://www.megaupload.com/?d=P60ND4ZK

---