nyuuzyou/wikis huggingface dataset:
Как перетаскивать (Drag and Drop) выделенный текст между компонентами Memo?

=== Как перетаскивать (Drag and Drop) выделенный текст между компонентами Memo? ===
Данный способ позволяет не погружаясь глубоко в создание компонент осуществить операцию "drag and drop" выделенного текста.
Создайте новый компонент (TMyMemo), наследовав его от TMemo. И объявите его следующим образом:
type
 TMyMemo = class(TMemo)
 private
 FLastSelStart: Integer;
 FLastSelLength: Integer;
 procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
 published
 property LastSelStart: Integer read FLastSelStart write FLastSelStart;
 property LastSelLength: Integer read FLastSelLength write FLastSelLength;
 end;
Добавьте обработчик WMLButtonDown:
procedure TMyMemo.WMLButtonDown(var Message: TWMLButtonDown);
var
 Ch: Integer;
begin
 if SelLength > 0 then
 begin
 Ch := LoWord(Perform(EM_CHARFROMPOS,0,
 MakeLParam(Message.XPos, Message.YPos)));
 LastSelStart := SelStart;
 LastSelLength := SelLength;
 if (Ch >= SelStart) and (Ch <= SelStart+SelLength-1) then
 BeginDrag(True)
 else
 inherited;
 end
 else
 inherited;
end;
Теперь установите этот компонент в package, создайте новый проект в Delphi и поместите на форму два TMyMemo. Для обоих компонент необходимо создать обработчики событий OnDragOver, которые должны выглядеть следующим образом:
procedure TForm1.MyMemo1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
begin
 Accept := Source is TMyMemo;
end;
Так же для них необходимо сделать обработчики событий OnDragDrop:
procedure TForm1.MyMemo1DragDrop(Sender, Source: TObject;
 X, Y: Integer);
var
 Dst, Src : TMyMemo;
 Ch : Integer;
 Temp : String;
begin
 Dst := Sender as TMyMemo;
 Src := Source as TMyMemo;
 Ch := LoWord(Dst.Perform(EM_CHARFROMPOS,0,MakeLParam(X,Y)));
 if (Src = Dst) and (Ch >= Src.LastSelStart) and
 (Ch <= Src.LastSelStart+Src.LastSelLength-1) then
 Exit;
 Dst.Text := Copy(Dst.Text,1,Ch)+Src.SelText+
 Copy(Dst.Text,Ch+1,Length(Dst.Text)-Ch);
 Temp := Src.Text;
 Delete(Temp,Src.LastSelStart+1,Src.LastSelLength);
 Src.Text := Temp;
end;
Запустите приложение, поместите в поля memo какой-нибудь текст, и посмотрите что произойдёт, если перетащить текст между полями.
Source: Взято из http://forum.sources.ru
ID: 00368
Category:VCL
Category:DragAndDrop
Category:TMemo
Как перетаскивать выделенный текст между компонентами Memo

=== Как перетаскивать выделенный текст между компонентами Memo ===
Данный способ позволяет не погружаясь глубоко в создание компонент осуществить операцию "drag and drop" выделенного текста. 
Создайте новый компонент (TMyMemo), наследовав его от TMemo. И объявите его следующим образом: 
type
 TMyMemo = class(TMemo)
 private
 FLastSelStart: Integer;
 FLastSelLength: Integer;
 procedure WMLButtonDown(var message: TWMLButtonDown); message WM_LBUTTONDOWN;
 published
 property LastSelStart: Integer read FLastSelStart write FLastSelStart;
 property LastSelLength: Integer read FLastSelLength write FLastSelLength;
end;
Добавьте обработчик WMLButtonDown: 
procedure TMyMemo.WMLButtonDown(var message: TWMLButtonDown);
var
 Ch: Integer;
begin
 if SelLength > 0 then
 begin
 Ch := LoWord(Perform(EM_CHARFROMPOS, 0,
 MakeLParam(message.XPos, message.YPos)));
 LastSelStart := SelStart;
 LastSelLength := SelLength;
 if (Ch >= SelStart) and (Ch <= SelStart+SelLength-1) then
 BeginDrag(True)
 else
 inherited;
 end
 else
 inherited;
end;
Теперь установите этот компонент в package, создайте новый проект в Delphi и поместите на форму два TMyMemo. Для обоих компонент необходимо создать обработчики событий OnDragOver, которые должны выглядеть следующим образом: 
procedure TForm1.MyMemo1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
 Accept := Source is TMyMemo;
