| 投稿日 | ： 2002/10/11(Fri) 13:39 |
| 投稿者 | ： コラボ |
| Ｅメール | ： k_colab@yahoo.co.jp |
| ＵＲＬ | ： |
| タイトル | ： SetWindowOrgExとSetWindowExtEx |
以前お世話になったコラボです。みなさまのご助言、
また、Stadt Homepageさん(今は閉鎖されているようで残念です。)の
メタファイル化を参照させていただいて当時の問題は解決しました。
改めて御礼申し上げます。
ところが、新たな問題で解決方法が見えないので教えてください。
以下のコードはメタファイルを作りピクチャー内(.Width=315,.Height=4410:A4size)に
表示するために検証用として作った一部です。
これを実行するとWin98ならピッタと納まりますが、XPだとSetWindowScaleの
引数WidthとHeightを1.5倍(解像度800*600,1024*768なら1.2倍位)しないとフィットしません。
この解決策について教えてください。よろしくお願いいたします。
******************
Option Explicit
Private Sub CardDrawDC(hDC&)
'hDC上に用紙を描く
Dim hPen&, hBrush&
SetBkMode hDC, TRANSPARENT
'背景を白で塗りつぶす
hPen = GetStockObject(NULL_PEN)
hBrush = GetStockObject(WHITE_BRUSH)
SelectObject hDC, hPen
SelectObject hDC, hBrush
Rectangle hDC, 0, 0, 210, 294 'Ａ４縦置き
hPen = CreatePen(2, 5, RGB(255, 255, 0))
SelectObject hDC, hPen
Rectangle hDC, 10, 10, 200, 284'余白10ミリで枠を描く
DeleteObject hPen
End Sub
-------------------------------------------
Private Sub Form_Load()
Set Picture1.Picture = CardCreate(frmMain.Picture1, 210, 294) 'フォーム出力 + A4縦サイズ
End Sub
-------------------------------------------
Private Function CardCreate(Target As Object, Width&, Height&) As Picture
Dim hDC&, hEMF&
Dim MyRect As RECT
Dim ViewH&, ViewW&
Dim MyPic As Picture
Dim TwipX!, TwipY!
Dim hdcRef&
'-----メタファイルの作成
With MyRect
.Left = 0
.Top = 0
.Right = Width * 100
.Bottom = Height * 100
End With
hdcRef = Target.hDC
hDC = CreateEnhMetaFile(hdcRef, vbNullString, MyRect, vbNullString)
'座標系の設定
SetMapMode hDC, MM_ANISOTROPIC
TwipX! = Screen.TwipsPerPixelX
TwipY! = Screen.TwipsPerPixelY
ViewW = Width / TwipX! * 56.7 'mm => pixel 変換(X)
ViewH = Height / TwipY * 56.7 'mm => pixel 変換(Y)
'ピクチャにあわせて描く
SetViewPortScale hDC, 0, 0, ViewW, ViewH
'座標系をmmに設定
SetWindowScale hDC, 0, 0, Width, Height
' ↑ ↑
' XPだと上記２変数を1.5しないとだめ。なぜ？
'実際の作図
Call CardDrawDC(hDC)
hEMF = CloseEnhMetaFile(hDC)
'---ピクチャオブジェクトに変換
Set MyPic = CreatePictureFromHandle(hEMF)
' ↑
' 中身はよく解かりません。素人目に関係なさそうなので省略します。
Set CardCreate = MyPic
End Function
***********************
Public Sub SetWindowScale(ByVal hDC&, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)
SetWindowOrgEx hDC, X1, Y1, ByVal 0&
SetWindowExtEx hDC, X2 - X1, Y2 - Y1, ByVal 0&
End Sub
-------------------------------------------
Sub SetViewPortScale(ByVal hDC&, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)
SetViewportOrgEx hDC, X1, Y1, ByVal 0&
SetViewportExtEx hDC, X2 - X1, Y2 - Y1, ByVal 0&
End Sub