Results 1 to 7 of 7

Thread: Synchron scrollen tussen Memo1 en Memo2

  1. #1

    Synchron scrollen tussen Memo1 en Memo2

    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.

  2. #2
    Doet het wel iets in Lazarus, of gebeurt er helemaal niets?
    1+1=b

  3. #3
    Fornicatorus Formicidae VideoRipper's Avatar
    Join Date
    Mar 2005
    Location
    Vicus Saltus Orientalem
    Posts
    5,372
    Voor zover ik nu zo zie (en denk, dus ik kan er naast zitten), vang je nu de WM_VSCROLL-berichten af die
    naar de TMyForm worden gestuurd: dat is niet dezelfde messagequeue als die van de memo die op deze
    TMyForm staat.
    Last edited by VideoRipper; 10-May-19 at 18:01.
    TMemoryLeak.Create(Nil);

  4. #4
    Volgens mij moet je in Lazarus de WndCallback zelf nog instellen als je message < WM_USER wilt hebben.

    Lazarus krijgt die niet automatisch zoals in Delphi.

    Zie de uitleg en voorbeeld in de wiki:
    http://wiki.lazarus.freepascal.org/W...in_your_window

  5. #5
    Hallo

    Het probleem zit is de regel : OnScroll := DoScroll;
    Lazarus geeft een fout melding dat DoScroll niet aanwezig is

    Ondertussen heb ik een andere oplossing gevonden welke hier onder staat.

    Iedereen bedankt voor het meedenken.

    H.G. Frans


    Code:
    unit Unit1;
    
    {$mode objfpc}{$H+}
    
    interface
    
    uses
      Classes, SysUtils, Forms, Controls, Dialogs, StdCtrls, SynEdit,
      Types, SynEditKeyCmds, LCLType;
    
    type
    
      { TForm1 }
    
      TForm1 = class(TForm)
        ScrollBar1: TScrollBar;
        ScrollBar2: TScrollBar;
        SynEdit1: TSynEdit;
        SynEdit2: TSynEdit;
        procedure FormCreate(Sender: TObject);
        procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
          var ScrollPos: integer);
        procedure ScrollBar2Scroll(Sender: TObject; ScrollCode: TScrollCode;
          var ScrollPos: integer);
        procedure SynEdit1KeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
        procedure SynEdit1KeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
        procedure SynEdit1MouseWheel(Sender: TObject; Shift: TShiftState;
          WheelDelta: integer; MousePos: TPoint; var Handled: boolean);
      private
    
      public
    
      end;
    
    var
      Form1: TForm1;
      LijnLen: integer;
      Y_Pos: integer;
    
    implementation
    
    {$R *.lfm}
    
    { TForm1 }
    
    procedure TForm1.FormCreate(Sender: TObject);
    var
      I: integer;
      HStr: string;
      LijnLen_Temp, Code: integer;
    begin
      LijnLen := 0;
      for I := 0 to SynEdit1.Lines.Count - 1 do
      begin
        HStr := SynEdit1.Lines.Strings[I];
        LijnLen_Temp := Length(HStr);
        if LijnLen_Temp > LijnLen then
          LijnLen := LijnLen_Temp;
      end;
      Y_Pos := 0;
    end;
    
    procedure TForm1.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: integer);
    begin
      ScrollBar1.Max := SynEdit1.Lines.Count - 1;
      SynEdit1.CaretY := ScrollPos;
      SynEdit2.CaretY := ScrollPos;
      ScrollBar1.Position := ScrollPos;
      Y_Pos := ScrollPos;
    end;
    
    procedure TForm1.SynEdit1KeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    begin
      if Key = 40 then
        Inc(Y_Pos, 2)
      else
        Dec(Y_Pos, 2);
      SynEdit1.CaretY := Y_Pos;
      SynEdit2.CaretY := Y_Pos;
      ScrollBar1.Position := Y_Pos;
    end;
    
    procedure TForm1.SynEdit1KeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
    begin
      if Key = 40 then
        Inc(Y_Pos, 2)
      else
        Dec(Y_Pos, 2);
      SynEdit1.CaretY := Y_Pos;
      SynEdit2.CaretY := Y_Pos;
      ScrollBar1.Position := Y_Pos;
    end;
    
    procedure TForm1.SynEdit1MouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: integer; MousePos: TPoint; var Handled: boolean);
    // Mouse wheel geblokkeerd
    begin
      Handled := True;
    end;
    
    // =============================================================================
    
    procedure TForm1.ScrollBar2Scroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: integer);
    // Scrollen in de X-richting
    begin
      ScrollBar2.Max := LijnLen + 2;
      SynEdit1.CaretX := ScrollPos;
      SynEdit2.CaretX := ScrollPos;
    end;
    
    end.

  6. #6
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    9,904
    Als je compatibiliteit met Delphi wil, moet je {$mode delphi} gebruiken, en niet {$mode objfpc}, dat is een FPC specifieke mode.

  7. #7
    John Kuiper
    Join Date
    Apr 2007
    Location
    Almere
    Posts
    8,492
    Voor lazarus:
    Delphi Code:
    1. OnScroll := @DoScroll
    Delphi is great. Lazarus is more powerfull

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •