Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 208
  • Last Modified:

Changing Screen Resolution

I have a colleague at work who is using DELPHI. I know nothing about DELPHI at all but he has an interesting problem. He wishes to automatically change his screen resolution settings within a Delphi application. I said I am not sue about this but would ask on EE. is there an API he can use? Yes I am only assigning 50 pts as its not my problem.
0
P_S_Price
Asked:
P_S_Price
1 Solution
 
intheCommented:
hi
i am posting an answer by Williams2 to a question i had a while back. this shows how to use the api's EnumDisplaySettings and
ChangeDisplaySettings.if you know nothing about delphi i suggest you copy whole answe and paste in notepad for your friend ,as he will need to know about activating OnFormCreate event before pasting this in to a test project
 
You will need a new project, then activate the OnFormCreate event procedure and replace the following lines to unit1:

unit Unit1;

interface
    {Coded by Williams2}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Menus;
 

type
  TForm1 = class(TForm)
    procedure FormCreate(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;
{coded by Williams2}
end.

Regards Barry
0
 
P_S_PriceAuthor Commented:
Thank you. I will pass the think on to my friend and will accept the answer or reject it when he tests it.
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now