pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

richview: internal restructure to easily do descendant components (for example rtfview needs this), version upgrade 0.5.2.3->0.5.3

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@74 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jesusr
2007-02-21 18:06:02 +00:00
parent 99f838537c
commit 88a1c9d090
6 changed files with 164 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/richview/demo/rvdemo.lpi
View File

@ -11,7 +11,7 @@
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/> <IconPath Value="./"/>
<TargetFileExt Value=".exe"/> <TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="2"/> <ActiveEditorIndexAtStart Value="0"/>
</General> </General>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
@ -45,8 +45,8 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ResourceFilename Value="unit1.lrs"/> <ResourceFilename Value="unit1.lrs"/>
<UnitName Value="Unit1"/> <UnitName Value="Unit1"/>
<CursorPos X="46" Y="20"/> <CursorPos X="48" Y="68"/>
<TopLine Value="1"/> <TopLine Value="37"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="24"/> <UsageCount Value="24"/>
<Loaded Value="True"/> <Loaded Value="True"/>

2
components/richview/demo/unit1.lrs
View File

@ -1,5 +1,3 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[ LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#4'Left'#2'~'#6'Height'#3','#1#3'Top'#2'{'#5'Width'#3 'TPF0'#6'TForm1'#5'Form1'#4'Left'#2'~'#6'Height'#3','#1#3'Top'#2'{'#5'Width'#3
+#179#1#18'HorzScrollBar.Page'#3#178#1#23'VertScrollBar.Increment'#2#12#18'Ve' +#179#1#18'HorzScrollBar.Page'#3#178#1#23'VertScrollBar.Increment'#2#12#18'Ve'

2
components/richview/lazrichview.lpk
View File

@ -16,7 +16,7 @@
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
<Version Minor="5" Release="2" Build="3"/> <Version Minor="5" Release="3"/>
<Files Count="7"> <Files Count="7">
<Item1> <Item1>
<Filename Value="rvfreereg.pas"/> <Filename Value="rvfreereg.pas"/>

243
components/richview/richview.pas
View File

@ -29,7 +29,7 @@ const
rvsBullet = -6; rvsBullet = -6;
type type
TRichView = class; TCustomRichView = class;
TRVSaveFormat = (rvsfText, TRVSaveFormat = (rvsfText,
rvsfHTML, rvsfHTML,
rvsfRTF, //<---not yet implemented rvsfRTF, //<---not yet implemented
@ -65,10 +65,10 @@ type
{------------------------------------------------------------------} {------------------------------------------------------------------}
TJumpEvent = procedure (Sender: TObject; id: Integer) of object; TJumpEvent = procedure (Sender: TObject; id: Integer) of object;
TRVMouseMoveEvent = procedure (Sender: TObject; id: Integer) of object; TRVMouseMoveEvent = procedure (Sender: TObject; id: Integer) of object;
TRVSaveComponentToFileEvent = procedure (Sender: TRichView; Path: String; SaveMe: TPersistent; SaveFormat: TRVSaveFormat; var OutStr:String) of object; TRVSaveComponentToFileEvent = procedure (Sender: TCustomRichView; Path: String; SaveMe: TPersistent; SaveFormat: TRVSaveFormat; var OutStr:String) of object;
TRVURLNeededEvent = procedure (Sender: TRichView; id: Integer; var url:String) of object; TRVURLNeededEvent = procedure (Sender: TCustomRichView; id: Integer; var url:String) of object;
TRVDblClickEvent = procedure (Sender: TRichView; ClickedWord: String; Style: Integer) of object; TRVDblClickEvent = procedure (Sender: TCustomRichView; ClickedWord: String; Style: Integer) of object;
TRVRightClickEvent = procedure (Sender: TRichView; ClickedWord: String; Style, X, Y: Integer) of object; TRVRightClickEvent = procedure (Sender: TCustomRichView; ClickedWord: String; Style, X, Y: Integer) of object;
{------------------------------------------------------------------} {------------------------------------------------------------------}
TBackgroundStyle = (bsNoBitmap, bsStretched, bsTiled, bsTiledAndScrolled); TBackgroundStyle = (bsNoBitmap, bsStretched, bsTiled, bsTiledAndScrolled);
{------------------------------------------------------------------} {------------------------------------------------------------------}
@ -84,8 +84,12 @@ type
public public
val: Integer; val: Integer;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
TRichView = class(TRVScroller)
{ TCustomRichView }
TCustomRichView = class(TRVScroller)
private private
{ Private declarations } { Private declarations }
ScrollDelta: Integer; ScrollDelta: Integer;
@ -158,10 +162,39 @@ type
procedure SetBackgroundStyle(Value: TBackgroundStyle); procedure SetBackgroundStyle(Value: TBackgroundStyle);
procedure SetVSmallStep(Value: Integer); procedure SetVSmallStep(Value: Integer);
function GetNextFileName(Path: String): String; virtual; function GetNextFileName(Path: String): String; virtual;
procedure ShareLinesFrom(Source: TRichView); procedure ShareLinesFrom(Source: TCustomRichView);
function FindClickedWord(var clickedword: String; var StyleNo: Integer): Boolean; function FindClickedWord(var clickedword: String; var StyleNo: Integer): Boolean;
procedure OnScrollTimer(Sender: TObject); procedure OnScrollTimer(Sender: TObject);
procedure Loaded; override; procedure Loaded; override;
protected // to be published properties
function GetCredits: string; virtual;
{ Published declarations }
//property PopupMenu;
//property OnClick;
//property OnKeyDown;
//property OnKeyUp;
//property OnKeyPress;
property FirstJumpNo: Integer read FFirstJumpNo write FFirstJumpNo;
property OnJump: TJumpEvent read FOnJump write FOnJump;
property OnRVMouseMove: TRVMouseMoveEvent read FOnRVMouseMove write FOnRVMouseMove;
property OnSaveComponentToFile: TRVSaveComponentToFileEvent read FOnSaveComponentToFile write FOnSaveComponentToFile;
property OnURLNeeded: TRVURLNeededEvent read FOnURLNeeded write FOnURLNeeded;
property OnRVDblClick: TRVDblClickEvent read FOnRVDblClick write FOnRVDblClick;
property OnRVRightClick: TRVRightClickEvent read FOnRVRightClick write FOnRVRightClick;
property OnSelect: TNotifyEvent read FOnSelect write FOnSelect;
property OnResized: TNotifyEvent read FOnResized write FOnResized;
property Style: TRVStyle read FStyle write FStyle;
property MaxTextWidth:Integer read FMaxTextWidth write FMaxTextWidth;
property MinTextWidth:Integer read FMinTextWidth write FMinTextWidth;
property LeftMargin: Integer read FLeftMargin write FLeftMargin;
property RightMargin: Integer read FRightMargin write FRightMargin;
property BackgroundBitmap: TBitmap read FBackBitmap write SetBackBitmap;
property BackgroundStyle: TBackgroundStyle read FBackgroundStyle write SetBackgroundStyle;
property Delimiters: String read FDelimiters write FDelimiters;
property AllowSelection: Boolean read FAllowSelection write FAllowSelection;
property SingleClick: Boolean read FSingleClick write FSingleClick;
public public
{ Public declarations } { Public declarations }
lines:TStringList; lines:TStringList;
@ -190,7 +223,7 @@ type
procedure Format; procedure Format;
procedure FormatTail; procedure FormatTail;
procedure AppendFrom(Source: TRichView); procedure AppendFrom(Source: TCustomRichView);
function GetLastCP: Integer; function GetLastCP: Integer;
property VSmallStep: Integer read SmallStep write SetVSmallStep; property VSmallStep: Integer read SmallStep write SetVSmallStep;
function SaveHTML(FileName, Title, ImagesPrefix: String; Options: TRVSaveOptions):Boolean; function SaveHTML(FileName, Title, ImagesPrefix: String; Options: TRVSaveOptions):Boolean;
@ -211,32 +244,45 @@ type
property LineCount: Integer read GetLineCount; property LineCount: Integer read GetLineCount;
property FirstLineVisible: Integer read GetFirstLineVisible; property FirstLineVisible: Integer read GetFirstLineVisible;
property LastLineVisible: Integer read GetLastLineVisible; property LastLineVisible: Integer read GetLastLineVisible;
end;
TRichView=class(TCustomRichView)
published published
{ Published declarations } // published from TRVScroller
property Visible;
property TabStop;
property TabOrder;
property Align;
property HelpContext;
property Tracking;
property VScrollVisible;
property OnVScrolled;
// published from TCustomRichView
property PopupMenu; property PopupMenu;
property OnClick; property OnClick;
property OnKeyDown; property OnKeyDown;
property OnKeyUp; property OnKeyUp;
property OnKeyPress; property OnKeyPress;
property FirstJumpNo: Integer read FFirstJumpNo write FFirstJumpNo; property FirstJumpNo;
property OnJump: TJumpEvent read FOnJump write FOnJump; property OnJump;
property OnRVMouseMove: TRVMouseMoveEvent read FOnRVMouseMove write FOnRVMouseMove; property OnRVMouseMove;
property OnSaveComponentToFile: TRVSaveComponentToFileEvent read FOnSaveComponentToFile write FOnSaveComponentToFile; property OnSaveComponentToFile;
property OnURLNeeded: TRVURLNeededEvent read FOnURLNeeded write FOnURLNeeded; property OnURLNeeded;
property OnRVDblClick: TRVDblClickEvent read FOnRVDblClick write FOnRVDblClick; property OnRVDblClick;
property OnRVRightClick: TRVRightClickEvent read FOnRVRightClick write FOnRVRightClick; property OnRVRightClick;
property OnSelect: TNotifyEvent read FOnSelect write FOnSelect; property OnSelect;
property OnResized: TNotifyEvent read FOnResized write FOnResized; property OnResized;
property Style: TRVStyle read FStyle write FStyle; property Style;
property MaxTextWidth:Integer read FMaxTextWidth write FMaxTextWidth; property MaxTextWidth;
property MinTextWidth:Integer read FMinTextWidth write FMinTextWidth; property MinTextWidth;
property LeftMargin: Integer read FLeftMargin write FLeftMargin; property LeftMargin;
property RightMargin: Integer read FRightMargin write FRightMargin; property RightMargin;
property BackgroundBitmap: TBitmap read FBackBitmap write SetBackBitmap; property BackgroundBitmap;
property BackgroundStyle: TBackgroundStyle read FBackgroundStyle write SetBackgroundStyle; property BackgroundStyle;
property Delimiters: String read FDelimiters write FDelimiters; property Delimiters;
property AllowSelection: Boolean read FAllowSelection write FAllowSelection; property AllowSelection;
property SingleClick: Boolean read FSingleClick write FSingleClick; property SingleClick;
end; end;
procedure InfoAboutSaD(var sad:TScreenAndDevice; Canvas: TCanvas); procedure InfoAboutSaD(var sad:TScreenAndDevice; Canvas: TCanvas);
@ -275,7 +321,7 @@ begin
end; end;
{$ENDIF} {$ENDIF}
{==================================================================} {==================================================================}
constructor TRichView.Create(AOwner: TComponent); constructor TCustomRichView.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FClientTextWidth := False; FClientTextWidth := False;
@ -316,7 +362,7 @@ begin
//Format_(False,0, Canvas, False); //Format_(False,0, Canvas, False);
end; end;
{-------------------------------------} {-------------------------------------}
destructor TRichView.Destroy; destructor TCustomRichView.Destroy;
begin begin
FBackBitmap.Free; FBackBitmap.Free;
Clear; Clear;
@ -327,23 +373,23 @@ begin
inherited Destroy; inherited Destroy;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.WMSize(var Message: TWMSize); procedure TCustomRichView.WMSize(var Message: TWMSize);
begin begin
Format_(True, 0, Canvas, False); Format_(True, 0, Canvas, False);
if Assigned(FOnResized) then FOnResized(Self); if Assigned(FOnResized) then FOnResized(Self);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.Format; procedure TCustomRichView.Format;
begin begin
Format_(False, 0, Canvas, False); Format_(False, 0, Canvas, False);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.FormatTail; procedure TCustomRichView.FormatTail;
begin begin
Format_(False, 0, Canvas, True); Format_(False, 0, Canvas, True);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.ClearTemporal; procedure TCustomRichView.ClearTemporal;
var i: Integer; var i: Integer;
begin begin
if ScrollTimer<>nil then begin if ScrollTimer<>nil then begin
@ -374,7 +420,7 @@ begin
nJmps :=0; nJmps :=0;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.Deselect; procedure TCustomRichView.Deselect;
begin begin
Selection := False; Selection := False;
FSelStartNo := -1; FSelStartNo := -1;
@ -384,7 +430,7 @@ begin
if Assigned(FOnSelect) then OnSelect(Self); if Assigned(FOnSelect) then OnSelect(Self);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.SelectAll; procedure TCustomRichView.SelectAll;
begin begin
FSelStartNo := 0; FSelStartNo := 0;
FSelEndNo := DrawLines.Count-1; FSelEndNo := DrawLines.Count-1;
@ -395,7 +441,7 @@ begin
if Assigned(FOnSelect) then OnSelect(Self); if Assigned(FOnSelect) then OnSelect(Self);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.Clear; procedure TCustomRichView.Clear;
var i: Integer; var i: Integer;
begin begin
Deselect; Deselect;
@ -422,7 +468,7 @@ begin
ClearTemporal; ClearTemporal;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AddFromNewLine(s: String; StyleNo:Integer); procedure TCustomRichView.AddFromNewLine(s: String; StyleNo:Integer);
var info: TLineInfo; var info: TLineInfo;
begin begin
info := TLineInfo.Create; info := TLineInfo.Create;
@ -432,7 +478,7 @@ begin
lines.AddObject(s, info); lines.AddObject(s, info);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.Add(s: String; StyleNo:Integer); procedure TCustomRichView.Add(s: String; StyleNo:Integer);
var info: TLineInfo; var info: TLineInfo;
begin begin
info := TLineInfo.Create; info := TLineInfo.Create;
@ -442,7 +488,7 @@ begin
lines.AddObject(s, info); lines.AddObject(s, info);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AddText(s: String;StyleNo:Integer); procedure TCustomRichView.AddText(s: String;StyleNo:Integer);
var p: Integer; var p: Integer;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -468,7 +514,7 @@ begin
end; end;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AddTextFromNewLine(s: String;StyleNo:Integer); procedure TCustomRichView.AddTextFromNewLine(s: String;StyleNo:Integer);
var p: Integer; var p: Integer;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -492,7 +538,7 @@ begin
end; end;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AddCenterLine(s: String;StyleNo:Integer); procedure TCustomRichView.AddCenterLine(s: String;StyleNo:Integer);
var info: TLineInfo; var info: TLineInfo;
begin begin
info := TLineInfo.Create; info := TLineInfo.Create;
@ -502,7 +548,7 @@ begin
lines.AddObject(s, info); lines.AddObject(s, info);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AddBreak; procedure TCustomRichView.AddBreak;
var info: TLineInfo; var info: TLineInfo;
begin begin
info := TLineInfo.Create; info := TLineInfo.Create;
@ -510,7 +556,7 @@ begin
lines.AddObject('', info); lines.AddObject('', info);
end; end;
{-------------------------------------} {-------------------------------------}
function TRichView.AddNamedCheckPoint(CpName: String): Integer; function TCustomRichView.AddNamedCheckPoint(CpName: String): Integer;
var info: TLineInfo; var info: TLineInfo;
cpinfo: TCPInfo; cpinfo: TCPInfo;
begin begin
@ -523,17 +569,17 @@ begin
AddNamedCheckPoint := checkpoints.Count-1; AddNamedCheckPoint := checkpoints.Count-1;
end; end;
{-------------------------------------} {-------------------------------------}
function TRichView.AddCheckPoint: Integer; function TCustomRichView.AddCheckPoint: Integer;
begin begin
AddCheckPoint := AddNamedCheckPoint(''); AddCheckPoint := AddNamedCheckPoint('');
end; end;
{-------------------------------------} {-------------------------------------}
function TRichView.GetCheckPointY(no: Integer): Integer; function TCustomRichView.GetCheckPointY(no: Integer): Integer;
begin begin
GetCheckPointY := TCPInfo(checkpoints.Objects[no]).Y; GetCheckPointY := TCPInfo(checkpoints.Objects[no]).Y;
end; end;
{-------------------------------------} {-------------------------------------}
function TRichView.GetJumpPointY(no: Integer): Integer; function TCustomRichView.GetJumpPointY(no: Integer): Integer;
var i: Integer; var i: Integer;
begin begin
GetJumpPointY := 0; GetJumpPointY := 0;
@ -544,7 +590,7 @@ begin
end; end;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AddPicture(gr: TGraphic); { gr not copied, do not free it!} procedure TCustomRichView.AddPicture(gr: TGraphic); { gr not copied, do not free it!}
var info: TLineInfo; var info: TLineInfo;
begin begin
info := TLineInfo.Create; info := TLineInfo.Create;
@ -555,7 +601,7 @@ begin
lines.AddObject('', info); lines.AddObject('', info);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AddHotSpot(imgNo: Integer; lst: TImageList; fromnewline: Boolean); procedure TCustomRichView.AddHotSpot(imgNo: Integer; lst: TImageList; fromnewline: Boolean);
var info: TLineInfo; var info: TLineInfo;
begin begin
info := TLineInfo.Create; info := TLineInfo.Create;
@ -566,7 +612,7 @@ begin
lines.AddObject('', info); lines.AddObject('', info);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AddBullet(imgNo: Integer; lst: TImageList; fromnewline: Boolean); procedure TCustomRichView.AddBullet(imgNo: Integer; lst: TImageList; fromnewline: Boolean);
var info: TLineInfo; var info: TLineInfo;
begin begin
info := TLineInfo.Create; info := TLineInfo.Create;
@ -577,7 +623,7 @@ begin
lines.AddObject('', info); lines.AddObject('', info);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AddControl(ctrl: TControl; center: Boolean); { do not free ctrl! } procedure TCustomRichView.AddControl(ctrl: TControl; center: Boolean); { do not free ctrl! }
var info: TLineInfo; var info: TLineInfo;
begin begin
info := TLineInfo.Create; info := TLineInfo.Create;
@ -589,7 +635,7 @@ begin
InsertControl(ctrl); InsertControl(ctrl);
end; end;
{-------------------------------------} {-------------------------------------}
function TRichView.GetMaxPictureWidth: Integer; function TCustomRichView.GetMaxPictureWidth: Integer;
var i,m: Integer; var i,m: Integer;
begin begin
m := 0; m := 0;
@ -612,7 +658,7 @@ begin
max := b; max := b;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.Format_(OnlyResized:Boolean; depth: Integer; Canvas: TCanvas; procedure TCustomRichView.Format_(OnlyResized:Boolean; depth: Integer; Canvas: TCanvas;
OnlyTail: Boolean); OnlyTail: Boolean);
var i: Integer; var i: Integer;
x,b,d,a: Integer; x,b,d,a: Integer;
@ -694,7 +740,7 @@ begin
LastLineFormatted := Lines.Count-1; LastLineFormatted := Lines.Count-1;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AdjustChildrenCoords; procedure TCustomRichView.AdjustChildrenCoords;
var i: Integer; var i: Integer;
dli: TDrawLineInfo; dli: TDrawLineInfo;
li : TLineInfo; li : TLineInfo;
@ -711,7 +757,7 @@ begin
end; end;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.FormatLine(no: Integer; var x,baseline,prevdesc,prevabove:Integer; Canvas: TCanvas; procedure TCustomRichView.FormatLine(no: Integer; var x,baseline,prevdesc,prevabove:Integer; Canvas: TCanvas;
var sad: TScreenAndDevice); var sad: TScreenAndDevice);
var sourceStrPtr, strForAdd, strSpacePos: PChar; var sourceStrPtr, strForAdd, strSpacePos: PChar;
sourceStrPtrLen: Integer; sourceStrPtrLen: Integer;
@ -958,7 +1004,7 @@ begin
end; end;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AdjustJumpsCoords; procedure TCustomRichView.AdjustJumpsCoords;
var i: Integer; var i: Integer;
begin begin
for i:=0 to jumps.Count-1 do begin for i:=0 to jumps.Count-1 do begin
@ -973,12 +1019,12 @@ const gdlnFirstVisible =1;
const gdlnLastCompleteVisible =2; const gdlnLastCompleteVisible =2;
const gdlnLastVisible =3; const gdlnLastVisible =3;
{-------------------------------------} {-------------------------------------}
function TRichView.GetFirstVisible(TopLine: Integer): Integer; function TCustomRichView.GetFirstVisible(TopLine: Integer): Integer;
begin begin
Result := GetDrawLineNo(TopLine,gdlnFirstVisible); Result := GetDrawLineNo(TopLine,gdlnFirstVisible);
end; end;
{-------------------------------------} {-------------------------------------}
function TRichView.GetFirstLineVisible: Integer; function TCustomRichView.GetFirstLineVisible: Integer;
var v: Integer; var v: Integer;
begin begin
v := GetDrawLineNo(VPos*SmallStep, gdlnFirstVisible); v := GetDrawLineNo(VPos*SmallStep, gdlnFirstVisible);
@ -989,7 +1035,7 @@ begin
Result := TDrawLineInfo(DrawLines.Objects[v]).LineNo; Result := TDrawLineInfo(DrawLines.Objects[v]).LineNo;
end; end;
{-------------------------------------} {-------------------------------------}
function TRichView.GetLastLineVisible: Integer; function TCustomRichView.GetLastLineVisible: Integer;
var v: Integer; var v: Integer;
begin begin
v := GetDrawLineNo(VPos*SmallStep+ClientHeight, gdlnLastVisible); v := GetDrawLineNo(VPos*SmallStep+ClientHeight, gdlnLastVisible);
@ -1000,7 +1046,7 @@ begin
Result := TDrawLineInfo(DrawLines.Objects[v]).LineNo; Result := TDrawLineInfo(DrawLines.Objects[v]).LineNo;
end; end;
{-------------------------------------} {-------------------------------------}
function TRichView.GetDrawLineNo(BoundLine: Integer; Option: Integer): Integer; function TCustomRichView.GetDrawLineNo(BoundLine: Integer; Option: Integer): Integer;
var var
a,b,mid: Integer; a,b,mid: Integer;
begin begin
@ -1060,7 +1106,7 @@ begin
GetDrawLineNo := mid; GetDrawLineNo := mid;
end; end;
{ {
function TRichView.GetFirstVisible(TopLine: Integer): Integer; function TCustomRichView.GetFirstVisible(TopLine: Integer): Integer;
var var
a,b,mid: Integer; a,b,mid: Integer;
begin begin
@ -1115,7 +1161,7 @@ end;
{$ENDIF} {$ENDIF}
{-------------------------------------} {-------------------------------------}
procedure TRichView.Paint; procedure TCustomRichView.Paint;
var i,no, yshift, xshift: Integer; var i,no, yshift, xshift: Integer;
cl, textcolor: TColor; cl, textcolor: TColor;
dli:TDrawLineInfo; dli:TDrawLineInfo;
@ -1146,7 +1192,7 @@ begin
Canvas.Font.Style := []; Canvas.Font.Style := [];
Canvas.FillRect(Canvas.ClipRect); Canvas.FillRect(Canvas.ClipRect);
if (csDesigning in ComponentState) then if (csDesigning in ComponentState) then
Canvas.TextOut(ClientRect.Left+1, ClientRect.Top+1, 'RichView v0.5.1 (www.trichview.com)') Canvas.TextOut(ClientRect.Left+1, ClientRect.Top+1, GetCredits)
else else
Canvas.TextOut(ClientRect.Left+1, ClientRect.Top+1, 'Error: style is not assigned'); Canvas.TextOut(ClientRect.Left+1, ClientRect.Top+1, 'Error: style is not assigned');
Canvas.Brush.Color := clWindowText; Canvas.Brush.Color := clWindowText;
@ -1288,7 +1334,7 @@ begin
buffer.Free; buffer.Free;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.InvalidateJumpRect(no: Integer); procedure TCustomRichView.InvalidateJumpRect(no: Integer);
var rec: TRect; var rec: TRect;
i, id : Integer; i, id : Integer;
begin begin
@ -1309,7 +1355,7 @@ begin
Update; Update;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.CMMouseLeave(var Message: TMessage); procedure TCustomRichView.CMMouseLeave(var Message: TMessage);
begin begin
if DrawHover and (LastJumpMovedAbove<>-1) then begin if DrawHover and (LastJumpMovedAbove<>-1) then begin
DrawHover := False; DrawHover := False;
@ -1322,7 +1368,7 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.MouseMove(Shift: TShiftState; X, Y: Integer); procedure TCustomRichView.MouseMove(Shift: TShiftState; X, Y: Integer);
var i, no, offs,ys: Integer; var i, no, offs,ys: Integer;
begin begin
ScrollDelta := 0; ScrollDelta := 0;
@ -1349,7 +1395,6 @@ begin
(Y<=TJumpInfo(jumps.objects[i]).t+TJumpInfo(jumps.objects[i]).h-VPos*SmallStep) then (Y<=TJumpInfo(jumps.objects[i]).t+TJumpInfo(jumps.objects[i]).h-VPos*SmallStep) then
begin begin
Cursor := FStyle.JumpCursor; Cursor := FStyle.JumpCursor;
Writeln('Cursor=',Cursor);
if Assigned(FOnRVMouseMove) and if Assigned(FOnRVMouseMove) and
(LastJumpMovedAbove<>TJumpInfo(jumps.objects[i]).id) then begin (LastJumpMovedAbove<>TJumpInfo(jumps.objects[i]).id) then begin
OnRVMouseMove(Self,TJumpInfo(jumps.objects[i]).id+FirstJumpNo); OnRVMouseMove(Self,TJumpInfo(jumps.objects[i]).id+FirstJumpNo);
@ -1379,7 +1424,7 @@ begin
if Selection then Invalidate; if Selection then Invalidate;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure TCustomRichView.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var i, StyleNo, no, offs, ys: Integer; var i, StyleNo, no, offs, ys: Integer;
clickedword: String; clickedword: String;
p: TPoint; p: TPoint;
@ -1428,7 +1473,7 @@ begin
inherited MouseUp(Button, Shift, X, Y); inherited MouseUp(Button, Shift, X, Y);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure TCustomRichView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var i,no, StyleNo: Integer; var i,no, StyleNo: Integer;
clickedword: String; clickedword: String;
begin begin
@ -1466,7 +1511,7 @@ begin
inherited MouseDown(Button, Shift, X, Y); inherited MouseDown(Button, Shift, X, Y);
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.AppendFrom(Source: TRichView); procedure TCustomRichView.AppendFrom(Source: TCustomRichView);
var i: Integer; var i: Integer;
gr: TGraphic; gr: TGraphic;
grclass: TGraphicClass; grclass: TGraphicClass;
@ -1510,12 +1555,12 @@ begin
end; end;
end; end;
{-------------------------------------} {-------------------------------------}
function TRichView.GetLastCP: Integer; function TCustomRichView.GetLastCP: Integer;
begin begin
GetLastCP := CheckPoints.Count-1; GetLastCP := CheckPoints.Count-1;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.SetBackBitmap(Value: TBitmap); procedure TCustomRichView.SetBackBitmap(Value: TBitmap);
begin begin
FBackBitmap.Assign(Value); FBackBitmap.Assign(Value);
if (Value=nil) or (Value.Empty) then if (Value=nil) or (Value.Empty) then
@ -1529,7 +1574,7 @@ begin
end; end;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.SetBackgroundStyle(Value: TBackgroundStyle); procedure TCustomRichView.SetBackgroundStyle(Value: TBackgroundStyle);
begin begin
FBackgroundStyle := Value; FBackgroundStyle := Value;
if FBackBitmap.Empty then if FBackBitmap.Empty then
@ -1543,7 +1588,7 @@ begin
end; end;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.DrawBack(DC: HDC; Rect: TRect; Width,Height:Integer); procedure TCustomRichView.DrawBack(DC: HDC; Rect: TRect; Width,Height:Integer);
var i, j: Integer; var i, j: Integer;
hbr: HBRUSH; hbr: HBRUSH;
begin begin
@ -1578,7 +1623,7 @@ begin
end end
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.WMEraseBkgnd(var Message: TWMEraseBkgnd); procedure TCustomRichView.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var r1: TRect; var r1: TRect;
begin begin
if (csDesigning in ComponentState) then exit; if (csDesigning in ComponentState) then exit;
@ -1595,13 +1640,13 @@ begin
OldHeight := ClientHeight; OldHeight := ClientHeight;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.SetVSmallStep(Value: Integer); procedure TCustomRichView.SetVSmallStep(Value: Integer);
begin begin
if (Value<=0) or (TextHeight div Value > 30000) then exit; if (Value<=0) or (TextHeight div Value > 30000) then exit;
SmallStep := Value; SmallStep := Value;
end; end;
{-------------------------------------} {-------------------------------------}
procedure TRichView.ShareLinesFrom(Source: TRichView); procedure TCustomRichView.ShareLinesFrom(Source: TCustomRichView);
begin begin
if ShareContents then begin if ShareContents then begin
Clear; Clear;
@ -1609,7 +1654,7 @@ begin
end; end;
end; end;
{-------------------------------------} {-------------------------------------}
function TRichView.FindItemAtPos(X,Y: Integer): Integer; function TCustomRichView.FindItemAtPos(X,Y: Integer): Integer;
var var
i, a,b,mid, midtop: Integer; i, a,b,mid, midtop: Integer;
dli: TDrawLineInfo; dli: TDrawLineInfo;
@ -1657,7 +1702,7 @@ begin
FindItemAtPos := -1; FindItemAtPos := -1;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.FindItemForSel(X,Y: Integer; var No, Offs: Integer); procedure TCustomRichView.FindItemForSel(X,Y: Integer; var No, Offs: Integer);
var var
styleno,i, a,b,mid, midtop, midbottom, midleft, midright, beginline, endline: Integer; styleno,i, a,b,mid, midtop, midbottom, midleft, midright, beginline, endline: Integer;
dli: TDrawLineInfo; dli: TDrawLineInfo;
@ -1780,7 +1825,7 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
function TRichView.FindClickedWord(var clickedword: String; var StyleNo: Integer): Boolean; function TCustomRichView.FindClickedWord(var clickedword: String; var StyleNo: Integer): Boolean;
var no, lno: Integer; var no, lno: Integer;
{$IFNDEF RICHVIEWDEF4} {$IFNDEF RICHVIEWDEF4}
arr: array[0..1000] of integer; arr: array[0..1000] of integer;
@ -1835,7 +1880,7 @@ begin
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.DblClick; procedure TCustomRichView.DblClick;
var var
StyleNo: Integer; StyleNo: Integer;
clickedword: String; clickedword: String;
@ -1846,7 +1891,7 @@ begin
FOnRVDblClick(Self, clickedword, StyleNo); FOnRVDblClick(Self, clickedword, StyleNo);
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.DeleteSection(CpName: String); procedure TCustomRichView.DeleteSection(CpName: String);
var i,j, startno, endno: Integer; var i,j, startno, endno: Integer;
begin begin
if ShareContents then exit; if ShareContents then exit;
@ -1865,7 +1910,7 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.DeleteLines(FirstLine, Count: Integer); procedure TCustomRichView.DeleteLines(FirstLine, Count: Integer);
var i: Integer; var i: Integer;
begin begin
if ShareContents then exit; if ShareContents then exit;
@ -1892,7 +1937,7 @@ begin
lines.EndUpdate; lines.EndUpdate;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.GetSelBounds(var StartNo, EndNo, StartOffs, EndOffs: Integer); procedure TCustomRichView.GetSelBounds(var StartNo, EndNo, StartOffs, EndOffs: Integer);
begin begin
if FSelStartNo <= FSelEndNo then begin if FSelStartNo <= FSelEndNo then begin
StartNo := FSelStartNo; StartNo := FSelStartNo;
@ -1914,7 +1959,7 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.StoreSelBounds(var StartNo, EndNo, StartOffs, EndOffs: Integer); procedure TCustomRichView.StoreSelBounds(var StartNo, EndNo, StartOffs, EndOffs: Integer);
var dli: TDrawLineInfo; var dli: TDrawLineInfo;
begin begin
GetSelBounds(StartNo, EndNo, StartOffs, EndOffs); GetSelBounds(StartNo, EndNo, StartOffs, EndOffs);
@ -1930,7 +1975,7 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.RestoreSelBounds(StartNo, EndNo, StartOffs, EndOffs: Integer); procedure TCustomRichView.RestoreSelBounds(StartNo, EndNo, StartOffs, EndOffs: Integer);
var i: Integer; var i: Integer;
dli, dli2, dli3: TDrawLineInfo; dli, dli2, dli3: TDrawLineInfo;
begin begin
@ -1990,12 +2035,12 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
function TRichView.GetLineCount: Integer; function TCustomRichView.GetLineCount: Integer;
begin begin
GetLineCount := lines.Count; GetLineCount := lines.Count;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
function TRichView.SelectionExists: Boolean; function TCustomRichView.SelectionExists: Boolean;
var StartNo, EndNo, StartOffs, EndOffs: Integer; var StartNo, EndNo, StartOffs, EndOffs: Integer;
begin begin
GetSelBounds(StartNo, EndNo, StartOffs, EndOffs); GetSelBounds(StartNo, EndNo, StartOffs, EndOffs);
@ -2005,7 +2050,7 @@ begin
Result := True; Result := True;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
function TRichView.GetSelText: String; function TCustomRichView.GetSelText: String;
var StartNo, EndNo, StartOffs, EndOffs, i: Integer; var StartNo, EndNo, StartOffs, EndOffs, i: Integer;
s : String; s : String;
li : TLineInfo; li : TLineInfo;
@ -2045,7 +2090,7 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.CopyText; procedure TCustomRichView.CopyText;
begin begin
if SelectionExists then begin if SelectionExists then begin
ClipBoard.Clear; ClipBoard.Clear;
@ -2053,7 +2098,7 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.KeyDown(var Key: Word; Shift: TShiftState); procedure TCustomRichView.KeyDown(var Key: Word; Shift: TShiftState);
begin begin
if SelectionExists and (ssCtrl in Shift) then begin if SelectionExists and (ssCtrl in Shift) then begin
if (Key = ord('C')) or (Key = VK_INSERT) then CopyText; if (Key = ord('C')) or (Key = VK_INSERT) then CopyText;
@ -2062,7 +2107,7 @@ begin
inherited KeyDown(Key,Shift) inherited KeyDown(Key,Shift)
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.OnScrollTimer(Sender: TObject); procedure TCustomRichView.OnScrollTimer(Sender: TObject);
begin begin
if ScrollDelta<>0 then begin if ScrollDelta<>0 then begin
VScrollPos := VScrollPos+ScrollDelta; VScrollPos := VScrollPos+ScrollDelta;
@ -2070,7 +2115,7 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.Notification(AComponent: TComponent; Operation: TOperation); procedure TCustomRichView.Notification(AComponent: TComponent; Operation: TOperation);
begin begin
inherited Notification(AComponent, Operation); inherited Notification(AComponent, Operation);
if (Operation=opRemove) and (AComponent=FStyle) then begin if (Operation=opRemove) and (AComponent=FStyle) then begin
@ -2078,17 +2123,23 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.Click; procedure TCustomRichView.Click;
begin begin
SetFocus; SetFocus;
inherited; inherited;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
procedure TRichView.Loaded; procedure TCustomRichView.Loaded;
begin begin
inherited Loaded; inherited Loaded;
Format; Format;
end; end;
function TCustomRichView.GetCredits: string;
begin
result := 'Lazarus TRichView based on RichView v0.5.1 (www.TCustomRichView.com)'
end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
{$I RV_Save.inc} {$I RV_Save.inc}
{------------------------------------------------------------------} {------------------------------------------------------------------}

8
components/richview/rv_save.inc
View File

@ -108,7 +108,7 @@ begin
CloseFontTag := s; CloseFontTag := s;
end; end;
{------------------------------------------------------------} {------------------------------------------------------------}
function TRichView.GetNextFileName(Path: String): String; function TCustomRichView.GetNextFileName(Path: String): String;
var fn: String; var fn: String;
begin begin
while True do begin while True do begin
@ -121,7 +121,7 @@ begin
end; end;
end; end;
{------------------------------------------------------------} {------------------------------------------------------------}
function TRichView.SavePicture(DocumentSaveFormat: TRVSaveFormat; Path: String; gr: TGraphic): String; function TCustomRichView.SavePicture(DocumentSaveFormat: TRVSaveFormat; Path: String; gr: TGraphic): String;
var fn: String; var fn: String;
bmp: TBitmap; bmp: TBitmap;
begin begin
@ -147,7 +147,7 @@ begin
end; end;
{------------------------------------------------------------} {------------------------------------------------------------}
function TRichView.SaveHTML(FileName,Title,ImagesPrefix: String; Options: TRVSaveOptions):Boolean; function TCustomRichView.SaveHTML(FileName,Title,ImagesPrefix: String; Options: TRVSaveOptions):Boolean;
var f: TextFile; var f: TextFile;
i,j: Integer; i,j: Integer;
li: TLineInfo; li: TLineInfo;
@ -303,7 +303,7 @@ begin
end; end;
end; end;
{------------------------------------------------------------------} {------------------------------------------------------------------}
function TRichView.SaveText(FileName: String; LineWidth: Integer):Boolean; function TCustomRichView.SaveText(FileName: String; LineWidth: Integer):Boolean;
var f: TextFile; var f: TextFile;
i,j: Integer; i,j: Integer;
li: TLineInfo; li: TLineInfo;

18
components/richview/rvscroll.pas
View File

@ -13,6 +13,7 @@ uses
type type
{ TRVScroller } { TRVScroller }
TRVScroller = class(TCustomControl) TRVScroller = class(TCustomControl)
private private
FTracking: Boolean; FTracking: Boolean;
@ -38,15 +39,7 @@ type
procedure ScrollChildren(dx, dy: Integer); procedure ScrollChildren(dx, dy: Integer);
procedure UpdateChildren; procedure UpdateChildren;
property FullRedraw: Boolean read FFullRedraw write FFullRedraw; property FullRedraw: Boolean read FFullRedraw write FFullRedraw;
public protected // to be publised properties
{ Public declarations }
constructor Create(AOwner: TComponent);override;
procedure EraseBackground(DC: HDC); override;
procedure ScrollTo(y: Integer);
property VScrollPos: Integer read GetVScrollPos write SetVScrollPos;
property VScrollMax: Integer read GetVScrollMax;
published
{ Published declarations }
property Visible; property Visible;
property TabStop; property TabStop;
property TabOrder; property TabOrder;
@ -55,6 +48,13 @@ type
property Tracking: Boolean read FTracking write FTracking; property Tracking: Boolean read FTracking write FTracking;
property VScrollVisible: Boolean read FVScrollVisible write SetVScrollVisible; property VScrollVisible: Boolean read FVScrollVisible write SetVScrollVisible;
property OnVScrolled: TNotifyEvent read FOnVScrolled write FOnVScrolled; property OnVScrolled: TNotifyEvent read FOnVScrolled write FOnVScrolled;
public
{ Public declarations }
constructor Create(AOwner: TComponent);override;
procedure EraseBackground(DC: HDC); override;
procedure ScrollTo(y: Integer);
property VScrollPos: Integer read GetVScrollPos write SetVScrollPos;
property VScrollMax: Integer read GetVScrollMax;
end; end;
procedure Tag2Y(AControl: TControl); procedure Tag2Y(AControl: TControl);