エディットボックスに画像転写          <TOP>

エディットボックスに画像を転写してみます。

GetDC デバイスコンテキストを取得

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

GetPixel 指定された座標のRGB値を取得

ReleaseDC デバイスコンテキストを解放

　

Picture1にｆlower.bmpを描画し、EditBoxに2倍のピクセル間隔で転写しています。

「描画」ボタンは文字をBSで消去した場合、EditBox内の画像を再描画するものです。

　

'================================================================
'= エディットボックスに画像転写
'=    (SetPixel.bas)
'================================================================
#include "Windows.bi"

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

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

' 指定された座標のピクセルのRGB値を取得
Declare Function Api_GetPixel& Lib "gdi32" Alias "GetPixel" (ByVal hDC&, ByVal X&, ByVal Y&)

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

Var Shared Edit1 As Object
Var Shared Button1 As Object
Var Shared Picture1 As Object
Var Shared Bitmap As Object

BitmapObject Bitmap
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Picture1.Attach GetDlgItem("Picture1")

Var Shared EhDC As Long
Var Shared PhDC As Long

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var i As Long
    Var j As Long
    Var Col As Long
    Var Ret As Long

    For i = 1 To Picture1.GetWidth - 1
        For j = 1 To Picture1.GetHeight - 1
            Col = Api_GetPixel(PhDC, i, j)
            Ret = Api_SetPixel(EhDC, 10 + i * 2, 10 + j * 2, Col)
            Ret = Api_SetPixel(EhDC, 130 + i, 10 + j, Col)
        Next
    Next
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Bitmap.LoadFile "flower.bmp"
    Picture1.StretchBitmap Bitmap, 0, 0, 46, 46
    Bitmap.DeleteObject

    EhDC = Api_GetDC(Edit1.GethWnd)
    PhDC = Api_GetDC(Picture1.GethWnd)

    Button1_on

    Edit1.SetFocus
End Sub

'================================================================
'=
'================================================================
Declare Sub Edit1_Change edecl ()
Sub Edit1_Change()
    Button1_on
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

    Ret = Api_ReleaseDC(Edit1.GethWnd, EhDC)
    Ret = Api_ReleaseDC(Picture1.GethWnd, PhDC)
    End
End Sub

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