An update to changing Windows screen resolution using Delphi

Alex TidmarshMr Alex Tidmarsh
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
// 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

Alex TidmarshMr Alex Tidmarsh

Comments (0)

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.