1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
| unit UREMarkLineMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm13 = class(TForm)
RichEdit1: TRichEdit;
procedure FormCreate(Sender: TObject);
procedure RichEdit1KeyPress(Sender: TObject; var Key: Char);
procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
FOldProc: TWndMethod;
FOffsetX, FOffsetY: Integer;
FredtMaxLine: Integer;
procedure NewWinProc(var Mag: TMessage);
procedure ItitialiseMarge;
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form13 : TForm13;
implementation
{$R *.dfm}
procedure TForm13.FormCreate(Sender: TObject);
var
R : TRect;
begin
R := RichEdit1.ClientRect;
inc(R.Left, 10); // largeur de la marge
RichEdit1.Perform(EM_SETRECT, 0, Longint(@R));
FOldProc := RichEdit1.WindowProc;
RichEdit1.WindowProc := NewWinProc;
FredtMaxLine := 15; // La marque à 15 lignes
ItitialiseMarge;
RichEdit1.Lines.Clear;
end;
procedure TForm13.NewWinProc(var Mag: TMessage);
var
Line, OffsetY: integer;
R : TRect;
Pt : TPoint;
begin
FOldProc(Mag);
if (Mag.Msg <> WM_PAINT)
or (Richedit1.Perform(EM_GETRECT, 0, integer(@R)) <> 0) then
Exit;
// Index de la 1ère ligne visible
Line := Richedit1.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
// récupère le décalage due au scroll
RichEdit1.Perform(EM_POSFROMCHAR, integer(@Pt), RichEdit1.Perform(EM_LINEINDEX, Line, 0));
with TCanvas.Create do
try
Handle := Getdc(RichEdit1.Handle);
Brush.Color := clSilver;
Brush.Style := bsSolid;
FillRect(Rect(0, 0, R.Left - 1, R.Bottom));
Brush.Color := clRed;
OffsetY := FOffsetY * (Pred(FredtMaxLine) - Line) + Pt.Y;
Rectangle(Rect(0, OffsetY, FOffsetX - 2, OffsetY - RichEdit1.Font.Height));
finally
Free;
end;
end;
procedure TForm13.ItitialiseMarge;
var
Pt0, Pt1 : TPoint;
begin
// il nous faut deux lignes au moins
while RichEdit1.Lines.Count < 2 do
RichEdit1.Lines.Add('');
RichEdit1.Perform(EM_POSFROMCHAR, integer(@Pt0), RichEdit1.Perform(EM_LINEINDEX, 0, 0));
RichEdit1.Perform(EM_POSFROMCHAR, integer(@Pt1), RichEdit1.Perform(EM_LINEINDEX, 1, 0));
FOffsetX := Pt1.X;
FOffsetY := Pt1.Y - Pt0.Y;
end;
procedure TForm13.RichEdit1KeyPress(Sender: TObject; var Key: Char);
begin
// ici on limite le nombre de ligne
if (Key = #13) and (RichEdit1.Lines.Count >= FredtMaxLine - 1) then
Key := #0;
end;
procedure TForm13.RichEdit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = 13) and (RichEdit1.Lines.Count >= FredtMaxLine - 1) then
Key := VK_DOWN;
end;
end. |
Partager