unit1.pas

我自己写的动态改变显示器分辨率的工具

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, SUIPopupMenu, ExtCtrls, SUIForm, SUIButton, shellapi,
  StdCtrls, SUITrackBar, SUIImagePanel, SUIGroupBox, SUIDlg;

type
  TForm1 = class(TForm)
    suiForm1: TsuiForm;
    suiPopupMenu1: TsuiPopupMenu;
    suiButton1: TsuiButton;
    N1: TMenuItem;
    N2: TMenuItem;
    suiButton2: TsuiButton;
    suiGroupBox2: TsuiGroupBox;
    suiTrackBar1: TsuiTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    suiButton3: TsuiButton;
    Label4: TLabel;
    suiMessageDialog1: TsuiMessageDialog;
    procedure TrayMenu(var Msg: TMessage); message WM_USER;
    procedure suiButton1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure suiButton2Click(Sender: TObject);
    procedure suiTrackBar1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure suiButton3Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
  private
    { Private declarations }
    Tray: NOTIFYICONDATA;
    procedure ShowInTray();
  public
    { Public declarations }
    procedure WMhotkeyhandle(var Msg: TMessage); message wm_hotkey;
  end;

var
  Form1: TForm1;
  hotkeyid_1: integer;
  hotkeyid_2: integer;

  atom: integer; //全局原子
function changedisplay(): boolean;
implementation
uses Unit2;
{$R *.dfm}

procedure TForm1.ShowInTray;
begin
  Tray.cbSize := sizeof(Tray);
  Tray.Wnd := Self.Handle;
  Tray.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  Tray.uCallbackMessage := WM_USER;
  Tray.hIcon := Application.Icon.Handle;
  Tray.szTip := '系统控制-正在监控中';
  Shell_NotifyIcon(NIM_ADD, @Tray);
end;

procedure TForm1.suiButton1Click(Sender: TObject);
begin
  //ShowWindow(Application.Handle, sw_minimize);
  //ShowWindow(Application.Handle, sw_hide);
  Form1.Hide;
  ShowInTray;

{  if CRTReset(640, 480)=false then
  begin
  suimessagedialog1.Caption:='错误！';
  suimessagedialog1.Text:='不能改变显示器分辨率为：';
  suimessagedialog1.IconType:=suiwarning;
  suimessagedialog1.ShowModal;
  end; }
end;

procedure TForm1.TrayMenu(var Msg: TMessage);
var
  X, Y: Tpoint;
  J, K: integer;
begin
  GetCursorPos(X);
  GetCursorPos(Y);
  J := X.X;
  K := Y.Y;
  if Msg.LParam = WM_RBUTTONDOWN then suiPopupMenu1.Popup(J, K);
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.suiButton2Click(Sender: TObject);
begin
  close;
end;


function CRTReset(X, Y: Word): boolean; //改变分辨率
var
  lpDevMode: TDeviceMode;
begin
  Result := EnumDisplaySettings(nil, 0, lpDevMode); //获取显示模式
  if Result then begin
    lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
    lpDevMode.dmPelsWidth := X;
    lpDevMode.dmPelsHeight := Y; //设置屏幕的宽度和高度
    lpDevMode.dmDisplayFrequency := 75;
    Result := ChangeDisplaySettings(lpDevMode, CDS_UPDATEREGISTRY) = DISP_CHANGE_SUCCESSFUL;
//改变屏幕分辨率并返回成功与否
//CDS_UPDATEREGISTRY  必须写，呵呵，要不就有你好看的（任务栏不变 ）
  end;
end;


{procedure TForm1.Button1Click(Sender: TObject);
begin
if CRTReset(640, 480) then ShowMessage('Now is 800*600'); //调用函数，设置分辨率为800×600
end;  }

procedure TForm1.suiTrackBar1Change(Sender: TObject);
var
  i: string;
begin
  case suiTrackBar1.Position of
    0: i := '640 X 480';
    1: i := '720 X 480';
    2: i := '720 X 576';
    3: i := '800 X 600';
    4: i := '848 X 480';
    5: i := '960 X 600';
    6: i := '1024 X 768';
    7: i := '1152 X 864';
    8: i := '1280 X 720';
    9: i := '1280 X 768';
    10: i := '1280 X 800';
    11: i := '1280 X 960';
    12: i := '1280 X 1024';
    13: i := '1360 X 768';
  end;
  Label3.Caption := i + ' 象素';
end;

function changedisplay(): boolean;
var
  i, J: integer;
const
  display_0: array[1..28] of integer =
  (640, 480, 720, 480, 720, 576, 800, 600, 848, 480, 960,
    600, 1024, 768, 1152, 864, 1280, 720, 1280, 768, 1280,
    800, 1280, 960, 1280, 1024, 1360, 768);