end;
Так же для них необходимо сделать обработчики событий OnDragDrop: 
procedure TForm1.MyMemo1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
 Dst, Src: TMyMemo;
 Ch: Integer;
 Temp: string;
begin
 Dst := Sender as TMyMemo;
 Src := Source as TMyMemo;
 Ch := LoWord(Dst.Perform(EM_CHARFROMPOS, 0, MakeLParam(X, Y)));
 if (Src = Dst) and (Ch >= Src.LastSelStart)
 and (Ch <= Src.LastSelStart + Src.LastSelLength-1) then
 Exit;
 Dst.Text := Copy(Dst.Text, 1, Ch) + Src.SelText
 + Copy(Dst.Text, Ch+1, Length(Dst.Text)-Ch);
 Temp := Src.Text;
 Delete(Temp, Src.LastSelStart+1, Src.LastSelLength);
 Src.Text := Temp;
end;
Запустите приложение, поместите в поля memo какой-нибудь текст, и посмотрите что произойдёт, если перетащить текст между полями. 
Source: http://delphiworld.narod.ru/
ID: 00714
Category:VCL
Category:DragAndDrop
Category:Memo
Как перетаскивать компоненты в Run-Time?

=== Как перетаскивать компоненты в Run-Time? ===
Возьмите форму, бросьте на нее панель, на onMouseDown панели прицепите код:
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 ReleaseCapture;
 Panel1.Perform(WM_SYSCOMMAND, $F012, 0);
end;
Теперь в run-time панель можно таскать как в дизайне...
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00369
Category:VCL
Category:DragAndDrop
Как перетащить целую колонку из StringGrid в ListBox

=== Как перетащить целую колонку из StringGrid в ListBox ===
В Object Inspector установите свойство dragmode у StringGrid в dmAutomatic. 
Ниже приведён полный код: 
type
 TForm1 = class(TForm)
 StringGrid1: TStringGrid;
 ListBox1: TListBox;
 procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
 procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
 procedure FormCreate(Sender: TObject);
 procedure StringGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
 procedure StringGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
 private
 { Private declarations }
 XMouseCord: Integer;
 StartDrag: Boolean;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
begin
 Accept := Source is TStringGrid;
end;
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
 i: integer;
 ColumVal, CurrentCol: Integer;
begin
 if Source is TStringGrid then
 begin
 // Вычисляем колонку
 ColumVal := 0;
 CurrentCol := 0;
 for i := 0 to TStringGrid(Source).ColCount - 1 do
 begin
 ColumVal := ColumVal + TStringGrid(Source).ColWidths[i];
 if XMouseCord <= ColumVal then
 begin
 CurrentCol := i;
 break;
 end;
 end;
 // Убеждаемся, что это не первая колонка, которая не содержит данных
 if CurrentCol <> 0 then
 begin
 for i := 1 to TStringGrid(Source).RowCount - 1 do
 begin
 ListBox1.items.Add(TStringGrid(Source).Cells[CurrentCol, i]);
 end;
 end;
 StartDrag := True;
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 // Для демонстрационных целей
 with StringGrid1 do
 begin
 Cells[1, 1] := 'T1';
 Cells[1, 2] := 'T2';
 Cells[1, 3] := 'T3';
 Cells[1, 4] := 'T4';
 Cells[2, 1] := 'T5';
 Cells[2, 2] := 'T6';
 Cells[2, 3] := 'T7';
 Cells[2, 4] := 'T8';
 Cells[3, 1] := 'T9';
 Cells[3, 2] := 'T10';
 Cells[3, 3] := 'T11';
 Cells[3, 4] := 'T12';
 Cells[4, 1] := 'T13';
 Cells[4, 2] := 'T14';
 Cells[4, 3] := 'T15';
 Cells[4, 4] := 'T16';
 end;
 StartDrag := True;
end;
procedure TForm1.StringGrid1DragOver(Sender, Source: TObject; X,
 Y: Integer; State: TDragState; var Accept: Boolean);
begin
 // Сохраняем колонку, когда начинается перетаскивание.
 if StartDrag then
 begin
 XMouseCord := X;
 StartDrag := False;
 end;
end;
procedure TForm1.StringGrid1DragDrop(Sender, Source: TObject; X,
 Y: Integer);
begin
 // В данном случае помещаем е? на грид
 StartDrag := True;
end;
Source: http://delphiworld.narod.ru/
ID: 00715
Category:VCL
Category:DragAndDrop
Category:StringGrid
Category:ListBox
Как перетащить целую колонку из Stringgrid в Listbox?

=== Как перетащить целую колонку из Stringgrid в Listbox? ===
После того, как поместите TListBox на форму, необходимо изменить свойство Style в TListBox на lbOwnerDrawFixed. Если не изменить свойство Style, то событие OnDrawItem никогда не вызовется. Теперь поместите следующий код в обработчик события OnDrawItem Вашего TListBox:
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
var
 myColor: TColor;
 myBrush: TBrush; 
begin
 myBrush := TBrush.Create; 
 with (Control as TListBox).Canvas do
 begin
 if not Odd(Index) then
 myColor := clSilver
 else
 myColor := clYellow;
 myBrush.Style := bsSolid; 
 myBrush.Color := myColor; 
 Windows.FillRect(handle, Rect, myBrush.Handle); 
 Brush.Style := bsClear; 
 TextOut(Rect.Left, Rect.Top, 
 (Control as TListBox).Items[Index]); 
 MyBrush.Free;
 end;
end;
Source: Взято из http://forum.sources.ru
ID: 00648
Как перехватить Ctrl-V в компоненте TMemo?

=== Как перехватить Ctrl-V в компоненте TMemo? ===
Следующий пример демонстрирует, как перехватить комбинацию Ctrl-V в компоненте TMemo и поместить в него свой текст вместо того, который в буфере обмена.
Пример:
uses ClipBrd;
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if ((Key = ord('V')) and (ssCtrl in Shift)) then begin
 if Clipboard.HasFormat(CF_TEXT) then
 ClipBoard.Clear;
 Memo1.SelText := 'Delphi is RAD!';
 key := 0;
 end;
end;
Source: Взято из http://forum.sources.ru
ID: 00551
Как перехватить клавишу табуляции (Tab) в TEdit?

=== Как перехватить клавишу табуляции (Tab) в TEdit? ===
Это можно довольно легко сделать переопределив на форме процедуру CMDialogKey. Чтобы посмотреть как это работает, поместите на форму Edit и введите следующий код:
type
 TForma = class(TForm)
 procedure CMDialogKey(var Msg: TWMKey); message CM_DIALOGKEY;
 end;
implementation
procedure TForma.CMDialogKey(var Msg: TWMKEY);
begin
 if (ActiveControl is TEdit) and (Msg.Charcode = VK_TAB) then
 begin
 ShowMessage('Нажата клавиша TAB?');
 end;
 inherited;
end;
Source: Взято из http://forum.sources.ru
ID: 00536
Как перехватить нажатие TAB?

=== Как перехватить нажатие TAB? ===
private
 procedure CMDialogKey(Var Msg: TWMKey); message CM_DIALOGKEY;
procedure TForm1.CMDialogKey(var Msg: TWMKey);
begin
 // здесь Ваш код
 Msg.Result := 0
end;
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01477
----
На уровне формы клавиша tab обычно обрабатывается Windows. В примере создается обработчик события CM_Dialog для перехвата Dialog keys 
type
 TForm1 = class(TForm)
 private
 procedure CMDialogKey(var msg: TCMDialogKey); message CM_DIALOGKEY;
end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
begin
 if msg.Charcode <> VK_TAB then
 inherited;
end;
procedure TForm1.FormKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
 if Key = VK_TAB then
 Form1.Caption := 'Tab Key Down!';
end;
Source: http://delphiworld.narod.ru/
ID: 01478
----
Единственное место в программе, где можно перехватить нажатие клавиши tab - в обработчике Application.OnMessages. Пример ниже:
unit Hndltabu;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes,
 Graphics, Controls, Forms, Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Edit1: TEdit;
 Edit2: TEdit;
 Label1: TLabel;
 procedure FormCreate(Sender: TObject);
 private { Private-Deklarationen }
 procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
 public { Public-Deklarationen }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
const
 shiftPressed: boolean = false;
begin
 if Msg.Message = WM_KEYDOWN then
 if not shiftPressed and (Msg.wParam = VK_SHIFT) then
 begin
 shiftPressed := true;
 Exit;
 end
 else
 begin
 if Msg.wParam = VK_TAB then
 if ActiveControl = Edit1 then
 begin
 if shiftPressed then
 Label1.Caption := 'BACKTAB!'
 else
 Label1.Caption := 'TAB!';
 Handled := true
 end
 else
 Label1.Caption := ;
 shiftPressed := false;
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnMessage := AppMessage;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 01479
Как перехватить нажатия функциональных клавиш и стрелок?

