alika1982
miy+var+xar!!!
ჯგუფი: Members
წერილები: 3318
წევრი No.: 1155
რეგისტრ.: 9-August 02
|
#671373 · 24 Sep 2004, 16:36 · · პროფილი · პირადი მიმოწერა · ჩატი
Как перезагрузить компьютер
Для перезагрузки компьютера следует использовать функцию ExitWindowsEx
function ExitWindowsEx(uFlags: Integer; dwReserved: Integer): BOOL;
где
uFlags
комбинация нижеприведенных флагов, определяющая действие функции:
ewx_force
ewx_logoff
ewx_poweroff
ewx_reboot
ewx_shutdown
dwReserved
этот параметр игнорируется
Запускать программу на старте Windows
Если ваша программа должна запускаться при каждом запуске Windows, то удобнее всего использовать не папку "Автозагрузка", а реестр. Если вы нажмете на кнопку, то при каждом запуске Windows эта программа будет запускаться.
uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
Reg := nil;
try
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false;
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',
false);
reg.WriteString('My App', Application.ExeName);
reg.CloseKey;
reg.free;
except
if Assigned(Reg) then Reg.Free;
end;
end;
Отключить и включить Ctrl+Alt+Delete
Если Windows думает, что работает хранитель экрана (ScreenSaver), то она отключает окно "Завершение работы программы", появляющееся по Ctrl+Alt+Delete. Эта программа сообщает Windows о том, что запущен хранитель экрана (ScreenSaver).
procedure TForm1.Button1Click(Sender: TObject);
var
b: boolean;
begin
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @b, 0);
if b then
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @b, 0);
end;
Как программно свернуть все окна
Это можно сделать большим количеством способов, самый простой - это, по-моему, такой:
SendMessage(FindWindow('Shell_TrayWnd,nil'),wm_command,$019f,0);
Отменить свертывание можно таким образом:
SendMessage(FindWindow('Shell_TrayWnd,nil'),wm_command,$0140,0);
Как отключить монитор программным путем
Монитор отключенный программным путем, включить можно только программным. Делается все это при помощи сообщений.
SendMessage(application.handle,WM_SysCommand,SC_MonitorPower,0); //выключить
SendMessage(application.handle,WM_SysCommand,SC_MonitorPower,1); //включить
Как узнать имя компьютера и пользователя
procedure TForm1.Button1Click(Sender: TObject);
Var szName : Array[0..100] of Char;
Name : String;
n:integer;
begin
n:=100;//максисмальное число возвращаемых символов
GetComputerName(szName,n);//имя компьютера
name:=StrPas(szName);
Label4.Caption:=Name;
n:=100;//эту строчку нельзя убирать!
GetUserName(szName,n);//имя пользователя
name:=StrPas(szName);
Label3.Caption:=Name;
end;
Как убрать значки на рабочем столе
Это осуществляется так:
var prog : HWND;
Begin
prog:=FindWindow('Progman',nil);
ShowWindow(prog,sw_hide);//Спрятать
ShowWindow(prog,sw_show);//Показать
End;
Скрытие приложения на панели задач.
ShowWindow(Application.Handle, sw_hide);//Спрятать
ShowWindow(Application.Handle, sw_show);//Показать
Скрытие приложения в списке по Alt+Tab
var WnHnd : HWND;
...
WnHnd := GetWindowLong(Application.Handle, GWL_EXSTYLE);
WnHnd := WnHnd or WS_EX_TOOLWINDOW;
SetWindowLong(Application.Handle, GWL_EXSTYLE, WnHnd);
...
Примечание:
Метод работает только под Windows95, кто знает способ лучше - пишите
Убрать программу из Alt+Tab и Ctrl+Alt+Del
Для удаления программы из диалога "Завершение работы программы", вызываемого по Ctrl+Alt+Del, нужно используют функцию RegisterServiceProcess. В Windows NT этой функции не существует. Поэтому, чтобы не происходило ошибки, нужно проверять версию Windows. Если это не Windows NT, то нужно динамически загрузить kernel32.dll.
Эта программа исчезает из Alt+Tab, не появляется и кнопка на TaskBar.
procedure TForm1.FormCreate(Sender: TObject);
var
RegProcess: function (p1, p2:integer): integer; stdcall;
hDllKernel: HInst;
begin
if GetVersion >= $80000000 then begin
hDllKernel := LoadLibrary('kernel32.dll');
RegProcess := GetProcAddress(hDllKernel, 'RegisterServiceProcess');
RegProcess(0, 1);
end;
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE) or
WS_EX_TOOLWINDOW);
end;
Алексей Вторыгин добавил в этот пример проверку версии Windows.
Как извлечь иконку из .dll или .exe файла
var NewIcon : TIcon;
NumIcon : Integer;//Номер извлекаемой иконки
...
NewIcon.Handle:=ExtractIcon(hInstance,'c:\windows\explorer.exe',NumIcon);
//c:\windows\explorer.exe - имя файла, из которого извлекается иконка
//Далее с NewIcon поступайте как вам угодно, например изменить иконку у формы:
Form1.Icon:=NewIcon;
Хочу заметить, что эта функция будет доступна, только если будет подключен модуль ShellApi.
Отключить и включить Ctrl+Alt+Delete
Если Windows думает, что работает хранитель экрана (ScreenSaver), то она отключает окно "Завершение работы программы", появляющееся по Ctrl+Alt+Delete. Эта программа сообщает Windows о том, что запущен хранитель экрана (ScreenSaver).
procedure TForm1.Button1Click(Sender: TObject);
var
b: boolean;
begin
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @b, 0);
if b then
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @b, 0);
end;
Сменить рисунок на кнопке "Пуск"
Нужно изменить изображение кнопки на нужное при помощи сообщения BM_GETIMAGE.
var
StartButton: hWnd;
bmOld: THandle;
bm: TBitMap;
procedure TForm1.FormCreate(Sender: TObject);
const
text = 'Ура!!!';
var
r: TRect;
i: integer;
begin
StartButton := FindWindowEx(
FindWindow('Shell_TrayWnd',nil),
0, 'Button', nil);
bm := TBitMap.Create;
bmOld := SendMessage(StartButton, BM_GETIMAGE, 0, 0);
GetWindowRect(StartButton, r);
bm.Width := r.Right - r.Left - 8;
bm.Height := r.Bottom - r.Top - 6;
with bm.Canvas do begin
Brush.Color := clBtnFace;
FillRect(ClipRect);
for i := 0 to bm.Width + 4 do begin
Pen.Color := RGB(i * 4, 255, 0);
MoveTo(i - 5, 0);
LineTo(i, bm.Height);
end;
Brush.Style := bsClear;
Font.Style := [fsBold];
Font.Name := 'Arial';
Font.Size := 9;
Font.Color := clBlue;
TextOut((bm.Width - TextWidth(text)) div 2,
(bm.Height - TextHeight(text)) div 2, text);
end;
SendMessage(StartButton, BM_SETIMAGE, 0, bm.Handle);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SendMessage(StartButton, BM_SetImage, 0, bmOld);
bm.Destroy;
end;
Спасибо за этот совет Владимиру Парфишину.
Спрятать и показать TaskBar
Вы можете из своей программы сделать панель задач (TaskBar) невидимой и снова видимой.
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_Hide);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_ShowNormal);
end;
Запустить Screen Saver
При нажатии на кнопку будет запускаться ScreenSaver (если он не отключен).
procedure TForm1.Button1Click(Sender: TObject);
SendMessage(Form1.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
end;
Вызвать диалог "Завершение работы с Windows"
Для того, чтобы вызвать стандартный диалог "Завершение работы с Windows", появляющийся по команде "Пуск | Завершение работы...", нужно послать сообщение WM_CLOSE окну "Program Manager".
Эта программа активизирует то окно, над которым находится мышь.
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(FindWindow('Progman', 'Program Manager'),
WM_CLOSE, 0, 0);
end;
Приостановить компьютер (sleep)
У компьютеров ATX есть функция Sleep. Эта программа заставляет компьютер "заснуть".
procedure TForm1.Button1Click(Sender: TObject);
begin
SetSystemPowerState(true, true);
end;
Определить, запущен ли ScreenSaver
Класс окна ScreenSaver-а должен иметь имя WINDOWSSCREENSAVERCLASS. Эта программа определяет каждую секунду имя активного окна. Если запущен хранитель экрана, то программа выдает звуковой сигнал.
procedure TForm1.Timer1Timer(Sender: TObject);
var
s: array [0..255] of char;
begin
GetClassName(GetForegroundWindow, s, length(s));
if UpperCase(s) = 'WINDOWSSCREENSAVERCLASS'
then beep;
end;
Disable, Enable Ctl-Alt-Delete and Alt-Tab, Ctl-Esc
Note: Click Title to view in Edit Box for easier copying.
public
Enabled1: Integer;
procedure TForm1.Button1Click(Sender: TObject);
var
Dummy : integer;
begin
Dummy := 0;
if Enabled1 = 1 then
Enabled1 := 0 //0 means enable ctl-alt-delete
else
Enabled1 := 1; //1 means disable controls
{Disable ALT-TAB}
SystemParametersInfo( SPI_SETFASTTASKSWITCH, Enabled1, @Dummy, 0);
{Disable CTRL-ALT-DEL}
SystemParametersInfo( SPI_SCREENSAVERRUNNING, Enabled1, @Dummy, 0);
end;
Убрать программу из Alt+Tab и Ctrl+Alt+Del
Для удаления программы из диалога "Завершение работы программы", вызываемого по Ctrl+Alt+Del, нужно используют функцию RegisterServiceProcess. В Windows NT этой функции не существует. Поэтому, чтобы не происходило ошибки, нужно проверять версию Windows. Если это не Windows NT, то нужно динамически загрузить kernel32.dll.
Эта программа исчезает из Alt+Tab, не появляется и кнопка на TaskBar.
procedure TForm1.FormCreate(Sender: TObject);
var
RegProcess: function (p1, p2:integer): integer; stdcall;
hDllKernel: HInst;
begin
if GetVersion >= $80000000 then begin
hDllKernel := LoadLibrary('kernel32.dll');
RegProcess := GetProcAddress(hDllKernel, 'RegisterServiceProcess');
RegProcess(0, 1);
end;
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE) or
WS_EX_TOOLWINDOW);
end;
Алексей Вторыгин добавил в этот пример проверку версии Windows.
Очистить меню "Пуск/Документы"
Эта программа очищает меню "Пуск/Документы"
uses ShlOBJ;
procedure TForm1.Button1Click(Sender: TObject);
begin
SHAddToRecentDocs(SHARD_PATH, nil);
end;
Добавить файл в меню "Пуск/Документы"
Эта программа добавляет файл "File.txt" в "Пуск/Документы".
uses ShlOBJ;
procedure TForm1.Button1Click(Sender: TObject);
begin
SHAddToRecentDocs(SHARD_PATH, PChar('File.txt'));
end;
Сменить обои рабочего стола
Эта программа меняет обои рабочего стола на открытый графический файл.
procedure TForm1.Button1Click(Sender: TObject);
begin
if (not OpenDialog1.Execute) then Exit;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0,
PChar(OpenDialog1.FileName), SPIF_SENDWININICHANGE);
end;
Убрать и показать иконки на Desctop'е
В этом примере я использую то, что иконки принадлежат окну рабочего стола, которое я просто делаю невидимым.
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowWindow(FindWindow('Progman', 'Program Manager'), SW_HIDE);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowWindow(FindWindow('Progman', 'Program Manager'), SW_SHOW);
end;
Запретить запуск второго экземпляра программы
В Windows 95, по-моему, это самый простой работающий вариант. Этот текст должен находиться в модуле проекта (добраться до него можно через меню View/Project Source).
program Project1;
uses
Forms,
Windows, // не забудьте эту строчку
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
var
HM: THandle;
function Check: boolean;
begin
HM := OpenMutex(MUTEX_ALL_ACCESS, false, 'MyOwnMutex');
Result := (HM <> 0);
if HM = 0 then HM := CreateMutex(nil, false, 'MyOwnMutex');
end;
begin
if Check then Exit;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Сменить язык
Эта программа при нажатии на Button1 меняет язык на следующий, при нажатии на Button2 – на русский, а на Button3 – на английский. Каждую секунду программа выводит в заголовок окна число, определяющее текущий язык.
procedure TForm1.Button1Click(Sender: TObject);
begin
ActivateKeyboardLayout(HKL_NEXT, 0);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ActivateKeyboardLayout(LoadKeyboardLayout('00000419', 0), 0);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
ActivateKeyboardLayout(LoadKeyboardLayout('00000409', 0), 0);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
s: array [0..63] of char;
begin
GetKeyboardLayoutName(s);
Form1.Caption := s;
end;
Найти активное окно
Чтобы получить Handle активного окна (не важно, ваше оно или нет) нужно воспользоваться функцией GetForegroundWindow. Приведенная программа каждую секунду пытается развернуть активное окно.
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ShowWindow(GetForegroundWindow, SW_MAXIMIZE);
end;
Закрыть приложение
Эта программа закрывает Delphi Help.
procedure TForm1.Button1Click(Sender: TObject);
begin
PostMessage(FindWindow(nil, 'Delphi Help'), WM_QUIT, 0, 0);
end;
Открыть Control Panel
Вы можете разместить в своей программе кнопку настройки принтеров, мыши или еще чего-нибудь, при нажатии на которую будет выводиться соответствующее окно настроек из панели управления (Control Panel). Можно показать и окно с самой папкой.
procedure TForm1.Button1Click(Sender: TObject);
var
buffer: array [0..1023] of char;
begin
GetWindowsDirectory(buffer, 1024);
WinExec(PChar(buffer + '\Control'),
sw_ShowNormal);
WinExec(PChar(buffer + '\Control PRINTERS'),
sw_ShowNormal);
WinExec(PChar(buffer + '\Control TIMEDATE.CPL'),
sw_ShowNormal );
WinExec(PChar(buffer + '\Control MOUSE'),
sw_ShowNormal);
end;
Disable and Enable Alt-Tab and Ctrl-Esc Keys
Note: Click Title to view in Edit Box for easier copying.
procedure TurnSysKeysOff;
var
OldVal : LongInt;
begin
SystemParametersInfo (97, Word (True), @OldVal, 0)
end;
procedure TurnSysKeysBackOn;
var
OldVal : LongInt;
begin
SystemParametersInfo (97, Word (False), @OldVal, 0)
end;
Disable, Enable Ctl-Alt-Delete and Alt-Tab, Ctl-Esc
Note: Click Title to view in Edit Box for easier copying.
public
Enabled1: Integer;
procedure TForm1.Button1Click(Sender: TObject);
var
Dummy : integer;
begin
Dummy := 0;
if Enabled1 = 1 then
Enabled1 := 0 //0 means enable ctl-alt-delete
else
Enabled1 := 1; //1 means disable controls
{Disable ALT-TAB}
SystemParametersInfo( SPI_SETFASTTASKSWITCH, Enabled1, @Dummy, 0);
{Disable CTRL-ALT-DEL}
SystemParametersInfo( SPI_SCREENSAVERRUNNING, Enabled1, @Dummy, 0);
end;
Сделать кнопки в MessageDlg русскими
Текст на кнопках в MessageDlg берется из файла ресурсов. Но поменять их не так просто. При каждой компиляции Delphi "восстанавливает" все "Cancel" и "Yes". Да и с кодировкой проблемы. Для решения этой задачи можно использовать стандартную функцию WinAPI MessageBox.
procedure TForm1.Button1Click(Sender: TObject);
begin
MessageBox(Form1.Handle,
PChar('Вы хотите сохранить изменения?'),
PChar('Моя программа'), 3);
end;
Form1.Handle можно заменить Application.Handle. Тогда пользователь не сможет пользоваться ни одним окном вашего приложения, пока не ответит.
Hiding from ALT+CTRL+DEL
Note: Click Title to view in Edit Box for easier copying.
add this before implementation
RegisterServiceProcess(dwProcessId,dwType:DWORD):DWORD; StdCall
external 'kernel32.dll' name 'RegisterServiceProcess';
and...
procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterServiceProcess(0,1);
end;
Hide Titlebar
Note: Click Title to view in Edit Box for easier copying.
Here is how to hide the titlebar:
Procedure TYourFormName.HideTitlebar;
Var
Save : LongInt;
Begin
If BorderStyle=bsNone then Exit;
Save:=GetWindowLong(Handle,gwl_Style);
If (Save and ws_Caption)=ws_Caption then Begin
Case BorderStyle of
bsSingle,
bsSizeable : SetWindowLong(Handle,gwl_Style,Save and
(Not(ws_Caption)) or ws_border);
bsDialog : SetWindowLong(Handle,gwl_Style,Save and
(Not(ws_Caption)) or ds_modalframe or ws_dlgframe);
End;
Height:=Height-getSystemMetrics(sm_cyCaption);
Refresh;
End;
end;
And here is how we show it again:
Procedure TYourFormName.ShowTitlebar;
Var
Save : LongInt;
begin
If BorderStyle=bsNone then Exit;
Save:=GetWindowLong(Handle,gwl_Style);
If (Save and ws_Caption)<>ws_Caption then Begin
Case BorderStyle of
bsSingle,
bsSizeable : SetWindowLong(Handle,gwl_Style,Save or
ws_Caption or ws_border);
bsDialog : SetWindowLong(Handle,gwl_Style,Save or
ws_Caption or ds_modalframe or ws_dlgframe);
End;
Height:=Height+getSystemMetrics(sm_cyCaption);
Refresh;
End;
end;
Окно
Сделать мигающим заголовок окна и кнопку на панели TaskBar
Отключить кнопку закрытия окна
Сделать окно с дыркой В Delphi3 установить минимальный размер окна
Убрать заголовок у окна
Сделать окно, перетаскивающееся за любое место
Сделать кнопки в MessageDlg русскими
Сделать кнопку на TaskBar для каждого окна
Сделать сложный фон окна
Сделать "плавающую панель"
Сделать мигающим заголовок окна и кнопку на панели TaskBar
Чтобы пользователь обратил внимание на Вашу программу (если, например, она выдала какое-то предупреждение), можно заставить мигать заголовок окна и кнопку программы на панели TaskBar.
var
Flash: boolean;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
// Мигание заголовка окна
FlashWindow(Form1.Handle, Flash);
// Мигание заголовка на панели задач
FlashWindow(Application.Handle, Flash);
Flash := not Flash;
end;
Отключить кнопку закрытия окна
Этот пример показывает, как сделать кнопку закрытия окна недоступной.
procedure TForm1.FormCreate(Sender: TObject);
begin
DeleteMenu(GetSystemMenu(Form1.Handle, false),
SC_CLOSE, MF_BYCOMMAND);
end;
Сделать окно с дыркой
Эта программа делает дырку в окне. Через эту дырку видно все, что находится за окном. В дырку видно даже меняющееся изображение.
Я сделал так, чтобы окно перемещалось за любое место, поскольку заголовок у него отсутствует.
...
private
procedure WMNCHITTEST(var Msg: TMessage); message WM_NCHITTEST;
...
procedure TForm1.WMNCHITTEST(var Msg: TMessage);
begin
inherited;
Msg.Result := HTCAPTION;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
r, r1: hRgn;
begin
Form1.BorderStyle := bsNone;
Width := 400;
Height := 200;
r := CreateEllipticRgn(0, 0, 400, 200);
r1 := CreateRoundRectRgn(150, 60, 250, 140, 20, 10);
CombineRgn(r, r1, r, RGN_XOR);
SetWindowRgn(Form1.Handle, r, true);
end;
Убрать заголовок у окна
Если нужно оставить рамку у окна, но убрать синюю полоску с кнопками, то можно использовать SetWindowLong, убрав флаг WS_CAPTION.
procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Handle, GWL_STYLE,
GETWINDOWLONG(Handle, GWL_STYLE) and (not WS_CAPTION));
Height := ClientHeight;
end;
Сделать сложный фон окна
Фон окна может представлять собой повторяющиеся картинки произвольного размера.
procedure TForm1.FormCreate(Sender: TObject);
begin
bm := TBitMap.Create;
bm.LoadFromFile('Example.bmp');
end;
procedure TForm1.FormPaint(Sender: TObject);
var
x, y: integer;
begin
for x := 0 to Form1.ClientWidth div bm.Width do
for y := 0 to Form1.ClientHeight div bm.Height do
Form1.Canvas.Draw(x * bm.Width, y * bm.Height, bm);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bm.Destroy;
end;
Вы можете использовать для "подложки" формы любой стиль кисти. Таким образом, можно получить окно "в полосочку", "в сеточку" и т.д.
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Brush.Style := bsDiagCross;
end;
Ту же задачу можно решить, используя свойство кисти Bitmap, позволяющее создавать свои стили. Размер картинки при этом всегда равен 8X8.
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Brush.Bitmap := TBitMap.Create;
Form1.Brush.Bitmap.LoadFromFile('Phone.bmp');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Form1.Brush.Bitmap.Destroy;
end;
Сделать "плавающую панель"
Так называемая "плавающая панель" используется обычно для панелей инструментов.
Текст в модуле с основной формой:
procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Show;
end;
Текст в модуле с "плавающей" панелью:
private
procedure CreateParams(var Params: TCreateParams); override;
...
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params do begin
Style := Style or WS_OVERLAPPED;
WndParent := Form1.Handle;
end;
end;
Открыть и закрыть CDROM
Открывать CDROM умеет TMediaPlayer, но закрыть он его не может. Эта программа может и открывать, и закрывать CDROM.
uses MMSystem;
procedure TForm1.Button1Click(Sender: TObject);
begin
mciSendString('Set cdaudio door open wait',
nil, 0, Form1.Handle);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
mciSendString('Set cdaudio door closed wait',
nil, 0, Form1.Handle);
end;
--------------------
ვისაც არ უყვარს - არც ენატრება. ვისაც არ ენატრება, არც არასოდეს ყვარებია და არც არავის ელოდება.
|
არადოკუმენტირებული API ფუნქციები, აბა ვის რა ინფორმაცია გაქვთ????
