يوليار-=بىل-=ASPساقلىۋېلىشباش بەت قىلىش
Font Qachilashكەڭ ھالەت

ئىنتىل تورى

 پارول قايتۇرىۋېلىش
 تىزىملىتىش
ئىزدەش
ئاۋات ئىزدەش: مۇسابىقەchromeexcelwordps
ئىنتىل تورى › سەينا › پروگرامما › Visual Basic › VB6.0 دە رەسىم بىر تەرەپ قىلىش
تىزىملىككە قايتىش تېما يوللاش
كۆرۈش: 291|ئىنكاس: 3

VB6.0 دە رەسىم بىر تەرەپ قىلىش [ئۇلانما كۆچۈرۈش]

mars36 [ئىشەنچلىك ئەزا]  实名认证 

Rank: 8Rank: 8

تۆھپە
637
تىللا
1175
شۆھرەت
1241

شەرەپ تىرىشچان

يوللىغان ۋاقتى 2012-7-19 16:59:48 |ھەممە قەۋەتنى كۆرۈش
VB6.0 دە رەسىم بىر تەرەپ قىلىش (1)
VB6.0图像处理

مەزكۇر ماقالە ئارقىلىق VB6.0 دە ئەڭ ئاز كود بىلەن ئەڭ تېز سۈرئەتتىكى رەسىمنى رەڭ جەھەتتىن بىر تەرەپ قىلىش مىسال قىلىنىدۇ (ئەلۋەتتە كودنى كۆپەيتىش ئارقىلىق رەسىم بىر تەرەپ قىلىش سۈرئىتىنى تېخىمۇ تېزلىتىشكە بولىدۇ، ئەمما يېڭى ئۆگەنگۈچىلەر ئۈچۈن ھەم چۈشىنىكسىز ھەم مۇرەككەپ بوپقالىدۇ). مەن مۇشۇنچىلىكلا قىلالىدىم، ناۋادا بۇنىڭدىنمۇ ئاز كود بىلەن بۇنىڭدىن تېز ئۈنۈم يارىتالايدىغانلار بولسا قارشى ئالىمەن (قانداق چارە ياكى كود قوللانمايلى، مەڭگۈ C تىلىدىكى تېزلىك ئۈنۈمىگە يەتكۈزەلمەيمىز).
رەسىم بىر تەرەپ قىلىشنىڭ نېمىلىكىنى PhotoShop ئىشلىتىپ باققانلار بىلىدۇ. بۇ يەردىكى رەڭ جەھەتتىن بىر تەرەپ قىلىش ئەسلى رەسىمدىكى رەڭلەرنى مۇددىئايىمىزغا ئاساسەن مەلۇم قىممەتتىكى رەڭگە ئالماشتۇرۇشنى كۆرسىتىدۇ (مەسىلەن، كۈلرەڭ، قەھۋە رەڭ، مەلۇم بىر خىللا رەڭدە كۆرسىتىش، ياغاچ ئويما، ئاق-قارا، قاپارتما ھەيكەل، غۇۋالاشتۇرۇش، ئېنىقلاشتۇرۇش… دېگەندەك). بۇنىڭ پىرىنسىپى بەك ئاددىي بولۇپ، ھەر بىر نۇقتىدىكى رەڭنى نىشان ئۈنۈمدىكى رەڭ قىممىتىگە كەلتۈرۈپ بولۇپ يەنە ئەسلى رەسىمگە قايتۇرۇپ سىزىش.
كودقا قاراپلا «ۋايجان، مۇشۇ API كودىنى چۈشىنشتىن، ئىشلىتىشتىن ساۋادىم چالا ھەم بىزار ئىدىم، ئەمدى بۇ كىشى ھەجەپ…؟!» دەپ ئويلىماڭلار. مەن شۇنداق بوپقالمىسۇن دەپ API كودىنى ئەڭ ئاز ئىشلەتتىم. بۇ يەردىكى مەقسەت تەگدىن چۈشىنىپ پروگرامما يېزىشنى ئۆگىنىش بولغاچقا نوقۇل سۈرئەت قوغلىشىپ كودنى كۆپ ۋەمۇرەككەپ قىلىشتىن ساقلاندىم. ناۋادا API فۇنكىسىيىسى ئشلەتمەيتتىم، دېگۈچىلەر رەسمىي كودتىن ئىلگىرى تۆۋەندىكى كودنى ئىشلىتىپ ئەڭ ئاددىي شەكىلدە رەسىمدىكى نۇقتىلارنى رېڭىنى ئۆزگەرتىپ سىناڭلار (مىسال پروگراممىدا ئۈچ خىل ئۇسۇلنىڭ تېزلىكتىكى سېلىشتۇرمىسى بېرىلدى. شۇنى سىناپ باقساڭلارمۇ بولىدۇ)، ئاندىن بىلىسىلەركى، سۈرئەت ئىچىڭىزنى پۇشۇرىۋەتكىدەك دەرىجىدە ئاستا.
VB6.0 دىكى رەسىم رامكىسىنىڭ ئۆزىدىلا رەسىمدىكى نۇقتىلارنىڭ رېڭنى ئېلىش ۋە رەسىمدىكى خالىغان نۇقتىغا خالىغان رەڭدە چېكىت ئۇرۇش فۇنكىسىيىسى بار، بەك ئاسان.
ئەمسە سىناقنى باشلايلى. VB6.0 نى قوزغىتىپ، كۆزنەككە بىر دانە رەسىم رامكىسى (图片框PictureBox) سىزىپ، ئۇنىڭ Picture خاسلىقىغا تۆۋەندىكى رەسىمنى ئەكىرىڭلار، AutuSize خاسلىقىنى True  قىلىڭلار ۋە ScaleMode، يەنى ئۆلچەم بىرلىكى خاسلىقىنى 3-Pixel قىلىڭلار. ئاندىن كود كۆزنىكىگە كىرىپ تۆۋەندىكى كودنى چاپلاپ سىناڭلار.

