マッピングモードの設定          <TOP>


マッピングモードを設定し、フォームサイズに合わせて図形および文字列を拡大縮小描画します。

CreateFontIndirect 論理フォントを作成

TextOut 文字を描画

SelectObject 指定されたデバイスコンテキストのオブジェクトを選択

GetMapMode 現在のマッピングモードを取得

SetMapMode 指定のデバイスコンテキストのマッピングモードを設定

GetWindowExtEx 指定のデバイスコンテキストのエクステントを取得

SetWindowExtEx 指定のデバイスコンテキストのエクステントを設定

GetViewportExtEx 指定のデバイスコンテキストのビューポートのエクステントを取得

SetViewportExtEx 指定のデバイスコンテキストのビューポートのエクステントを設定

Polyline 複数の線分からなる連続した線を描画(実行後はペンの現在位置が変更される)

GetClientRect ウィンドウのクライアント領域の座標を取得

GetPixel 指定された座標のピクセルのRGB値を取得

SetBkColor デバイスコンテキストの背景色を設定

GetDC デバイスコンテキストのハンドルを取得

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

 

フォームサイズを変更しても同じ比率で図形を拡大縮小します。

文字サイズは、フォームの縦サイズに比例させています。

 

'================================================================
'= マッピングモードの設定
'=    (SetmapMode.bas)
'================================================================
#include "Windows.bi"

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type
 
Type POINTAPI
    x As Long
    y As Long
End Type
 
#define LF_FACESIZE 32

Type LOGFONT
    lfHeight         As Long
    lfWidth          As Long
    lfEscapement     As Long
    lfOrientation    As Long
    lfWeight         As Long
    lfItalic         As Byte
    lfUnderline      As Byte
    lfStrikeOut      As Byte
    lfCharSet        As Byte
    lfOutPrecision   As Byte
    lfClipPrecision  As Byte
    lfQuality        As Byte
    lfPitchAndFamily As Byte
    lfFaceName(LF_FACESIZE) As Byte
End Type

' 論理フォントを作成
Declare Function Api_CreateFontIndirect& Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT)

' 文字を描画
Declare Function Api_TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC&, ByVal nXStart&, ByVal nYStart&, ByVal lpString$, ByVal cbString&)

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

' 現在のマッピングモードを取得
Declare Function Api_GetMapMode& Lib "gdi32" Alias "GetMapMode" (ByVal hDC&)

' 指定のデバイスコンテキストのマッピングモードを設定
Declare Function Api_SetMapMode& Lib "gdi32" Alias "SetMapMode" (ByVal hDC&, ByVal nMapMode&)

' 指定のデバイスコンテキストのエクステントを取得
Declare Function Api_GetWindowExtEx& Lib "gdi32" Alias "GetWindowExtEx" (ByVal hDC&, lpSize As POINTAPI)

' 指定のデバイスコンテキストのエクステントを設定
Declare Function Api_SetWindowExtEx& Lib "gdi32" Alias "SetWindowExtEx" (ByVal hDC&, ByVal nX&, ByVal nY&, lpSize As Any)

' 指定のデバイスコンテキストのビューポートのエクステントを取得
Declare Function Api_GetViewportExtEx& Lib "gdi32" Alias "GetViewportExtEx" (ByVal hDC&, lpSize As POINTAPI)

' 指定のデバイスコンテキストのビューポートのエクステントを設定
Declare Function Api_SetViewportExtEx& Lib "gdi32" Alias "SetViewportExtEx" (ByVal hDC&, ByVal nX&, ByVal nY&, lpSize As Any)

' 複数の線分からなる連続した線を描画(実行後はペンの現在位置が変更される)
Declare Function Api_Polyline& Lib "gdi32" Alias "Polyline" (ByVal hDC&, lpPoint As POINTAPI, ByVal nCount&)

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

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

' デバイスコンテキストの背景色を設定
Declare Function Api_SetBkColor& Lib "gdi32" Alias "SetBkColor" (ByVal hDC&, ByVal crColor&)

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

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

