:: MVP ::
|
|
:: RSS ::
|
|
|
Как в Win9x скрыть программу из списка "Завершение работы программы" по CTRL+ALT+DEL?
// Способ первый
var
Form1: TForm1;
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer;
stdcall; external 'kernel32.dll';
{ Убрать из списка }
procedure TForm1.Button1Click(Sender: TObject);
begin
if not (csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID, 1);
end;
{ Вернуть обратно }
procedure TForm1.Button2Click(Sender: TObject);
begin
if not (csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID, 0);
end;
// Способ второй
procedure RegisterServiceProcess;
stdcall; external 'kernel32.dll' name 'RegisterServiceProcess';
{ Убрать из списка }
procedure TForm1.Button1Click(Sender: TObject);
begin
asm
push 1
push 0
call RegisterServiceProcess
end;
end;
{ Вернуть обратно }
procedure TForm1.Button2Click(Sender: TObject);
begin
asm
push 0
push 0
call RegisterServiceProcess
end;
end;
|
Как узнать, была ли перемещена форма?
type
TForm1 = class(TForm)
private
procedure OnMove(var Msg: TWMMove); message WM_MOVE;
{...}
end;
procedure TForm1.OnMove(var Msg: TWMMove);
begin
inherited;
if Self.Visible then
ShowMessage('Форма была перемещена');
end;
|
Как отловить минимизацию окна?
type
TForm1 = class(TForm)
private
procedure OnFormMinimize(var Msg: TMessage); message WM_SYSCOMMAND;
procedure OnMinimizeProc(Sender:TObject);
{...}
end;
// Эта процедура сработает по нажатию кнопки минимизации
// и при выборе пункта "свернуть" в системном меню формы
procedure TForm1.OnFormMinimize(var Msg: TMessage);
begin
inherited;
if Msg.WParam = SC_MINIMIZE then
begin
// Отловили минимизацию, делаем что нужно
end;
end;
// Чтобы минимизация срабатывала по нажатию кнопки
// на панели задач, обработаем Application.onMinimize
procedure TForm1.OnMinimizeProc(Sender: TObject);
begin
PostMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.onMinimize := OnMinimizeProc;
end;
|
Как сделать скриншот своей формы и сохранить его в *.bmp файл?
// Способ первый
procedure ScreenMyForm;
var
c: TCanvas;
Im: TImage;
r1, r2: TRect;
begin
r1 := Rect(Form1.Left, Form1.Top,
Form1.Left + Form1.Width, Form1.Top + Form1.Height);
r2 := Rect(0, 0, Form1.Width, Form1.Height);
try
Im := TImage.Create(Application);
Im.Width := Form1.Width;
Im.Height := Form1.Height;
c := TCanvas.Create;
c.Handle := GetDC(GetDesktopWindow);
Im.Canvas.CopyRect(r2, c, r1);
Im.Picture.SaveToFile('c:\ScreenMyForm.bmp');
except
c.Free;
Im.Free;
end;
end;
// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
var
DC: hDC;
bm: TBitmap;
begin
DC := GetWindowDC(Handle);
bm := TBitmap.Create;
bm.Width := Width;
bm.Height := Height;
BitBlt(bm.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
bm.SaveToFile('c:\ScreenMyForm.bmp');
bm.Free;
ReleaseDC(Handle, DC);
end;
// Способ третий
// С помощью функции PrintWindow
// Появилась начиная с Windows XP (client) и Windows Server 2003 (server)
// Прототип функции - function PrintWindow( HWND: HWND; hdcBlt: HDC; nFlags: DWORD ): BOOL; stdcall; external 'user32.dll';
// ВНИМАНИЕ: закомментированный код может пригодиться в MDI приложениях в Windows Vista и выше, в XP PrintWindow вообще работает коряво.
uses
{...,} Math;
function WindowSnap(Wnd: HWND; Bmp: TBitmap; ClientOnly: Boolean = False): Boolean;
// function IsWindowSizebox(Wnd: HWND): Boolean;
// var
// Style: Integer;
// begin
// Style := GetWindowLong(Wnd, GWL_STYLE);
// Result := (Style and WS_SIZEBOX) = WS_SIZEBOX;
// end;
//
// function IsWindowCaption(Wnd: HWND): Boolean;
// var
// Style: Integer;
// begin
// Style := GetWindowLong(Wnd, GWL_STYLE);
// Result := (Style and WS_CAPTION) = WS_CAPTION;
// end;
const
PW_CLIENTONLY = 1;
var
r: TRect;
DLLHandle: THandle;
Flags: UINT;
PrintWindow: function(hwnd: HWND; hdcBlt: HDC; nFlags: UINT): BOOL; stdcall;
begin
Result := False;
DLLHandle := GetModuleHandle(user32);
if DLLHandle <> 0 then
begin
@PrintWindow := GetProcAddress(DLLHandle, 'PrintWindow');
if @PrintWindow <> nil then
begin
GetWindowRect(Wnd, r);
Bmp.Width := r.Right - r.Left;
Bmp.Height := r.Bottom - r.Top;
// if ClientOnly then
// begin
// if IsWindowSizebox(Wnd) then
// begin
// Bmp.Width := Bmp.Width - GetSystemMetrics(SM_CXSIZEFRAME) * 2;
// Bmp.Height := Bmp.Height - GetSystemMetrics(SM_CYSIZEFRAME) * 2;
// if IsWindowCaption( Wnd ) then
// Bmp.Height := Bmp.Height - GetSystemMetrics(SM_CYCAPTION);
// end
// else
// begin
// Bmp.Width := Bmp.Width - GetSystemMetrics(SM_CXFIXEDFRAME) * 2;
// Bmp.Height := Bmp.Height - GetSystemMetrics(SM_CYFIXEDFRAME) * 2;
// if IsWindowCaption( Wnd ) then
// Bmp.Height := Bmp.Height - GetSystemMetrics(SM_CYCAPTION);
// end;
// end;
Bmp.Canvas.Lock;
Flags := IfThen(ClientOnly, PW_CLIENTONLY, 0);
try
Result := PrintWindow(Wnd, Bmp.Canvas.Handle, Flags);
finally
Bmp.Canvas.Unlock;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
bm: TBitmap;
begin
bm := TBitmap.Create;
WindowSnap(Handle, bm);
bm.PixelFormat := pf24bit;
bm.SaveToFile('c:\screen.bmp');
bm.Free;
end;
|
Как сделать скриншот клиентской области формы и сохранить его в *.bmp файл?
// В компоненте TForm уже есть метод, возвращающий
// растровое изображение клиентской области формы.
// Его описание выглядит следующим образом -
// function GetFormImage: TBitmap;
procedure TForm1.Button1Click(Sender: TObject);
var
bm: TBitmap;
begin
bm := TBitmap.Create;
bm.Width := Width;
bm.Height := Height;
bm := GetFormImage;
bm.SaveToFile('c:\ScreenMyForm.bmp');
bm.Free;
end;
// Будте внимательны, поскольку данный метод не может получать
// изображения VBX компонент - на их месте будет пустое пространство.
// Это связано с различными методами реализации VCL и VBX компонент.
|
Как в Win9x подавить реакцию приложения на Alt+Tab, Ctrl+Alt+Del?
var
Form1: TForm1;
Int: LongInt;
// Отключаем Alt+Tab и Ctrl+Alt+Del
SystemParametersInfo(SPI_SCREENSAVERRUNNING, Word(True), @Int, 0);
// Включаем Alt+Tab и Ctrl+Alt+Del
SystemParametersInfo(SPI_SCREENSAVERRUNNING, Word(False), @Int, 0);
// Только для Alt-Tab: SPI_SETFASTTASKSWITCH
|
Как подавить реакцию приложения на Alt+F4?
// Способ первый
// Проверено в WinXP (работает) и Win7 (не работает)
type
TForm1 = class(TForm)
private
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
{...}
end;
implementation
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
with Msg do
if Result = HTCLOSE then
Result := HTCLIENT; {или HTNOWHERE}
end;
// Способ второй
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if ssAlt in Shift then
if Key = VK_F4 then
Key := 0;
end;
|
Как отследить переход фокуса в приложении?
// На форме должны быть компоненты,
// которые могут получать фокус
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
procedure AppControlChange(Sender: TObject);
{...}
end;
procedure TForm1.AppControlChange(Sender: TObject);
begin
if Sender is TScreen then
Caption := TScreen(Sender).ActiveForm.ActiveControl.Name;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.OnActiveControlChange := AppControlChange;
end;
|
Как определить, запущена программа с локального диска или с сетевого?
// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
DriveType: Cardinal;
DriveChar: string;
begin
DriveChar := ExtractFileDrive(ParamStr(0));
DriveType := GetDriveType(PChar(DriveChar + '\'));
case DriveType of
DRIVE_FIXED: ShowMessage('Локальный диск ' + DriveChar + '\');
DRIVE_REMOTE: ShowMessage('Сетевой диск ' + DriveChar + '\');
end;
end;
// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
case Application.ExeName[1] of
'\': ShowMessage('Программа запущена с сетевого компьютера');
else
ShowMessage('Программа запущена с локального компьютера');
end;
end;
|
При использовании материала - ссылка на сайт обязательна
|
|