DOBON.NETプログラミング道掲示板

ログ内検索
・キーワードを複数指定する場合は 半角スペース で区切ってください。
・検索条件は、(AND)=[A かつ B] (OR)=[A または B] となっています。
・[返信]をクリックすると返信ページへ移動します。 (*過去ログは表示されません)
・過去ログから探す場合は検索範囲から過去ログを選択。
過去ログより前の全過去ログはこちらで検索できます。

キーワード/ 検索条件 /
検索範囲/ 強調表示/ ON (自動リンクOFF)
結果表示件数/ 記事No検索/ ON
投稿日時/ 日以内
大文字と小文字を区別する

現在のログを検索

<< 0 >>
■35120  Re[2]: bitmapを複数スレッドで処理したい
□投稿者/ Trans -(2022/07/31(Sun) 20:55:29)
  • アイコン
    2022/07/31(Sun) 20:55:54 編集(投稿者)
    
    ■No35119に返信(Azuleanさんの記事)
    > ■No35118に返信(Transさんの記事)
    >>同じbitmapに複数スレッドからの操作は出来ないんじゃないか?という気はするのですが、何をどうすればいいのかがわかりません。
    > 
    > そうですね、1 つの Bitmap を複数のスレッドから触ることはできません。
    > 
    > LockBits を使ってメモリに展開したものを複数のスレッドで同時に加工することはできるかもしれません。
    > https://dobon.net/vb/dotnet/graphics/drawnegativeimage.html#lockbits
    
    なるほど。一旦メモリ展開ですか。
    案内の内容を参考に以下のように直してみたら動いたようです。
    ありがとうございました。
    {
        // 画像をメモリに読み込む
        FileStream fs = File.OpenRead(filename);
        Image img = Image.FromStream(fs, false, false);
        Bitmap bitmap = new Bitmap(img);
    
        //読み込んだ画像を表示する
        PictureBox.Image = bitmap;
        PictureBox.Refresh();
    
        // 縦横サイズを取得
        int w = img.Width;
        int h = img.Height;
    
        // Bitmapをロックする
        Rectangle rect = new Rectangle(0, 0, w, h);
        BitmapData bmpData = bitmap.LockBits(rect, ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format32bppArgb);
    
        // ピクセルデータをバイト型配列で取得する
        IntPtr ptr = bmpData.Scan0;
        string[] array = new string[3];
        byte[] pixels = new byte[bmpData.Stride * img.Height - 1];
        System.Runtime.InteropServices.Marshal.Copy(ptr, pixels, 0, pixels.Length);
    
        Parallel.Invoke(
            () => TransformPixel(pixels, 0, 99999),
            () => TransformPixel(pixels, 100000, pixels.Length)
        );
    
        // ピクセルデータを元に戻す
        System.Runtime.InteropServices.Marshal.Copy(pixels, 0, ptr, pixels.Length);
    
        // ロックを解除する
        bitmap.UnlockBits(bmpData);
    
        //作成した画像を表示する
        PictureBox.Image = bitmap;
    
    }
    
    private void TransformPixel(byte[] pixels, int start, int end)
    {
        for (int i = start; i < end; i++)
        {
            pixels[i] = (byte)~pixels[i];
        }
    
    }
    
記事No.35118 のレス / END / 返信ページ / 関連記事表示
削除チェック/

