urif
asked on
add a gutter to a richedit
I know there are lots of custom richedit components out there, but most of them are shareware, with nag screen and anyway i need to add the gutter to an already customized richedit.
so, the question is, is there a way to add a gutter to a richedit?
if yes, any example code or link that i can follow?
thanks
so, the question is, is there a way to add a gutter to a richedit?
if yes, any example code or link that i can follow?
thanks
I know that you need to add it by code, but there's an already coded free cmp that have this feauture. Look at Synedit http://synedit.sourceforge.net/download.php...you could read the code to learn how to add it to a ritchedit
ASKER
thanks i tried that option, i even tried using synedit, but the code is a bit complex in some files that it gave me a headache, more than help.
it's a great component in itself, but to change it or extract part of its code, well, that';s another story. to make it short, tried it, didn't work.
thanks anyway
it's a great component in itself, but to change it or extract part of its code, well, that';s another story. to make it short, tried it, didn't work.
thanks anyway
Try this. It's for a tCustomMemo, but I believe RichEdit stems from that...
procedure SetMemoMargins(aMemo:tCust omMemo; aLeft,aRight:word);
begin
if Assigned(aMemo) then
SendMessage(aMemo.Handle,E M_SETMARGI NS,EC_LEFT MARGIN or EC_RIGHTMARGIN,MakeLong(aL eft,aRight ));
end;
procedure SetMemoMargins(aMemo:tCust
begin
if Assigned(aMemo) then
SendMessage(aMemo.Handle,E
end;
ASKER
it doesn't do anything.
this is the code i have when i create my richedit:
procedure TForm1.SetMemoMargins(aMem o:TCustomR ichEdit; aLeft,aRight:word);
begin
if Assigned(aMemo) then
SendMessage(aMemo.Handle,E M_SETMARGI NS,EC_LEFT MARGIN or EC_RIGHTMARGIN,MakeLong(aL eft,aRight ));
end;
procedure TForm1.FormCreate(Sender: TObject);
var
t : TTabSheet;
r : TRichedit;
begin
DragAcceptFiles(Handle, true);
t := TTabsheet.Create(self);
t.PageControl := PageControl1;
t.parent := PageControl1;
t.Caption:='Untitled1';
r := trichedit.create(self);
r.parent := t;
r.align := alClient;
r.Font.Name:='Courier New';
r.Font.Size:=10;
r.ScrollBars:=ssBoth;
r.PopupMenu:=PopupMenu1;
r.WordWrap:=true;
r.PlainText:=true;
r.OnChange:=REChange;
r.OnKeyUp:=EditorKeyUp;
r.OnKeyPress:=EditorKeyPre ss;
r.OnMouseDown:=EditorMouse Down;
r.HideSelection:=false;
r.WantTabs:=true;
t.show;
ActiveRich:=r;
SetMemoMargins(r,100,100); //<---------------------- now, just playing, but it won't do anything
end;
any ideas?
this is the code i have when i create my richedit:
procedure TForm1.SetMemoMargins(aMem
begin
if Assigned(aMemo) then
SendMessage(aMemo.Handle,E
end;
procedure TForm1.FormCreate(Sender: TObject);
var
t : TTabSheet;
r : TRichedit;
begin
DragAcceptFiles(Handle, true);
t := TTabsheet.Create(self);
t.PageControl := PageControl1;
t.parent := PageControl1;
t.Caption:='Untitled1';
r := trichedit.create(self);
r.parent := t;
r.align := alClient;
r.Font.Name:='Courier New';
r.Font.Size:=10;
r.ScrollBars:=ssBoth;
r.PopupMenu:=PopupMenu1;
r.WordWrap:=true;
r.PlainText:=true;
r.OnChange:=REChange;
r.OnKeyUp:=EditorKeyUp;
r.OnKeyPress:=EditorKeyPre
r.OnMouseDown:=EditorMouse
r.HideSelection:=false;
r.WantTabs:=true;
t.show;
ActiveRich:=r;
SetMemoMargins(r,100,100);
end;
any ideas?
What about this idea?
Here's some code found somewhere and adjusted to have a Gutter Kind....
*** Unit1.pas ***
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
gutter: TRichEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure RichWindowProc(var Message: TMessage);
procedure SyncVScroll;
public
{ Public declarations }
end;
var
Form1: TForm1;
oldRichProc: TWndMethod;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
OldRichProc := RichEdit1.WindowProc;
RichEdit1.WindowProc := RichWindowProc;
// Add the line numbers to the gutter
for i:=0 to RichEdit1.Lines.Count-1 do
gutter.Lines.Add(Format('% d',[i+1])) ;
end;
procedure TForm1.RichWindowProc(var Message: TMessage);
begin
OldRichProc(Message);
case Message.Msg of
WM_VSCROLL:
// For scrolling via the scroll bar
gutter.Dispatch(Message);
WM_MOUSEMOVE:
// For highlighting text
// Only if Left button is down
if ( (GetAsyncKeyState(VK_LBUTT ON) and $8000)<>0 ) then
SyncVScroll;
WM_TIMER:
// For scrolling using the mouse wheel - this uses the TIMER event
SyncVScroll;
WM_KEYDOWN:
// For scrolling using the cursor movement keys
case Message.WParam of
VK_DOWN,VK_UP,
VK_PRIOR,VK_NEXT:
SyncVScroll;
VK_HOME,VK_END:
// Only if CTRL is down
if ( (GetAsyncKeyState(VK_CONTR OL) and $8000)<>0 ) then
SyncVScroll;
end;
end;
end;
procedure TForm1.SyncVScroll;
var
Msg: TWMScroll;
begin
Msg.Msg := WM_VSCROLL;
Msg.Pos := GetScrollPos(RichEdit1.Han dle,SB_VER T);
Msg.ScrollBar := 0;
Msg.ScrollCode := SB_THUMBTRACK;
gutter.Dispatch(Msg);
Msg.ScrollCode := SB_THUMBPOSITION;
gutter.Dispatch(Msg);
Msg.ScrollCode := SB_ENDSCROLL;
gutter.Dispatch(Msg);
end;
end.
*** Unit1.dfm ***
object Form1: TForm1
Left = 192
Top = 107
Width = 231
Height = 259
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object RichEdit1: TRichEdit
Left = 32
Top = 0
Width = 185
Height = 201
Lines.Strings = (
'interface'
''
'uses'
'Windows, Messages, SysUtils, '
'Variants, Classes, Graphics, '
'Controls, Forms,'
'Dialogs, ComCtrls, StdCtrls;'
''
'type'
'TForm1 = class(TForm)'
'RichEdit1: TRichEdit;'
'gutter: TRichEdit;'
'procedure FormCreate(Sender: '
'TObject);'
'private'
'{ Private declarations }'
'procedure RichWindowProc(var '
'Message: TMessage);'
'procedure SyncVScroll;'
'public'
'{ Public declarations }'
'end;'
''
'var'
'Form1: TForm1;'
'oldRichProc: TWndMethod;'
''
'implementation'
''
'{$R *.dfm}'
''
'procedure TForm1.FormCreate'
'(Sender: TObject);'
'var'
'i: integer;'
'begin'
'OldRichProc := '
'RichEdit1.WindowProc;'
'RichEdit1.WindowProc := '
'RichWindowProc;'
''
'// Add the line numbers to the '
'gutter'
'for i:=0 to RichEdit1.Lines.Count-1 '
'do'
'gutter.Lines.Add(Format(' '%d'',[i+1 ]));'
'end;'
''
'procedure '
'TForm1.RichWindowProc(var '
'Message: TMessage);'
'begin'
'OldRichProc(Message);'
''
'case Message.Msg of'
'WM_VSCROLL:'
'// For scrolling via the scroll bar'
'gutter.Dispatch(Message); '
'WM_MOUSEMOVE:'
'// For highlighting text'
'// Only if Left button is down'
'if ( (GetAsyncKeyState'
'(VK_LBUTTON) and $8000)<>0 ) '
'then'
'SyncVScroll;'
'WM_TIMER:'
'// For scrolling using the mouse '
'wheel - this uses the TIMER event'
'SyncVScroll;'
'WM_KEYDOWN:'
'// For scrolling using the cursor '
'movement keys'
'case Message.WParam of'
'VK_DOWN,VK_UP,'
'VK_PRIOR,VK_NEXT:'
'SyncVScroll;'
'VK_HOME,VK_END:'
'// Only if CTRL is down'
'if ( (GetAsyncKeyState'
'(VK_CONTROL) and $8000)<>0 ) '
'then'
'SyncVScroll;'
'end;'
'end;'
'end;'
''
'procedure TForm1.SyncVScroll;'
'var'
'Msg: TWMScroll;'
'begin'
'Msg.Msg := WM_VSCROLL;'
'Msg.Pos := GetScrollPos'
'(RichEdit1.Handle,SB_VERT );'
'Msg.ScrollBar := 0;'
'Msg.ScrollCode := '
'SB_THUMBTRACK;'
'gutter.Dispatch(Msg);'
'Msg.ScrollCode := '
'SB_THUMBPOSITION;'
'gutter.Dispatch(Msg);'
'Msg.ScrollCode := '
'SB_ENDSCROLL;'
'gutter.Dispatch(Msg);'
'end;'
''
'end.')
ScrollBars = ssVertical
TabOrder = 0
end
object gutter: TRichEdit
Left = 0
Top = 0
Width = 33
Height = 201
BevelOuter = bvRaised
BevelKind = bkSoft
Color = clBtnFace
TabOrder = 1
end
end
F68 ;-)
Here's some code found somewhere and adjusted to have a Gutter Kind....
*** Unit1.pas ***
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
gutter: TRichEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure RichWindowProc(var Message: TMessage);
procedure SyncVScroll;
public
{ Public declarations }
end;
var
Form1: TForm1;
oldRichProc: TWndMethod;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
OldRichProc := RichEdit1.WindowProc;
RichEdit1.WindowProc := RichWindowProc;
// Add the line numbers to the gutter
for i:=0 to RichEdit1.Lines.Count-1 do
gutter.Lines.Add(Format('%
end;
procedure TForm1.RichWindowProc(var Message: TMessage);
begin
OldRichProc(Message);
case Message.Msg of
WM_VSCROLL:
// For scrolling via the scroll bar
gutter.Dispatch(Message);
WM_MOUSEMOVE:
// For highlighting text
// Only if Left button is down
if ( (GetAsyncKeyState(VK_LBUTT
SyncVScroll;
WM_TIMER:
// For scrolling using the mouse wheel - this uses the TIMER event
SyncVScroll;
WM_KEYDOWN:
// For scrolling using the cursor movement keys
case Message.WParam of
VK_DOWN,VK_UP,
VK_PRIOR,VK_NEXT:
SyncVScroll;
VK_HOME,VK_END:
// Only if CTRL is down
if ( (GetAsyncKeyState(VK_CONTR
SyncVScroll;
end;
end;
end;
procedure TForm1.SyncVScroll;
var
Msg: TWMScroll;
begin
Msg.Msg := WM_VSCROLL;
Msg.Pos := GetScrollPos(RichEdit1.Han
Msg.ScrollBar := 0;
Msg.ScrollCode := SB_THUMBTRACK;
gutter.Dispatch(Msg);
Msg.ScrollCode := SB_THUMBPOSITION;
gutter.Dispatch(Msg);
Msg.ScrollCode := SB_ENDSCROLL;
gutter.Dispatch(Msg);
end;
end.
*** Unit1.dfm ***
object Form1: TForm1
Left = 192
Top = 107
Width = 231
Height = 259
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object RichEdit1: TRichEdit
Left = 32
Top = 0
Width = 185
Height = 201
Lines.Strings = (
'interface'
''
'uses'
'Windows, Messages, SysUtils, '
'Variants, Classes, Graphics, '
'Controls, Forms,'
'Dialogs, ComCtrls, StdCtrls;'
''
'type'
'TForm1 = class(TForm)'
'RichEdit1: TRichEdit;'
'gutter: TRichEdit;'
'procedure FormCreate(Sender: '
'TObject);'
'private'
'{ Private declarations }'
'procedure RichWindowProc(var '
'Message: TMessage);'
'procedure SyncVScroll;'
'public'
'{ Public declarations }'
'end;'
''
'var'
'Form1: TForm1;'
'oldRichProc: TWndMethod;'
''
'implementation'
''
'{$R *.dfm}'
''
'procedure TForm1.FormCreate'
'(Sender: TObject);'
'var'
'i: integer;'
'begin'
'OldRichProc := '
'RichEdit1.WindowProc;'
'RichEdit1.WindowProc := '
'RichWindowProc;'
''
'// Add the line numbers to the '
'gutter'
'for i:=0 to RichEdit1.Lines.Count-1 '
'do'
'gutter.Lines.Add(Format('
'end;'
''
'procedure '
'TForm1.RichWindowProc(var
'Message: TMessage);'
'begin'
'OldRichProc(Message);'
''
'case Message.Msg of'
'WM_VSCROLL:'
'// For scrolling via the scroll bar'
'gutter.Dispatch(Message);
'WM_MOUSEMOVE:'
'// For highlighting text'
'// Only if Left button is down'
'if ( (GetAsyncKeyState'
'(VK_LBUTTON) and $8000)<>0 ) '
'then'
'SyncVScroll;'
'WM_TIMER:'
'// For scrolling using the mouse '
'wheel - this uses the TIMER event'
'SyncVScroll;'
'WM_KEYDOWN:'
'// For scrolling using the cursor '
'movement keys'
'case Message.WParam of'
'VK_DOWN,VK_UP,'
'VK_PRIOR,VK_NEXT:'
'SyncVScroll;'
'VK_HOME,VK_END:'
'// Only if CTRL is down'
'if ( (GetAsyncKeyState'
'(VK_CONTROL) and $8000)<>0 ) '
'then'
'SyncVScroll;'
'end;'
'end;'
'end;'
''
'procedure TForm1.SyncVScroll;'
'var'
'Msg: TWMScroll;'
'begin'
'Msg.Msg := WM_VSCROLL;'
'Msg.Pos := GetScrollPos'
'(RichEdit1.Handle,SB_VERT
'Msg.ScrollBar := 0;'
'Msg.ScrollCode := '
'SB_THUMBTRACK;'
'gutter.Dispatch(Msg);'
'Msg.ScrollCode := '
'SB_THUMBPOSITION;'
'gutter.Dispatch(Msg);'
'Msg.ScrollCode := '
'SB_ENDSCROLL;'
'gutter.Dispatch(Msg);'
'end;'
''
'end.')
ScrollBars = ssVertical
TabOrder = 0
end
object gutter: TRichEdit
Left = 0
Top = 0
Width = 33
Height = 201
BevelOuter = bvRaised
BevelKind = bkSoft
Color = clBtnFace
TabOrder = 1
end
end
F68 ;-)
Try this one, seems to work for a richedit ...
procedure SetMemoMargins(aMemo:tCust omMemo; aLeft,aRight:word);
var
R:TRect;
begin
if Assigned(aMemo) then begin
SendMessage(aMemo.Handle,E M_GetRect, 0,longint( @R));
R.Left:=R.Left+aLeft;
R.Right:=R.RIght-aRight;
SendMessage(aMemo.Handle,E M_SetRect, 0,longint( @R));
end;
end;
procedure SetMemoMargins(aMemo:tCust
var
R:TRect;
begin
if Assigned(aMemo) then begin
SendMessage(aMemo.Handle,E
R.Left:=R.Left+aLeft;
R.Right:=R.RIght-aRight;
SendMessage(aMemo.Handle,E
end;
end;
ASKER
Ferruccio68:
ok, what it does is to add another richedit to the side? and use it as a gutter?
i tried a solution similar to this but it's a pain in the... to synchonize both things, plus it doesn't look good. there is that line in between the two richedits.... to make it short, tried that before.
the only reason i am asking here is because i tried a lot of possible solutions and so far nothing, i was hopping that someone might give me an answer, thanks so much anyway.
LRHGuy:
i don;t know what richedit are you using, or maybe you are just using a memo. in any case it doesn't work _at all_ with neither delphi 6 nor delphi 7 versions and the richedits that come with them. thanks anyways.
by the way you can download the whole source code from http://www.geocities.com/urifrid/eedit-5.2-src.zip
and tried it yourself. the project is open source so i'll be happy if you want to help
ok, what it does is to add another richedit to the side? and use it as a gutter?
i tried a solution similar to this but it's a pain in the... to synchonize both things, plus it doesn't look good. there is that line in between the two richedits.... to make it short, tried that before.
the only reason i am asking here is because i tried a lot of possible solutions and so far nothing, i was hopping that someone might give me an answer, thanks so much anyway.
LRHGuy:
i don;t know what richedit are you using, or maybe you are just using a memo. in any case it doesn't work _at all_ with neither delphi 6 nor delphi 7 versions and the richedits that come with them. thanks anyways.
by the way you can download the whole source code from http://www.geocities.com/urifrid/eedit-5.2-src.zip
and tried it yourself. the project is open source so i'll be happy if you want to help
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.