FAQ VCL
Форма (приложение)

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: 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;


Как показать вторую форму, а заголовок первой оставить активным?

// У дочерней формы пишем
procedure TForm2.FormActivate(Sender: TObject);
begin
  SendMessage(Application.MainForm.Handle, WM_NCACTIVATE, Integer(True), 0);
end;


Как узнать, модальная ли форма или нет?

procedure TForm2.Button1Click(Sender: TObject);
begin
  if fsModal in FormState then
    ShowMessage('Модальная форма');
end;


Как создать новую форму, которая бы не отбирала фокус у существующей?

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form2 := TForm2.Create(Application);
  Form2.Visible := False;
  ShowWindow(Form2.Handle, SW_SHOWNA);
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;

При использовании материала - ссылка на сайт обязательна