Ross.jpg
  1. Dim W As Integer, H As Integer, I As Long, J As Long
  2. Dim R As Integer, G As Integer, B As Integer, Clr As Long,

  4. Private Function nRed(ByVal mlColor As Long) As Long
  5.     nRed = mlColor And &HFF
  6. End Function
  7. Private Function nGreen(ByVal mlColor As Long) As Long
  8.     nGreen = (mlColor \ &H100) And &HFF
  9. End Function
  10. Private Function nBlue(ByVal mlColor As Long) As Long
  11.     nBlue = (mlColor \ &H10000) And &HFF
  12. End Function

  14. Private Sub Command1_Click(Index As Integer)
  15.     Me.MousePointer = 11
  16.     W = Picture1.ScaleWidth
  17.     H = Picture1.ScaleHeight
  18.    
  19.     For I = 0 To W
  20.         For J = 0 To H
  21.             Clr = Picture1.Point(I, J)
  22.             R = nRed(Clr): G = nGreen(Clr): B = nBlue(Clr)
  23.             Clr = (R + G + B) / 3
  24.             Picture1.PSet (I, J), RGB(Clr, Clr, Clr)
  25.     Next J, I
  26.     Set Picture1.Picture = Picture1.Image
  27.     Me.MousePointer = 0
  28. End Sub