=== Как перехватить нажатия функциональных клавиш и стрелок? ===
Проверяйте значение переменной key на равенство VK_RIGHT, VK_LEFT, VK_F1 и т.д. на событии KeyDown формы
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if Key = VK_RIGHT then
 Form1.Caption := 'Right';
 if Key = VK_F1 then
 Form1.Caption := 'F1';
end;
Source: Взято из http://forum.sources.ru
ID: 01516
----
Обработка нажатий клавиш вверх-вниз 
Почти всегда требуется обработка нажатий клавиш "вверх-вниз" для смены фокуса ввода - мои "тетки-юзеры" боются мышей, да и сам я не любитель комбинаций мышь-клавиатура.
procedure TfmAbProps.edNameKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if (Key = vk_down) and not (ssAlt in Shift) then
 begin
 {// здесь обработка для "выпадающих" окошек типа TRxDBCalcEdit }
 Key := 0;
 SelectNext(Sender as TWinControl, true, true);
 end
 else if Key = vk_up then
 begin
 Key := 0;
 SelectNext(Sender as TWinControl, false, true);
 end;
end;
Для элементов редактирования типа TDbEdit, TRxDBCalcEdit or TDBDateEdit назначим
OnKeyDown := edNameKeyDown 
Сложнее с типами вроде TRxDBLookupCombo. Наш прежний обработчик для них не подходит. Я пытался изменить характер TRxDBLookupCombo - но вовремя опомнился - есть же FormKeyDown;
procedure TfmAbProps.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if (ActiveControl is TRxDBLookupCombo) then
 begin
 if Key = vk_down then
 begin
 // здесь нельзя обработать нажатие при вызове "выпадающего"
 if not (ssAlt in Shift)
 and not (ActiveControl as TRxDBLookupCombo).IsDropDown then
 begin // и в случае уже "выпавшего"
 Key := 0;
 selectnext(ActiveControl, true, true);
 end;
 end
 else if Key = vk_up then
 begin
 if not (ActiveControl as TRxDBLookupCombo).IsDropDown then
 begin
 Key := 0;
 selectnext(ActiveControl, false, true);
 end;
 end;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01517
----
 procedure WMGetDlgCode(var Msg: TMessage); message WM_GETDLGCODE;
implementation
procedure TMyControl.WMGetDlgCode(var Msg : TMessage);
begin
 Msg.Result := DLGC_WANTARROWS;
end;
Author: Cheers, Julian (TeamB & TurboPower Software)
Source: http://delphiworld.narod.ru/
ID: 01518
----
Вы можете перехватывать нажатие курсорных клавиш на уровне приложения: 
Создайте HandleMessages как метод формы и затем назначьте его Application.HandleMessages.
procedure tForm1.HandleMessages(var Msg: tMsg; var Handled: Boolean);
begin
 if (Msg.Message = WM_KeyDown)
 and (Msg.wParam in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT]) then
 begin
 case Msg.wParam of
 VK_UP: ShowMessage('Нажата стрелка вверх');
 VK_DOWN: ShowMessage('Нажата стрелка вниз');
 VK_LEFT: ShowMessage('Нажата стрелка влево');
 VK_RIGHT: ShowMessage('Нажата стрелка вправо');
 end;
 Handled := True;
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnMessage := HandleMessages;
end;
Source: http://delphiworld.narod.ru/
ID: 01519
Как перехватить события в неклиентской области формы, в заголовке окна, например?

=== Как перехватить события в неклиентской области формы, в заголовке окна, например? ===
Создайте обработчик одного из сообщений WM_NC (non client - не клиентских) (посмотрите WM_NC в Windows API help). Пример показывает как перехватить движение мыши во всей неклиенстской области окна (рамка и заголовок).
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 private
 { Private declarations }
 procedure WMNCMOUSEMOVE(var Message: TMessage); message WM_NCMOUSEMOVE;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);
var
 s: string;
