this slowpoke moves

Change Screen Resolution

// Beispiel 1:
function NewRes(XRes, YRes: DWORD; Frequency: Cardinal): Integer;
var
  DevMode: TDeviceMode;
begin
  EnumDisplaySettings(nil, 0, DevMode);
  DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_DISPLAYFREQUENCY;
  DevMode.dmPelsWidth := XRes;
  DevMode.dmPelsHeight := YRes;
  DevMode.dmDisplayFrequency := Frequency;
  Result := ChangeDisplaySettings(DevMode, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if NewRes(1280, 1024, 85) = DISP_CHANGE_SUCCESSFUL then
    ShowMessage('Resolution changed!');
end;


// Beispiel 2:
function ChangeResolution(XResolution, YResolution, Depth: DWORD): BOOL;
var
  DevMode: TDeviceMode;
  i: Integer;
begin
  {
The function NewRes can have the following result:

DISP_CHANGE_SUCCESSFUL The settings change was successful.
DISP_CHANGE_RESTART The computer must be restarted in order for the graphics mode to work.
DISP_CHANGE_BADFLAGS An invalid set of flags was passed in.
DISP_CHANGE_FAILED The display driver failed the specified graphics mode.
DISP_CHANGE_BADMODE The graphics mode is not supported.
DISP_CHANGE_NOTUPDATED Windows NT only: Unable to write settings to the registry.
}

  Result := False;
  i      := 0;
  while EnumDisplaySettings(nil, i, DevMode) do
    with DevMode do
    begin
      if (dmPelsWidth = XResolution) and
        (dmPelsHeight = YResolution) and
        (dmBitsPerPel = Depth) then
        if ChangeDisplaySettings(DevMode, CDS_UPDATEREGISTRY) =
          DISP_CHANGE_SUCCESSFUL then
        begin
          Result := True;
          SendMessage(HWND_BROADCAST, WM_DISPLAYCHANGE, SPI_SETNONCLIENTMETRICS, 0);
          Break;
        end;
      Inc(i);
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if ChangeResolution(800, 600, 32) then ShowMessage('Resolution changed!');
end;


// Beispiel 3:
// ListView auf VsReport stellen und ein Column hinzufügen
procedure TForm1.FormCreate(Sender: TObject);
var
  devmode: TDEVMODE;
  d: Integer;
  litem: TListItem;
  p: ^TDevmode;
begin
  devmode.dmSize := SizeOf(TDevMode);
  devmode.dmDriverExtra := 0;
  d := 0;
  ListView1.Columns[0].Width := 400;
  while EnumDisplaySettings(nil, d, devmode) do
    with devmode do
    begin
      Inc(d);
      litem := ListView1.Items.Add;
      litem.Caption := Format('Mode %3d : %dx%d, %d Colors   (%d Hz)',
        [d, dmPelsWidth, dmPelsHeight, 1 shl (dmBitsPerPel), dmDisplayFrequency]);
      New(p);
      p^ := Devmode;
      litem.Data := p;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ChangeDisplaySettings(TDevmode(ListView1.Selected.Data^), 0);
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate