Solved

Setting resolution of screen from Delphi

Posted on 1998-12-01
3
343 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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

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…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

707 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now