begin
 case Message.wParam of
 HTERROR: s := 'HTERROR';
 HTTRANSPARENT:s := 'HTTRANSPARENT';
 HTNOWHERE: s := 'HTNOWHERE';
 HTCLIENT: s := 'HTCLIENT';
 HTCAPTION: s := 'HTCAPTION';
 HTSYSMENU: s := 'HTSYSMENU';
 HTSIZE: s := 'HTSIZE';
 HTMENU: s := 'HTMENU';
 HTHSCROLL: s := 'HTHSCROLL';
 HTVSCROLL: s := 'HTVSCROLL';
 HTMINBUTTON: s := 'HTMINBUTTON';
 HTMAXBUTTON: s := 'HTMAXBUTTON';
 HTLEFT: s := 'HTLEFT';
 HTRIGHT: s := 'HTRIGHT';
 HTTOP: s := 'HTTOP';
 HTTOPLEFT: s := 'HTTOPLEFT';
 HTTOPRIGHT: s := 'HTTOPRIGHT';
 HTBOTTOM: s := 'HTBOTTOM';
 HTBOTTOMLEFT: s := 'HTBOTTOMLEFT';
 HTBOTTOMRIGHT:s := 'HTBOTTOMRIGHT';
 HTBORDER: s := 'HTBORDER';
 HTOBJECT: s := 'HTOBJECT';
 HTCLOSE: s := 'HTCLOSE';
 HTHELP: s := 'HTHELP';
 else s := ;
 end;
 Form1.Caption := s;
 Message.Result := 0;
end;
end.
ID: 02315
Как перехватить события в неклиентской области формы?

=== Как перехватить события в неклиентской области формы? ===
Создайте обработчик одного из сообщений WM_NC (non client - не клиентских) (посмотрите
WM_NC в Windows API help). Пример показывает как перехватить движение мыши во всей
неклиенстской области окна (рамка и заголовок).
Пример:
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 private
 { Private declarations }
 procedure WMNCMOUSEMOVE(var Message: TMessage); message WM_NCMOUSEMOVE;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);
var
 s: string;
begin
 case Message.wParam of
 HTERROR: s := 'HTERROR';
 HTTRANSPARENT: s := 'HTTRANSPARENT';
 HTNOWHERE: s := 'HTNOWHERE';
 HTCLIENT: s := 'HTCLIENT';
 HTCAPTION: s := 'HTCAPTION';
 HTSYSMENU: s := 'HTSYSMENU';
 HTSIZE: s := 'HTSIZE';
 HTMENU: s := 'HTMENU';
 HTHSCROLL: s := 'HTHSCROLL';
 HTVSCROLL: s := 'HTVSCROLL';
 HTMINBUTTON: s := 'HTMINBUTTON';
 HTMAXBUTTON: s := 'HTMAXBUTTON';
 HTLEFT: s := 'HTLEFT';
 HTRIGHT: s := 'HTRIGHT';
 HTTOP: s := 'HTTOP';
 HTTOPLEFT: s := 'HTTOPLEFT';
 HTTOPRIGHT: s := 'HTTOPRIGHT';
 HTBOTTOM: s := 'HTBOTTOM';
 HTBOTTOMLEFT: s := 'HTBOTTOMLEFT';
 HTBOTTOMRIGHT: s := 'HTBOTTOMRIGHT';
 HTBORDER: s := 'HTBORDER';
 HTOBJECT: s := 'HTOBJECT';
 HTCLOSE: s := 'HTCLOSE';
 HTHELP: s := 'HTHELP';
 else 
 s := ;
 end;
 Form1.Caption := s;
 Message.Result := 0;
end;
end.
 DELPHI VCL FAQ Перевод с английского
 Подборку, перевод и адаптацию материала подготовил Aziz(JINX)
 специально для Королевства Дельфи
Source: Взято из 
ID: 00479
Как перехватить сообщение об ошибке?

=== Как перехватить сообщение об ошибке? ===
{©Drkb v.3(2007): www.drkb.ru, 
 ®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}
Try
 {здесь вы пишите код в котором может произойти ошибка}
Except
 on e: Exception do ShowMessage(e.message);
End
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: http://forum.vingrad.ru
ID: 00024
Как перехватить сообщения скроллирования в TScrollBox?

=== Как перехватить сообщения скроллирования в TScrollBox? ===
Следующий пример перехватывает сообщения скроллирования в компоненте TScrollBox, тем самым синхронизируя два скролбара. Если один из скролбаров изменяет своё положение, то значение второго скролбара изменяется на такую же величину. Сообщения скролирования перехватываются путём сабклассинга оконной процедуры (WinProc) у скролбара.
Пример:
type
{$IFDEF WIN32}
 WParameter = LongInt;
{$ELSE}
 WParameter = Word;
{$ENDIF}
 LParameter = LongInt;
{Объявляем переменную для хранения подменённой оконной процедуры}
var
 OldWindowProc: Pointer;
