Sample 02

上下変換
2000年1月11日修正版

DownLoad

Command1
Picture1
Picture2

をフォームに貼り付けて、以下のコードを、フォームのソースコードへコピーして貼り付けてください。

Picture2　にお好きな画像を貼り付ければ実行できます。

VB4以降であれば、問題なく実行可能なはずです。

手抜きしてます(￣▽￣;)すみません。
描画対象を[書込みと読込み]を同じオブジェクトへ指定すると下半分ダブってしまいます。

このままの場合は、全部読込んでから　書込みしてください。

Option Explicit

Private Declare Function GetPixel Lib "gdi32" _
                     (ByVal hdc As Long, _
                      ByVal x As Long, _
                      ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" _
                     (ByVal hdc As Long, _
                      ByVal x As Long, _
                      ByVal y As Long, _
                      ByVal crColor As Long) As Long
'--------------------------------------------------------------
Private Sub Command1_Click()

    Screen.MousePointer = 11

    Call BitMapUpsideDown(Picture2.hdc, _
                                    Picture1.hdc, _
                                    Picture2.ScaleWidth, _
                                    Picture2.ScaleHeight)

    Screen.MousePointer = 0
End Sub
'--------------------------------------------------------------
Private Sub Form_Load()

    '初期設定(サンプルということで...)
    Picture1.AutoSize = False 
    Picture1.AutoRedraw = True 
    Picture1.BorderStyle = 0 
    Picture1.ScaleMode = vbPixels 'ピクセル

    Picture2.AutoSize = True
    Picture2.AutoRedraw = True
    Picture2.BorderStyle = 0
    Picture2.ScaleMode = vbPixels 'ピクセル
End Sub

'修正版
'------------------------------------
'上下反転する
'------------------------------------
Private Sub BitMapUpsideDown(ByVal PichDC As Long, _
                                            ByVal OuthDC As Long, _
                                            ByVal PictX As Long, _
                                            ByVal PictY As Long)

    Dim y As Long, x As Long

    For x = 0 To PictX
        For y = 0 To PictY
        '
        'カラー値を取得して書込む
        '
        Call SetPixelV(OuthDC, x, PictY - y - 1, GetPixel(PichDC, x, y))
        Next y
    DoEvents
    Next x
End Sub