خرید بک لینک,خرید رپورتاژ آگهی
zula

عکس گرفتن از TextBox - کمک فوری لطفا

شروع موضوع توسط hamid_80386 ‏30 اکتبر 2007 در انجمن Visual Basic 6

  1. hamid_80386

    hamid_80386 Registered User

    تاریخ عضویت:
    ‏28 فوریه 2007
    نوشته ها:
    46
    تشکر شده:
    0
    سلام به همه عزیزان

    برای یه پروژه مجبورم یه ماژول یا شاید یه OCX که کار Print Preview رو انجام میده بسازم.

    برای این کار باید از محتویات TextBox عکس بگیرم و اون عکس رو به ClipBoard منتقل کنم و بعد با متد GetData اون رو از کلیپ بورد بخونم.

    اما نمیدونم چه طوری از TextBox عکس بگیرم.

    لطفا اگه کسی میدونه راهنمایی کنه که متاسفانه خیلی عجله دارم.

    در ضمن علاوه بر این اگه قبلا کسی ماژول یا Ocx برای Print Preview ساخته، ممنون میشم اگه در اختیارمون بذاره.
     
  2. کوتاه کننده لینک
  3. pirmard

    pirmard Registered User

    تاریخ عضویت:
    ‏21 آگوست 2007
    نوشته ها:
    837
    تشکر شده:
    3
    راهی که انتخاب کردی که زیاد جالب نیست :(

    ضمنا اکتیوکسش هم ساخته شده . رو نت زیاده . یه سرچ ساده بزن . اگه گیر نیووردی بگو .
     
  4. m3hrz4d

    m3hrz4d Registered User

    تاریخ عضویت:
    ‏21 سپتامبر 2005
    نوشته ها:
    620
    تشکر شده:
    1
    محل سکونت:
    اصفهان
    دوستمون درست میگه فکر کنم استفاده از کلیپ برد روش مناسبی نباشه اما به هر حال یک روش واسی کپی کردن عکس TextBox (فقط اون قسمتی که نشون داده میشه) توی کلیپ برد این هست, شاید روش بهتری هم واسه کپی کردن باشه:
    کد:
    Option Explicit
    
    Private Const CF_BITMAP = 2
    Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
    
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function CreateCompatibleDC 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
      
    Private Function TakePicture(ByVal Obj As VB.Control) As Boolean
    
        Dim hBitmap As Long
        Dim hObjDC As Long
        Dim hCmpDC As Long
        Dim hScreenDC As Long
    
        Dim ObjWidth As Long
        Dim ObjHeight As Long
        
        ObjWidth = ScaleX(Obj.Width, ScaleMode, vbPixels)
        ObjHeight = ScaleY(Obj.Height, ScaleMode, vbPixels)
          
        hObjDC = GetDC(Obj.hwnd)
            
        If (hObjDC = 0) Then
            TakePicture = False
            Exit Function
        End If
        
        hScreenDC = GetDC(0)
        
        If (hScreenDC = 0) Then
            TakePicture = False
            GoTo f4
        End If
        
        hCmpDC = CreateCompatibleDC(hScreenDC)
        
        If (hCmpDC = 0) Then
            TakePicture = False
            GoTo f3
        End If
        
        hBitmap = CreateCompatibleBitmap(hScreenDC, _
                                                                                   ObjWidth, ObjHeight)
                                                                                   
        If (hBitmap = 0) Then
            TakePicture = False
            GoTo f2
        End If
            
        Call SelectObject(hCmpDC, hBitmap)
        
        BitBlt hCmpDC, 0, 0, ObjWidth, ObjHeight, hObjDC, 0, 0, SRCCOPY
        
        If (OpenClipboard(Me.hwnd) = 0) Then
            TakePicture = False
            GoTo f1
        End If
        
        EmptyClipboard
        SetClipboardData CF_BITMAP, hBitmap
        CloseClipboard
        
       TakePicture = True
       
    f1:
        Call DeleteObject(hBitmap)
    f2:
        Call DeleteDC(hCmpDC)
    f3:
        Call ReleaseDC(0, hScreenDC)
    f4:
       Call ReleaseDC(Obj.hwnd, hObjDC)
       
    End Function
    
    
    Private Sub Command1_Click()
        
            Call TakePicture (Text1)
            
    End Sub
    
    
    تابع TakePicture با گرفتن اسم یک کنترل به عنوان پارامتر, عکس اون کنترل رو توی ClipBoard کپی میکنه.
     
  5. hamid_80386

    hamid_80386 Registered User

    تاریخ عضویت:
    ‏28 فوریه 2007
    نوشته ها:
    46
    تشکر شده:
    0
    هر چی رو اینترنت دیدم پولی بوده یا نسخه Trial بوده.

    ولی اگه شما راه بهتری سراغ دارید خوشحال میشم راهنمایی بکنید.
     
  6. cracki

    cracki Registered User

    تاریخ عضویت:
    ‏23 مارس 2004
    نوشته ها:
    672
    تشکر شده:
    23
    من تا حالا نيازم نشده كه Print Preview بسازم. اگه OCX خيلي خوبي پيدا كردي و تست كردي كه خوبه بزار تا كرك كنيم. فكر كنم به كارم بياد
     
avanak عسل طبیعی و گرده گل ایرانی همکاری در فروش