[リストへもどる]
一括表示

投稿時間: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

投稿時間:2002/10/12(Sat) 00:56
投稿者名:NAO★
Eメール:
URL :
タイトル:
Re: SetWindowOrgExとSetWindowExtEx
回答ではありません。

「画面のプロパティ」でテーマをWindowsクラシックにしたときは
どうなりますか?

投稿時間:2002/10/12(Sat) 09:39
投稿者名:コラボ
Eメール:
URL :
タイトル:
Re^2: SetWindowOrgExとSetWindowExtEx
NAO様、早速のご助言有り難うございます。
> 「画面のプロパティ」でテーマをWindowsクラシックにしたときは
> どうなりますか?
テーマ並びにデザインを変更してみましたが症状は改善されませんでした。

投稿時間:2002/10/12(Sat) 10:10
投稿者名:K.J.K.
Eメール:akiya@koalanet.ne.jp
URL :
タイトル:
Re: SetWindowOrgExとSetWindowExtEx
必ずしもXPに限ったものではなく、Windows2000でもなります。
サイズの計算を別方法で求めるしかなさそうです。

投稿時間:2002/10/12(Sat) 14:53
投稿者名:コラボ
Eメール:
URL :
タイトル:
Re^2: SetWindowOrgExとSetWindowExtEx
K.J.K.様、有り難うございます。
ところで

> サイズの計算を別方法で求めるしかなさそうです。

なのですが、具体的にはどのような方法があるのかご教授いただけませんでしょうか?