投稿時間:2002/10/11(Fri) 13:39 投稿者名:コラボ 
Eメール:k_colab@yahoo.co.jp 
URL : 
タイトル: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 'A4縦置き 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だと上記2変数を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 
 
 |