画像転送とピクセル描画・直線描画 <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