■35200  Re[4]: VB.NetでVB6.0と同じFontを指定しても同様に印刷されない
□投稿者/ ゆりりん -(2022/10/26(Wed) 13:45:04)
  • アイコン> 逆に VB6 や VBA 側で GDI+ を使いたい場合は、Declare ステートメントで
    > GdiPlus.dll のもつ API 群を呼び出す形になりますね。
    > GdipDrawImageRectI API とか、GdipDrawString API とか。
    >
    > 今回は VB6 開発をするわけでも無いので、蛇足だとは思いますが。

    ありがとうございます。

    アドバイスをいただき、TextOutを使用して、印刷のプログラムを作成し、印刷してみたのですが、
    座標は合っているようなのですが、想定していたよりかなり小さく印刷されてしまい、ほとんど解読できないような大きさでした。
    単純に大きな値にしたら、見えるようにはなったのですが、Fontサイズの指定の仕方がわかりません。
    色々調べてみたのですが、わからなかったので、また、ここに質問させていただきます。

    ※以前のVB.Netのサンプル

    e.Graphics.PageUnit = GraphicsUnit.Millimeter
    Dim f As New Font("MS ゴシック", 9, FontStyle.Regular)
    e.Graphics.DrawString("IN-OUT<AB>CD EFG-HIJK-LMN A<10>", f, Brushes.Black, 12.5, 30.7)

    だったので、同様に、同じFontとFontSizeを指定して以下のようにやってみました。
    少し長いですが、すみません。

     ' 印刷データを指定の位置に出力します
    <System.Runtime.InteropServices.DllImportAttribute("gdi32.dll")> _
    Friend Shared Function TextOut(ByVal hdc As IntPtr, _
    ByVal nXStart As Integer, ByVal nYStart As Integer, _
    ByVal lpString As String, ByVal cbString As Integer) As Integer
    End Function

    ' 論理フォントを作成します
    <System.Runtime.InteropServices.DllImportAttribute("gdi32.dll")> _
    Friend Shared Function CreateFont(ByVal nHeight As Integer, ByVal nWidth As Integer, ByVal nEscapement As Integer, _
    ByVal nOrientation As Integer, ByVal fnWeight As Integer, ByVal fdwItalic As Boolean, _
    ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Integer, _
    ByVal fdwOutputPrecision As Integer, ByVal fdwClipPrecision As Integer, ByVal fdwQuality As Integer, _
    ByVal fdwPitchAndFamily As Integer, ByVal lpszFace As String) As IntPtr
    End Function

    --------- 省略 ---------

    Private Sub pd_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)

    Dim mFont As IntPtr
    Dim mFontOld As IntPtr

    ' Graphicsの設定をします
    e.Graphics.PageUnit = GraphicsUnit.Millimeter

    Dim intX As Integer = 0 ' X座標
    Dim intY As Integer = 0 ' Y座標
    Dim intFont As Integer = 0 ' フォントサイズ
    Dim Dt As String ' 印刷データ

    Dim hdc As IntPtr

    ' 印刷データを設定します
    Dt = "IN-OUT<AB>CD EFG-HIJK-LMN A<10>"

    ' --- QRコードを印刷 ---

    ' デバイスコンテキストを識別するハンドルを取得します
    hdc = e.Graphics.GetHdc()
    ' 座標とFontSize設定
    intX = 3
    intY = 5
    intFont = 1
    Call SetFont(hdc, "QR-01", intFont) 'QR-01:プリンタに登録したQRコードのFont
    Call PrintTextOut(hdc, intX, intY, Dt, Dt.Length) ← このQRコードはきちんと印刷されます

    ' グラフィックオブジェクトを削除し、システムリソースの解放をします
    DeleteObject(mFont)
    ' デバイスコンテキストにオブジェクトの選択をします
    SelectObject(hdc, mFontOld)
    ' デバイスコンテキストハンドルを解放します
    e.Graphics.ReleaseHdc(hdc)

    ' --- 文字列を印刷 ---

    ' デバイスコンテキストを識別するハンドルを取得します
    hdc = e.Graphics.GetHdc()
    ' 座標とFontSize設定
    intX = 12
    intY = 30
    intFont = 9
    Call SetFont(hdc, "MS ゴシック", intFont)
    Call PrintTextOut(hdc, intX, intY, Dt, Dt.Length) ← これが読み取れないくらい小さく印刷されます

    ' グラフィックオブジェクトを削除し、システムリソースの解放をします
    DeleteObject(mFont)
    ' デバイスコンテキストにオブジェクトの選択をします
    SelectObject(hdc, mFontOld)
    ' デバイスコンテキストハンドルを解放します
    e.Graphics.ReleaseHdc(hdc)


    End Sub

    ' 論理フォント作成

    Private Sub SetFont(ByVal control As IntPtr, ByVal fontFamily As String, ByVal fontSize As Integer)

    mFont = CreateFont(fontSize * -1, 0, 0, 0, 400, 0, 0, 0, 1, 0, 0, 0, 0, fontFamily)
    mFontOld = SelectObject(control, mFont)

    End Sub

    ' 文字列描写

    Private Sub PrintTextOut(ByVal hdc As IntPtr, ByVal intX As Integer, ByVal intY As Integer, ByVal strPrint As String, ByVal intCount As Integer)

    ' SATO CL4NX-J 609dpi(24dot/mm)より1dot辺りのMillimeterを指定しています
    Dim dbldotmm As Double = 0.04166
    Dim intPixelX As Integer = Convert.ToInt16(intX / dbldotmm)
    Dim intPixelY As Integer = Convert.ToInt16(intY / dbldotmm)

    Call TextOut(hdc, intPixelX, intPixelY, strPrint, intCount)

    End Sub

    e.Graphics.DrawStringの時と、同じFontとFontSizeなのですが、印刷される大きさが違ってしまいます。
    FontSizeはどのように設定すればよいのでしょうか。

    どうぞよろしくお願いいたします。
記事No.35185 のレス / 返信ページ / 関連記事表示
削除チェック/

■35202  Re[5]: VB.NetでVB6.0と同じFontを指定しても同様に印刷されない
□投稿者/ 魔界の仮面弁士 -(2022/10/26(Wed) 18:29:47)
  • アイコンNo35200に返信(ゆりりんさんの記事)
    > 想定していたよりかなり小さく印刷されてしまい、
    物理単位と論理単位の違いでは無いでしょうか。

    恐らく、最初の回答で述べた「TextRenderer.DrawText」を使った場合と
    同じぐらいのサイズで描画されていませんか?

    GDI+ 側の PageUnit プロパティを操作しても、
    GDI 側のデバイスコンテキストには影響を与えないと思います。


    > 座標は合っているようなのですが、想定していたよりかなり小さく印刷されてしまい
    単位系が未設定の場合、初期値として
    GDI+ 側(PageUnit プロパティ)は Display(1) を返し、
    GDI 側(GetMapMode API)は MM_TEXT(1) を返すようです。

    Sub SetFont でフォントを生成する際に、
    MM_TEXT から MM_LOMETRIC あるいは MM_HIMETRIC で
    生成するようにしてみては如何でしょうか。


    > Private Sub pd_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
    >  Dim mFont As IntPtr
    ここで宣言されたローカル変数の mFont と

    > Private Sub SetFont(ByVal control As IntPtr, ByVal fontFamily As String, ByVal fontSize As Integer)
    >  mFont = CreateFont(fontSize * -1, 0, 0, 0, 400, 0, 0, 0, 1, 0, 0, 0, 0, fontFamily)
    ここで利用されているフィールド変数の mFont は
    それぞれ別の変数ですが、大丈夫ですか?
記事No.35185 のレス / 返信ページ / 関連記事表示
削除チェック/

■35207  Re[6]: VB.NetでVB6.0と同じFontを指定しても同様に印刷されない
□投稿者/ ゆりりん -(2022/10/28(Fri) 10:38:17)
  • アイコンいつもありがとうございます。

    > 物理単位と論理単位の違いでは無いでしょうか。
    >
    > GDI+ 側の PageUnit プロパティを操作しても、
    > GDI 側のデバイスコンテキストには影響を与えないと思います。

     そういうことだったのですね。

    > Sub SetFont でフォントを生成する際に、
    > MM_TEXT から MM_LOMETRIC あるいは MM_HIMETRIC で
    > 生成するようにしてみては如何でしょうか。

     早速、やってみようと思います。
     
    >> Dim mFont As IntPtr
    > ここで宣言されたローカル変数の mFont と
    >
    >> mFont = CreateFont(fontSize * -1, 0, 0, 0, 400, 0, 0, 0, 1, 0, 0, 0, 0, fontFamily)
    > ここで利用されているフィールド変数の mFont は
    > それぞれ別の変数ですが、大丈夫ですか?

     すみません。
     ここに載せる時に、間違えました。
     実際には、論理フォントの作成の後に入っています。
     お気づきいただき、ありがとうございました。
記事No.35185 のレス / 返信ページ / 関連記事表示
削除チェック/

■35212  Re[6]: VB.NetでVB6.0と同じFontを指定しても同様に印刷されない
□投稿者/ ゆりりん -(2022/10/28(Fri) 16:49:02)
  • アイコン> Sub SetFont でフォントを生成する際に、
    > MM_TEXT から MM_LOMETRIC あるいは MM_HIMETRIC で
    > 生成するようにしてみては如何でしょうか。


    <System.Runtime.InteropServices.DllImportAttribute("gdi32.dll")>
    Friend Shared Function SetMapMode(ByVal hdc As Integer, ByVal fnMapMode As Integer) As Integer
    End Function

     を追加しまして、

    Private Sub SetFont(ByVal control As IntPtr, ByVal fontFamily As String, ByVal fontSize As Integer)

    Call SetMapMode(control, 2) 'MM_LOMETRIC
    mFont = CreateFont(fontSize * -1, 0, 0, 0, 400, 0, 0, 0, 1, 0, 0, 0, 0, fontFamily)
    mFontOld = SelectObject(control, mFont)

    End Sub

     このように書いてみたのですが、
     何も印刷されなくなってしまいました。
     SetMapMode の使い方が、間違っているのでしょうか。

     度々申し訳ございません。
     ご教授いただければと思います。
     どうぞよろしくお願いいたします。

記事No.35185 のレス / 返信ページ / 関連記事表示
削除チェック/

■35237  Re[2]: アプリでHDMIへ出す解像度を変えたい
□投稿者/ ま〜 -(2022/11/16(Wed) 15:17:35)
  • アイコンいつもありがとうございます

    320:160サイズのRichTextBoxに書いてる文字が小さすぎて見にくいのでFontDATAをいじらないで文字を拡大表示させたい
    そこで解像度の切替かMouseホールでRichTextBoxの内容を拡大表示みたいな事が出来ないかとの発想です。
    ホイールの方は倍率の設定が難しそうなので解像度の変更と考えた次第です
    確認用なので実際にLEDモニタは接続せず今使っているモニタ出力信号をハード的に解像度(HDMIに出す解像度)を変更したいです。

    でもアドバイスにありました画像でやれば簡単そうに思えたのでやって見ました所
    https://dobon.net/vb/dotnet/graphics/drawimage.html#scaling
    の bmp.Save("C:\test\1.BMp")でコピペなので入力間違いはないと思いますがSaveで例外エラーとなります。

    以下はエラーの内容です。宜しくお願いします。

    System.Runtime.InteropServices.ExternalException
    HResult=0x80004005
    Message=GDI+ で汎用エラーが発生しました。
    Source=System.Drawing
    スタック トレース:
    場所 System.Drawing.Image.Save(String filename, ImageCodecInfo encoder, EncoderParameters encoderParams)
    場所 System.Drawing.Image.Save(String filename, ImageFormat format)
    場所 System.Drawing.Image.Save(String filename)
    場所 勉強.文字編集Form.Button6_Click(Object sender, EventArgs e) (C:\Users\maeda\source\repos\勉強\文字編集Form.vb):行 818
    場所 System.Windows.Forms.Control.OnClick(EventArgs e)
    場所 System.Windows.Forms.Button.OnClick(EventArgs e)
    場所 System.Windows.Forms.Button.OnMouseUp(MouseEventArgs mevent)
    場所 System.Windows.Forms.Control.WmMouseUp(Message& m, MouseButtons button, Int32 clicks)
    場所 System.Windows.Forms.Control.WndProc(Message& m)
    場所 System.Windows.Forms.ButtonBase.WndProc(Message& m)
    場所 System.Windows.Forms.Button.WndProc(Message& m)
    場所 System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
    場所 System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
    場所 System.Windows.Forms.NativeWindow.DebuggableCallback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)
    場所 System.Windows.Forms.UnsafeNativeMethods.DispatchMessageW(MSG& msg)
    場所 System.Windows.Forms.Application.ComponentManager.System.Windows.Forms.UnsafeNativeMethods.IMsoComponentManager.FPushMessageLoop(IntPtr dwComponentID, Int32 reason, Int32 pvLoopData)
    場所 System.Windows.Forms.Application.ThreadContext.RunMessageLoopInner(Int32 reason, ApplicationContext context)
    場所 System.Windows.Forms.Application.ThreadContext.RunMessageLoop(Int32 reason, ApplicationContext context)
    場所 Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.OnRun()
    場所 Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.DoApplicationModel()
    場所 Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.Run(String[] commandLine)
    場所 勉強.My.MyApplication.Main(String[] Args) ():行 23


記事No.35233 のレス / 返信ページ / 関連記事表示
削除チェック/

■35279  Re[6]: RichTextBoxのテキストをpictureBOXへ
□投稿者/ KOZ -(2022/12/08(Thu) 18:38:13)
  • アイコン
    2022/12/09(Fri) 04:27:45 編集(投稿者)
    
    ■No35275に返信(ま〜さんの記事)
    >>高 DPI 環境で実行している場合は、ズレる可能性がありますね。
    > まさにこれが原因でした。凄いです感激です。
    
    これ動きますか?
    ちょっと問題があって、画像を縮小するせいか、少しぼやけた感じになります。
    ,NET Framework 4.7 以上なら RichTextBox の DrawToBitmap を使ったほうがいいかもしれません。
    
    Imports System.Runtime.InteropServices
    
    Public Class Form1
    
        <DllImport("User32.dll")>
        Public Shared Function LogicalToPhysicalPointForPerMonitorDPI(ByVal hwnd As IntPtr, ByRef point As Point) As Boolean
        End Function
    
        Private Shared Function LogicalToPhysicalRectangleForPerMonitorDPI(ByVal hwnd As IntPtr, ByVal r As Rectangle) As Rectangle
            Dim p1 As Point = r.Location
            Dim p2 As Point = New Point(r.Right, r.Bottom)
            LogicalToPhysicalPointForPerMonitorDPI(hwnd, p1)
            LogicalToPhysicalPointForPerMonitorDPI(hwnd, p2)
            Return Rectangle.FromLTRB(p1.X, p1.Y, p2.X, p2.Y)
        End Function
    
        Private Function LogicalToPhysicalRectangleForPerMonitorDPI(ByVal r As Rectangle) As Rectangle
            Return LogicalToPhysicalRectangleForPerMonitorDPI(Handle, r)
        End Function
    
        Public Sub New()
            InitializeComponent()
            PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
            PictureBox1.Size = RichTextBox1.Size
        End Sub
    
        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            Dim rectangle1 = RectangleToScreen(RichTextBox1.Bounds)
            Dim rectangle2 = LogicalToPhysicalRectangleForPerMonitorDPI(rectangle1)
            Dim bmp = New Bitmap(rectangle2.Width, rectangle2.Height)
            Using g = Graphics.FromImage(bmp)
                g.CopyFromScreen(rectangle2.Location, Point.Empty, rectangle2.Size)
            End Using
            If PictureBox1.Image IsNot Nothing Then
                PictureBox1.Image.Dispose()
            End If
            PictureBox1.Image = bmp
        End Sub
    
    End Class
    
記事No.35270 のレス / 返信ページ / 関連記事表示
削除チェック/

■35282  Re[8]: RichTextBoxのテキストをpictureBOXへ
□投稿者/ KOZ -(2022/12/15(Thu) 18:00:28)
  • アイコン
    No35280に返信(ま〜さんの記事)
    > こんにちは、体調を崩して回答が遅れました。すみません。
    
    お大事に。
    
    > ですがTabPage環境化ではズレました。
    > Parentをと思って色々やってみましたが中々上手くいかずTabPage下の座標知る方法はないのでしょうか?
    
    むむむ、やっかいですね高DPI。
    スクリーン座標を取るのが目的でないなら、以下のコードでキャプチャはできると思います。
    
    Imports System.Runtime.InteropServices
    
    Public Class Form1
    
        Public Sub New()
            InitializeComponent()
            PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
            PictureBox1.Size = RichTextBox1.Size
        End Sub
    
        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            Dim bmp = CreateBitmapFromControl(RichTextBox1)
            If PictureBox1.Image IsNot Nothing Then
                PictureBox1.Image.Dispose()
            End If
            PictureBox1.Image = bmp
        End Sub
    
        Private Const SRCCOPY As Integer = &HCC0020
    
        <DllImport("User32.dll")>
        Private Shared Function GetWindowDC(hWnd As IntPtr) As IntPtr
        End Function
    
        <DllImport("user32.dll")>
        Private Shared Function ReleaseDC(hWnd As IntPtr, hDC As IntPtr) As Boolean
        End Function
    
        <DllImport("gdi32.dll")>
        Private Shared Function BitBlt(hdcDest As IntPtr,
                                       nXDest As Integer, nYDest As Integer,
                                       nWidth As Integer, nHeight As Integer,
                                       hdcSrc As IntPtr,
                                       nXSrc As Integer, nYSrc As Integer,
                                       dwRop As Integer) As Boolean
        End Function
    
        Private Shared Function CreateBitmapFromControl(con As Control) As Bitmap
            Dim cs = con.Size
            Dim bmp As New Bitmap(cs.Width, cs.Height)
            Using g = Graphics.FromImage(bmp)
                Dim hdcDest = g.GetHdc()
                Dim hdcSrc = GetWindowDC(con.Handle)
                BitBlt(hdcDest, 0, 0, cs.Width, cs.Height, hdcSrc, 0, 0, SRCCOPY)
                ReleaseDC(con.Handle, hdcSrc)
                g.ReleaseHdc()
            End Using
            Return bmp
        End Function
    
    End Class
    
記事No.35270 のレス / 返信ページ / 関連記事表示
削除チェック/

