title image


Smiley Hier die Komponente
Kopiere den folgenden Code in eine leere Textdatei und speicher diese als "SyncMemo.pas".



Das ist die fertige Komponente "SyncMemo", Du kannst Sie installieren. Es wird dann ein neues Komponenten-Register hinzugefügt, mit dem Namen "SyncMemo" hier findest Du dann auch die Komponente und kannst Sie auf Deine Form ziehen. Benutze für beide Memos diese neue SyncMemo-Komponente. In den Eigenschaften der Komponente (F11) gibt es im Vergleich zu einem normalen Memo jetzt zwei neue Punkte:



1) ScrollControl

Hier kannst Du das andere SyncMemo auswählen, das mitgescrollt

werden soll



2) SyncStyle

Hier kannst Du wählen, welche Scrollbar des unter 1) gewählten

SyncMemos mitgescrollt werden soll



Somit kannst Du festlegen, ob Memo1 Auswirkung auf Memo2 hat, oder umgekehrt oder beides..



Hier also der Code:



unit SyncMemo;



interface



uses

Windows, Messages, Classes, SysUtils, Graphics, Controls, Forms, Dialogs,

StdCtrls;



const

UM_BUDDYHSCROLL = WM_USER + 1111;

UM_BUDDYVSCROLL = WM_USER + 1112;



type



TSyncMemo = class(TMemo)

private

{ Private declarations }

{ Handlers for windows messages }

procedure WMVScroll( Var msg: TMessage );

message WM_VSCROLL;

procedure WMHScroll( Var msg: TMessage );

message WM_HSCROLL;

procedure UMBuddyHScroll( Var msg: TMessage );

message UM_BUDDYHSCROLL;

procedure UMBuddyVScroll( Var msg: TMessage );

message UM_BUDDYVSCROLL;



Procedure SetScrollControl( aScrollControl: TCustomMemo );

protected

{ Protected declarations }

FInBuddyScroll: Boolean;

FBuddy: TCustomMemo;

FSyncStyle: TScrollStyle;

public

{ Public declarations }

published

{ Published declarations }



property SyncStyle: TScrollStyle read FSyncStyle write FSyncStyle;

property ScrollControl: TCustomMemo read FBuddy write SetScrollControl;

end;



procedure Register;



implementation



procedure Register;

begin

RegisterComponents('SyncMemo', [TSyncMemo]);

end;



{ TSyncMemo }



procedure TSyncMemo.UMBuddyHScroll(var msg: TMessage);

begin

FInBuddyScroll:= True;

try

msg.result := Perform( WM_HSCROLL, msg.wparam, msg.lparam );

finally

FInBuddyScroll := False;

end;

end;



procedure TSyncMemo.UMBuddyVScroll(var msg: TMessage);

begin

FInBuddyScroll:= True;

try

msg.result := Perform( WM_VSCROLL, msg.wparam, msg.lparam );

finally

FInBuddyScroll := False;

end;

end;



procedure TSyncMemo.WMHScroll(var msg: TMessage);

begin

If not FInBuddyScroll and

(FSyncStyle In [ssBoth, ssHorizontal]) and

Assigned( FBuddy )

Then Begin

If FBuddy Is TsyncMemo Then

FBuddy.Perform( UM_BUDDYHSCROLL, msg.wparam, msg.lparam )

Else

FBuddy.Perform( WM_HSCROLL, msg.wparam, msg.lparam );

End;

inherited;

end;



procedure TSyncMemo.WMVScroll(var msg: TMessage);

begin

If not FInBuddyScroll and

(FSyncStyle In [ssBoth, ssVertical]) and

Assigned( FBuddy )

Then Begin

If FBuddy Is TsyncMemo Then

FBuddy.Perform( UM_BUDDYVSCROLL, msg.wparam, msg.lparam )

Else

FBuddy.Perform( WM_VSCROLL, msg.wparam, msg.lparam );

End;

inherited;

end;



Procedure TSyncMemo.SetScrollControl( aScrollControl: TCustomMemo );

Begin

If (aScrollControl FBuddy) and (aScrollControl Self) Then

FBuddy := aScrollControl;

End;



end.





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: