Link to home
Start Free TrialLog in
Avatar of Levente
Levente

asked on

How to change resolution and color depth on-the-fly?

How to change screen resolution and color depth on-the-fly?
ASKER CERTIFIED SOLUTION
Avatar of inthe
inthe

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of inthe
inthe

part if example to show:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    CheckListBox1: TCheckListBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Function GetChildMenuItem(var ParentItem,Item: TMenuItem;
      ItemName,ItemCaption: String): String;
  public
    { Public declarations }
    MainMenu1: TMainMenu;
    procedure MenuItemClick(Sender: TObject);
    procedure CreateResolutionEntries;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MenuItemClick(Sender: TObject);
const
  CDS_NONE = 0;
Var
  Mode: Integer;
  DevMode: TDevMode;
  res: Integer;
begin
  Mode:= TMenuItem(Sender).Tag;
  //Mode 0 is the current registrated resolution!
  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_NONE );
    //Following options can be used also
    //CDS_TEST - Tests whether the displaymode is available
    //CDS_UPDATEREGISTRY - Updates the changes to the registry

    Case res of
      DISP_CHANGE_SUCCESSFUL: //The settings change was successful.
        MessageDlg('You successfully changed resolution.',mtInformation,[mbOk],0);
      DISP_CHANGE_RESTART: //The computer must be restarted in order for the graphics mode to work.
        MessageDlg('You will 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);
end;

Function TForm1.GetChildMenuItem(var ParentItem,Item: TMenuItem;
  ItemName,ItemCaption: String): String;
Begin
  Item:= TMenuItem(FindComponent(ItemName));
  if Item = nil then
  begin
    Item:= TMenuItem.Create(Self);
    Item.Caption:= ItemCaption;
    Item.name:= ItemName;
    ParentItem.Add(Item);
  End;
  Result:= Item.Name;
End;

Procedure TForm1.CreateResolutionEntries;
var
  Res: BOOL;
  DevMode: TDevMode;
  AccS,S,ItemName: String;
  i: Integer;
  Father,BitsPerPelItem,ResolutionItem,FreqItem,Item: TMenuItem;
begin
  //First create a resolution menuitem;
  Father:= TMenuItem.Create(Self);
  Father.Caption:='Resolutions';
  MainMenu1.Items.Add(Father);
  i:= 0;
  Repeat
    Res:= EnumDisplaySettings(
       nil, // specifies the display device
       i, // specifies the graphics mode
       DevMode // points to structure to receive settings
      );
    If Res then
    With DevMode do
    Begin
      //Find first entry in MainMenu - bits per pixel;

      //AccS: Is the name of the current item.. It needs to be cateconated
      //with the next item, for the ItemName to be unique.
      AccS:= GetChildMenuItem(Father,
                              BitsPerPelItem,
                              'x'+IntToStr(dmBitsPerPel),
                              IntToStr(dmBitsPerPel)+' bit mode');

      //Find next entry in MainMenu - width and height;
      S:= IntToStr(dmPelsWidth)+'x'+IntToStr(dmPelsHeight);
      AccS:= GetChildMenuItem(BitsPerPelItem,
                              ResolutionItem,
                              AccS+'_'+S,
                              S);

      //find or create third entry in MainMenu - Frequency
      S:= IntToStr(dmDisplayFrequency);
      AccS:= GetChildMenuItem(ResolutionItem,
                              FreqItem,
                              AccS+'_'+S,
                              S+' Hz');

      //find or create 4th entry in MainMenu - Colormode/Interlaced
      If (dmDisplayFlags AND DM_GRAYSCALE)>0 then
      Begin
        ItemName:='BW';
        S:='B/W ';
      End else
      begin
        ItemName:='C';
        S:='Color ';
      End;
      If (dmDisplayFlags AND DM_INTERLACED)>0 then
      begin
        ItemName:= ItemName+'Int';
        S:= S+'Interlaced';
      End;

      AccS:= GetChildMenuItem(FreqItem,
                              Item,
                              AccS+'_'+ItemName,
                              S);
      Item.Tag:= i;
      Item.OnClick:= MenuItemClick;
    End;
    Inc(i);
  Until not(res);
End;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MainMenu1:= TMainMenu.Create(Self);
  CreateResolutionEntries;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//ignore this was for something else
end;

end.


this puts available resolution on the menu ansd changes when you click.
some resolutions need a restart some dont depends on graphics card and drivers.
hope that gives more help
Regards Barry
inthe,

CDS_TEST isn't only optional but required! This tells Windows to test whether the given mode could be set. Combined with CDS_FULLSCREEN the application can check whether the video mode can be set without reboot (see also http://www.gnomehome.demon.nl/uddf/pages/fullscrn.htm).

Ciao, Mike
Avatar of Levente

ASKER

Thank you for your fast response. Both example works perfectly.

Levente