Отразить picture

[Alprog]

Подскажите, чем можно отобразить picture слева-направо?
Так, чтобы быстро было, желательно не попиксельно.

[Хакер]

Непопиксельно — никак.
StretchBlt попробуй с инвесрной шириной.

[jangle]

Хакер прав, только попиксельно. В принципе, даже обычной CopyMemory можно обойтись

[BV]

Еще можно воспользоваться StretchDIBits. Но я тут набросал маленький тестик, и оказалось, что StretchBlt быстрее StretchDIBits...

Код: Выделить всё

Option Explicit

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Const BI_RGB As Long = 0
Private Const DIB_RGB_COLORS As Long = 0

Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function StretchDIBits 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 wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Private Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Private Sub cmdTest_Click()
    Dim lTime As Long
   
    lTime = GetTickCount()
    Call FlipImageUsingStretchBlt
    MsgBox "StretchBlt time: " + Str$(GetTickCount() - lTime), vbInformation
   
    lTime = GetTickCount()
    Call FlipImageUsingStretchDIBits
    MsgBox "StretchDIBits time: " + Str$(GetTickCount() - lTime), vbInformation
   
End Sub

Private Sub Form_Load()
    picSrc.Picture = LoadPicture(App.Path + "\Img.jpg")
End Sub

Private Sub FlipImageUsingStretchBlt()
    Call StretchBlt(picDest.hdc, 0, 0, picSrc.ScaleWidth, picSrc.ScaleHeight, picSrc.hdc, _
        picSrc.ScaleWidth - 1, 0, -picSrc.ScaleWidth, picSrc.ScaleHeight, vbSrcCopy)
End Sub

Private Sub FlipImageUsingStretchDIBits()
    Dim BMI As BITMAPINFO
    Dim bBytes() As Byte
   
    With BMI.bmiHeader
        .biSize = Len(BMI.bmiHeader)
        .biBitCount = 24
        .biCompression = BI_RGB
        .biPlanes = 1
        .biWidth = picSrc.ScaleWidth
        .biHeight = picSrc.ScaleHeight
    End With
   
    ReDim bBytes(1 To picSrc.ScaleWidth * picSrc.ScaleHeight * 3) As Byte

    Call GetDIBits(picSrc.hdc, picSrc.Image.Handle, 0, picSrc.ScaleHeight, bBytes(1), BMI, DIB_RGB_COLORS)
    Call StretchDIBits(picDest.hdc, 0, 0, picSrc.ScaleWidth, picSrc.ScaleHeight, picSrc.ScaleWidth - 1, 0, _
        -picSrc.ScaleWidth, picSrc.ScaleHeight, bBytes(1), BMI, DIB_RGB_COLORS, vbSrcCopy)
End Sub

[arthur2]

Еще можно воспользоваться StretchDIBits. Но я тут набросал маленький тестик, и оказалось, что StretchBlt быстрее StretchDIBits...

А у меня StretchDIBits из твоего кода почему-то вообще не заработал: картинка просто стала черной. (StretchBlt сработал нормально)

[BV]

Проверь пошагово, отработал ли GetDIBits

[arthur2]

Нет. Ну, то-есть, он вызвался, но все байты остались нулями

[Penumbra]

Подскажите, чем можно отобразить picture слева-направо?
Так, чтобы быстро было, желательно не попиксельно.

слева-направо(справо-налево)

Код: Выделить всё

(при  Picture2.AutoRedraw=False )
Picture2.PaintPicture Picture2.Image, Picture2.ScaleWidth, 0, -Picture2.ScaleWidth, Picture2.ScaleHeight, , , , , vbSrcCopy

или
Picture2.PaintPicture tempPicture.Image, Picture2.ScaleWidth, 0, -Picture2.ScaleWidth, Picture2.ScaleHeight, , , , , vbSrcCopy
где tempPicture- временный PictureБокс


с верху вниз (снизу-вверх)

Код: Выделить всё

Picture2.PaintPicture Picture2.Image, 0, Picture2.ScaleHeight, _
                      Picture2.ScaleWidth, -Picture2.ScaleHeight, , , , , vbSrcCopy