'================================================================
'= グレースケールセピア変換
'=    (GrayScale.bas)
'================================================================
#include "Windows.bi"

' 指定されたデバイスコンテキストに関連するデバイスと互換性のあるメモリデバイスコンテキストを作成
Declare Function Api_CreateCompatibleDC& Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hDC&)

' デバイスコンテキストと互換性のあるビットマップを作成
Declare Function Api_CreateCompatibleBitmap& Lib "gdi32" Alias "CreateCompatibleBitmap" (ByVal hDC&, ByVal nWidth&, ByVal nHeight&)

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' 指定されたデバイスコンテキストを削除
Declare Function Api_DeleteDC& Lib "gdi32" Alias "DeleteDC" (ByVal hDC&)

' ペン、ブラシ、フォント、ビットマップ、リージョン、パレットのいずれかの論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放します。オブジェクトを削除した後は、指定されたハンドルは無効になります。
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' ビットブロック転送を行います。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピーします。
Declare Function Api_BitBlt& Lib "gdi32" Alias "BitBlt" (ByVal hDestDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)

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

' 指定の位置のピクセルを指定のカラーに最も近いカラー値に設定
Declare Function Api_SetPixelV& Lib "gdi32" Alias "SetPixelV" (ByVal hDC&, ByVal X&, ByVal Y&, ByVal crColor&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得。その後、GDI 関数を使って、返されたデバイスコンテキスト内で描画を行える
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 DSTINVERT &H550009              'コピー先を反転してコピー

Var Shared Picture1 As Object
Var Shared Picture2 As Object
Var Shared Radio1 As Object
Var Shared Radio2 As Object
Var Shared Button1 As Object

Picture1.Attach GetDlgItem("Picture1")
Picture2.Attach GetDlgItem("Picture2")
Radio1.Attach GetDlgItem("Radio1") : Radio1.SetFontSize 14
Radio2.Attach GetDlgItem("Radio2") : Radio2.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared Bitmap As Object
BitmapObject Bitmap

Var Shared hDC1 As Long
Var Shared hDC2 As Long
Var Shared Flag As Byte

'================================================================
'=
'================================================================
Declare Function GraySepiaBltSub(ByVal lngColor As Long) As Long
Function GraySepiaBltSub(ByVal lngColor As Long) As Long
    On Error Goto *Er_Trap
    
    Var Ret As Long

    '色をRGBに分割し、YIQ変換を実行
    Ret = (lngColor And &HFF) * 0.299 + ((lngColor And &HFF00) / 256) * 0.587 + ((lngColor And &HFF0000) / 65536) * 0.114
    
    'RGB値が0〜255の範囲に収まるようにする
    If Ret >= 255 Then
        Ret = 255
    Else If Ret <= 0 Then
        Ret = 0
    End If

    '変換した値を返す
    If Flag = 0 Then
        GraySepiaBltSub = RGB(Ret, Ret, Ret)                     'グレースケール
    Else
        GraySepiaBltSub = RGB(Ret + 30, Ret, Ret - 30)           'セピア
    End If
    Exit Function

*Er_Trap
    Resume Next    
End Function

'================================================================
'=
'================================================================
Declare Sub GraySepiaBlt(ByVal srchDC As Long, ByVal srcLeft As Long, ByVal srcTop As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal hDC2 As Long, ByVal trgLeft As Long, ByVal trgTop As Long )
Sub GraySepiaBlt(ByVal srchDC As Long, ByVal srcLeft As Long, ByVal srcTop As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal hDC2 As Long, ByVal trgLeft As Long, ByVal trgTop As Long )
    On Error Goto *Er_Trap

    Var lX As Long
    Var lY As Long
    Var Ret As Long
    Var mhDC As Long
    Var hBmp As Long

    'メモリDCを作成
    mhDC = Api_CreateCompatibleDC(srchDC)

    'ビットマップオブジェクトの作成
    hBmp = Api_CreateCompatibleBitmap(srchDC, srcWidth, srcHeight)

    'メモリDCへビットマップを割付
    Ret = Api_SelectObject(mhDC, hBmp)

    'メモリDCへ画像をコピー
    Ret = Api_BitBlt(mhDC, 0, 0, srcWidth, srcHeight, srchDC, srcLeft, srcTop, SRCCOPY)
    
    '色情報の読み込み及びYIQ変換処理
    For lY = 0 To srcHeight - 1
        For lX = 0 To srcWidth - 1
            Ret = Api_SetPixelV(mhDC, lX, lY, GraySepiaBltSub(Api_GetPixel(mhDC, lX, lY)))
        Next lX
    Next lY
    
    '対象のDCにメモリDCをコピー
    Ret = Api_BitBlt(hDC2, trgLeft, trgTop, srcWidth, srcHeight, mhDC, 0, 0, SRCCOPY)
    
*Er_Trap
    'メモリDCの削除
    Ret = Api_DeleteDC(mhDC)

    'ビットマップオブジェクトの削除
    Ret = Api_DeleteObject(hBmp)
End Sub

'================================================================
'=
'================================================================
Declare Sub Mainform_Start edecl ()
Sub mainform_Start()
    'Picture1にBitmap読込
    Bitmap.LoadFile "flower.bmp"
    Picture1.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    'Picture1のデバイスコンテキスト取得
    hDC1 = Api_GetDC(Picture1.GethWnd)
    hDC2 = Api_GetDC(Picture2.GethWnd)

    If Radio1.GetCheck = 1 Then Flag = 0 Else Flag = 1

    SetMousePointer 2
    Picture2.Cls

    'グレースケール・セピア変換実行
    GraySepiaBlt hDC1, 0, 0, Picture1.GetWidth, Picture1.GetHeight, hDC2, 0, 0

    SetMousePointer 0

    'デバイスコンテキスト解放
    Ret = Api_ReleaseDC(Picture1.GethWnd, hDC1)
    Ret = Api_ReleaseDC(Picture2.GethWnd, hDC2)
End Sub

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