Solved

Setting resolution of screen from Delphi

Posted on 1998-12-01
3
365 Views
Last Modified: 2010-04-04

Hi there.

Anybody knows how to set the resolution fo
a screen from Delphi

faithfully

GOMF
0
Comment
Question by:GOMF
3 Comments
 
LVL 8

Accepted Solution

by:
ZifNab earned 90 total points
ID: 1348735
GOMF,

here is something for another author :

+------------------------------------------------------------
| Program ChangeDisplay                          |
| Version: 1.0 Created: 24.10.97, 14:15:47
| Last Modified: 24.10.97, 14:15:47
| Author : P. Below
| Project: API examples
| Description:
| This is a windowless Win32 program that shows how to
| change the video resolution on the fly. The program
| takes up to four parameters on the command line:
| 1: wanted resolution in X in pixels
| 2: wanted resolution in Y in pixels
| 3: wanted color depth in bits per pixel
| 4: flag indicating if the new mode should be made the
| system default (stored into the registry).
| The first three parameters have to be integer numbers, the
| fourth is optional can can be any character, only its presence
| or absence matters. The parameters are separated
| by a single space each.
| If no parameters or less than three are given the program
| restores the system video mode from the registry.
| Example:
| ChangeDisplay 640 480 8
| changes to 256 color VGA mode temporarily
| ChangeDisplay 640 480 8 P
| changes to 256 color VGA mode and makes it the system
| default mode by storing the settings into the registry.
| ChangeDisplay
| restores the last settings that have been stored into
| the registry.
| The program returns an exit code of 0 if all went well,
| an exit code of 240 if the passed parameters do not
| correspond to a valid video mode, 239 if the number of
| parameters is not correct or there is a non-numerical
| parameter where a number is expected, 238 if an unexpected
| exception happened, otherwise
| one of the return values of ChangeDisplaySettings, which are
| DISP_CHANGE_SUCCESSFUL = 0;
| DISP_CHANGE_RESTART = 1;
| DISP_CHANGE_FAILED = -1; ( byte equivalent is 255 )
| DISP_CHANGE_BADMODE = -2; ( 254 )
| DISP_CHANGE_NOTUPDATED = -3; ( 253 )
| DISP_CHANGE_BADFLAGS = -4; ( 252 )
| DISP_CHANGE_BADPARAM = -5; ( 251 )
| The program is designed to be used from a batch file and
| will not show any messages.
| Note:
| The video driver may require a reboot to make the changed
| settings active. This is up to the driver.
                +------------------------------------------------------------}
Program Changedisplay;
Uses  Windows;
 
Type
  TRequestedVideomode = Record
    PelsWidth, PelsHeight, bitsPerPel: Integer;
    storeIntoRegistry : Boolean;
    restoreDefaults : Boolean;
  End;

Function ChangeDisplaySettings(
  lpDevMode: PDeviceMode; dwFlags: DWORD): Longint; stdcall;
   external 'user32.dll' name 'ChangeDisplaySettingsA';

{ Note: ChangeDisplaySettings is defined in Windows.Pas with the
  first parameter as a Var parameter of type TDeviceMode. That
  makes it hard to pass Nil as this parameter, so we redeclare
  it here. }


                         {+------------------------------------------------------------
| Function EvaluateParameters                          |
| Parameters:
| videomode: returns the requested settings as parsed from
| the command line.
| Returns:
| True if the parameters look ok, false if they are missing or
| not numeric.
| Call method:
| static
| Description:
| Parses the parameters from the command line.
| Error Conditions:
| all errors are handled internally and cause the function
| to return false.
|
|Created: 24.10.97 14:29:45 by P. Below
                       +------------------------------------------------------------}
Function EvaluateParameters(Var videomode: TRequestedVideomode ): Boolean ;
 Function EvalParameter(param: String; Var value: Integer): Boolean;
   Var
     err: Integer;
   Begin
  { Try to convert passed string to an integer. Return success
                                or failure. }
     Val( param, value, err );
     Result := err = 0;
   End; { EvalParameter }
 Begin
   FillChar( videomode, sizeof(videomode), 0);
   If ParamCount >= 3 Then Begin
   { Convert individual parameters to numbers, only the first
          three parameters are considered for this. }
   Result :=
      EvalParameter( ParamStr(1), videomode.PelsWidth ) and
      EvalParameter( ParamStr(2), videomode.PelsHeight ) and
      EvalParameter( ParamStr(3), videomode.bitsPerPel );
  { If there are more than 3 parameters we store the new
                                 settings into the registry. }
   If Result Then
       videomode.storeIntoRegistry := ParamCount > 3;
   End { If }
    Else Begin
     { If there are less than three parameters we ignore any        parameters and restore the defaults from registry. }
     Result := True;
     videomode.restoreDefaults := True;
    End; { Else }
