Hallo allemaal,
Onderstaande code werkt wel in Delphi 7 maar niet in Lazarus 2.0.2.
Is er een oplossing voor?
H.G. Frans Dubbeld
Code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TScrollEvent = procedure(Sender: TObject; Message: TMessage) of Object;
TMyMemo = Class(TMemo)
private
FOnScroll: TScrollEvent;
protected
procedure WndProc(var Message: TMessage); override;
public
Property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
end;
{ TForm1 }
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
Procedure DoScroll(Sender: TObject; Message: TMessage);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var M: TMyMemo;
i: integer;
begin
M := TMyMemo.Create(Application);
With M do
begin
Parent := Panel2;
Align := alClient;
ScrollBars := ssBoth;//Vertical;
Memo1.Lines.Clear;
M.Lines.Clear;
For i := 1 to 100 do
begin
Lines.Add('Origineel'+Inttostr(i));
Memo1.Lines.Add('Gekoppeld aan '+IntTOStr(i));
end;
OnScroll := DoScroll;
end;
end;
{ TMyMemo }
procedure TMyMemo.WndProc(var Message: TMessage);
begin
inherited;
if Message.Msg = WM_VSCROLL then
if Assigned(FOnScroll) then FOnScroll(Self,Message);
end;
procedure TForm1.DoScroll(Sender: TObject; Message: TMessage);
begin
Sendmessage(Memo1.Handle,WM_VSCROLL,Message.WParam,Message.LParam);
end;
end.
Bookmarks