■35318  Re[2]: PictureBoxの画像を連続保存
□投稿者/ ま〜 -(2023/01/11(Wed) 13:59:21)
  • アイコンいつもありがとうございます。

    >>ファイル保存の方は問題なく出来ると思うのですが
    > 思うだけで、まだ保存はできていないという事でしょうか。


    すみません
    説明不足でした。15個の PictureBoxに作画してる内容(画像)を15個ファイルに保存したいが目的です


    2つのPictureBoxに作画した状態で
    直前に作画を実行したPictureBoxにしか保存できない。1歩手前に作画したPictureBoxはエラーとなってしまします
    2個とも作画済みが条件で
    下記のコードで PictureBox1を再作画した後でSaveをするとPictureBox1は保存できる。PictureBox2はエラーとなります
    PictureBox2を再作画した後だとPictureBox1を保存するとエラーとなります

    PictureBox1.Image.Save(PicturePath + "MojiGAZou1.Png", System.Drawing.Imaging.ImageFormat.Png)
    PictureBox2.Image.Save(PicturePath + "MojiGAZou2.Png", System.Drawing.Imaging.ImageFormat.Png)

    エラー内容は下記通りです

    System.ArgumentException
    HResult=0x80070057
    Message=使用されたパラメーターが有効ではありません。
    Source=System.Drawing
    スタック トレース:
    at System.Drawing.Image.Save(String filename, ImageCodecInfo encoder, EncoderParameters encoderParams)
    at System.Drawing.Image.Save(String filename, ImageFormat format)
    at 勉強.文字編集Form.Button10_Click(Object sender, EventArgs e) in C:\Users\userMM\OneDrive\ソフト\勉強\文字編集Form.vb:line 736
    at System.Windows.Forms.Control.OnClick(EventArgs e)
    at System.Windows.Forms.Button.OnClick(EventArgs e)
    at System.Windows.Forms.Button.OnMouseUp(MouseEventArgs mevent)
    at System.Windows.Forms.Control.WmMouseUp(Message& m, MouseButtons button, Int32 clicks)
    at System.Windows.Forms.Control.WndProc(Message& m)
    at System.Windows.Forms.ButtonBase.WndProc(Message& m)
    at System.Windows.Forms.Button.WndProc(Message& m)
    at System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
    at System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
    at System.Windows.Forms.NativeWindow.DebuggableCallback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)
    at System.Windows.Forms.UnsafeNativeMethods.DispatchMessageW(MSG& msg)
    at System.Windows.Forms.Application.ComponentManager.System.Windows.Forms.UnsafeNativeMethods.IMsoComponentManager.FPushMessageLoop(IntPtr dwComponentID, Int32 reason, Int32 pvLoopData)
    at System.Windows.Forms.Application.ThreadContext.RunMessageLoopInner(Int32 reason, ApplicationContext context)
    at System.Windows.Forms.Application.ThreadContext.RunMessageLoop(Int32 reason, ApplicationContext context)
    at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.OnRun()
    at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.DoApplicationModel()
    at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.Run(String[] commandLine)
    at 勉強.My.MyApplication.Main(String[] Args) in :line 83

    以上、宜しくお願いします

記事No.35316 のレス / 返信ページ / 関連記事表示
削除チェック/

■35323  Re[7]: 複数のPictureBox画像を複数のファイルへ保存したい
□投稿者/ ま〜 -(2023/01/12(Thu) 14:13:11)
  • アイコンいつもありがとうございます
    フィールド変数の件は棚ぼたです。出来ないと思ってました。助かります。

    本題ですが先のコードでわDisposeした方が良いのか程度で書いてました
    Form LoadでDisposeしてますがボタンクリックでTextBoxから画像を生成して各PictureBoxに書いてますので問題ないと解釈していました
    今二つの問題に当たっています。スレッドを分けなかったのは同じ要因かなと思ってです。

    流れ RichTextBoxへ文字入力 ⇒生成⇒ PictureBox16 ⇒サイズを変えてコピー⇒ 各PictureBox ⇒ すべてのPictureBoxの画像をファイル保存


    ――――――――ボタン@――――――――ー
    Dim bmp = CreateBitmapFromControl(Rbox(PageNo))
    If PictureBox16.Image IsNot Nothing Then
      PictureBox16.Image.Dispose()
    End If

    ‘P PageNo←どのPictureBoxを操作するか
    PictureBox16.Image = bmp ← 自動生成されたイメージが入っている
    ‘ピクチャ1−15へ各個転送
    Dim Picture() As PictureBox = {PictureBox1, PictureBox2, PictureBox3, ・・・・・PictureBox15} 
    Picture(PageNo).Image = PictureBox16.Image

    これは同じ画像を各PictureBoxへ書いたと同じ扱いになりますか?一旦PictureBox16経由で各PictureBoxへ作画されています
    これがやっては駄目な事でしょうか?

    最後の書いたPictureBoxをBで保存する事は出来ました。
    それ以外のPictureBox以外でBのコードを実行するエラーとなる

    ―――――――Bエラーになる箇所――――――――――
    Picture(PageNo).Image.Save(PicturePath"MojiGAZou1.bmp",System.Drawing.Imaging.ImageFormat.Bmp)


    Imageは使わない方がよいのでしょうか?

    ―――――――――ボタンA――――――――――――
    試してみました

    Dim Picture() As PictureBox = {PictureBox1, PictureBox2, PictureBox3, PictureBox4, PictureBox5}
    For i As Byte = 0 To 4
    Picture(i).Size = New Size(Picture(i).Size.Width, 320)
    Picture(i).Size = New Size(Picture(i).Size.Height, 160)
    Picture(i).SizeMode = PictureBoxSizeMode.Zoom
    Picture(i).Image = Image.FromFile(PicturePath + "MojiGAZou" & CStr(i + 1) & ".bmp")
    Next

    Me.PictureBox1.Image.Save(PicturePath + "MojiGAZou1.bmp", System.Drawing.Imaging.ImageFormat.Bmp)
    Me.PictureBox2.Image.Save(PicturePath + "MojiGAZou2.bmp", System.Drawing.Imaging.ImageFormat.Bmp)
    Me.PictureBox3.Image.Save(PicturePath + "MojiGAZou3.bmp", System.Drawing.Imaging.ImageFormat.Bmp)
    Me.PictureBox4.Image.Save(PicturePath + "MojiGAZou4.bmp", System.Drawing.Imaging.ImageFormat.Bmp)
    Me.PictureBox5.Image.Save(PicturePath + "MojiGAZou5.bmp", System.Drawing.Imaging.ImageFormat.Bmp)

    これもPictureBox1.のSaveの所でエラーとなります。こんな事は出来ない?

    以下はエラーの内容です

    System.Runtime.InteropServices.ExternalException
    HResult=0x80004005
    Message=GDI+ で汎用エラーが発生しました。
    Source=System.Drawing
    スタック トレース:
    at System.Drawing.Image.Save(String filename, ImageCodecInfo encoder, EncoderParameters encoderParams)
    at System.Drawing.Image.Save(String filename, ImageFormat format)
    at Test.文字編集Form.Button18_Click(Object sender, EventArgs e) in C:\Users\userMM\OneDrive\Test\文字編集Form.vb:line 232
    at System.Windows.Forms.Control.OnClick(EventArgs e)
    at System.Windows.Forms.Button.OnClick(EventArgs e)
    at System.Windows.Forms.Button.OnMouseUp(MouseEventArgs mevent)
    at System.Windows.Forms.Control.WmMouseUp(Message& m, MouseButtons button, Int32 clicks)
    at System.Windows.Forms.Control.WndProc(Message& m)
    at System.Windows.Forms.ButtonBase.WndProc(Message& m)
    at System.Windows.Forms.Button.WndProc(Message& m)
    at System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
    at System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
    at System.Windows.Forms.NativeWindow.DebuggableCallback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)
    at System.Windows.Forms.UnsafeNativeMethods.DispatchMessageW(MSG& msg)
    at System.Windows.Forms.Application.ComponentManager.System.Windows.Forms.UnsafeNativeMethods.IMsoComponentManager.FPushMessageLoop(IntPtr dwComponentID, Int32 reason, Int32 pvLoopData)
    at System.Windows.Forms.Application.ThreadContext.RunMessageLoopInner(Int32 reason, ApplicationContext context)
    at System.Windows.Forms.Application.ThreadContext.RunMessageLoop(Int32 reason, ApplicationContext context)
    at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.OnRun()
    at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.DoApplicationModel()
    at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.Run(String[] commandLine)
    at Test.My.MyApplication.Main(String[] Args) in :line 83


    Disposeする必要は無いので何か良い方法はありますか?

    あと

    >No35282 の KOZ さんの実装パターンに相当しますね。
    >
    > PictureBox1.Image?.Dispose() '処分
    > PictureBox1.Image = Nothing '解放

    とありますがこれはどの様な意味ですか?

    以上、長々とすみません
