今回は息子くんが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 とかも使ってほしい。とかとか。
でも私も古い人間なので、私の時代の良いとされてきたコーディングスタイルは現代にそぐわないかもしれないのかなとも思いつつ。
・需要はどこに！？
プログラム上から画面解像度を変更したいことがあるかなぁ？と素朴な疑問。
・でもよくできてます。これからもがんばってね☆
スター・はてブ・ブログ村リンクとても嬉しいです！
にほんブログ村
