Link to home
Start Free TrialLog in
Avatar of GOMF
GOMFFlag for Denmark

asked on

Setting resolution of screen from Delphi


Hi there.

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

faithfully

GOMF
ASKER CERTIFIED SOLUTION
Avatar of ZifNab
ZifNab

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 williams2
williams2

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.
Avatar of GOMF

ASKER

thanks, sorry it took so long ;-)


GOMF