小5息子くんWindowsの画面解像度を変更するプログラムを作る

今回は息子くんがWindowsの画面解像度を変更するプログラムを作ったという話。

仕様

開発環境は
Visual Studio 2017 の VB
動作環境は Windowです。

「他の操作」メニュー

「一般的に使える解像度」をクリックすると、解像度の一覧が表示されます。

設定できる解像度としてはこのリストの中からさらに対象のマシンが対応している画面解像度のみとなります。

使い方としてはシンプルに、
「変更」ボタンを押すと、入力した解像度に変更されます。

プログラム

今回は息子くんから珍しく「プログラムを公開してほしい」との依頼がありました。
いつもは恥ずかしいのかかたくなに「公開されたくない！」というので公開してないんですけど…。

今回公開したい理由を尋ねると、「自分が参考になるサイトがなくて苦労したから」だそうです。
そんなことも考えるようになったとは成長したね、息子くん。

これ、中身としては、WindowsAPI使って解像度の設定をしています。

Daclare Functionの定義

Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByRef DEVMODE As DEVMODE, ByVal flags As long) As long

ネットで調べると、なにかと第二引数（flags）や戻り値がLongで説明されてて、そのまま使おうとして失敗してました。
VB.NETからはLongはIntegerになった旨説明をして、書き換えて成功。

＜正＞

Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByRef DEVMODE As DEVMODE, ByVal flags As Integer) As Integer

私、VB4～VB.NETまで開発してきた経験がこんなところで生かされて子供に教えてあげることができました。笑

ソースの全貌です。
◆Form1.vb

Public Class Form1
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        BppSelection.SelectedItem = Screen.PrimaryScreen.BitsPerPixel.ToString()
        BppSelection.DropDownStyle = ComboBoxStyle.DropDownList
        Width.Text = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width.ToString()
        Height.Text = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height.ToString()
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles ChangeButton.Click
        If Width.Text = "0" Then
            MsgBox("0にできません", vbCritical)
            Exit Sub
        End If
        If Height.Text = "0" Then
            MsgBox("0にできません", vbCritical)
            Exit Sub
        End If
        Dim Success = ScreenResolution.ChangeResolution(Integer.Parse(Width.Text), Integer.Parse(Height.Text), Integer.Parse(BppSelection.SelectedItem))
        If Success Then
            MsgBox("成功しました", vbInformation)
        Else
            MsgBox("失敗しました" + vbCrLf + "対応していない解像度、ビット毎ピクセル" + vbCrLf + "もしくは再起動等が必要の可能性があります。", vbCritical)
        End If
    End Sub

    Private Sub 使い方ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 使い方ToolStripMenuItem.Click
        MsgBox("ScreenResolution.ChangeResolution(X,Y,bpp)" + vbCrLf + "で使用してください")
    End Sub

    Private Sub BppとはToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BppとはToolStripMenuItem.Click
        Process.Start("http://e-words.jp/w/bpp.html")
    End Sub

    Private Sub 一般的に使える解像度ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 一般的に使える解像度ToolStripMenuItem.Click
        MsgBox("1920x1080" + vbCrLf + "1680x1050" + vbCrLf + "1600x900" + vbCrLf + "1440x900" + vbCrLf + "1400x900" + vbCrLf + "1366x768" + vbCrLf + "1360x768" + vbCrLf + "1280x1024" + vbCrLf + "1280x960" + vbCrLf + "1280x800" + vbCrLf + "1280x768" + vbCrLf + "1280x720" + vbCrLf + "1280x600" + vbCrLf + "1152x864" + vbCrLf + "1024x768" + vbCrLf + "800x600", vbInformation)
    End Sub

    Private Sub Width_KeyPress(sender As Object, e As KeyPressEventArgs) Handles Width.KeyPress
        If e.KeyChar < "0"c OrElse "9"c < e.KeyChar Then
            '押されたキーが 0～9もしくはBackSpace、Deleteでない場合は、イベントをキャンセルする
            If Not Asc(e.KeyChar) = Keys.Back Then
                If Not Asc(e.KeyChar) = Keys.Delete Then
                    e.Handled = True
                End If
            End If
        End If
    End Sub

    Private Sub Height_KeyPress(sender As Object, e As KeyPressEventArgs) Handles Height.KeyPress
        If e.KeyChar < "0"c OrElse "9"c < e.KeyChar Then
            '押されたキーが 0～9もしくはBackSpace、Deleteでない場合は、イベントをキャンセルする
            If Not Asc(e.KeyChar) = Keys.Back Then
                If Not Asc(e.KeyChar) = Keys.Delete Then
                    e.Handled = True
                End If
            End If
        End If
    End Sub
End Class

◆ScreenRosolution.vb

Imports System.Runtime.InteropServices
Public Class ScreenResolution
    Const CDS_TEST As Long = &H2
    Const CDS_FORCE As Integer = &H80000000
    Const CCDEVICENAME As Integer = 32
    Const CCFORMNAME As Integer = 32
    Const DISP_CHANGE_SUCCESSFUL As Integer = 0
    Const DM_BITSPERPEL As Integer = &H40000
    Const DM_PELSWIDTH As Integer = &H80000
    Const DM_PELSHEIGHT As Integer = &H100000
    Const BITSPIXEL As Integer = 12
    Const HORZRES As Integer = 8
    Const VERTRES As Integer = 10

    <StructLayout(LayoutKind.Sequential)> Public Structure DEVMODE
        <MarshalAsAttribute(UnmanagedType.ByValTStr, SizeConst:=CCDEVICENAME)> Public dmDeviceName As String
        Public dmSpecVersion As Short
        Public dmDriverVersion As Short
        Public dmSize As Short
        Public dmDriverExtra As Short
        Public dmFields As Integer
        Public dmOrientation As Short
        Public dmPaperSize As Short
        Public dmPaperLength As Short
        Public dmPaperWidth As Short
        Public dmScale As Short
        Public dmCopies As Short
        Public dmDefaultSource As Short
        Public dmPrintQuality As Short
        Public dmColor As Short
        Public dmDuplex As Short
        Public dmYResolution As Short
        Public dmTTOption As Short
        Public dmCollate As Short
        <MarshalAsAttribute(UnmanagedType.ByValTStr, SizeConst:=CCFORMNAME)> Public dmFormName As String
        Public dmUnusedPadding As Short
        Public dmBitsPerPel As Short
        Public dmPelsWidth As Integer
        Public dmPelsHeight As Integer
        Public dmDisplayFlags As Integer
        Public dmDisplayFrecuency As Integer
    End Structure

    Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByRef DEVMODE As DEVMODE, ByVal flags As Integer) As Integer

    Public Shared Function ChangeResolution(ByVal width As Integer, ByVal height As Integer, ByVal bitsPerPixel As Integer) As Boolean
        Dim devM As New DEVMODE
        devM.dmPelsWidth = width
        devM.dmPelsHeight = height
        devM.dmBitsPerPel = bitsPerPixel
        devM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
        devM.dmSize = CShort(Marshal.SizeOf(GetType(DEVMODE)))

        If ChangeDisplaySettings(devM, CDS_TEST) <> DISP_CHANGE_SUCCESSFUL Then
            Return False
        Else
            Dim iResultado As Integer = ChangeDisplaySettings(devM, CDS_FORCE)
            Return (iResultado = DISP_CHANGE_SUCCESSFUL)
        End If
    End Function
End Class

感想

・職業柄、めっちゃコードレビューがしたくなる。
　でも親子喧嘩のもとになるのでなるべく言わないで小出しにしよう…。
　一番気になるのは画面上の「Form1」の文言を変えて、アイコンも設定してほしい！
　あとコード上でもButton1とかもあとで読みやすいように名前ちゃんとつけてほしい、せっかくVBなんでwith とかも使ってほしい。とかとか。
　でも私も古い人間なので、私の時代の良いとされてきたコーディングスタイルは現代にそぐわないかもしれないのかなとも思いつつ。

・需要はどこに！？
　プログラム上から画面解像度を変更したいことがあるかなぁ？と素朴な疑問。

・でもよくできてます。これからもがんばってね☆

スター・はてブ・ブログ村リンクとても嬉しいです！
にほんブログ村