:: MVP ::
|
|
:: RSS ::
|
|
|
Как зарегистрировать горячие клавиши в приложении?
type
TForm1 = class(TForm)
private
procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
{...}
end;
const
MY_HOTKEY = $F001;
procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterHotKey(Handle, MY_HOTKEY, MOD_WIN, VK_F6);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnregisterHotKey(Handle, MY_HOTKEY);
end;
procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
if Msg.HotKey = MY_HOTKEY then
ShowMessage('WIN + F6');
end;
|
Как показать окно дочерней формы без окна главной формы?
// В дочерней форме сделать следующее
type
TForm2 = class(TForm)
private
procedure CreateParams(var Params: TCreateParams); override;
{...}
end;
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WndParent := GetDesktopWindow;
end;
// Присваивая дескриптор окна родительской формы Рабочему столу, вы удаляете ту связь,
// которая, в нормальной ситуации, при выводе окна на самый верхний уровень, заставляет
// переместиться туда также целиком все приложение.
|
Как получить «второй» (градиентный) цвета заголовка формы?
function clGradientActiveCaption: Integer;
var
b: BOOL;
begin
SystemParametersInfo(SPI_GETGRADIENTCAPTIONS, 0, @b, 0);
if B then
Result := GetSysColor(COLOR_GRADIENTACTIVECAPTION)
else
Result := GetSysColor(COLOR_ACTIVECAPTION);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Color := clGradientActiveCaption;
end;
|
Как создать "наполовину" активное окно?
type
TForm1 = class(TForm)
private
procedure WMNCHitTest(var M: TWMNCHitTest); message WM_NCHITTEST;
{...}
end;
procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
if M.Result = htClient then
M.Result := htCaption;
end;
|
Как изменить главную форму во время выполнения?
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2},
Unit3 in 'Unit3.pas' {Form3};
{$R *.res}
procedure SetAsMainForm(aForm:TForm);
var
P: Pointer;
begin
P := @Application.Mainform;
Pointer(P^) := aForm;
end;
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
Application.CreateForm(TForm3, Form3);
if Paramstr(1) = 'Param1' then
SetAsMainForm(Form2);
if Paramstr(1) = 'Param2' then
SetAsMainForm(Form3);
Application.Run;
end.
|
Как просмотреть текст формы из запущенной программы?
procedure TForm1.Button1Click(Sender: TObject);
var
rs: TResourceStream;
ms: TMemoryStream;
begin
rs := TResourceStream.Create(HInstance, ClassName {'TForm1'}, RT_RCDATA);
try
ms := TMemoryStream.Create;
try
ObjectBinaryToText(rs, ms);
ms.Seek(0, 0);
Memo1.Lines.LoadFromStream(ms);
finally
ms.Free;
end;
finally
rs.Free;
end;
end;
|
Как заблокировать перемещение формы?
// Способ первый
// Проверено в 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
begin
// Result := DefWindowProc(Handle, Msg, Unused, MakeWParam(XPos, YPos));
if Result = HTCAPTION then
Result := HTNOWHERE {или HTCLIENT};
end;
end;
// Способ второй
type
TForm1 = class(TForm)
private
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
{...}
end;
implementation
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
if Msg.CmdType <> 61458 then
inherited;
end;
// Способ третий
procedure TForm1.FormCreate(Sender: TObject);
begin
Align := alCustom;
end;
|
При использовании материала - ссылка на сайт обязательна
|
|