記事No.35316 のレス / 返信ページ / 関連記事表示
削除チェック/

■35433  jumbo icon(256x256)が存在するか知る方法
□投稿者/ inunoshi -(2023/06/04(Sun) 20:10:12)
  • アイコン環境/言語:[.NET Framework] 
    分類:[.NET] 

    jumbo icon(256x256)の取得をしたいです。
    以下のコードで取得できますが、256x256アイコンを持ってないファイルの場合、
    以下の画像のように48x48アイコンが左上に描画された256x256アイコンが
    取得されていしまいます。
    256x256アイコンを持っていないことを知る方法はありませんでしょうか。
    IImageListを使って知る方法でもわかればありがたいですが、できればWindowsAPIを
    使って知る方法がわかればありがたいです。
    ご存じの方、ご教授ください。



    ---------------------------------------------------------
    //プログラムと同じフォルダに「C:\Windows\winhlp32.exe」の256x256アイコンを出力
    using System;
    using System.Drawing;
    using System.Windows.Forms;
    using System.Runtime.InteropServices;
    using System.IO;
    using System.Reflection;

    public class Icon256
    {
    [StructLayout(LayoutKind.Sequential, CharSet = CharSet.Unicode)]
    public struct SHFILEINFO
    {
    public IntPtr hIcon;
    public int iIcon;
    public uint dwAttributes;
    [MarshalAs(UnmanagedType.ByValTStr, SizeConst = 260)]
    public string szDisplayName;
    [MarshalAs(UnmanagedType.ByValTStr, SizeConst = 80)]
    public string szTypeName;
    }

    [DllImport("shell32.dll")]
    static extern int SHGetImageList(uint iImageList, ref Guid riid, out IntPtr ppv);

    [DllImport("comctl32.dll", SetLastError=true)]
    static extern bool ImageList_DrawEx(IntPtr himl, int i, IntPtr hdcDst, int x, int y, int dx, int dy, uint rgbBk, uint rgbFg, int fStyle);

    [DllImport("shell32.dll", EntryPoint = "SHGetFileInfoW", CharSet = CharSet.Unicode)]
    public static extern IntPtr SHGetFileInfo(string pszPath, uint dwFileAttributes, out SHFILEINFO psfi, uint cbFileInfo, uint uFlags);

    public static void Main()
    {
    Bitmap iconImage = new Bitmap(256, 256);
    Guid IID_IImageList = new Guid("46EB5926-582E-4017-9FDF-E8998DAA0950");
    const uint SHIL_JUMBO = 0x0004;
    IntPtr pimgList;

    SHGetImageList(SHIL_JUMBO, ref IID_IImageList, out pimgList);

    uint SHGFI_ICON = 0x00000100;
    uint SHGFI_SYSICONINDEX = 0x00004000;
    uint SHGFI_OVERLAYINDEX = 0x00000040;
    uint vFlags = SHGFI_ICON | SHGFI_SYSICONINDEX | SHGFI_OVERLAYINDEX;

    SHFILEINFO shfi = new SHFILEINFO();
    SHGetFileInfo(@"C:\Windows\winhlp32.exe", 0, out shfi, (uint)Marshal.SizeOf(shfi), vFlags);

    Graphics g = Graphics.FromImage(iconImage);
    uint CLR_DEFAULT = 0xFF000000;
    ImageList_DrawEx(pimgList, shfi.iIcon & 0xFFFFFF, g.GetHdc(), 0, 0, 0, 0, CLR_DEFAULT, CLR_DEFAULT, 0);
    g.Dispose();

    string dstPathName = Path.GetDirectoryName(Assembly.GetEntryAssembly().Location) + @"\testIcon256.png";
    iconImage.Save(dstPathName);
    }
    }
