マッピングモードの設定 <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