مەزمۇننى كۆچۈرۈۋېلىش
قانداق، ئۈنۈمدىن رازى بولدىڭىزمۇ؟ سۈرئەتتىنچۇ؟!
شۇڭا بىز ئىككى API فۇنكىسىيىسى ئىشلىتىپ سۈرئەتنى ئىككى ھەسسە ئاشۇرۇشنى ياكى ئۈچلا API فۇنكىسىيىسى بىلەن سۈرئەتنى 7-8 ھەسسە كۆتۈرۈشنى تاللايمىز. بۇنداق بولغاندا ھەم ئاددىيراق، چۈشىنىشلىك بولىدۇ، ھەم سۈرئەتتىن ئۇتالايمىز. كۆپراق ئىشلەتسەك سۈرئەتنى تېخىمۇ تېزلەتكىلى بولاتتى، ئەمما مۇرەككەپلىشىپ، پىكرىڭلار چېچىلىدۇ (API فۇنكىسىيىسى ئىشلىتىشنى ئۆگىنىشنىڭ ياخشى ئۇسۇلى دەل ئاۋۋال ئاددىي ئىشلىتىپ، بارا-بارا مۇرەككەپ، كۈچلۈكلىرىنى ئىشلىتىش).
ئەمدى يۇقىرىقى كود ئاساسىدا ئىككى ۋە ئۈچ خىل API فۇنكىسىيىسى ئىشلەتكەن ئەھۋالدىكى تېزلىك ۋە كودنى مىسالدىن كۆرۈپ بېقىڭ (ئېلىش نومۇرى: uQAyCKT2).
Ross2.jpg


يۇقىرىقى جەريانلاردىن كېيىن بىز رەسىمدىكى نۇقتىلارنى ئالىدىغان ۋە ئاخىرىدا ئورنىغا قويىدىغان ئۇنىۋېرسال فۇنكىسيە قۇرۇۋالايلى (مىسالدىكى يەنە بىر فۇنكىسيە ئالماشتۇرۇلدى. مەقسەت، ئۆزگەرتكەن رەسىمنى كېيىنچە ھۆججەت قىلىپ ساقلىغىلى بولۇش ئۈچۈن). يەنى، تۆۋەندىكىدەك:
  1. '用于获得指定类型的当前选定对象
  2. Public Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
  3. '用这个函数删除GDI对象，比如画笔、刷子、字体、位图、区域以及调色板等等。对象使用的所有系统资源都会被释放
  4. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

  6. '将来自一幅位图的二进制位复制到一幅与设备无关的位图里
  7. Public Declare Function GetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hbmp As Long, ByVal uStartScan As Long, ByVal cScanLines As Long, lpvBits As Any, lpbmi As Any, ByVal uUsage As Long) As Long
  8. '将一幅与设备无关位图的全部或部分数据直接复制到一个设备。这个函数在设备中定义了一个目标矩形，以便接收位图数据。它也在DIB中定义了一个源矩形，以便从中提取数据
  9. Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long

  11. Public Const OBJ_BITMAP = 7
  12. Public Const DIB_RGB_COLORS = 0

  14. Public Type BitMapInfoHeader '文件信息头——BITMAPINFOHEADER
  15.    biSize As Long
  16.    biWidth As Long
  17.    biHeight As Long
  18.    biPlanes As Integer
  19.    biBitCount As Integer
  20.    biCompression As Long
  21.    biSizeImage As Long
  22.    biXPelsPerMeter As Long
  23.    biYPelsPerMeter As Long
  24.    biClrUsed As Long
  25.    biClrImportant As Long
  26. End Type

  28. Public Type RGBQuad
  29.         rgbBlue As Byte
  30.         rgbGreen As Byte
  31.         rgbRed As Byte
  32.         'rgbReserved As Byte
  33. End Type

  35. Public Type BITMAPINFO
  36.         bmiHeader As BitMapInfoHeader
  37.         bmiColors As RGBQuad
  38. End Type

  40. Public Const Bits As Long = 32          '颜色深度，这里把所有图像都按照32位来处理
  41. Public ColVal() As Byte                 '用于存放从DIB输入/输出的像素值
  42. Public iBitmap As Long
  43. Public BI As BITMAPINFO                 '定义BMP信息
  44. Public I As Long, J As Long
  45. Public W As Long, H As Long
  46. Public C As Long, R As Integer, G As Integer, B As Integer

  48. Public Function GetPixel(Obj As Object) As Long
  49.     W = Obj.ScaleWidth: H = Obj.ScaleHeight
  50.     ReDim ColVal(3, W, H) As Byte
  51.     With BI.bmiHeader
  52.         .biBitCount = Bits
  53.         .biCompression = 0
  54.         .biPlanes = 1
  55.         .biSize = Len(BI.bmiHeader)
  56.         .biWidth = W
  57.         .biHeight = H
  58.     End With
  59.     iBitmap = GetCurrentObject(Obj.hdc, OBJ_BITMAP)
  60.     GetPixel = GetDIBits(Obj.hdc, iBitmap, 0, H, ColVal(0, 0, 0), BI, DIB_RGB_COLORS) '获得图片像素信息
  61.     DeleteObject iBitmap
  62. End Function

  64. Public Function SetPixel(Obj As Object) As Long
  65.     With BI.bmiHeader
  66.         LineBytes = ((W * Bits + 31) And &HFFFFFFE0) \ 8
  67.         .biSizeImage = LineBytes * H
  68.     End With
  69.     SetPixel = SetDIBitsToDevice(Obj.hdc, 0, 0, W, H, 0, 0, 0, H, ColVal(0, 0, 0), BI, DIB_RGB_COLORS)
  70.     Erase ColVal: Set Obj.Picture = Obj.Image ': Obj.Refresh
  71. End Function

  73. Public Function nRed(ByVal mlColor As Long) As Long
  74.     nRed = mlColor And &HFF
  75. End Function
  76. Public Function nGreen(ByVal mlColor As Long) As Long
  77.     nGreen = (mlColor \ &H100) And &HFF
  78. End Function
  79. Public Function nBlue(ByVal mlColor As Long) As Long
  80.     nBlue = (mlColor \ &H10000) And &HFF
  81. End Function
مەزمۇننى كۆچۈرۈۋېلىش
بۇنى بىر دانە بۆلەك (模块Module) ھۆججىتىگە ساقلىۋېلىپ، بۇندىن كېيىنكى ھەر خىل رەسىم ئۆزگەرتىشلەردە چاقىرىپ ئىشلىتىمىز. ئىشلىتىش ئۇسۇلى تۆۋەندىكىدەك:
  1. Private Sub Command1_Click()
  2.     Picture1.Picture = LoadPicture("")
  3.     Me.MousePointer = 11: GetPixel Picture1
  4.     For I = 0 To W
  5.         For J = 0 To H
  6.             R = ColVal(2, I, J): G = ColVal(1, I, J): B = ColVal(0, I, J)
  7.             C = (R + G + B)/3 ‘这是核心代码，处理像素点
  8.             ColVal(0, I, J) = C:ColVal(1, I, J) = C:ColVal(2, I, J) = C
  9.         Next J
  10.     Next I
  11.     Call SetPixel(Picture1):Me.MousePointer = 0
  12. End Sub
مەزمۇننى كۆچۈرۈۋېلىش
كودتىكى ھالقىلىق كود، دېگەن قۇرى (ئۇيغۇرچە ئىزاھات قىلمىدىم، نورمال كۆرۈنمەيدۇ) دەل بىزنىڭ رەسىم بىر تەرەپ قىلىشتىكى مۇھىم ھەل قىلىش ئۇسۇلى، يەنى ئالگورىزم (ھېسابلاش ئۇسۇلى算法Algorithm) بولۇپ، مۇشۇنى ئۆزگەرتىش ئارقىلىق ئوخشىمىغان ئۈنۈملەرنى ئەمەلگە ئاشۇرالايمىز. ماقالىنىڭ باشقا قىسىملىرى مۇشۇ بىر قۇر ئۇسۇلنى ئۆزگەرتىش ئارقىلىق داۋاملىشىدۇ، سىنىغاندا مۇشۇ قۇرنى ئالماشتۇرساڭلار بولىدۇ. ۋاقىپ بولغايسىزلەر.

مەنبە ۋە تېما داۋاملىشىش ئادرېسى: يارۇق بلوگى بۇ يازمىنى ئاخىرىدا   mars36 تەھرىرلىگەن. ۋاقتى  2012-7-19 17:00  

