[EEEPC] EEEPC_Utility V1.1 Source Code原始碼公開

UNIT Unit1;

INTERFACE

USES
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Registry, MShape, SUIMemo, SUIButton, ExtCtrls,
SUIForm, SUIURLLabel, jpeg, ShellAPI, CoolTrayIcon, TextTrayIcon,
Menus, SUIImagePanel, SUIGroupBox, SUIRadioGroup, FileCtrl,
SUIComboBox, AppEvnts, ActnList, OleCtrls, MSINFO32Lib_TLB;

TYPE
TForm1 = CLASS(TForm)
suiForm1: TsuiForm;
MultiShape2: TMultiShape;
MultiShape3: TMultiShape;
Timer1: TTimer;
CoolTrayIcon1: TCoolTrayIcon;
PopupMenu1: TPopupMenu;
N1024x6001: TMenuItem;
N800x6001: TMenuItem;
N800x4801: TMenuItem;
Exit1: TMenuItem;
N1: TMenuItem;
TextTrayIcon1: TTextTrayIcon;
Timer2: TTimer;
TextTrayIcon2: TTextTrayIcon;
TextTrayIcon3: TTextTrayIcon;
suiCheckBox1: TsuiCheckBox;
suiRadioGroup1: TsuiRadioGroup;
suiButton1: TsuiButton;
Button1: TButton;
suiCheckBox2: TsuiCheckBox;
suiButton2: TsuiButton;
suiCheckGroup1: TsuiCheckGroup;
PROCEDURE suitempButton8Click(Sender: TObject);
PROCEDURE SetResolution(swidth: integer; sheight: integer; sbits: integer);
PROCEDURE FormCloseQuery(Sender: TObject; VAR CanClose: Boolean);
PROCEDURE Timer1Timer(Sender: TObject);
PROCEDURE CoolTrayIcon1DblClick(Sender: TObject);
PROCEDURE FormCreate(Sender: TObject);
PROCEDURE suiButton1Click(Sender: TObject);
PROCEDURE N800x6001Click(Sender: TObject);
PROCEDURE N1024x6001Click(Sender: TObject);
PROCEDURE N800x4801Click(Sender: TObject);
PROCEDURE LoadSetting();
PROCEDURE Exit1Click(Sender: TObject);
PROCEDURE Button1Click(Sender: TObject);
PROCEDURE Timer2Timer(Sender: TObject);
PROCEDURE suiButton2Click(Sender: TObject);
PROCEDURE FormResize(Sender: TObject);


Private
{ Private declarations }
Public
{ Public declarations }
END;

VAR
Form1: TForm1;
timercount: integer;
Tenablescaling, autostart: BOOLEAN;
detecting: integer;
Twidth, THeight, TBits: integer;
run: integer;
myReg: Tregistry;

IMPLEMENTATION

{$R *.dfm}


FUNCTION Downscaling(enabled: boolean): integer;
VAR
buffer0: ARRAY[0..3] OF char;
BEGIN
myreg := TRegistry.Create;
myreg.RootKey := HKEY_LOCAL_MACHINE;
IF myreg.OpenKey('SYSTEM\CurrentControlSet\Services\ialm\Device0', false) THEN
BEGIN
IF enabled THEN
BEGIN
buffer0[0] := chr($01);
Tenablescaling := true;
END
ELSE
BEGIN
buffer0[0] := chr($00);
Tenablescaling := false;
END;
buffer0[1] := chr($00);
buffer0[2] := chr($00);
buffer0[3] := chr($00);
myreg.WriteBinaryData('Display1_DownScalingEnabled', buffer0, 4);
END;
myreg.CloseKey;
myreg.RootKey := HKEY_LOCAL_MACHINE;
IF myreg.OpenKey('Software\EEEPC Utility', true) THEN
BEGIN
//if myreg.ValueExists('scaling') then
myreg.WriteBool('scaling', Tenablescaling);
END;
result := 0;
END;

