Public Sub ReSetBackground() ' デバイスコンテキストを取得 Dim screenDc As IntPtr = GetDC(IntPtr.Zero) Dim memDc As IntPtr = CreateCompatibleDC(screenDc) Dim hBitmap As IntPtr = IntPtr.Zero Dim hOldBitmap As IntPtr = IntPtr.Zero Try '文字を描く DrawStringImage() hBitmap = srcbmp.GetHbitmap(Color.FromArgb(0)) hOldBitmap = SelectObject(memDc, hBitmap) ' レイヤードウィンドウを更新 Dim r As Boolean = UpdateLayeredWindow( _ Me.Handle, screenDc, Me.Location, _ New Size(srcbmp.Width, srcbmp.Height), _ memDc, New Point(0, 0), 0, blend, ULW_ALPHA _ ) Finally ReleaseDC(IntPtr.Zero, screenDc) If Not hBitmap.Equals(IntPtr.Zero) Then SelectObject(memDc, hOldBitmap) DeleteObject(hBitmap) End If DeleteDC(memDc) End Try srcbmp.Dispose() End Sub
Private Sub DrawStringImage() 'スクロール移動量の設定 xpos += 10 If xpos > scrollstrsize Then xpos = 0 : stopcount = 0 '文字を描く-描画したグラフィックより引用領域を指定してコピー srcbmp = baseBitmap.Clone() Dim g2 As Graphics = Graphics.FromImage(srcbmp) 'g2.DrawImage(b, New Rectangle(4, 4, 230, 14), _ 'New Rectangle(xpos + 230, 0, 230, 14), GraphicsUnit.Pixel) g2.DrawImage(b, New Rectangle(50, 230, 812, 260), _ New Rectangle(xpos + 230, 0, 812, 260), GraphicsUnit.Pixel) g2.Dispose() End Sub Private Sub SetStringImage(ByVal src As String) b = New Bitmap(4096, 300) Dim g As Graphics = Graphics.FromImage(b) '文字列をグラフィック領域に描画 g.DrawString(src, myFont, Brushes.Black, 230, 0) Dim rc As SizeF = g.MeasureString(src, myFont, New SizeF(2048.0!, 14.0!)) scrollstrsize = CInt(rc.Width) xpos = 0 g.Dispose() End Sub
分類:[.NET]
はじめまして、じぞうと申します。
皆さまのお知恵をお借りしたく、投稿させて頂きました。
WANKUMAさんの「レイヤードウインドウで半透明フォームを実現する」な
どとURLがググってもヒットしなくなって分かりませんが(たしか、「み プロ
グラミングとかなんとか)、同様にUpdateLayerdWindowを利用して、文字列を表示
して文字列をスクロールさせるコードが記述されていたので、コードを丸写しして
数値を変えながら動作の理解をしていました。
ただ、文字のフォントサイズを変更して行くと「100.0!」(72を掛けて96で割ると
おおよそ75pt?)で、文字がスクロールされなくなります。
コードを十分理解出来ていないので、正確に分からないのでご教授頂ければ幸い
です。
SetBackGroundメソッドまでは、WANKUMAさんのコードと同じですが
Public Sub ReSetBackground()
' デバイスコンテキストを取得
Dim screenDc As IntPtr = GetDC(IntPtr.Zero)
Dim memDc As IntPtr = CreateCompatibleDC(screenDc)
Dim hBitmap As IntPtr = IntPtr.Zero
Dim hOldBitmap As IntPtr = IntPtr.Zero
Try
'文字を描く
DrawStringImage()
hBitmap = srcbmp.GetHbitmap(Color.FromArgb(0))
hOldBitmap = SelectObject(memDc, hBitmap)
' レイヤードウィンドウを更新
Dim r As Boolean = UpdateLayeredWindow( _
Me.Handle, screenDc, Me.Location, _
New Size(srcbmp.Width, srcbmp.Height), _
memDc, New Point(0, 0), 0, blend, ULW_ALPHA _
)
Finally
ReleaseDC(IntPtr.Zero, screenDc)
If Not hBitmap.Equals(IntPtr.Zero) Then
SelectObject(memDc, hOldBitmap)
DeleteObject(hBitmap)
End If
DeleteDC(memDc)
End Try
srcbmp.Dispose()
End Sub
Private Sub DrawStringImage()
'スクロール移動量の設定
xpos += 10
If xpos > scrollstrsize Then xpos = 0 : stopcount = 0
'文字を描く-描画したグラフィックより引用領域を指定してコピー
srcbmp = baseBitmap.Clone()
Dim g2 As Graphics = Graphics.FromImage(srcbmp)
'g2.DrawImage(b, New Rectangle(4, 4, 230, 14), _
'New Rectangle(xpos + 230, 0, 230, 14), GraphicsUnit.Pixel)
g2.DrawImage(b, New Rectangle(50, 230, 812, 260), _
New Rectangle(xpos + 230, 0, 812, 260), GraphicsUnit.Pixel)
g2.Dispose()
End Sub
Private Sub SetStringImage(ByVal src As String)
b = New Bitmap(4096, 300)
Dim g As Graphics = Graphics.FromImage(b)
'文字列をグラフィック領域に描画
g.DrawString(src, myFont, Brushes.Black, 230, 0)
Dim rc As SizeF = g.MeasureString(src, myFont, New SizeF(2048.0!, 14.0!))
scrollstrsize = CInt(rc.Width)
xpos = 0
g.Dispose()
End Sub
参考にさせて頂いた、HPには上記の3つのメソッドが追加されていました。(中の位置の数値などは変更しています。)
プラスフォントの宣言
Dim myFont As Font = New Font("MS ゴシック", 100.0!, FontStyle.Regular, GraphicsUnit.Point)
です。この「100.0!」をこれ以上大きくするとスクロールしなくなります。
色々原因を考えてみましたが、コードを理解出来ていないので的外れかもしれませ
んが、
このコードでは、元になる画像の上のレイヤーに文字を書いて「特定の場所の
み」、上のレイヤーが表示されるように書いた文字のString(長さ)を測定して
指定した位置からずらして表示を更新していると思っておりますが間違い無いで
しょうか?
上記により、フォントサイズを大きくして行くと、表示されてはいないが描画し
た文字の初期位置がWindowsの描画範囲を超えていると考えたのですが、合ってるで
しょうか?
ただ、プログラムをデバッグで起動すると文字が動かないけど表示されているの
で本当に私の考えている事が原因なのか分かりません。
それとも、Windows APIで利用出来るフォントの最大サイズを超えてしまっている
のでしょうか?(フォームにTextBoxやLabelを張り付けてフォントのダイアログBox
に表示されている72pt以上である200ptを入力しても文字は大きくなるので、なぜな
のかが全く理解できません。)
文章の記載方法が、分かりにくいとは存じますが、解決策などご存じのかたよろしくお願いいたします。