يۇمشاق تۈگۈلگەن مۇشت ياش سۈرتۈشكە يارايدۇ
سىندەرس: سەينادىن پايدىلىنىش

جابدۇق ئىشلىتىش پاش قىلىش

mars36 [ئىشەنچلىك ئەزا]  实名认证 

Rank: 8Rank: 8

تۆھپە
637
تىللا
1175
شۆھرەت
1241

شەرەپ تىرىشچان

يوللىغان ۋاقتى 2012-7-20 21:00:58 |ھەممە قەۋەتنى كۆرۈش
باشقا ئۈنۈملەرنىمۇ كۆرۈپ بېقىڭ.
实例.jpg

جابدۇق ئىشلىتىش پاش قىلىش

uqkun77 实名认证 

Rank: 5Rank: 5

تۆھپە
1102
تىللا
1430
شۆھرەت
1960

تىرىشچان دەلىللەنگەن ئەزا

يوللىغان ۋاقتى 2012-7-22 11:01:09 |ھەممە قەۋەتنى كۆرۈش
مارىس ئەپەندى بەكلا يوقاپ كەتتىڭىز ، يوقاپ كەتمىسىڭىز بولاتتى. مۇشۇنداق ئىسىل تىمىلىرىڭىز ئۇزۇلمىگەي.

جابدۇق ئىشلىتىش پاش قىلىش

mars36 [ئىشەنچلىك ئەزا]  实名认证 

Rank: 8Rank: 8

تۆھپە
637
تىللا
1175
شۆھرەت
1241

شەرەپ تىرىشچان

يوللىغان ۋاقتى 2012-7-22 13:09:42 |ھەممە قەۋەتنى كۆرۈش
uqkun77 يوللىغان ۋاقتى  2012-7-22 11:01
مارىس ئەپەندى بەكلا يوقاپ كەتتىڭىز ، يوقاپ كەتمىسىڭىز  ...

ئەسسالامۇ-ئەلەيكۇم، قانداق ئەھۋالىڭىز؟
نېمىسىنى دەي ... مەن ئىلىمنىڭ زاكىتىنى بېرىش ئۈچۈن تەتقىقاتىمنىڭ مەخپىيىتىنى بىر ياققا تاشلاپ قويۇپ تېما يوللىسام كۆرگۈچىلەرنىڭ ھالى تايىنلىق... ئەمدى باشقا تەرەپلەرگە قىزىقارمۇ-يا، دەپ پەدىنى ئۆزگەرتسەم ئەھۋال يەنە ئوخشاش. «قەدىرسىزلەر ئارىسىدا قەدرىڭنى سىنىما» دېگەننى ئەمدى بىلدىم. خەير، يەنىلا (ئىمكان بار) قىممەتلىك تېمىلارنى يوللايمەن، ئاخىرىنىڭ چىقىش-چىقماسلىقى شۇنىڭغا نەزەر سالغۇچىلارنىڭ ھارارىتىگە باغلىق. زاكات بەرگىلى داۋاملىق ئادەم بولماۋەرسە ئەمدى قايتا تېما يوللىماسلىقىم مۇمكىن...
يۇمشاق تۈگۈلگەن مۇشت ياش سۈرتۈشكە يارايدۇ

جابدۇق ئىشلىتىش پاش قىلىش

تىزىملىككە قايتىش تېما يوللاش
ئالىي ئىنكاس
B Color Image Link Quote Code Smilies
كىرگەندىن كىيىن ئىنكاس يازالايسىز كىرىش | تىزىملىتىش

يانفۇن|Archiver|intil.cn ( 新ICP备11001938号 )

GMT+8, 2012-11-8 13:34 , Processed in 0.467933 second(s), 21 queries .

Powered by Discuz! X2(NurQut Team) Licensed

© 2001-2011 Comsenz Inc.

چوققىغا قايتىش