PROCEDURE TForm1.LoadSetting();
BEGIN
TWidth := 0;
Theight := 0;
Tbits := 0;
myreg := TRegistry.Create;
myreg.RootKey := HKEY_LOCAL_MACHINE;
IF myreg.OpenKey('Software\EEEPC Utility', true) THEN
BEGIN
IF myreg.ValueExists('scaling') THEN
BEGIN
Tenablescaling := MYREG.ReadBool('scaling');
IF Tenablescaling THEN BEGIN suiCheckBox1.Checked := true; downscaling(true); END ELSE BEGIN downscaling(false); suiCheckBox1.Checked := false; END;
END;
IF myreg.ValueExists('CapLock') THEN
BEGIN
suiCheckGroup1.Checked[0] := MYREG.ReadBool('CapLock');
END;

IF myreg.ValueExists('NumLock') THEN
BEGIN
suiCheckGroup1.Checked[1] := MYREG.ReadBool('NumLock');
END;

IF myreg.ValueExists('ScrollLock') THEN
BEGIN
suiCheckGroup1.Checked[2] := MYREG.ReadBool('ScrollLock');
END;



IF myreg.ValueExists('Width') THEN
Twidth := myreg.ReadInteger('Width');
IF myreg.ValueExists('Height') THEN
THeight := myreg.ReadInteger('Height');
IF myreg.ValueExists('Bits') THEN
TBits := myreg.ReadInteger('Bits');
IF (TWidth 0) AND (Theight 0) AND (Tbits 0) THEN
BEGIN
SetResolution(Twidth, THeight, TBits);
IF (Twidth = 1024) AND (THeight = 768) THEN
BEGIN
suiRadioGroup1.ItemIndex := 0;
END;
IF (Twidth = 800) AND (THeight = 600) THEN
BEGIN
suiRadioGroup1.ItemIndex := 1;
END;
IF (Twidth = 800) AND (THeight = 480) THEN
BEGIN
suiRadioGroup1.ItemIndex := 2;
END;
END;
myreg.CloseKey;
IF myreg.OpenKey('Software\MicroSoft\Windows\CurrentVersion\Run', false) THEN
BEGIN
IF myreg.ValueExists('EEEPC Utility') THEN
BEGIN
autostart := true;
suiCheckBox2.Checked := true;
END
ELSE
BEGIN
autostart := false;
suiCheckBox2.Checked := false;
END;
END;
END;
END;


PROCEDURE TForm1.SetResolution(swidth: integer; sheight: integer; sbits: integer);
VAR
lpDevMode: TDeviceMode;
result: integer;
BEGIN
EnumDisplaySettings(NIL, 0, lpDevMode);
lpDevMode.dmFields := DM_PELSWIDTH OR DM_PELSHEIGHT;
IF sheight < 480 THEN<br>SetResolution(800, 480, sbits);
lpDevMode.dmPelsWidth := swidth;
Twidth := swidth;
lpDevMode.dmPelsHeight := sheight;
THeight := sHeight;
lpDevMode.dmBitsPerPel := sbits;
TBits := sbits;
//PostMessage(HWND_BROADCAST ,WM_DISPLAYCHANGE,32,sheight*65536+swidth);
result := ChangeDisplaySettings(lpDevMode, CDS_UPDATEREGISTRY);
Form1.Visible := false;
CooltrayIcon1.Hint := IntToStr(TWidth) + 'x' + IntToStr(Theight) + 'x' + inttostr(TBits);
CoolTrayIcon1.MinimizeToTray := true;
myreg := TRegistry.Create;
myreg.RootKey := HKEY_LOCAL_MACHINE;
IF myreg.OpenKey('Software\EEEPC Utility', true) THEN
BEGIN
myreg.WriteInteger('Width', Twidth);
myreg.WriteInteger('Height', THeight);
myreg.WriteInteger('Bits', TBits);
END;
END;

PROCEDURE TForm1.suitempButton8Click(Sender: TObject);
VAR
buffer0: ARRAY[0..3] OF char;
BEGIN
myreg := TRegistry.Create;
myreg.RootKey := HKEY_LOCAL_MACHINE;
IF myreg.OpenKey('SYSTEM\CurrentControlSet\Services\ialm\Device0', false) THEN
BEGIN
buffer0[0] := chr($01);
buffer0[1] := chr($00);
buffer0[2] := chr($00);
buffer0[3] := chr($00);
myreg.WriteBinaryData('Display1_DownScalingEnabled', buffer0, 4);
END;
END;

PROCEDURE TForm1.FormCloseQuery(Sender: TObject; VAR CanClose: Boolean);
BEGIN
//downscaling(false);
END;

PROCEDURE TForm1.Timer1Timer(Sender: TObject);
BEGIN
inc(timercount);

IF timercount = 1 THEN
BEGIN

Timer1.Enabled := false;
IF paramcount() > 1 THEN
BEGIN
IF ParamStr(1) = '0' THEN downscaling(false);
IF ParamStr(1) = '1' THEN downscaling(true);
END;
IF paramcount() = 4 THEN
BEGIN
TRY
setresolution(StrToInt(paramStr(2)), StrToInt(paramStr(3)), StrToInt(paramStr(4)));
CoolTrayIcon1.Hint := paramStr(2) + 'x' + paramStr(3) + 'x' + paramStr(4);
FINALLY
END;
END;
loadsetting();
//suiImagePanel1.SetFocus;
Form1.Visible := false;
CoolTrayIcon1.MinimizeToTray := true;
END;
END;

PROCEDURE TForm1.CoolTrayIcon1DblClick(Sender: TObject);
BEGIN
Form1.Visible := true;
END;

PROCEDURE TForm1.FormCreate(Sender: TObject);
VAR
handle1, handle2, handle3: Thandle;
BEGIN
timercount := 0;
handle1 := 0;
handle2 := 0;
handle3 := 0;
Form1.Left := GetSystemMetrics(SM_CXSCREEN) DIV 2 - Form1.Width DIV 2;
Form1.Top := GetSystemMetrics(SM_CYSCREEN) DIV 2 - Form1.height DIV 2;

WHILE ((handle1 = 0) OR (handle1 = 0) OR (handle1 = 0)) DO
BEGIN
handle1 := FindWindow('Shell_TrayWnd', NIL);
handle2 := FindWindow('ProgMan', NIL);
handle3 := FindWindow(NIL, 'Program Manager');
sleep(1);
END;
timer1.Enabled := true;
END;

PROCEDURE TForm1.suiButton1Click(Sender: TObject);
BEGIN
IF suiCheckBox1.Checked THEN
BEGIN
downscaling(true);
END
ELSE
downscaling(false);
CASE suiRadioGroup1.ItemIndex OF
0: BEGIN CoolTrayIcon1.Hint := '1024x768x32'; SetResolution(1024, 768, 32); END;
1: BEGIN CoolTrayIcon1.Hint := '800x600x32'; SetResolution(800, 600, 32); END;
2: BEGIN CoolTrayIcon1.Hint := '800x480x32'; SetResolution(800, 480, 32); END;
END;
myreg.CloseKey;
IF myreg.OpenKey('Software\EEEPC Utility', true) THEN
BEGIN
myreg.WriteBool('CapLock', suiCheckGroup1.Checked[0]);
myreg.WriteBool('NumLock', suiCheckGroup1.Checked[1]);
myreg.WriteBool('ScrollLock', suiCheckGroup1.Checked[2]);
END;


IF suiCheckBox2.Checked THEN
BEGIN
myreg := TRegistry.Create;
myreg.RootKey := HKEY_LOCAL_MACHINE;
IF myreg.OpenKey('Software\MicroSoft\Windows\CurrentVersion\Run', false) THEN
BEGIN
IF myreg.ValueExists('Asustray') THEN myreg.DeleteValue('Asustray');
myreg.WriteString('EEEPC Utility', Application.ExeName);
END;
END
ELSE
BEGIN
IF myreg.OpenKey('Software\MicroSoft\Windows\CurrentVersion\Run', false) THEN
BEGIN
IF myreg.ValueExists('EEEPC Utility') THEN myreg.DeleteValue('EEEPC Utility');
END;
END;

END;

PROCEDURE TForm1.N800x6001Click(Sender: TObject);
BEGIN
suicheckBox1.Checked := true;
suiRadioGroup1.ItemIndex := 1;
suiButton1Click(self);
END;

PROCEDURE TForm1.N1024x6001Click(Sender: TObject);
BEGIN
suicheckBox1.Checked := true;
suiRadioGroup1.ItemIndex := 0;
suiButton1Click(self);
END;

PROCEDURE TForm1.N800x4801Click(Sender: TObject);
BEGIN
suicheckBox1.Checked := true;
suiRadioGroup1.ItemIndex := 2;
suiButton1Click(self);
END;

PROCEDURE TForm1.Exit1Click(Sender: TObject);
BEGIN
Form1.Close;
END;

PROCEDURE TForm1.Button1Click(Sender: TObject);
VAR
ks: tkeyboardstate;
BEGIN
detecting := 1;
sleep(1);
application.ProcessMessages;

IF suiCheckGroup1.Checked[1] THEN
BEGIN
TextTrayIcon1.iconvisible := true;
IF GetKeyStatE(vk_nUMlOCK) 0 THEN //odd(ks[VK_NUMLOCK]) THEN
BEGIN
TextTrayIcon1.Font.Color := clnavy;
TextTrayIcon1.Text := 'N';
TexttrayIcon1.COLOR := clLime;
TexttrayIcon1.Hint := 'Num Lock ON';
END
ELSE
BEGIN
TextTrayIcon1.COLOR := clBtnFace;
TextTrayIcon1.Text := '';
TexttrayIcon1.Hint := 'Num Lock OFF';
END;
END
ELSE
BEGIN
TextTrayIcon1.iconvisible := false;
END;

IF suiCheckGroup1.Checked[0] THEN
BEGIN
sleep(1);
application.ProcessMessages;
TextTrayIcon2.iconvisible := true;
IF GetKeyStatE(VK_CAPITAL) 0 THEN
BEGIN
TextTrayIcon2.Text := 'A';
TexttrayIcon2.COLOR := clAqua;
TextTrayIcon2.Font.Color := clNavy;
TexttrayIcon2.Hint := 'Cap Lock ON';
END
ELSE
BEGIN
TextTrayIcon2.Text := 'a';
TexttrayIcon2.Hint := 'Cap Lock OFF';

END;
END
ELSE
BEGIN
TextTrayIcon2.iconvisible := false;
END;
IF suiCheckGroup1.Checked[2] THEN
BEGIN
TextTrayIcon3.iconvisible := true;
sleep(1);
application.ProcessMessages;
IF GetKeyStatE(VK_SCROLL) 0 THEN
BEGIN
TextTrayIcon3.Font.Color := clnavy;
TextTrayIcon3.Text := 'S';
TextTrayIcon3.COLOR := clFuchsia;
TexttrayIcon3.Hint := 'Scroll Lock ON';
END
ELSE
BEGIN
TextTrayIcon3.Text := '';
TextTrayIcon3.COLOR := clBtnFace;
TexttrayIcon3.Hint := 'Scroll Lock OFF';
END;
END
ELSE
BEGIN
TextTrayIcon3.iconvisible := false;
END;
detecting := 0;
END;

PROCEDURE TForm1.Timer2Timer(Sender: TObject);
BEGIN
IF detecting = 0 THEN
Button1Click(self);
END;

PROCEDURE TForm1.suiButton2Click(Sender: TObject);
BEGIN
ShellExecute(0, pchar('open'), 'https://www.paypal.com/cgi-bin/webscr?cmd=_donations&business=kkjj_tw%40msn%2ecom&item_name=EEEPC%20Utility&no_shipping=0&no_note=1&tax=0¤cy_code=USD&lc=TW&bn=PP%2dDonationsBF&charset=UTF%2d8', NIL, NIL, SW_MAXIMIZE);
END;

PROCEDURE TForm1.FormResize(Sender: TObject);
BEGIN
Form1.Width := 387;
Form1.Height := 165;
END;

END.

;================有需要的請自已改寫=======================================

因為沒有eeepc,想改進也沒得測,讓有心在工具開發的站友可接力下去。
2008-02-17 8:46 發佈
文章關鍵字 EEEPC
感謝分享
我昨天也自行解決了畫面壓縮問題(找很久機碼)
剛看了您的code原來您也是去改機碼
anyway
希望能有更多人來開發更方便的小程式囉
好熟悉的 DELPHI @@
約8,9年前那一陣子使用過很長一陣子
都是開發資料庫的程式,那時DELPHI 的 VCL 很紅的
曾幾何時,唉,有感而發,感謝您的分享
sky777 wrote:
感謝分享我昨天也自行...(恕刪)


舊Driver是改機碼,新Driver有另一個網友有開放。你可以向他請教。
內文搜尋
X
評分
評分
複製連結
Mobile01提醒您
您目前瀏覽的是行動版網頁
是否切換到電腦版網頁呢?