tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板 [ツリー表示へ]   [Home]
一括表示(VB6.0)
タイトルフルスクリーンにした場合のラベル等の位置
記事No13869
投稿日: 2009/07/21(Tue) 11:41
投稿者わいも
VB6.0を使っています。

下記のように、スクリーンの大きさが違うパソコンでも画面サイズを最大化し、
(VBにフラッシュムービーを貼り付けているので)フラッシュムービーも
最大化できるようなプログラムを記述しました。
そしてそのフラッシュムービーの上からラベルや画像を貼り付けました。
作業用のパソコンとは違うパソコンで再生したところ、スクリーンの大きさが違うらしく、
ラベルや画像が設定したところに来ておらず、移動してしまっています。

スクリーンが違うパソコンでも同じ場所にラベルや画像がくるような
プログラムがあればを教えてください。

Private img As Object
Private imgStyle As Object
Private baseWidth As Integer
Private baseHeight As Integer


Private Sub Resize()
    a2.Move 0, 0, ScaleWidth, ScaleHeight
    If img Is Nothing Then
        Exit Sub
    End If
    Dim xZoom As Single, yZoom As Single
    On Error Resume Next
    xZoom = ScaleWidth / baseWidth
    yZoom = ScaleHeight / baseHeight
    If Err.Number <> 0 Then
        xZoom = 1!
        yZoom = 1!
    End If
    On Error GoTo 0
    If xZoom <= 1! Or yZoom <= 1! Then
        imgStyle.Zoom = "100%"
    Else
        imgStyle.Zoom = Format(IIf(xZoom < yZoom, xZoom, yZoom), "0.000%")
    End If
End Sub


Private Sub Form_Resize()
    Resize


End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Dim doc As Object
    Set doc = pDisp.Document
    Dim body As Object
    Set body = doc.body
    With body.runtimeStyle
        .padding = "0"
        .margin = "0"
        .overflow = "hidden"
        .BorderStyle = "none"
        .BackgroundColor = "ThreeDFace"
    End With
    Set img = doc.getElementsByTagName("IMG")(0)
    baseWidth = img.clientWidth
    baseHeight = img.clientHeight
    Set imgStyle = img.runtimeStyle
    imgStyle.margin = "0"
    Resize
End Sub


Private Sub Form_Load()
    ScaleMode = vbPixels

       a2.Movie = (App.Path & "フラッシュ.swf")
       Call a2.Play
      
End Sub

[ツリー表示へ]
タイトルRe: フルスクリーンにした場合のラベル等の位置
記事No13870
投稿日: 2009/07/21(Tue) 16:27
投稿者ダンボ
imgStyle.Zoomが何だかわからないんですが、こんな感じでいいんじゃないでしょうか。

> Private Sub Resize()
>     a2.Move 0, 0, ScaleWidth, ScaleHeight
>     If img Is Nothing Then
>         Exit Sub
>     End If
>     Dim xZoom As Single, yZoom As Single
>     On Error Resume Next
>     xZoom = ScaleWidth / baseWidth
>     yZoom = ScaleHeight / baseHeight
>     If Err.Number <> 0 Then
>         xZoom = 1!
>         yZoom = 1!
>     End If
>     On Error GoTo 0

      Label1.Move Label1BaseLeft * xZoom , Label1BaseTop * yZoom , Label1BaseWidth * xZoom , Label1BaseHeight * yZoom

>     If xZoom <= 1! Or yZoom <= 1! Then
>         imgStyle.Zoom = "100%"
>     Else
>         imgStyle.Zoom = Format(IIf(xZoom < yZoom, xZoom, yZoom), "0.000%")
>     End If
> End Sub

[ツリー表示へ]
タイトルRe^2: フルスクリーンにした場合のラベル等の位置
記事No13871
投稿日: 2009/07/22(Wed) 11:09
投稿者わいも
ダンボさん、お返事ありがとうございます。

ダンボさんのプログラムを試させていただきました。
しかし、まだパソコンによってピクチャやラベルが移動してしまいます。
本当に申し訳ないのですが、もう一度教えていただけたら嬉しいです。
お願いいたします。

[ツリー表示へ]
タイトルRe^3: フルスクリーンにした場合のラベル等の位置
記事No13872
投稿日: 2009/07/22(Wed) 17:31
投稿者ダンボ
いかにもxZoomはスクリーン横幅の拡大(縮小)率、yZoomはスクリーンの縦幅の
拡大(縮小)率を求めているように見えました。

>     xZoom = ScaleWidth / baseWidth
>     yZoom = ScaleHeight / baseHeight

しかし、下のほうで

>    Set img = doc.getElementsByTagName("IMG")(0)
>    baseWidth = img.clientWidth
>    baseHeight = img.clientHeight

があるので、xZoom、yZoomはスクリーンの拡大(縮小)率では無いようですね。
早とちりしてすみません。

スクリーンの拡大(縮小)率を求めてください。
設計したPCでのラベルやその他コントロールの元座標・元大きさ、にその拡大(縮小)率を
掛けてやれば、スクリーンの拡大(縮小)に伴った移動・拡大(縮小)をする筈です。
(本当はフォントの拡大(縮小)なども考えなければならないけれど)

[ツリー表示へ]
タイトルRe^4: フルスクリーンにした場合のラベル等の位置
記事No13878
投稿日: 2009/07/22(Wed) 22:10
投稿者わいも
ご返信本当にありがとうございます。
拡大(縮小)率について調べてみました。

>スクリーンの拡大(縮小)率を求めてください。
zoom1 = Me.ScaleWidth / clpScaleWidth
zoom2 = Me.ScaleHeight / clpScaleHeight
(↑合っていますでしょうか)

>設計したPCでのラベルやその他コントロールの元座標・元大きさ、にその拡大(縮小)率を
掛けてやれば
Picture1.Move 3120 * zoom1, 9480 * zoom2, 11111 * zoom1, 2775 * zoom2

というように記述しました。
しかしどうしてもスクリーンの大きさによってピクチャや画像が移動してしまいます。

長々と申し訳ありませんが、下記のプラグラムの中で
何か至らないところがあれば教えてください。
勉強不足ですみません。
Private img As Object
Private baseWidth As Integer
Private baseHeight As Integer
Dim zoom1   As Double
Dim zoom2  As Double
Private clpScaleWidth   As Double
Private clpScaleHeight  As Double

Private Sub Resize()
    フラッシュ.Move 0, 0, ScaleWidth, ScaleHeight
    
    clpScaleWidth = Me.ScaleWidth
    clpScaleHeight = Me.ScaleHeight

    zoom1 = Me.ScaleWidth / clpScaleWidth
    zoom2 = Me.ScaleHeight / clpScaleHeight

    Picture1.Move 3120 * zoom1, 9480 * zoom2, 11111 * zoom1, 2775 * zoom2

    If img Is Nothing Then
        Exit Sub
    End If
    Dim xZoom As Single, yZoom As Single
    On Error Resume Next
    xZoom = ScaleWidth / baseWidth
    yZoom = ScaleHeight / baseHeight
    If Err.Number <> 0 Then
        xZoom = 1!
        yZoom = 1!
    End If
    On Error GoTo 0

End Sub

Private Sub Form_Resize()
    Resize
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Dim doc As Object
    Set doc = pDisp.Document
    Dim body As Object
    Set body = doc.body
    With body.runtimeStyle
        .padding = "0"
        .margin = "0"
        .overflow = "hidden"
        .BorderStyle = "none"
        .BackgroundColor = "ThreeDFace"
    End With
    Set img = doc.getElementsByTagName("IMG")(0)
    baseWidth = img.clientWidth
    baseHeight = img.clientHeight

    Resize
End Sub

[ツリー表示へ]
タイトルRe^5: フルスクリーンにした場合のラベル等の位置
記事No13880
投稿日: 2009/07/22(Wed) 22:45
投稿者魔界の仮面弁士
質問の細かい内容を追っていないので、思いつきだけで回答しますが:

両環境で、Screen.TwipsPerPixelX および 同Y プロパティの値は同じでしょうか?

Twip 単位系の場合、画面上のドット単位の位置(ピクセル単位系)は、
OS の画面のプロパティにある DPI 設定値に依存するすることになるので。

[ツリー表示へ]
タイトルRe^6: フルスクリーンにした場合のラベル等の位置
記事No13881
投稿日: 2009/07/23(Thu) 08:46
投稿者わいも
お返事ありがとうございます。

> 両環境で、Screen.TwipsPerPixelX および 同Y プロパティの値は同じでしょうか?
 調べてみたところ、同じでした。

[ツリー表示へ]
タイトルRe^5: フルスクリーンにした場合のラベル等の位置
記事No13882
投稿日: 2009/07/23(Thu) 09:52
投稿者ダンボ
>     clpScaleWidth = Me.ScaleWidth
>     clpScaleHeight = Me.ScaleHeight
>     zoom1 = Me.ScaleWidth / clpScaleWidth
>     zoom2 = Me.ScaleHeight / clpScaleHeight
これでは常にzoom1 とzoom2は1になってしまいます。

     zoom1 = Me.Width / デザイナーで見たFormのWidth
     zoom2 = Me.Height / デザイナーで見たFormのHeight

[ツリー表示へ]