testIcon256.png/1KB
testIcon256.png
/1KB
親記事 / 返信ページ / 関連記事表示
削除チェック/

■35498  Re[3]: VB.NETからcmdでpingを実行した時の結果
□投稿者/ KOZ -(2023/08/23(Wed) 05:54:27)
  • アイコン
    2023/08/23(Wed) 05:57:00 編集(投稿者)
    
    ■No35497に返信(ぱんださんの記事)
    
    CTRL+C を送ってキャンセルでいいんですかね?
    
    Imports System.Runtime.InteropServices
    
    Public Class Form1
    
        Private cmdProcess As Process
    
        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            If cmdProcess IsNot Nothing Then Return
            TextBox1.Clear()
            cmdProcess = New Process
            cmdProcess.StartInfo.FileName = Environment.GetEnvironmentVariable("ComSpec")
            cmdProcess.StartInfo.UseShellExecute = False
            cmdProcess.StartInfo.RedirectStandardOutput = True
            cmdProcess.StartInfo.RedirectStandardInput = False
            cmdProcess.StartInfo.CreateNoWindow = True
            cmdProcess.StartInfo.Arguments = "/c " & TextBox2.Text
            cmdProcess.Start()
            Task.Run(AddressOf ReadTask)
            Button1.Enabled = False
            Button2.Enabled = True
        End Sub
    
        Private Sub ReadTask()
            Dim reader = cmdProcess.StandardOutput
            Do Until reader.EndOfStream
                Dim buffer = reader.ReadLine()
                Invoke(Sub()
                           TextBox1.AppendText(vbCrLf & buffer)
                           Refresh()
                       End Sub)
            Loop
            cmdProcess.WaitForExit()
            cmdProcess.Dispose()
            cmdProcess = Nothing
            Invoke(Sub()
                       Button1.Enabled = True
                       Button2.Enabled = False
                   End Sub)
        End Sub
    
        Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
            If AttachConsole(cmdProcess.Id) Then
                SetConsoleCtrlHandler(IntPtr.Zero, True)
                GenerateConsoleCtrlEvent(CTRL_C_EVENT, 0)
                cmdProcess.WaitForExit()
                SetConsoleCtrlHandler(IntPtr.Zero, False)
                FreeConsole()
            End If
        End Sub
    
        Private Const CTRL_C_EVENT = 0
        Private Const CTRL_BREAK_EVENT = 1
    
        <DllImport("Kernel32")>
        Private Shared Sub GenerateConsoleCtrlEvent(dwCtrlEvent As Integer, dwProcessGroupId As Integer)
        End Sub
    
        <DllImport("Kernel32")>
        Private Shared Function AttachConsole(dwProcessId As Integer) As Boolean
        End Function
    
        <DllImport("Kernel32")>
        Private Shared Function SetConsoleCtrlHandler(HandlerRoutine As IntPtr, add As Boolean) As Boolean
        End Function
    
        <DllImport("Kernel32")>
        Private Shared Function FreeConsole() As Boolean
        End Function
    
    End Class
    
記事No.35494 のレス / 返信ページ / 関連記事表示
削除チェック/

