delphi 取屏幕分辨率
For the original Question, see: Setting resolution of screen from Delphi
有关原始问题，请参见 ： 从Delphi设置屏幕分辨率
Here's the code for a Delphi main form unit. Take and learn whatever you need. Note that it also sorts the menu so that the best resolution is also the most accessible.
这是Delphi主表单单元的代码。 采取并学习任何您需要的东西。 请注意，它还会对菜单进行排序，以便最容易获得最佳分辨率。
(
)
unit ChangeResMainUnit;
//==================================================================================================================================
// Note that this source file is arranged for 132-column display/editing - use the WIDTH, Luke!
//
// The following code was adapted by Alex Tidmarsh from an example provided by "williams2" upon https://www.experts-exchange.com.
// The point of it all is to (a) make it a little easier to use, and (b) ensure the task bar also resizes/moves for the resolution.
// In particular, it was recoded to help manage resolution changes under VMware KVM, especially for an older OS like Windows NT4.
// It ensures the "highest" modes are displayed as drop down menu options first, which ensures they are the ones most likely to be
// seen when trying to use this tool in a very low resolution! Otherwise you would need many clicks to increase it from 320x200!
//==================================================================================================================================
//==================================================================================================================================
interface
//==================================================================================================================================
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, ShellAPI;
type TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
MainMenu1: TMainMenu;
procedure MenuItemClick(Sender: TObject);
procedure CreateSortedResolutionEntries;
end;
var Form1: TForm1;
//==================================================================================================================================
implementation
//==================================================================================================================================
{$R *.DFM}
// ShowTaskBar allows the taskbar to be hidden and shown again - which can in theory be useful for REALLY small screen real-estates.
procedure ShowTaskBar(show:Boolean);
var taskbar : HWND;
begin
taskbar := FindWindow('Shell_TrayWnd', nil);
if (taskbar <> 0) then
begin
if Show then ShowWindow(taskbar, SW_SHOW )
else ShowWindow(taskbar, SW_HIDE);
UpdateWindow(taskbar);
end;
end;
// MenuItemClick implements the Device Mode chosen from the menu at runtime
procedure TForm1.MenuItemClick(Sender: TObject);
Var Mode: Integer;
DevMode: TDevMode;
res: Integer;
begin
ShowTaskBar(FALSE); // If (as happens in NT4 under VMware) the display surface is way too small, increase real estate.
try
Mode:= TMenuItem(Sender).Tag;
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_UPDATEREGISTRY ); // MUST update registry to ensure taskbar movement/resize.
// We could use CDS_TEST, which apparently tests whether the displaymode is available, or ZERO (CDS_NONE) that changes the
// display mode, but does not necessarily cause certain windows (like the TaskBar in NT4 for instance) to also change.
// Check the outcome...
case res of
DISP_CHANGE_SUCCESSFUL:// The settings change was successful.
;
DISP_CHANGE_RESTART: // The computer must be restarted in order for the graphics mode to work.
MessageDlg('You 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);
finally
ShowTaskBar(TRUE); // Always, always, always - give the task bar back to the user!
end;
end;
// CreateSortedResolutionEntries creates a conveniently arranged drop-down menu of device modes to select from.
Procedure TForm1.CreateSortedResolutionEntries;
var HaveDevMode: BOOL;
DevMode: TDevMode;
S: String;
ModeNumber,b,r,f,c: Integer;
Index : Integer;
LBitsPerPel,LResolution,LFreq,LColour: TStringList;
MenuItem,BitsPerPelItem,ResolutionItem,FreqItem,ColorItem: TMenuItem;
begin
// First create a sorted list structure, starting with Bits/Pel at its lowest tier
LBitsPerPel:= TStringList.Create;
LBitsPerPel.Sorted := TRUE;
LBitsPerPel.Duplicates := dupIgnore;
// Now enumerate the device modes
ModeNumber:= 0;
repeat
HaveDevMode := EnumDisplaySettings( nil, // specifies the display device
ModeNumber, // specifies the device mode number
DevMode // points to structure to receive settings
);
if HaveDevMode then // Add this device mode to a pre-sorted list structure with no duplicates
with DevMode do
begin
// Find bits per pixel - note that we use an easily removable 2-digit hex code to provide a sort-order
Index := LBitsPerPel.add( IntToHex(dmBitsPerPel,2) + IntToStr(dmBitsPerPel)+' bit mode' );
// Start (or re-use) the next tier in the structure, which is Resolution
LResolution := TStringList( LBitsPerPel.Objects[ Index ] );
if LResolution = nil then
begin
LResolution := TStringList.Create;
LResolution.Sorted := TRUE;
LResolution.Duplicates := dupIgnore;
LBitsPerPel.Objects[ Index ] := LResolution;
end;
// Find width and height - note that we use an easily removable 10-digit hex code to provide a sort-order
Index := LResolution.add( IntToHex(dmPelsWidth,5) + IntToHex(dmPelsHeight,5)
+ IntToStr(dmPelsWidth)+'x'+IntToStr(dmPelsHeight) );
// Start (or re-use) the next tier in the structure, which is Frequency
LFreq := TStringList( LResolution.Objects[ Index ] );
if LFreq = nil then
begin
LFreq := TStringList.Create;
LFreq.Sorted := TRUE;
LFreq.Duplicates := dupIgnore;
LResolution.Objects[ Index ] := LFreq;
end;
// Find or create Frequency - note that we use an easily removable 4-digit hex code to provide a sort-order
Index := LFreq.add( IntToHex(dmDisplayFrequency,4) + IntToStr(dmDisplayFrequency)+' Hz' );
// Start (or re-use) the next tier in the structure, which is Colour
LColour := TStringList( LFreq.Objects[ Index ] );
if LColour = nil then
begin
LColour := TStringList.Create;
LColour.Sorted := TRUE;
LColour.Duplicates := dupIgnore;
LFreq.Objects[ Index ] := LColour;
end;
// Find Color Mode + Interlaced option.
If (dmDisplayFlags AND DM_GRAYSCALE)>0 then S:='B/W ' else S:='Color ';
If (dmDisplayFlags AND DM_INTERLACED)>0 then S:= S+'Interlaced';
Index := LColour.add( S );
LColour.Objects[ Index ] := TObject(ModeNumber);
end;
inc(ModeNumber);
until not(HaveDevMode);
// Create a menu structure from the sorted list structure we just built
LBitsPerPel.Sorted := FALSE;
LBitsPerPel.Sorted := TRUE;
MenuItem:= TMenuItem.Create(Self);
MenuItem.Caption:='Resolutions';
MainMenu1.Items.Add(MenuItem);
for b := LBitsPerPel.Count-1 downto 0 do // Make highest mode first!
begin
BitsPerPelItem := TMenuItem.Create(self);
BitsPerPelItem.Caption := Copy(LBitsPerPel[b],3,99); // Remove 2-digit hex sort code and use remaining bits/pel string
MenuItem.Add( BitsPerPelItem );
LResolution := TStringList(LBitsPerPel.Objects[ b ]);
for r := LResolution.Count -1 downto 0 do // Make highest mode first!
begin
ResolutionItem := TMenuItem.Create(self);
ResolutionItem.Caption := Copy(LResolution[r],11,99); // Remove 10-digit hex sort code & use remaining resolution string
BitsPerPelItem.Add( ResolutionItem );
LFreq := TStringList(LResolution.Objects[ r ]);
for f := LFreq.Count -1 downto 0 do // Make highest mode first!
begin
FreqItem := TMenuItem.Create(self);
FreqItem.Caption := Copy(LFreq[f],5,99); // Remove 4-digit hex sort code and use remaining freq string
ResolutionItem.Add( FreqItem );
LColour := TStringList(LFreq.Objects[ f ]);
for c := 0 to LColour.Count-1 do // Make highest mode first (already sorts that way)
begin
ColorItem := TMenuItem.Create(self);
ColorItem.Caption := LColour[c]; // This option was self-sorting already (text only, not varying-digit numeric)
FreqItem.Add( ColorItem );
// Add the payload.
ModeNumber := Integer(LColour.Objects[ c ]);
ColorItem.Tag := ModeNumber;
ColorItem.OnClick := MenuItemClick;
end;
end;
end;
end;
// Discard the list structure
for b := 0 to LBitsPerPel.Count-1 do
begin
LResolution := TStringList(LBitsPerPel.Objects[ b ]);
for r := 0 to LResolution.Count -1 do
begin
LFreq := TStringList(LResolution.Objects[ r ]);
for f := 0 to LFreq.Count -1 do
begin
LColour := TStringList(LFreq.Objects[ f ]);
LColour.Free;
end;
LFreq.Free;
end;
LResolution.Free;
end;
LBitsPerPel.Free;
end;
// Create the form with a menu!
procedure TForm1.FormCreate(Sender: TObject);
begin
MainMenu1:= TMainMenu.Create(Self);
CreateSortedResolutionEntries;
end;
end.
delphi 取屏幕分辨率
扫一扫
2665
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