#define MM_ANISOTROPIC 8                '論理単位は、任意にスケーリングされた軸上の任意の単位にマップされる
#define MM_HIENGLISH 5                  '各論理単位は、0.001インチにマップされる。xの値は右に、yの値は上に向かって増加 
#define MM_HIMETRIC 3                   '各論理単位は、0.01ミリメートルにマップされる。xの値は右に、yの値は上に向かって増加
#define MM_ISOTROPIC 7                  '論理単位は、等しくスケーリングされた軸上の任意の単位にマップされる。すなわち、X 軸方向の1単位は、Y軸方向の1単位と同じになる
#define MM_LOENGLISH 4                  '各論理単位は、0.01インチにマップされる。xの値は右に、yの値は上に向かって増加
#define MM_LOMETRIC 2                   '各論理単位は、0.1 ミリにマップされる。xの値は右に、yの値は上に向かって増加
#define MM_TEXT 1                       '各論理単位は、1デバイスピクセルにマップされる。xの値は右に、yの値は下に向かって増加
#define MM_TWIPS 6                      '各論理単位は、ポイント数の20分の1にマップされる。xの値は右に、yの値は上に向かって増加
 
Var Shared OldMapMode As Long
Var Shared OldWindowExt As POINTAPI
Var Shared OldViewport As POINTAPI
Var Shared PT(5) As POINTAPI
Var Shared ClientR As RECT
Var Shared hDC As Long

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var Txt As String
    Var length As Long
    Var LF As LOGFONT
    Var rFont As Long
    Var Size As Integer
    Var BkCol As Long
    Var Ret As Long

    '5角形要素
    PT(0).x = 50
    PT(0).y = 2
    PT(1).x = 98
    PT(1).y = 35
    PT(2).x = 79
    PT(2).y = 90
    PT(3).x = 21
    PT(3).y = 90
    PT(4).x = 2
    PT(4).y = 35
    PT(5).x = 50
    PT(5).y = 2
    
    Txt = "札幌市abcDEF"
    length = Len(Txt)
    Size = 10
    LF.lfHeight = Size
    LF.lfCharSet = 128                                '日本語(全角)対応

    Cls

    hDC = Api_GetDC(GethWnd)
    BkCol = Api_GetPixel(hDC, 0, 0)                   'フォームの背景色取得
    Ret = Api_SetBkColor(hDC, BkCol)                  '文字の背景色を設定

    OldMapMode = Api_GetMapMode(hDC)         '現在のMapMode取得
    Ret = Api_GetViewportExtEx(hDC, OldViewport)
    Ret = Api_GetWindowExtEx(hDC, OldWindowExt)
    Ret = Api_GetClientRect(GethWnd, ClientR)

    Ret = Api_SetMapMode(hDC, MM_ANISOTROPIC)         '拡大縮小を設定できるMapModeにする
    Ret = Api_SetWindowExtEx(hDC, 100, 92, ByVal 0)   'Formサイズに対する5角形の比率(100:92)
    Ret = Api_SetViewportExtEx(hDC, ClientR.Right, ClientR.Bottom, ByVal 0) '拡大縮小率を設定する
    
    rFont = Api_CreateFontIndirect(LF)                '論理フォントを作成
    Ret = Api_SelectObject(hDC, rFont)                'オブジェクトを選択
    Ret = Api_TextOut(hDC, 0, 0, Txt, length)         '位置(0,0)文字描画

    Ret = Api_Polyline(hDC, PT(0), 6)                 '連続した線を描画
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Resize edecl ()
Sub MainForm_Resize()
    MainForm_Start
End Sub

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

    Ret = Api_SetMapMode(hDC, OldMapMode)
    Ret = Api_SetViewportExtEx(hDC, OldViewport.x, OldViewport.y, ByVal 0)
    Ret = Api_SetWindowExtEx(hDC, OldWindowExt.x, OldWindowExt.y, ByVal 0)
    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

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