画像転送とピクセル描画・直線描画          <TOP>


既出のテストと重複しますが、拡大縮小転送・ピクセル描画・直線描画を実行しています。

SetPixel 指定した座標に点を配置する

PaintDesktop 指定の領域をデスクトップと同じパターン・壁紙で塗りつぶす

SetStretchBltMode 指定されたデバイスコンテキストのビットマップ伸縮モードを設定

StretchBlt 拡縮をともなうグラフィックデバイス間のイメージを転送

MoveToEx 現在位置を受け取るバッファを参照で指定

LineTo 現在の位置から終点までを直線で描画

 

左:LineToで直線を描画    右:SetPixelで点を描画

 

左:Picture2(右上)のデスクトップをPicture1(左下)にSetStretchBltModeで転送    右:全てのボタンをクリック

 

上図でSetStretchBltModeを使用しない場合の転送先画像

 

'================================================================
'= 画像転送とピクセル描画・直線描画
'=    (SetPixel.bas)
'================================================================
#include "Windows.bi"

Type POINTAPI
    X As Long
    Y As Long
End Type

' 指定した座標に点を配置する
Declare Function Api_SetPixel& Lib "gdi32" Alias "SetPixel" (ByVal hDC&, ByVal X&, ByVal Y&, ByVal crColor&)

' 指定の領域をデスクトップと同じパターン・壁紙で塗りつぶす
Declare Function Api_PaintDesktop& Lib "user32" Alias "PaintDesktop" (ByVal hDC&)

' 指定されたデバイスコンテキストのビットマップ伸縮モードを設定
Declare Function Api_SetStretchBltMode& Lib "gdi32" Alias "SetStretchBltMode" (ByVal hDC&, ByVal nStretchMode&)

' 拡縮をともなうグラフィックデバイス間のイメージを転送
Declare Function Api_StretchBlt& Lib "gdi32" Alias "StretchBlt" (ByVal hDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal nSrcWidth&, ByVal nSrcHeight&, ByVal dwRop&)

' 現在位置を受け取るバッファを参照で指定
Declare Function Api_MoveToEx& Lib "gdi32" Alias "MoveToEx" (ByVal hDC&, ByVal X&, ByVal Y&, lpPoint As POINTAPI)

' 現在の位置から終点までを直線で描画
Declare Function Api_LineTo& Lib "gdi32" Alias "LineTo" (ByVal hDC&, ByVal x&, ByVal y&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

#define SRCCOPY &HCC0020
#define COLORONCOLOR 3

Var Shared Picture1 As Object
Var Shared Picture2 As Object

Picture1.Attach GetDlgItem("Picture1")
Picture2.Attach GetDlgItem("Picture2")

Var Shared fmhDC As Long
Var Shared p1hDC As Long
Var Shared p2hDC As Long

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Picture2.SetWindowSize 140, 140                             '/ PictureBoxサイズ指定
    Picture1.SetWindowSize 70, 70

    fmhDC = Api_GetDC(GethWnd)
    p1hDC = Api_GetDC(Picture1.GethWnd)
    p2hDC = Api_GetDC(Picture2.GethWnd)
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var i As byte
    Var j As byte
    Var nPoint As POINTAPI
    Var Ret As Long

    For i = 20 To 120 step 3
        For j = 20 To 120 step 3
            nPoint.X = i                                        '/ スタートポイント設定
            nPoint.Y = j

            Ret = Api_MoveToEx(fmhDC, i, j, nPoint)             '/ アクティブポイント
            Ret = Api_LineTo(fmhDC, 230, 200)                   '/ アクティブポイントから線を引く
        Next j
    Next i
End Sub

'================================================================
'=
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var i As byte
    Var j As byte
    Var Ret As Long

    For i = 0 To 150 step 5
        For j = 0 To 150 Step 5
            Ret = Api_SetPixel(fmhDC, i, j, RGB(255, 0, 0))     '/ ピクセル描画
        Next j
    Next i
End Sub

'================================================================
'=
'================================================================
Declare Sub Button3_on edecl ()
Sub Button3_on()
    Var Ret As Long
    Ret = Api_PaintDesktop(p2hDC)                               '/ デスクトップをコピー
    Ret = Api_SetStretchBltMode(p1hDC, COLORONCOLOR)
    Ret = Api_StretchBlt(p1hDC, 0, 0, 70, 70, p2hDC, 0, 0, 140, 140, SRCCOPY) '/ 拡大伸縮転送
End Sub

'================================================================
'=
'================================================================
Declare Sub MainFOrm_QueryClose edecl (Cancel As Integer, Mode As Integer)
Sub MainForm_QueryClose(Cancel As Integer, Mode As Integer)
    Var Ret As Long

    If cancel = 0 Then
        Ret = Api_ReleaseDC(GethWnd, fmDC)
        Ret = Api_ReleaseDC(Picture1.GethWnd, ph1DC)
        Ret = Api_ReleaseDC(Picture2.GethWnd, ph2DC)
    End If
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End