API: unit mmsystem PlaySound('SystemExit', null, SND_SYNC); или sndPlaySound('SystemExit', SND_SYNC);Вернуться к содержанию
WM_SYSCOMMAND uCmdType = wParam; // type of system command requested xPos = LOWORD(lParam); // horizontal postion, in screen coordinates yPos = HIWORD(lParam); // vertical postion, in screen coordinates
Type TMain = class(TForm) .... protected Procedure WMGetSysCommand(var Message : TMessage); message WM_SYSCOMMAND; end; ..... //---------------------------------------------------------------- // Обработка сообщения WM_SYSCOMMAND (перехват минимизации окна) //---------------------------------------------------------------- Procedure TMain.WMGetSysCommand(var Message : TMessage) ; Begin IF (Message.wParam = SC_MINIMIZE) Then Main.Visible:=False Else Inherited; End;
//----------------------------------------------------- // ограничение на изменение размера формы //----------------------------------------------------- procedure TFormBarParity.WMGetMinMaxInfo(var Message : TMessage); type PTMinMaxInfo = ^TMinMaxInfo; begin with PTMinMaxInfo(Message.LParam)^.ptMinTrackSize do begin x := 400; y := 45; end; with PTMinMaxInfo(Message.LParam)^.ptMaxTrackSize do begin y := 45; end; inherited; end;
Функция GetKeyState (Win32API) возвращает статус кнопки клавиатуры, переданной ей в качестве параметра. Статус определяет, что кнопка нажата(down), отпущена(up) или переключена(on/off, как например клавиши NumLock или CapsLock). Если старший разряд возвращаемого значения равен 1, то кнопка нажата, иначе она отпущена. Если младший разряд равен 1, то кнопка включена(состояние On), иначе кнопка выключена(off).
SHORT GetKeyState( int nVirtKey ); Например: IF GetKeyState(VK_NUMLOCK) = 1 Then ...// Кнопка "NumLock" включена (on)
SetWindowLong (Main.Handle,GWL_STYLE, GetWindowLong(Main.Handle, GWL_STYLE) AND NOT WS_CAPTION OR WS_SIZEBOX);
Type TMain = class(TForm) .... protected Procedure LastFocus(var Mess : TMessage) ; message WM_ACTIVATE; End; //-------------------------------------------------------------- Procedure TMain.LastFocus(var Mess : TMessage) ; Begin IF Mess.wParam = WA_INACTIVE Then PanelCaption.Color:=clInactiveCaption Else PanelCaption.Color:=clActiveCaption; Inherited; End;
type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure OnMyMenu; private procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; end; var Form1: TForm1; implementation {$R *.DFM} const SC_MyMenuItem = WM_USER + 1; //---------------------------------------------------- procedure TForm1.FormCreate(Sender: TObject); begin // добавление своего пункта в системное меню приложения AppendMenu(GetSystemMenu(Handle, FALSE), MF_SEPARATOR, 0, ''); AppendMenu(GetSystemMenu(Handle, FALSE), MF_STRING, SC_MyMenuItem, 'Новый пункт в меню'); end; //---------------------------------------------------- procedure TForm1.OnMyMenu; Begin // Обработка нажатия на новый пункт меню End; //---------------------------------------------------- procedure TForm1.WMSysCommand(var Msg: TWMSysCommand); begin // перехват события выбора нового пункта меню if Msg.CmdType = SC_MyMenuItem then OnMyMenu else inherited; end; //----------------------------------------------------
В файл MyWave.rc надо записать: MyWave RCDATA LOADONCALL MyWave.wav brcc32.exe MyWave.rc, получаешь MyWave.res. Непосредственно в программе: {$R a.res} Все! Пpедупpеждая следующий вопpос 'а как пpочитать вавчик из EXE?': procedure RetrieveMyWave; var hResource: THandle; pData: Pointer; begin hResource:=LoadResource( hInstance, FindResource(hInstance, 'MyWave', RT_RCDATA)); try pData := LockResource(hResource); if pData = nil then raise Exception.Create('Cannot read MyWave'); // Здесь pData указывает на MyWave // Тепеpь можно, напpимеp, пpоигpать его (Win32): PlaySound('MyWave', 0, SND_MEMORY); finally FreeResource(hResource); end; end;
Hачнем с создания.
Сущность свойства Owner в том, что владелец перед смертью уничтожает
(через Free) принадлежащие ему объекты. Таким образом, все зависит от
того, кому вы хотите доверить уничтожение созданных форм/компонентов.
В частности, если вы сами будете этим заниматься, то AOwner может
быть, например, nil.
Для того, чтобы созданный компонент появился на экране, надо указать его родителя, заполнив свойство Parent, например, NewButton.Parent := Form1;
Пример кода, обрабатывающего события от свежесозданных компонентов:
type TForm1 = class(TForm) { ... } private { эта процедура будет вызываться при нажатии на кнопку } procedure ButtonClicked(Sender : TObject); public { в этой процедуре происходит создание кнопки } procedure CreateButton; end; { ... } procedure TForm1.CreateButton; var btn : TButton; begin btn := TButton.Create(Self); { Уничтожать кнопку будет форма } btn.Parent := Self; { Родителем кнопки будет форма } btn.OnClick := ButtonClicked; { Процедура, которая будет исполняться при } btn.Visible := true; { нажатии на кнопку } end;
Как сделать возможным передвижение формы если пользователь щелкнул в форму вне пространства заголовка?
В следующем примере показано как можно передвигать форму если пользователь "захватил" Client-пространство. Наиболее простое решение - "обмануть" Windows и Client-пространство выдать за заголовок окна.
unit DragMain; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCrtls; type TForm1 = class(TForm) Button1: TButton; procedure ButtonClick(Sender: TObject); private procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCCHitTest; end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1. WMNCHitTest(var M: TWMNCHitTest); begin inherited; if M.Result = htClient then M.Result := htCaption; end; procedure TForm1.Button1Click(Sender: TObject); begin Close; end; end.Вернуться к содержанию
Для этого необходимо создать новый курсор(ы) в подходящем для этого редакторе ресурсов (например борландовский Resource Workshop). При этом надо обратить внимание на то что имена в редакторе ресурсов (особенно в том, который поставляется с Delphi) надо писать заглавными буквами. После этого "перед внутренним употреблением" (лучше всего в процедуре обработки события OnCreate главной формы) необходимо загрузить курсор(ы) из res-файла как указано ниже:
{$I CURSOR.RES} Screen.Cursors[1] := LoadCursor(hInstance, 'CURSOR_1'); Button1.Cursor := 1;
Обратите внимание на то, что системные курсоры в Screen.Cursors начинаются с нуля
и идут в минусовом направлении. Поэтому при создании новых курсоров лучше выбирать положительные
числа (лучше не слишком большие :-)).
Более удобный вариант - это объявить постоянную (равную например 12):
const CUR_HAND = 12; ... Screen.Cursors[CUR_HAND] := LoadCursor(hInstance, 'CURSOR_HAND'); Button1.Cursor := CUR_HAND;Вернуться к содержанию
OnCreateЕто может быть важно например для того чтобы координировать некоторые акции по управлению положением формы и т.п.
OnShow
OnPaint
OnActivate
OnResize
OnPaint
for t := 1 to 5 do FindComponent('Label' + IntToStr(t)).Visible := TRUE;Вернуться к содержанию
type TDriveState(DS_NO_DISK, DS_UNFORMATTED_DISK, DS_EMPTY_DISK, DS_DISK_WITH_FILES); function DriveState(DrvLetter: Char): TDriveState; var Mask: String[6]; SearchRec: TSearchRec; oldMode: Cardinal; ReturnCode: Integer; begin oldMode: = SetErrorMode(SEM_FAILCRITICALERRORS); Mask:= '?:\*.*'; Mask[1] := DrvLetter; {$I-} { отключить обработку исключительных ситуаций } ReturnCode := FindFirst(Mask, faAnyfile, SearchRec); FindClose(SearchRec); {$I+} case ReturnCode of { как минимум один файл был найден } 0: Result := DS_DISK_WITH_FILES; { файлов не найдено и дискета в порядке } -18: Result := DS_EMPTY_DISK; { DS_NO_DISK для DOS, ERROR_NOT_READY для WinNT, ERROR_PATH_NOT_FOUND для Win 3.1 } -21, -3: Result := DS_NO_DISK; else { дискета лежит в дисководе но она не форматировнная } Result := DS_UNFORMATTED_DISK; end; SetErrorMode(oldMode); end; { DriveState }Вернуться к содержанию
function GetFileDate(FileName: string): string; var FHandle: Integer; begin FHandle := FileOpen(FileName, 0); try Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle))); finally FileClose(FHandle); end; end;Вернуться к содержанию