An update to changing Windows screen resolution using Delphi

Published on
4,376 Points
Last Modified:
This is an update to some code that someone else posted on Experts Exchange. It is an alternate approach, I think a little easier to use, & makes sure that things like the Task Bar will update.

For the original Question, see: Setting resolution of screen from Delphi

Here's the code for a Delphi main form unit.  Take and learn whatever you need.  Note that it also sorts the menu so that the best resolution is also the most accessible.

unit ChangeResMainUnit;
// Note that this source file is arranged for 132-column display/editing - use the WIDTH, Luke!
// The following code was adapted by Alex Tidmarsh from an example provided by "williams2" upon https://www.experts-exchange.com.
// The point of it all is to (a) make it a little easier to use, and (b) ensure the task bar also resizes/moves for the resolution.
// In particular, it was recoded to help manage resolution changes under VMware KVM, especially for an older OS like Windows NT4.
// It ensures the "highest" modes are displayed as drop down menu options first, which ensures they are the ones most likely to be
// seen when trying to use this tool in a very low resolution!  Otherwise you would need many clicks to increase it from 320x200!

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, ShellAPI;

type TForm1 = class(TForm)
                 procedure FormCreate(Sender: TObject);
                 MainMenu1: TMainMenu;
                 procedure MenuItemClick(Sender: TObject);
                 procedure CreateSortedResolutionEntries;

var Form1: TForm1;

{$R *.DFM}
// ShowTaskBar allows the taskbar to be hidden and shown again - which can in theory be useful for REALLY small screen real-estates.
   procedure ShowTaskBar(show:Boolean);
   var taskbar : HWND;
      taskbar := FindWindow('Shell_TrayWnd', nil);
      if (taskbar <> 0) then
         if Show then ShowWindow(taskbar, SW_SHOW )
                 else ShowWindow(taskbar, SW_HIDE);
// MenuItemClick implements the Device Mode chosen from the menu at runtime
   procedure TForm1.MenuItemClick(Sender: TObject);
   Var Mode: Integer;
       DevMode: TDevMode;
       res: Integer;
      ShowTaskBar(FALSE); // If (as happens in NT4 under VMware) the display surface is way too small, increase real estate.
         Mode:= TMenuItem(Sender).Tag; 
         if EnumDisplaySettings(  nil,     // specifies the display device
                                  Mode,    // specifies the graphics mode
                                  DevMode  // points to structure to receive settings
                                ) then
            res:= ChangeDisplaySettings( DevMode, CDS_UPDATEREGISTRY ); // MUST update registry to ensure taskbar movement/resize.
         // We could use CDS_TEST, which apparently tests whether the displaymode is available, or ZERO (CDS_NONE) that changes the
         // display mode, but does not necessarily cause certain windows (like the TaskBar in NT4 for instance) to also change.
         // Check the outcome...
            case res of
               DISP_CHANGE_SUCCESSFUL:// The settings change was successful.
               DISP_CHANGE_RESTART:   // The computer must be restarted in order for the graphics mode to work.
                                         MessageDlg('You need to restart the computer to invoke changes.',mtInformation,[mbOk],0);
               DISP_CHANGE_BADFLAGS:  // An invalid set of flags was passed in.
                                         MessageDlg('Graphic settings are invalid.',mtError,[mbOk],0);
               DISP_CHANGE_FAILED:    // The display driver failed the specified graphics mode.
                                         MessageDlg('Failed to change to specified displaymode.',mtError,[mbOk],0);
               DISP_CHANGE_BADMODE:   // The graphics mode is not supported.
                                         MessageDlg('Graphic mode is invalid.',mtError,[mbOk],0);
               DISP_CHANGE_NOTUPDATED:// Unable to write settings to the registry.
                                         MessageDlg('Unable to update the system registry.',mtError,[mbOk],0);
         end else MessageDlg('Unable to retrieve mode!',mtError,[mbOk],0);
         ShowTaskBar(TRUE);  // Always, always, always - give the task bar back to the user!

