<

An update to changing Windows screen resolution using Delphi

Published on
3,273 Points
273 Views
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!
//==================================================================================================================================

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

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

var Form1: TForm1;

//==================================================================================================================================
                                                         implementation
//==================================================================================================================================
{$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;
   begin
      taskbar := FindWindow('Shell_TrayWnd', nil);
      if (taskbar <> 0) then
      begin
         if Show then ShowWindow(taskbar, SW_SHOW )
                 else ShowWindow(taskbar, SW_HIDE);
         UpdateWindow(taskbar);
      end;
   end;
// MenuItemClick implements the Device Mode chosen from the menu at runtime
   procedure TForm1.MenuItemClick(Sender: TObject);
   Var Mode: Integer;
       DevMode: TDevMode;
       res: Integer;
   begin
      ShowTaskBar(FALSE); // If (as happens in NT4 under VMware) the display surface is way too small, increase real estate.
      try
         Mode:= TMenuItem(Sender).Tag; 
         if EnumDisplaySettings(  nil,     // specifies the display device
                                  Mode,    // specifies the graphics mode
                                  DevMode  // points to structure to receive settings
                                ) then
         begin
            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;
         end else MessageDlg('Unable to retrieve mode!',mtError,[mbOk],0);
      finally
         ShowTaskBar(TRUE);  // Always, always, always - give the task bar back to the user!
      end;
   end;

// 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;
   begin
   // 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;
      repeat
         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
         begin
         // 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
            begin
               LResolution := TStringList.Create;
               LResolution.Sorted := TRUE;
               LResolution.Duplicates := dupIgnore;
               LBitsPerPel.Objects[ Index ] := LResolution;
            end;
         // 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
            begin
               LFreq := TStringList.Create;
               LFreq.Sorted := TRUE;
               LFreq.Duplicates := dupIgnore;
               LResolution.Objects[ Index ] := LFreq;
            end;
         // 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
            begin
               LColour := TStringList.Create;
               LColour.Sorted := TRUE;
               LColour.Duplicates := dupIgnore;
               LFreq.Objects[ Index ] := LColour;
            end;
         // 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);
         end;
         inc(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);
      MenuItem.Caption:='Resolutions';
      MainMenu1.Items.Add(MenuItem);
      for b := LBitsPerPel.Count-1 downto 0 do  // Make highest mode first!
      begin
         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!
         begin
            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!
            begin
               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)
               begin
                  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;
               end;
             end;
         end;
      end;
   // Discard the list structure
      for b := 0 to LBitsPerPel.Count-1 do
      begin
         LResolution := TStringList(LBitsPerPel.Objects[ b ]);
         for r := 0 to LResolution.Count -1 do
         begin
            LFreq := TStringList(LResolution.Objects[ r ]);
            for f := 0 to LFreq.Count -1 do
            begin
               LColour := TStringList(LFreq.Objects[ f ]);
               LColour.Free;
            end;
            LFreq.Free;
         end;
         LResolution.Free;
      end;
      LBitsPerPel.Free;
   end;

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


Alex Tidmarsh


0
Comment
0 Comments

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Join & Write a Comment

As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
In this video, we discuss why the need for additional vertical screen space has become more important in recent years, namely, due to the transition in the marketplace of 4x3 computer screens to 16x9 and 16x10 screens (so-called widescreen format). …

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month