■35512  Re[1]: 重なったPictureBox同士を透過する方法
□投稿者/ KOZ -(2023/09/05(Tue) 12:01:54)
  • アイコン
    2023/09/05(Tue) 19:59:32 編集(投稿者)
    2023/09/05(Tue) 19:59:28 編集(投稿者)
    
    ■No35510に返信(本体は眼鏡さんの記事)
    
    親の子コントロールの処理がまずかったので修正しています。
    
    いつか作ろうと思って作ってなかったんですが、いい機会なのでカスタムコントロールを作ってみました。
    (1) 背景に親コントロールを描画
    親コントロールは子コントロールを除いて描画する(でないと自分が描画されてしまい、ループする)
    描画は WM_PRINTCLIENT メッセージを送ることで行っています。
    
    (2) 親の子コントロールを描画
    親の子コントロールは、その子も描画するので DrawToBitmap で良い
    
    Option Strict On
    Imports System.Runtime.InteropServices
    
    Public Class TransparentPictureBox
        Inherits PictureBox
    
        Protected Overrides Sub OnPaintBackground(pevent As PaintEventArgs)
            MyBase.OnPaintBackground(pevent)
            If Parent IsNot Nothing Then
                DrawParent(pevent.Graphics, Parent)
                Dim ctls = Parent.Controls
                Dim i = ctls.Count - 1
                While i >= 0
                    Dim ctrl As Control = ctls(i)
                    If ctrl Is Me Then Exit While
                    If ctrl.Visible Then
                        DrawSameHierarchy(pevent.Graphics, ctrl)
                    End If
                    i -= 1
                End While
            End If
        End Sub
    
        Private Sub DrawParent(g As Graphics, ctrl As Control)
            Dim mapRect = MapRectangle(Me, Me.ClientRectangle, ctrl)
            Dim rect = Rectangle.Intersect(ctrl.ClientRectangle, mapRect)
            If rect.Width > 0 AndAlso rect.Height > 0 Then
                Using bmp As New Bitmap(ctrl.Width, ctrl.Height,
                                        Imaging.PixelFormat.Format32bppRgb)
                    Using bmpG = Graphics.FromImage(bmp)
                        Dim hdc = bmpG.GetHdc()
                        Dim printParam = PRF_CLIENT Or PRF_ERASEBKGND
                        SendMessage(ctrl.Handle, WM_PRINTCLIENT,
                                    hdc, New IntPtr(printParam))
                        bmpG.ReleaseHdc()
                    End Using
                    Dim drawRect = MapRectangle(ctrl, rect, Me)
                    g.DrawImage(bmp, drawRect, rect, GraphicsUnit.Pixel)
                End Using
            End If
        End Sub
    
        Private Sub DrawSameHierarchy(g As Graphics, ctrl As Control)
            Dim mapRect = MapRectangle(Me, Me.ClientRectangle, Parent)
            Dim rect = Rectangle.Intersect(ctrl.Bounds, mapRect)
            If rect.Width > 0 AndAlso rect.Height > 0 Then
                Using bmp As New Bitmap(ctrl.Width, ctrl.Height,
                                        Imaging.PixelFormat.Format32bppRgb)
                    ctrl.DrawToBitmap(bmp, New Rectangle(Point.Empty, ctrl.Size))
                    Dim drawRect = MapRectangle(Parent, rect, Me)
                    Dim clipRect = New Rectangle(
                                    rect.Location - CType(ctrl.Location, Size), rect.Size)
                    g.DrawImage(bmp, drawRect, clipRect, GraphicsUnit.Pixel)
                End Using
            End If
        End Sub
    
        Private Function MapRectangle(fromCtrl As Control,
                                      fromRect As Rectangle,
                                      toCtrl As Control) As Rectangle
            Dim rect As New RECT(fromRect)
            MapWindowPoints(fromCtrl.Handle, toCtrl.Handle, rect, 2)
            Return rect.ToRectangle()
        End Function
    
        Private Const WM_PRINTCLIENT = &H318
        Private Const PRF_CHECKVISIBLE = &H1,
                      PRF_NONCLIENT = &H2,
                      PRF_CLIENT = &H4,
                      PRF_ERASEBKGND = &H8,
                      PRF_CHILDREN = &H10
    
        <StructLayout(LayoutKind.Sequential)>
        Private Structure RECT
            Public Left, Top, Right, Bottom As Integer
            Public Sub New(r As Rectangle)
                Left = r.Left
                Top = r.Top
                Bottom = r.Bottom
                Right = r.Right
            End Sub
            Public Function ToRectangle() As Rectangle
                Return Rectangle.FromLTRB(Left, Top, Right, Bottom)
            End Function
        End Structure
    
        <DllImport("user32")>
        Private Shared Function MapWindowPoints(
                            hwndFrom As IntPtr, hwndTo As IntPtr,
                            ByRef RECT As RECT, cPoints As Integer) As Integer
        End Function
    
        <DllImport("user32", CharSet:=CharSet.Auto)>
        Private Shared Function SendMessage(
                            hwnd As IntPtr, msg As Integer,
                            wparam As IntPtr, lparam As IntPtr) As IntPtr
        End Function
    
    End Class
    
記事No.35510 のレス / 返信ページ / 関連記事表示
削除チェック/

■35517  Re[5]: 重なったPictureBox同士を透過する方法
□投稿者/ KOZ -(2023/09/09(Sat) 11:50:05)
  • アイコン
    2023/09/09(Sat) 11:50:38 編集(投稿者)
    
    Windows 8 から子ウインドウがレイヤードウインドウになれるので、アプリケーションマニュフェストを追加して
    
          <!-- Windows 8 -->
          <!--<supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" />-->
    
    のコメントアウトを解除すると、簡単に透過できますね。
    
    # GetWindowLong/SetWindowLong を使っているのは手抜きです。(長くなるので)
    # プロセスが 64bit なら GetWindowLongPtr,SetWindowLongPtr を使うのが正式なやり方。
    # 64bit で SetWindowLong を使うと成功しても戻り値がゼロになってしまいます。
    
    Imports System.Runtime.InteropServices
    
    Public Class Form1
    
        Private Const WS_EX_LAYERED = &H80000
        Private Const GWL_EXSTYLE = -20
        Private Enum LWA
            COLORKEY = &H1
            ALPHA = &H2
        End Enum
    
        Private Sub PictureBox_HandleCreated(sender As Object, e As EventArgs) _
                    Handles PictureBox1.HandleCreated,
                            PictureBox2.HandleCreated
            Dim pic = DirectCast(sender, PictureBox)
            pic.Image = My.Resources.megane_hikaru_woman
            pic.SizeMode = PictureBoxSizeMode.Zoom
            pic.BackColor = Color.Gray
            Dim dwStyle = GetWindowLong(pic.Handle, GWL_EXSTYLE)
            dwStyle = dwStyle Or WS_EX_LAYERED
            SetWindowLong(pic.Handle, GWL_EXSTYLE, dwStyle)
            SetLayeredWindowAttributes(
                    pic.Handle, ColorTranslator.ToWin32(pic.BackColor),
                    0, LWA.COLORKEY)
        End Sub
    
        <DllImport("user32.dll")>
        Private Shared Function GetWindowLong(
                    hWnd As IntPtr, nIndex As Integer) As Integer
        End Function
    
        <DllImport("user32.dll")>
        Private Shared Function SetWindowLong(
                    hWnd As IntPtr, nIndex As Integer,
                    dwNewLong As Integer) As Integer
        End Function
    
        <DllImport("user32.dll")>
        Private Shared Function SetLayeredWindowAttributes(
                    hWnd As IntPtr, crKey As Integer,
                    bAlpha As Byte, dwFlags As LWA) As Boolean
        End Function
    
    End Class
    
    透過画像のまわりに BackColor が残ってしまいますが、目立たない色を設定しておくといいです。
    
    
    
layeredWindow.jpg/15KB
layeredWindow.jpg
/15KB
記事No.35510 のレス / END / 返信ページ / 関連記事表示
削除チェック/



<< 0 >>

パスワード/


- Child Tree -