End; { EvaluateParameters }

                        {+------------------------------------------------------------
| Function Process
|
| Parameters:
| videomode: requested videomode parameters
| Returns:
| exitcode for the program, 240 if invalid
| video mode requested, otherwise the return value of
| ChangeDisplaySettings. See program header comment for a
| list of possible values.
| Call method:
| static
| Description:
| Uses the API function EnumDisplaySettings to find all the
| video modes supported by the video driver. If one matches
| the requested settings ChangeDisplaySettings is used to switch
| to these settings.
| Error Conditions:
| All errors are handled internally and cause a return value
| <> 0.
|
|Created: 24.10.97 14:46:02 by P. Below
                          +------------------------------------------------------------}
Function Process(Const videomode: TRequestedVideomode): Integer;
    Var
      DevMode: TDeviceMode;
      modeindex: Integer;
 Begin
   If videomode.restoreDefaults Then Begin
     { Use settings in registry }
    Result := ChangeDisplaySettings( Nil, 0 );
   End { If }
     Else Begin
      { Enumerate the display modes. }
      modeindex := 0;
      While EnumDisplaySettings(Nil, modeindex, DevMode) Do Begin
     { Check if this mode matches the one requested }
       If (DevMode.dmBitsPerPel = videomode.bitsPerPel) and
        (DevMode.dmPelsWidth = videomode.PelsWidth) and
        (DevMode.dmPelsHeight = videomode.PelsHeight)
        Then Begin
        { Found a videomode matching our requirements. Use it and
          break out of this function. }
          DevMode.dmFields :=
             DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT or
             DM_DISPLAYFLAGS or DM_DISPLAYFREQUENCY;
          If videomode.storeIntoRegistry Then
          Result := ChangeDisplaySettings( @DevMode, CDS_UPDATEREGISTRY )
           Else
            Result := ChangeDisplaySettings( @DevMode, 0 );
            Exit;
           End; { If }

 { If we end here the video mode did not match, get the next
                                   one. }
          modeindex := modeindex + 1;
       End; { While }

 { If we end here no matching video mode was found. Return
                    error code 240. }
       Result := 240;
     End; { Else }
  End; { Process }


   Var
     retcode: Integer;
     videomode: TRequestedVideomode;
   Begin { ChangeDisplay.Main }
     try
      If not EvaluateParameters(videomode) Then
       retcode := 239
      Else
       retcode := Process(videomode);
     except
      retcode := 238;
     end;
     Halt(retcode);
   End. { Program ChangeDisplay }
0
 
LVL 3

Expert Comment

by:williams2
ID: 1348736
HI ZifNab.. Hmmm I think you made it before me, but I can well enough publish my results, they are for no use anyway, but they might be a bit more easy to use :-)

The following needs you to startup a new project and doubleclick the forms OnCreate property. The rest is Cut'n'paste to Unit1:

unit Unit1;

interface

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;
{      ItemName:= AccS+ItemName;
      Item:= TMenuItem(FindComponent(ItemName));
      if Item = nil then
      begin
        Item:= TMenuItem.Create(Self);
        Item.Caption:= S;
        Item.Name:= ItemName;
        Item.Tag:= i; //Tag the MenuItem, so we will now which mode# to use
        Item.OnClick:= MenuItemClick;
        FreqItem.Add(Item);
      End;
      }
    End;
    Inc(i);
  Until not(res);
End;

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

end.
0
 

Author Comment

by:GOMF
ID: 1348737
thanks, sorry it took so long ;-)


GOMF
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Delphi XE10, MySQL Query 4 164
Delphi Mdi application Child forms get behind control 7 270
find a node in VST 2 70
DBGrid or StringGrid ? 6 104
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question