// CreateSortedResolutionEntries creates a conveniently arranged drop-down menu of device modes to select from.
   Procedure TForm1.CreateSortedResolutionEntries;
   var HaveDevMode: BOOL;
       DevMode: TDevMode;
       S: String;
       ModeNumber,b,r,f,c: Integer;
       Index : Integer;
       LBitsPerPel,LResolution,LFreq,LColour: TStringList;
       MenuItem,BitsPerPelItem,ResolutionItem,FreqItem,ColorItem: TMenuItem;
   // First create a sorted list structure, starting with Bits/Pel at its lowest tier
      LBitsPerPel:= TStringList.Create;
      LBitsPerPel.Sorted := TRUE;
      LBitsPerPel.Duplicates := dupIgnore;
   // Now enumerate the device modes
      ModeNumber:= 0;
         HaveDevMode := EnumDisplaySettings( nil,        // specifies the display device
                                             ModeNumber, // specifies the device mode number
                                             DevMode     // points to structure to receive settings
         if HaveDevMode then // Add this device mode to a pre-sorted list structure with no duplicates
         with DevMode do
         // Find bits per pixel - note that we use an easily removable 2-digit hex code to provide a sort-order
            Index := LBitsPerPel.add( IntToHex(dmBitsPerPel,2) + IntToStr(dmBitsPerPel)+' bit mode' );
         // Start (or re-use) the next tier in the structure, which is Resolution
            LResolution := TStringList( LBitsPerPel.Objects[ Index ] );
            if LResolution = nil then
               LResolution := TStringList.Create;
               LResolution.Sorted := TRUE;
               LResolution.Duplicates := dupIgnore;
               LBitsPerPel.Objects[ Index ] := LResolution;
         // Find width and height - note that we use an easily removable 10-digit hex code to provide a sort-order
            Index := LResolution.add( IntToHex(dmPelsWidth,5) + IntToHex(dmPelsHeight,5)
                                      + IntToStr(dmPelsWidth)+'x'+IntToStr(dmPelsHeight) );
         // Start (or re-use) the next tier in the structure, which is Frequency
            LFreq := TStringList( LResolution.Objects[ Index ] );
            if LFreq = nil then
               LFreq := TStringList.Create;
               LFreq.Sorted := TRUE;
               LFreq.Duplicates := dupIgnore;
               LResolution.Objects[ Index ] := LFreq;
         // Find or create Frequency - note that we use an easily removable 4-digit hex code to provide a sort-order
            Index := LFreq.add( IntToHex(dmDisplayFrequency,4) + IntToStr(dmDisplayFrequency)+' Hz' );
         // Start (or re-use) the next tier in the structure, which is Colour
            LColour := TStringList( LFreq.Objects[ Index ] );
            if LColour = nil then
               LColour := TStringList.Create;
               LColour.Sorted := TRUE;
               LColour.Duplicates := dupIgnore;
               LFreq.Objects[ Index ] := LColour;
         // Find Color Mode + Interlaced option.
            If (dmDisplayFlags AND DM_GRAYSCALE)>0 then S:='B/W ' else S:='Color ';
            If (dmDisplayFlags AND DM_INTERLACED)>0 then S:= S+'Interlaced';
            Index := LColour.add( S );
            LColour.Objects[ Index ] := TObject(ModeNumber);
      until not(HaveDevMode);
   // Create a menu structure from the sorted list structure we just built
      LBitsPerPel.Sorted := FALSE;
      LBitsPerPel.Sorted := TRUE;
      MenuItem:= TMenuItem.Create(Self);
      for b := LBitsPerPel.Count-1 downto 0 do  // Make highest mode first!
         BitsPerPelItem := TMenuItem.Create(self);
         BitsPerPelItem.Caption := Copy(LBitsPerPel[b],3,99); // Remove 2-digit hex sort code and use remaining bits/pel string
         MenuItem.Add( BitsPerPelItem );
         LResolution := TStringList(LBitsPerPel.Objects[ b ]);
         for r := LResolution.Count -1 downto 0 do  // Make highest mode first!
            ResolutionItem := TMenuItem.Create(self);
            ResolutionItem.Caption := Copy(LResolution[r],11,99); // Remove 10-digit hex sort code & use remaining resolution string
            BitsPerPelItem.Add( ResolutionItem );
            LFreq := TStringList(LResolution.Objects[ r ]);
            for f := LFreq.Count -1 downto 0 do  // Make highest mode first!
               FreqItem := TMenuItem.Create(self);
               FreqItem.Caption := Copy(LFreq[f],5,99); // Remove 4-digit hex sort code and use remaining freq string
               ResolutionItem.Add( FreqItem );
               LColour := TStringList(LFreq.Objects[ f ]);
               for c := 0 to LColour.Count-1 do  // Make highest mode first (already sorts that way)
                  ColorItem := TMenuItem.Create(self);
                  ColorItem.Caption := LColour[c]; // This option was self-sorting already (text only, not varying-digit numeric)
                  FreqItem.Add( ColorItem );
               // Add the payload.
                  ModeNumber := Integer(LColour.Objects[ c ]);
                  ColorItem.Tag := ModeNumber;
                  ColorItem.OnClick := MenuItemClick;
   // Discard the list structure
      for b := 0 to LBitsPerPel.Count-1 do
         LResolution := TStringList(LBitsPerPel.Objects[ b ]);
         for r := 0 to LResolution.Count -1 do
            LFreq := TStringList(LResolution.Objects[ r ]);
            for f := 0 to LFreq.Count -1 do
               LColour := TStringList(LFreq.Objects[ f ]);

// Create the form with a menu!
   procedure TForm1.FormCreate(Sender: TObject);
     MainMenu1:= TMainMenu.Create(Self);

Alex Tidmarsh

Ask questions about what you read
If you have a question about something within an article, you can receive help directly from the article author. Experts Exchange article authors are available to answer questions and further the discussion.
Get 7 days free