function NewWindowProc(WindowHandle : hWnd;
 TheMessage : WParameter;
 ParamW : WParameter;
 ParamL : LParameter): LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
var
 TheRangeMin: integer;
 TheRangeMax: integer;
 TheRange: integer;
begin
 if TheMessage = WM_VSCROLL then
 begin
 { Получаем минимальное и максимальное значения scroll box }
 GetScrollRange(WindowHandle, SB_HORZ, TheRangeMin, TheRangeMax);
 { Получаем вертикальную позицию scroll box }
 TheRange := GetScrollPos(WindowHandle, SB_VERT);
 { Проверим, чтобы не выйти за диапазон }
 if TheRange < TheRangeMin then
 TheRange := TheRangeMin
 else
 if TheRange > TheRangeMax then
 TheRange := TheRangeMax;
 { Устанавливаем горизонтальный scroll bar }
 SetScrollPos(WindowHandle, SB_HORZ, TheRange, True);
 end;
 if TheMessage = WM_HSCROLL then
 begin
 { Получаем мин. и макс. диапазон горизонтального scroll box }
 GetScrollRange(WindowHandle, SB_VERT, TheRangeMin, TheRangeMax);
 { Получаем позицию горизонтального scroll box }
 TheRange := GetScrollPos(WindowHandle, SB_HORZ);
 { Проверим, чтобы не выйти за диапазон }
 if TheRange < TheRangeMin then
 TheRange := TheRangeMin
 else
 if TheRange > TheRangeMax then
 TheRange := TheRangeMax;
 { Устанавливаем вертикальный scroll bar }
 SetScrollPos(WindowHandle, SB_VERT, TheRange, True);
 end;
 { Вызываем старую оконную процедуру }
 { чтобы обработались сообщения. }
 NewWindowProc := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 { Устанавливаем новую оконную процедуру для контрола }
 { и запоминаем старую оконную процедуру. }
 OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc)));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 { Возвращаем обратно старую оконную процедуру. }
 SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end;
Source: Взято из http://forum.sources.ru
ID: 01226
Как перехватывать kernel-signals?

program TestSignals;
{$APPTYPE CONSOLE}
uses
 Libc;
var
 bTerminate: Boolean;
procedure SignalProc(SigNum: Integer); cdecl;
begin
 case SigNum of
 SIGQUIT:
 begin
 WriteLn('signal SIGQUIT');
 bTerminate := true;
 end;
 SIGUSR1: WriteLn('signal SIGUSR1');
 else
 WriteLn('not handled signal');
 end;
 signal(SigNum, SignalProc); // catch the signal again
end;
begin
 bTerminate := false;
 signal(SIGQUIT, SignalProc); // catch the signal SIGQUIT to procedure SignalProc
 signal(SIGUSR1, SignalProc); // catch the signal SIGUSR1 to procedure SignalProc
 repeat
 sleep(1);
 until bTerminate;
end.
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04591
Category:Kylix
Category:Linux
Как перехватывать горячие клавиши в StringGrid?

=== Как перехватывать горячие клавиши в StringGrid? ===
Следующий пример демонстрирует перехват сообщения CM_DIALOGCHAR на уровне формы. Это даст нам возможность реагировать на диалоговые комбинации клавиш только, если нажата клавиша Alt, не давая тем самым отработать стандартному обработчику.
type
 TForm1 = class(TForm)
 Button1: TButton;
 StringGrid1: TStringGrid;
 procedure FormCreate(Sender: TObject);
 procedure Button1Click(Sender: TObject);
 procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
 private
 { Private declarations }
 procedure CMDialogChar(var Message: TCMDialogChar);
 message CM_DIALOGCHAR;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
 Button1.Caption := 'E&xit';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Application.Terminate;
end;
procedure TForm1.StringGrid1KeyDown(Sender: TObject; 
var Key: Word; Shift: TShiftState);
begin
 ShowMessage('Grid keypress = ' + Char(Key));
 Key := 0;
end;
procedure TForm1.CMDialogChar(var Message: TCMDialogChar);
begin
 if ssAlt in KeyDataToShiftState(Message.KeyData) then
 inherited;
end;
Source: Взято из http://forum.sources.ru
ID: 00608