www.adept7.kiev.ua

1.Перехват нажатия на системные кнопки формы (закрытие , минимизация окна и т.д.)
Сообщение WM_SYSCOMMAND приходит перед выполнением соответствующей команды, что дает возможность переопределить код.
Описание :

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;Вернуться к содержанию

2.Ограничение на размеры формы
Используется обработка Windows сообщения WM_GETMINMAXINFO
Например, ограничение на уменьшение размера формы и на увеличение ее по высоте:

//------------------------------------------------------------------------------
//ограничение на изменение размера формы
//------------------------------------------------------------------------------
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;
//------------------------------------------------------------------------------

Вернуться к содержанию

3.Компонент TStringGrid - назначение цвета для каждой строки, вывод содержимого ячейки в несколько строк
С помощью функции DrawText (Windows API), на событие TStringGrid.onDrawCell.
Причем, для того , чтобы длинная строка выводилась в ячейке в несколько строк, необходимо явно добавить в нужные места символ перевода строки(CHR(13))
Примечание: В данном примере COLUMN_INVCOMING, COLUMN_MESSAGE и ROW_HEADER мои собственные константы, с помощью которых я определяю что и каким цветом в TStringGrid надо рисовать. То есть цвет меняется во всех строках кроме ROW_HEADER в ячейке с номером COLUMN_MESSAGE. И цвет определяется значением ячейки с номером COLUMN_INCOMING.

//------------------------------------------------------------------------------
procedure TFormHistory.ListHistoryDrawCell(Sender: TObject; Col,
  Row: Integer; Rect: TRect; State: TGridDrawState);
Var
  S  : String;
  DrawRect : TRect;
  CurrentColor : TColor;
begin

  // Определяем цвет строки в зависимости типа Imcoming
  IF (Sender As TStrinGgrid).Cells[COLUMN_INCOMING , Row ] = '1'
  Then CurrentColor:=clBlue
  Else CurrentColor:=clMaroon;

  IF (Sender As TStrinGgrid).Row = Row
  Then CurrentColor := clHighlightText ;(Sender  As  TStrinGgrid).Canvas.font.color :=CurrentColor;S:=(Sender As TStrinGgrid).Cells[ Col,  Row ];IF (Col= COLUMN_MESSAGE ) AND (Row <> ROW_HEADER) ThenBegin If  Length(S) >  0 ThenBeginDrawRect: = Rect;
  DrawText((Sender As TStrinGgrid).Canvas.Handle, Pchar(S),  Length(S), DrawRect, dt_calcrect or dt_wordbreak or dt_left );If (DrawRect.bottom - DrawRect.top) > (Sender As TStrinGgrid).RowHeights[Row]Then (Sender As TStrinGgrid).RowHeights[row] : = (DrawRect.bottom- DrawRect.top)Else Begin  DrawRect.Right:= Rect.Right;
  (Sender As TStrinGgrid).Canvas.FillRect( DrawRect );DrawText((Sender As TStrinGgrid).Canvas.Handle, Pchar(S),
  Length(S), DrawRect, dt_wordbreak or dt_left);  End;
End;
  End
Else IF Row <>  ROW_HEADER
  Then (Sender As TStrinGgrid).Canvas.Textout(rect.left+3, rect.top+3 , S );

end;
//------------------------------------------------------------------------------

Вернуться к содержанию

5. Убрать из формы Caption.

 SetWindowLong (Main.Handle,GWL_STYLE,
  GetWindowLong(Main.Handle, GWL_STYLE) AND NOT WS_CAPTION OR WS_SIZEBOX);

Вернуться к содержанию

6. Событие при потере и установке фокуса для формы.
Примечание: В данном примере при потере фокуса формой, PanelCaption окрашивается в цвет неактивного заголовка, в случае получения фокуса формой - в цвет активного заголовка. То есть цвет панели повторяет изменение цвета Caption самой формы.

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;

Вернуться к содержанию

7.Добавить свой пункт в системное меню приложения.
Добавить пункт в системное меню, написать обработчик его выбора и перехватить сообщение о выборе пункта из системного меню.
Примечание: Константа WM_USER используется в приложении для определения собственных сообщений.
Значения от 0 до (WM_USER-1) зарезервированы для системных сообщений.

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

Вернуться к содержанию

Вопрос:

Как создать мигающий заголовок окна (пиктограмму)?
Ответ:
Можно воспользоваться функцией API FlashWindow():

Пример:

  var  Flash : bool;procedure TForm1.Timer1Timer(Sender: TObject);  begin  FlashWindow(Form1.Handle, Flash);  FlashWindow(Application.Handle, Flash);  Flash := not Flash;  end;procedure TForm1.FormCreate(Sender: TObject);  beginFlash := False;  end;