begin
  Result := true;
  i := display_0[Form1.suiTrackBar1.Position * 2 + 1];
  J := display_0[Form1.suiTrackBar1.Position * 2 + 2];
  if CRTReset(i, J) = false then
  begin
    Form1.suiMessageDialog1.Caption := '错误！';
    Form1.suiMessageDialog1.Text := '不能改变显示器分辨率为：';
    Form1.suiMessageDialog1.IconType := suiwarning;
    Form1.suiMessageDialog1.ShowModal;
    Result := false;
  end;

end;












procedure TForm1.WMhotkeyhandle(var Msg: TMessage);
begin
  if (Msg.LParamHi = 106) {and (Msg.lparamLo = mod_control )} then
  begin
    Msg.Result := 1;

    changedisplay();

  end
  else
  begin
    if (Msg.LParamHi = 122) {and (Msg.lparamLo = mod_control )} then
    begin
      Msg.Result := 1;

      Form1.Show;

    end;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
//var
  //lpDevMode: TDeviceMode;
begin
{如果没运行则在表中增加信息 }
  if GlobalFindAtom('PROGRAM_RUNNING') = 0 then
  begin
    atom := GlobalAddAtom('PROGRAM_RUNNING');
  end
  else
  begin
   {如果程序已运行则显示信息然后退出 }
    suiMessageDialog1.Caption := '警告！';
    suiMessageDialog1.Text := '程序已经在运行！';
    suiMessageDialog1.IconType := suiInformation;
    suiMessageDialog1.ShowModal;
    Halt;
  end;



 { EnumDisplaySettings(nil, 0, lpDevMode); //获取显示模式
  Memo1.Lines.Add('dmSpecVersion:' + inttostr(lpDevMode.dmSpecVersion));
  Memo1.Lines.Add('dmDriverVersion:' + inttostr(lpDevMode.dmDriverVersion));
  Memo1.Lines.Add('dmSize:' + inttostr(lpDevMode.dmSize));
  Memo1.Lines.Add('dmDriverExtra:' + inttostr(lpDevMode.dmDriverExtra));
  Memo1.Lines.Add('dmFields:' + inttostr(lpDevMode.dmFields));
  Memo1.Lines.Add('dmOrientation:' + inttostr(lpDevMode.dmOrientation));
  Memo1.Lines.Add('dmPaperSize:' + inttostr(lpDevMode.dmPaperSize));
  Memo1.Lines.Add('dmPaperLength:' + inttostr(lpDevMode.dmPaperLength));
  Memo1.Lines.Add('dmPaperWidth:' + inttostr(lpDevMode.dmPaperWidth));
  Memo1.Lines.Add('dmColor:' + inttostr(lpDevMode.dmColor));
  Memo1.Lines.Add('dmDuplex:' + inttostr(lpDevMode.dmDuplex));
  Memo1.Lines.Add('dmYResolution:' + inttostr(lpDevMode.dmYResolution));
  Memo1.Lines.Add('dmTTOption:' + inttostr(lpDevMode.dmTTOption));
  Memo1.Lines.Add('dmDisplayFlags:' + inttostr(lpDevMode.dmDisplayFlags));
  Memo1.Lines.Add('dmDisplayFrequency:' + inttostr(lpDevMode.dmDisplayFrequency));
  Memo1.Lines.Add('dmICMMethod:' + inttostr(lpDevMode.dmICMMethod));
  Memo1.Lines.Add('dmICMIntent:' + inttostr(lpDevMode.dmICMIntent));
  Memo1.Lines.Add('dmMediaType:' + inttostr(lpDevMode.dmMediaType));
  Memo1.Lines.Add('dmDitherType:' + inttostr(lpDevMode.dmDitherType));
  Memo1.Lines.Add('dmICCManufacturer:' + inttostr(lpDevMode.dmICCManufacturer));
  Memo1.Lines.Add('dmICCModel:' + inttostr(lpDevMode.dmICCModel));
  Memo1.Lines.Add('dmPanningWidth:' + inttostr(lpDevMode.dmPanningWidth));
  Memo1.Lines.Add('dmPanningHeight:' + inttostr(lpDevMode.dmPanningHeight));
  }


  hotkeyid_1 := GlobalAddAtom('My HotKey1') - $C000;
  registerhotkey(Handle, hotkeyid_1, 0, 106);
  hotkeyid_2 := GlobalAddAtom('My HotKey2') - $C000;
  registerhotkey(Handle, hotkeyid_2, 0, 122);
//设定快捷键为*
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{程序退出时，从原子表中移走信息}
  GlobalDeleteAtom(atom);
{删除托盘中的图标}
  Shell_NotifyIcon(NIM_DELETE, @Tray);
  unregisterhotkey(Handle, hotkeyid_1);
  unregisterhotkey(Handle, hotkeyid_2);
end;

procedure TForm1.suiButton3Click(Sender: TObject);
begin
  Form2.Show;
  Form2.suiEdit1.SetFocus;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  Form1.Show;
end;

end.