Как сделать синхронную прокрутку трех memo. То есть кручу Scrollbars и информация в трех Memo синхронно прокручивается.
1 ответ
Ответ обновлен!
Упрощен код метода Synchronize
; добавлен тип TSyncType
.
Это реализовать весьма несложно. Как мне показалось, наилучшим решением будет создать новый компонент (наследуясь от уже существующего - TMemo
) и немного его улучшить.
Такой подход требует определенных трудозатрат:
- Создание юнита для компонента.
- Создание
*.dcr
-файла для компонента (в нем будет его иконка для палитры компонентов в IDE). - Собственно, инсталляция компонента в IDE.
С другой стороны, Вы получаете на выходе "полуфабрикат", который можно безболезненно модифицировать, распространять и не бояться, что какой-то костыль важный код потеряется по дороге. Тем не менее, в дальнейшем будет приведен только код, касающийся компонента. Создание пакета и его инсталляция - за рамками данного вопроса.
Вся работа базируется на перехвате сообщения WM_HSCROLL/WM_VSCROLL
. Мы узнаём как именно пользователь выполнил прокрутку данных (за ползунок или кнопками управления полосой прокрутки) и вызываем кастомное событие типа TNotifyEvent
. В режиме design-time необходимо выполнить настройку этого события, используя публичную процедуру новоиспеченного компонента Synchronize
для синхронизации прокрутки основного компонента и подчиненных (определяются пользователем).
Впрочем, хватит вступления, перейдем непосредственно к коду.
Объявление класса:
// Тип прокрутки (горизонтальный, вертикальный)
TSyncType = (stHorz, stVert);
TMemoEx = class(TMemo)
private
FOnScrollHorz: TNotifyEvent;
FOnScrollVert: TNotifyEvent;
FCurrentWord: Word;
protected
procedure WMHSCROLL(var Message: TMessage); message WM_HSCROLL;
procedure WMVSCROLL(var Message: TMessage); message WM_VSCROLL;
procedure WMCOMMAND(var Message: TWMCOMMAND); message CN_COMMAND;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
procedure Synchronize(AMemo: TMemo; ASyncType: TSyncType);
published
property OnScrollHorz : TNotifyEvent read FOnScrollHorz write FOnScrollHorz;
property OnScrollVert : TNotifyEvent read FOnScrollVert write FOnScrollVert;
end;
Реализация класса:
procedure TMemoEx.WMHSCROLL(var Message: TMessage);
begin
Inherited;
FCurrentWord := LOWORD(Message.WParam);
if Assigned(FOnScrollHorz) then
FOnScrollHorz(Self);
end;
procedure TMemoEx.WMVSCROLL(var Message: TMessage);
begin
Inherited;
FCurrentWord := LOWORD(Message.WParam);
if Assigned(FOnScrollVert) then
FOnScrollVert(Self);
end;
procedure TMemoEx.CNCOMMAND(var Message: TWMCOMMAND);
begin
Inherited;
if Message.NotifyCode = EN_HSCROLL then
begin
if Assigned(FOnScrollHorz) then
FOnScrollHorz(Self);
end
else
if Message.NotifyCode = EN_VSCROLL then
begin
if Assigned(FOnScrollVert) then
FOnScrollVert(Self);
end;
end;
function TMemoEx.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
begin
Result := Inherited DoMouseWheel(Shift, WheelDelta, MousePos);
if HandleAllocated then
begin
if WheelDelta < 0 then
FCurrentWord := SB_LINEDOWN
else
FCurrentWord := SB_LINEUP;
end;
end;
procedure TMemoEx.KeyDown(var Key: Word; Shift: TShiftState);
begin
Inherited KeyDown(Key, Shift);
if Key = VK_HOME then
FCurrentWord := SB_TOP
else
if Key = VK_END then
FCurrentWord := SB_BOTTOM
else
if (Key = VK_DOWN) or (Key = VK_RIGHT) then
FCurrentWord := SB_LINEDOWN
else
if (Key = VK_UP) or (Key = VK_LEFT) then
FCurrentWord := SB_LINEUP;
end;
procedure TMemoEx.Synchronize(AMemo: TMemo; ASyncType: TSyncType);
var
ScrollInfo: TScrollInfo;
LongWParam: DWord;
Msg: DWord;
Bar: Integer;
begin
if FCurrentWord = SB_ENDSCROLL then
Exit;
if HandleAllocated and Assigned(AMemo) and AMemo.HandleAllocated then
begin
if ASyncType = stHorz then
begin
Msg := WM_HSCROLL;
Bar := SB_HORZ;
end
else
begin
Msg := WM_VSCROLL;
Bar := SB_VERT;
end;
if (FCurrentWord = SB_THUMBPOSITION) or (FCurrentWord = SB_THUMBTRACK) then
begin
ScrollInfo.cbSize := SizeOf(ScrollInfo);
ScrollInfo.fMask := SIF_ALL;
GetScrollInfo(Handle, Bar, ScrollInfo);
LongWParam := MakeWParam(FCurrentWord, ScrollInfo.nPos);
end
else
LongWParam := MakeWParam(FCurrentWord, 0);
SendMessage(AMemo.Handle, Msg, LongWParam, 0);
end;
end;
Полезная информация:
scrollTo
что ли?