'================================================================
'= メタファイルの作成
'=    (CreateEnhMetaFile2.bas)
'================================================================
#include "Windows.bi"

#define HORZSIZE 4                      '物理画面の幅(ミリメートル単位)
#define VERTSIZE 6                      '物理画面の高さ(ミリメートル単位)
#define HORZRES 8                       '画面の幅(ピクセル単位)
#define VERTRES 10                      '画面の高さ(ピクセル単位)
#define STRETCH_ANDSCANS 1              '既存のカラー値とAND演算
#define STRETCH_DELETESCANS 3           'コピー先のピクセルをコピー元のピクセルで置き換え
#define STRETCH_HALFTONE 4              'コピー先のピクセルの平均カラー値を取得
#define STRETCH_ORSCANS 2               '既存のカラー値とOR演算
#define SRCCOPY &HCC0020                'そのまま転送

Type Rect
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

' 拡張メタファイルの新規作成
Declare Function Api_CreateEnhMetaFile& Lib "gdi32" Alias "CreateEnhMetaFileA" (ByVal hdcRef&, ByVal lpFileName$, ByRef lpRect As RECT, ByVal lpDescription$)

' 拡張メタファイル用デバイスコンテキストのクローズ
Declare Function Api_CloseEnhMetaFile& Lib "gdi32" Alias "CloseEnhMetaFile" (ByVal hDC&)

' 拡張メタファイルの削除
Declare Function Api_DeleteEnhMetaFile& Lib "gdi32" Alias "DeleteEnhMetaFile" (ByVal hEmf&)

' 拡張メタファイルの描画
Declare Function Api_PlayEnhMetaFile& Lib "gdi32" Alias "PlayEnhMetaFile" (ByVal hDC&, ByVal hEmf&, ByRef lpRect As Any)

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
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&)

' デバイス固有の情報を取得
Declare Function Api_GetDeviceCaps& Lib "gdi32" Alias "GetDeviceCaps" (ByVal hDC&, ByVal nIndex&)

' ウィンドウのクライアント領域の座標を取得
Declare Function Api_GetClientRect& Lib "user32" Alias "GetClientRect" (ByVal hWnd&, lpRect As RECT)

' ウィンドウの座標をスクリーン座標系で取得
Declare Function Api_GetWindowRect& Lib "user32" Alias "GetWindowRect" (ByVal hWnd&, lpRect As RECT)

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

' Windowsのデスクトップウィンドウを識別。返されるポインタは、一時的なポインタ。後で使用するために保存しておくことはできない
Declare Function Api_GetDesktopWindow& Lib "user32" Alias "GetDesktopWindow" ()

' 指定されたウィンドウのデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

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

Var Shared Picture1 As Object
Var Shared Button1 As Object

Picture1.Attach GetDlgItem("Picture1")
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'= デバイスコンテキストからメタファイル作成
'================================================================
Declare Function DcToEmf2(ByVal hDcIn As Long, inArea As Rect, sOutputFile As String) As Long
Function DcToEmf2(ByVal hDcIn As Long, inArea As Rect, sOutputFile As String) As Long
    Var rc As Rect
    Var MetaDC As Long
    Var OldMode As Long
    Var hsize As Long
    Var vsize As Long
    Var hres As Long
    Var vres As Long
    Var Ret As Long

    hsize = Api_GetDeviceCaps(hDcIn, HORZSIZE) * 100
    vsize = Api_GetDeviceCaps(hDcIn, VERTSIZE) * 100
    hres = Api_GetDeviceCaps(hDcIn, HORZRES)
    vres = Api_GetDeviceCaps(hDcIn, VERTRES)
   
    rc.Left = (inArea.Left * hsize) / hres
    rc.Top = (inArea.Top * vsize) / vres
    rc.Right = (inArea.Right * hsize) / hres
    rc.Bottom = (inArea.Bottom * vsize) / vres
    
    'メタファイルのデバイスコンテキスト
    MetaDC = Api_CreateEnhMetaFile(hDcIn, sOutputFile, rc, ByVal 0)
        
    If MetaDC Then
        'メタファイルのデバイスコンテキストに伸縮モード設定
        OldMode = Api_SetStretchBltMode(MetaDC, STRETCH_HALFTONE)

        'メタファイルデバイスコンテキストにデスクトップデバイスコンテキストを伸縮コピー
        Ret = Api_BitBlt(MetaDC, 0, 0, (inArea.Right - inArea.Left), (inArea.Bottom - inArea.Top), hDcIn, inArea.Left, inArea.Top, SRCCOPY)

        Ret = Api_SetStretchBltMode(MetaDC, OldMode)
        DcToEmf2 = Api_CloseEnhMetaFile(MetaDC)
    End If
End Function

'================================================================
'= クライアントからメタファイルへ
'================================================================
Declare Function WindowClientToEMF(ByVal hwndIn As Long, sOutputFile As String) As Long
Function WindowClientToEMF(ByVal hwndIn As Long, sOutputFile As String) As Long
    Var rc As Rect
    Var hTmpDc As Long
    Var Ret As Long

    hTmpDC = Api_GetDC(hwndIn)

    If hTmpDC <> 0 Then
        If Api_GetClientRect(hwndIn, rc) <> 0 Then
            WindowClientToEMF = DcToEmf2(hTmpDC, rc, sOutputFile)
            Ret = Api_ReleaseDC(hwndIn, hTmpDC)
        End If
    End If
End Function

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
   Button1.SetWindowText "メタファイル作成"
End Sub

'================================================================
'= メタファイル作成・保存・描画
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hEMF As Long
    Var rc As Rect
    Var hDC As Long
    Var Ret As Long

    hEMF = WindowClientToEMF(Api_GetDesktopWindow(), "TempEMF.emf")

    'Picture1のデバイスコンテキスト取得
    hDC = Api_GetDC(Picture1.GethWnd)

    Picture1.Cls
   
    'Picture1のクライアント領域の座標を取得
    Ret = Api_GetClientRect(Picture1.GethWnd, rc)

    'Picture1にメタファイル描画
    Ret = Api_PlayEnhMetaFile(hDC, hEMF, rc)

    '拡張メタファイルの削除
    Ret = Api_DeleteEnhMetaFile(hEMF)

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

'================================================================
'= ピクチャボックスクリア
'================================================================
Declare Sub Picture1_Click edecl ()
Sub Picture1_Click()
    Picture1.Cls
End Sub

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

'************************************************************************
'*      メタファイルの描画サンプルプログラム                            *
'*              COPYRIGHT FUJITSU LIMITED 1995-1999                     *
'************************************************************************
#include "Windows.bi"

Var Shared MetaF As Object

MetaFileObject MetaF

Declare Sub MainForm_Start edecl ()
Sub mainForm_Start()

    MetaF.LoadFile "Tempemf.emf"
    PlayMetaFile MetaF
    MetaF.DeleteObject
End Sub

While 1
    WaitEvent
Wend
Stop
End