You've already forked lazarus-ccr
f2502d8ad3
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7431 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1570 lines
41 KiB
ObjectPascal
1570 lines
41 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvTFGlanceTextViewer.PAS, released on 2003-08-01.
|
|
|
|
The Initial Developer of the Original Code is Unlimited Intelligence Limited.
|
|
Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
Mike Kolter (original code)
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.delphi-jedi.org
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id$
|
|
|
|
unit JvTFGlanceTextViewer;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
LCLIntf, LCLType, LMessages,
|
|
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
|
|
JvComponent,
|
|
JvTFManager, JvTFGlance, JvTFUtils;
|
|
|
|
type
|
|
TJvTFGlanceTextViewer = class;
|
|
|
|
TJvTFGlTxtVwDrawInfo = record
|
|
Cell: TJvTFGlanceCell;
|
|
Font: TFont;
|
|
Color: TColor;
|
|
aRect: TRect;
|
|
end;
|
|
|
|
TJvTFGlTxtVwPointInfo = record
|
|
AbsX: Integer;
|
|
AbsY: Integer;
|
|
AbsLineNum: Integer;
|
|
RelLineNum: Integer;
|
|
end;
|
|
|
|
TJvDrawApptEvent = procedure(Sender: TObject; ACanvas: TCanvas; DrawInfo: TJvTFGlTxtVwDrawInfo;
|
|
Appt: TJvTFAppt; Rect:TRect; var Handled: Boolean) of object;
|
|
TJvApptHintEvent = procedure(Sender: TObject; Appt: TJvTFAppt; var Handled: Boolean) of object;
|
|
|
|
TJvTFGVTxtEditor = class(TMemo)
|
|
private
|
|
FLinkedAppt: TJvTFAppt;
|
|
protected
|
|
FCancelEdit: Boolean;
|
|
procedure DoExit; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property LinkedAppt: TJvTFAppt read FLinkedAppt write FLinkedAppt;
|
|
end;
|
|
|
|
TJvTFGVTextControl = class(TJvCustomControl)
|
|
private
|
|
FViewer: TJvTFGlanceTextViewer;
|
|
FReplicating: Boolean;
|
|
FMouseLine: Integer;
|
|
FCanEdit: Boolean;
|
|
FShowDDButton: Boolean;
|
|
|
|
function GetGlanceControl: TJvTFCustomGlance;
|
|
procedure SetTopLine(Value: Integer);
|
|
function GetTopLine: Integer;
|
|
procedure SetCanEdit(const Value: Boolean);
|
|
procedure SetShowDDButton(const Value: Boolean);
|
|
protected
|
|
FMousePtInfo: TJvTFGlTxtVwPointInfo;
|
|
FDDBtnRect: TRect;
|
|
FMouseInControl: Boolean;
|
|
FScrollUpBtnBMP: TBitmap;
|
|
FScrollDnBtnBMP: TBitmap;
|
|
FEditor: TJvTFGVTxtEditor;
|
|
|
|
// See in MouseDown for details on usage of these three members
|
|
FWasMovedTicks: Cardinal;
|
|
FWasInDblClick: Boolean;
|
|
FHasScrolled: Boolean;
|
|
|
|
procedure MouseEnter(Control: TControl); override;
|
|
procedure MouseLeave(Control: TControl); override;
|
|
|
|
procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND;
|
|
procedure DoEnter; override;
|
|
procedure DoExit; override;
|
|
|
|
procedure SetMouseLine(Value: Integer);
|
|
property MouseLine: Integer read FMouseLine write SetMouseLine;
|
|
procedure UpdateDDBtnRect;
|
|
|
|
procedure DblClick; override;
|
|
procedure DoViewerDblClick;
|
|
procedure DoViewerClick;
|
|
procedure DoViewerEnter;
|
|
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseAccel(X, Y: Integer);
|
|
procedure Click; override;
|
|
|
|
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
|
|
var Accept: Boolean); override;
|
|
|
|
// mouse wheel support
|
|
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override ;
|
|
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
|
|
|
|
property Replicating: Boolean read FReplicating;
|
|
procedure Paint; override;
|
|
procedure DrawDDButton(ACanvas: TCanvas);
|
|
{
|
|
procedure DrawScrollUpBtn(ACanvas: TCanvas; aCellRect: TRect);
|
|
procedure DrawScrollDnBtn(ACanvas: TCanvas; aCellRect: TRect);
|
|
}
|
|
function GetStartEndString(Appt: TJvTFAppt): string;
|
|
|
|
function CalcLineHeight: Integer;
|
|
function CalcAbsLineNum(Y: Integer): Integer;
|
|
function LineRect(AbsLineNum: Integer): TRect;
|
|
function CalcPointInfo(X, Y: Integer): TJvTFGlTxtVwPointInfo;
|
|
function RelToAbs(Rel: Integer): Integer;
|
|
function AbsToRel(Abs: Integer): Integer;
|
|
function FindApptAtLine(RelLineNum: Integer): TJvTFAppt;
|
|
function GetApptRelLineNum(Appt: TJvTFAppt): Integer;
|
|
|
|
procedure Scroll(ADelta: Integer);
|
|
function ScrollUpBtnRect(aCellRect: TRect): TRect;
|
|
function ScrollDnBtnRect(aCellRect: TRect): TRect;
|
|
procedure InitScrollUpBtnBMP;
|
|
procedure InitScrollDnBtnBMP;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure PaintTo(ACanvas: TCanvas; DrawInfo: TJvTFGlTxtVwDrawInfo); overload;
|
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
|
|
|
|
property Viewer: TJvTFGlanceTextViewer read FViewer;
|
|
property GlanceControl: TJvTFCustomGlance read GetGlanceControl;
|
|
|
|
// editor management routines
|
|
//procedure EditAppt(Col, Row: Integer; Appt: TJvTFAppt);
|
|
procedure EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer; Appt: TJvTFAppt);
|
|
procedure FinishEditAppt;
|
|
function Editing: Boolean;
|
|
|
|
function LineCount: Integer;
|
|
function AbsLineCount: Integer;
|
|
function ViewableLines: Integer;
|
|
function FullViewableLines: Integer;
|
|
property TopLine: Integer read GetTopLine write SetTopLine;
|
|
|
|
function GetApptAt(X, Y: Integer): TJvTFAppt;
|
|
function GetApptAccel(X, Y: Integer): TJvTFAppt;
|
|
|
|
property CanEdit: Boolean read FCanEdit write SetCanEdit;
|
|
property ShowDDButton: Boolean read FShowDDButton write SetShowDDButton default True;
|
|
end;
|
|
|
|
TJvTFLineDDClickEvent = procedure(Sender: TObject; LineNum: Integer) of object;
|
|
|
|
TJvTFTxtVwApptAttr = class(TPersistent)
|
|
private
|
|
FColor: TColor;
|
|
FFontColor: TColor;
|
|
FOnChange: TNotifyEvent;
|
|
procedure SetColor(Value: TColor);
|
|
procedure SetFontColor(Value: TColor);
|
|
protected
|
|
procedure Change;
|
|
public
|
|
constructor Create(AOwner: TComponent);
|
|
procedure Assign(Source: TPersistent); override;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
published
|
|
property Color: TColor read FColor write SetColor default clBlue;
|
|
property FontColor: TColor read FFontColor write SetFontColor default clWhite;
|
|
end;
|
|
|
|
TJvTFGlTxtVwEditorAlign = (eaLine, eaCell);
|
|
|
|
TJvTFGlanceTextViewer = class(TJvTFGlanceViewer)
|
|
private
|
|
FViewControl: TJvTFGVTextControl;
|
|
FLineSpacing: Integer;
|
|
FEditorAlign: TJvTFGlTxtVwEditorAlign;
|
|
FOnLineDDClick: TJvTFLineDDClickEvent;
|
|
FShowStartEnd: Boolean;
|
|
FTopLines: TStringList;
|
|
FSelApptAttr: TJvTFTxtVwApptAttr;
|
|
FSelAppt: TJvTFAppt;
|
|
FOnDblClick: TNotifyEvent;
|
|
FOnClick: TNotifyEvent;
|
|
FOnEnter: TNotifyEvent;
|
|
FOnDrawAppt: TJvDrawApptEvent;
|
|
|
|
procedure SetLineSpacing(Value: Integer);
|
|
procedure SetSelApptAttr(Value: TJvTFTxtVwApptAttr);
|
|
procedure SetEditorAlign(Value: TJvTFGlTxtVwEditorAlign);
|
|
procedure SetShowStartEnd(Value: Boolean);
|
|
function GetCellString(ACell: TJvTFGlanceCell): string;
|
|
procedure SetShowLineDDButton(const Value: Boolean);
|
|
function GetShowLineDDButton: Boolean;
|
|
protected
|
|
procedure SetVisible(Value: Boolean); override;
|
|
procedure SetGlanceControl(Value: TJvTFCustomGlance); override;
|
|
procedure SelApptAttrChange(Sender: TObject);
|
|
procedure Change; virtual;
|
|
procedure LineDDClick(LineNum: Integer); virtual;
|
|
|
|
procedure DoDblClick(); virtual;
|
|
procedure DoClick; virtual;
|
|
procedure DoEnter; virtual;
|
|
procedure DoDrawAppt(ACanvas: TCanvas; DrawInfo: TJvTFGlTxtVwDrawInfo;
|
|
Appt: TJvTFAppt; Rect: TRect; var Handled: Boolean);
|
|
|
|
procedure ParentReconfig; override;
|
|
procedure SetSelAppt(Value: TJvTFAppt);
|
|
procedure SetInplaceEdit(const Value: Boolean); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); override;
|
|
procedure MouseAccel(X, Y: Integer); override;
|
|
|
|
procedure Refresh; override;
|
|
procedure Realign; override;
|
|
procedure PaintTo(ACanvas: TCanvas; ACell: TJvTFGlanceCell); override;
|
|
function GetDrawInfo(ACell: TJvTFGlanceCell): TJvTFGlTxtVwDrawInfo;
|
|
procedure ResetTopLines;
|
|
property SelAppt: TJvTFAppt read FSelAppt;
|
|
|
|
procedure SetTopLine(ACell: TJvTFGlanceCell; Value: Integer);
|
|
function GetTopLine(ACell: TJvTFGlanceCell): Integer;
|
|
function GetApptAt(X, Y: Integer): TJvTFAppt; override;
|
|
|
|
function CanScrollCell(ADir: TJvTFVScrollDir): Boolean; override;
|
|
procedure ScrollCell(ADelta: Integer); override;
|
|
|
|
// editor management routines
|
|
procedure EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer; Appt: TJvTFAppt);
|
|
procedure FinishEditAppt; override;
|
|
function Editing: Boolean; override;
|
|
function CanEdit: Boolean; override;
|
|
published
|
|
property LineSpacing: Integer read FLineSpacing write SetLineSpacing default 0;
|
|
property OnLineDDClick: TJvTFLineDDClickEvent read FOnLineDDClick write FOnLineDDClick;
|
|
property SelApptAttr: TJvTFTxtVwApptAttr read FSelApptAttr write SetSelApptAttr;
|
|
property EditorAlign: TJvTFGlTxtVwEditorAlign read FEditorAlign write SetEditorAlign default eaLine;
|
|
property ShowStartEnd: Boolean read FShowStartEnd write SetShowStartEnd default True;
|
|
property ShowLineDDButton: Boolean read GetShowLineDDButton write SetShowLineDDButton default True;
|
|
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
|
|
property OnClick: TNotifyEvent read FOnClick write FOnClick;
|
|
property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
|
|
property OnDrawAppt: TJvDrawApptEvent read FOnDrawAppt write FOnDrawAppt;
|
|
property OnApptHint;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
JvResources;
|
|
|
|
//=== { TJvTFGVTextControl } =================================================
|
|
|
|
constructor TJvTFGVTextControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
if AOwner is TJvTFGlanceTextViewer then
|
|
FViewer := TJvTFGlanceTextViewer(AOwner);
|
|
|
|
DoubleBuffered := True;
|
|
FShowDDButton := True;
|
|
|
|
FReplicating := True;
|
|
FMouseLine := -1;
|
|
|
|
FScrollUpBtnBMP := TBitmap.Create;
|
|
InitScrollUpBtnBMP;
|
|
FScrollDnBtnBMP := TBitmap.Create;
|
|
InitScrollDnBtnBMP;
|
|
|
|
FEditor := TJvTFGVTxtEditor.Create(Self);
|
|
FEditor.Visible := False;
|
|
FEditor.Parent := Self;
|
|
|
|
FWasMovedTicks := 0;
|
|
FWasInDblClick := False;
|
|
|
|
//FEditor.Parent := Viewer.GlanceControl;
|
|
// (rom) deactivated seems of no use
|
|
// if FEditor.Parent = nil then
|
|
// Beep;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.CalcAbsLineNum(Y: Integer): Integer;
|
|
begin
|
|
Result := Y div CalcLineHeight;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.DrawDDButton(ACanvas: TCanvas);
|
|
begin
|
|
with ACanvas do
|
|
begin
|
|
Brush.Color := clBtnFace;
|
|
FillRect(FDDBtnRect);
|
|
|
|
DrawArrow(ACanvas, FDDBtnRect, dirDown);
|
|
|
|
Pen.Color := clBlack;
|
|
Polyline([FDDBtnRect.TopLeft, Point(FDDBtnRect.Right, FDDBtnRect.Top),
|
|
FDDBtnRect.BottomRight, Point(FDDBtnRect.Left, FDDBtnRect.Bottom),
|
|
FDDBtnRect.TopLeft]);
|
|
{
|
|
if Windows.PtInRect(aRect, FMouseLoc) then
|
|
begin
|
|
Pen.Color := clBtnHighlight;
|
|
MoveTo(aRect.Left, aRect.Top);
|
|
LineTo(aRect.Left, aRect.Bottom);
|
|
MoveTo(aRect.Left, aRect.Top);
|
|
LineTo(aRect.Right, aRect.Top);
|
|
|
|
Pen.Color := clBtnShadow;
|
|
MoveTo(aRect.Right - 1, aRect.Top);
|
|
LineTo(aRect.Right - 1, aRect.Bottom);
|
|
MoveTo(aRect.Right, aRect.Bottom - 1);
|
|
LineTo(aRect.Left, aRect.Bottom - 1);
|
|
end;
|
|
}
|
|
end;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.GetGlanceControl: TJvTFCustomGlance;
|
|
begin
|
|
Result := nil;
|
|
if Assigned(Viewer) then
|
|
Result := Viewer.GlanceControl;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.CalcLineHeight: Integer;
|
|
begin
|
|
Result := Canvas.TextHeight('Wq') + Viewer.LineSpacing;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.LineRect(AbsLineNum: Integer): TRect;
|
|
var
|
|
LineHt: Integer;
|
|
begin
|
|
LineHt := CalcLineHeight;
|
|
Result := ClientRect;
|
|
Result.Top := LineHt * AbsLineNum;
|
|
Result.Bottom := Lesser(Result.Top + LineHt, Result.Bottom);
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.Paint;
|
|
var
|
|
DrawInfo: TJvTFGlTxtVwDrawInfo;
|
|
begin
|
|
{
|
|
All drawing should be done in a PaintTo method. PaintTo should have ACanvas
|
|
and aRect Params. All drawing code within PaintTo should rely solely on
|
|
the ACanvas and aRect parameters given.
|
|
|
|
This method (Paint) should then call PaintTo(Canvas, ClientRect) to draw the
|
|
info on the viewer control. TJvTFCustomGlance.DrawCell should call
|
|
PaintTo(PaintBuffer, CellBodyRect(Col, Row, Selected, False)) to draw the
|
|
info on the GlanceControl.
|
|
}
|
|
|
|
Viewer.SetTo(Viewer.PhysicalCell);
|
|
DrawInfo := Viewer.GetDrawInfo(Viewer.Cell);
|
|
DrawInfo.aRect := ClientRect;
|
|
|
|
FReplicating := False;
|
|
try
|
|
PaintTo(Canvas, DrawInfo);
|
|
finally
|
|
FReplicating := True;
|
|
end;
|
|
|
|
{
|
|
// for TESTING PURPOSES ONLY!!
|
|
with Canvas do
|
|
begin
|
|
Pen.Color := clBlack;
|
|
MoveTo(0, 0);
|
|
LineTo(ClientWidth, ClientHeight);
|
|
end;
|
|
}
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.PaintTo(ACanvas: TCanvas; DrawInfo: TJvTFGlTxtVwDrawInfo);
|
|
var
|
|
I, NextLineTop, LastLine, lLine: Integer;
|
|
aRect, lLineRect, TxtRect: TRect;
|
|
Flags: UINT;
|
|
Txt: string;
|
|
Appt: TJvTFAppt;
|
|
RegFontColor,
|
|
RegBrushColor: TColor;
|
|
DrawingHandled: Boolean;
|
|
begin
|
|
Viewer.SetTo(DrawInfo.Cell);
|
|
|
|
with ACanvas do
|
|
begin
|
|
aRect := DrawInfo.aRect;
|
|
|
|
//Brush.Color := Viewer.Color;
|
|
Brush.Color := DrawInfo.Color;
|
|
FillRect(aRect);
|
|
|
|
//Font.Assign(Viewer.Font);
|
|
Font.Assign(DrawInfo.Font);
|
|
Self.Canvas.Font.Assign(DrawInfo.Font);
|
|
FixFont(Self.Canvas.Font);
|
|
|
|
RegBrushColor := Brush.Color;
|
|
RegFontColor := Font.Color;
|
|
|
|
NextLineTop := aRect.Top;
|
|
lLineRect.Left := aRect.Left;
|
|
lLineRect.Right := aRect.Right;
|
|
|
|
//Flags := DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER;
|
|
Flags := DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_TOP;
|
|
|
|
if csDesigning in ComponentState then
|
|
LastLine := 2
|
|
else
|
|
LastLine := Lesser(ViewableLines - 1, LineCount - TopLine - 1);
|
|
|
|
for I := 0 to LastLine do
|
|
begin
|
|
Brush.Color := RegBrushColor;
|
|
Font.Color := RegFontColor;
|
|
|
|
lLineRect.Top := NextLineTop;
|
|
lLineRect.Bottom := Lesser(NextLineTop + CalcLineHeight, aRect.Bottom);
|
|
|
|
if csDesigning in ComponentState then
|
|
begin
|
|
Txt := 'Appt ' + IntToStr(I);
|
|
Appt := nil;
|
|
end
|
|
else
|
|
begin
|
|
lLine := AbsToRel(I);
|
|
if lLine < 0 then
|
|
lLine := 0;
|
|
if lLine >= Viewer.ApptCount then
|
|
lLine := 0;
|
|
Appt := Viewer.Appts[lLine];
|
|
|
|
Txt := '';
|
|
if Viewer.ShowStartEnd then
|
|
Txt := GetStartEndString(Appt) + ': ';
|
|
Txt := Txt + StringReplace(Appt.Description, #13#10, ' ', [rfReplaceAll]);
|
|
|
|
if Appt = Viewer.SelAppt then
|
|
begin
|
|
Brush.Color := Viewer.SelApptAttr.Color;
|
|
Font.Color := Viewer.SelApptAttr.FontColor;
|
|
|
|
FillRect(lLineRect);
|
|
|
|
if I <> 0 then
|
|
begin
|
|
MoveTo(aRect.Left, lLineRect.Top);
|
|
LineTo(aRect.Right, lLineRect.Top);
|
|
end;
|
|
if I <> AbsLineCount - 1 then
|
|
begin
|
|
MoveTo(aRect.Left, lLineRect.Bottom - 1);
|
|
LineTo(aRect.Right, lLineRect.Bottom - 1);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if Appt.Color <> clDefault then
|
|
begin
|
|
Brush.Color := Appt.Color;
|
|
FillRect(lLineRect);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
TxtRect := lLineRect;
|
|
InflateRect(TxtRect, -1, -1);
|
|
|
|
DrawingHandled := False;
|
|
if Assigned(Viewer) then
|
|
Viewer.DoDrawAppt(ACanvas, DrawInfo, Appt, lLineRect, DrawingHandled);
|
|
|
|
if not DrawingHandled then
|
|
begin
|
|
// PTxt := StrAlloc((Length(Txt) + 4) * SizeOf(Char));
|
|
// StrPCopy(PTxt, Txt);
|
|
// Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
|
|
// StrDispose(PTxt);
|
|
DrawText(ACanvas.Handle, PChar(Txt), Length(Txt), TxtRect, Flags);
|
|
end;
|
|
|
|
Inc(NextLineTop, CalcLineHeight);
|
|
end;
|
|
end;
|
|
|
|
if not (csDesigning in ComponentState) then
|
|
begin
|
|
if not Replicating and (FMousePtInfo.RelLineNum < Viewer.ApptCount) and
|
|
FMouseInControl and FShowDDButton then
|
|
DrawDDButton(ACanvas);
|
|
|
|
(* wp: looks ugly. Was replaced by scroll buttons in cell title...
|
|
BtnRect := ScrollUpBtnRect(DrawInfo.aRect);
|
|
if not IsRectEmpty(BtnRect) then
|
|
DrawScrollUpBtn(ACanvas, DrawInfo.aRect);
|
|
|
|
BtnRect := ScrollDnBtnRect(DrawInfo.aRect);
|
|
if not IsRectEmpty(BtnRect) then
|
|
DrawScrollDnBtn(ACanvas, DrawInfo.aRect);
|
|
*)
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.WMEraseBkgnd(var Msg: TLMessage);
|
|
begin
|
|
Msg.Result := LRESULT(False);
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
GlancePt: TPoint;
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
FMousePtInfo := CalcPointInfo(X, Y);
|
|
MouseLine := FMousePtInfo.AbsLineNum;
|
|
//SetFocus;
|
|
|
|
GlancePt := Point(X, Y);
|
|
GlancePt := Viewer.GlanceControl.ScreenToClient(ClientToScreen(Point(X, Y)));
|
|
Viewer.GlanceControl.CheckViewerApptHint(GlancePt.X, GlancePt.Y);
|
|
|
|
// for TESTING ONLY!!!
|
|
//Invalidate;
|
|
////////////////////
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
|
begin
|
|
// If the control is being moved, we keep track of when this happened.
|
|
// See in MouseUp for details of usage of this value.
|
|
if (Left <> ALeft) or (Top <> ATop) then
|
|
FWasMovedTicks := GetTickCount64
|
|
else
|
|
FWasMovedTicks := 0;
|
|
|
|
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.SetMouseLine(Value: Integer);
|
|
begin
|
|
if Value <> FMouseLine then
|
|
begin
|
|
FMouseLine := Value;
|
|
UpdateDDBtnRect;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.UpdateDDBtnRect;
|
|
begin
|
|
FDDBtnRect := LineRect(FMousePtInfo.AbsLineNum);
|
|
FDDBtnRect.Right := ClientRect.Right - 1;
|
|
FDDBtnRect.Left := FDDBtnRect.Right - 10;
|
|
Inc(FDDBtnRect.Top, 2);
|
|
Dec(FDDBtnRect.Bottom, 1);
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.DoEnter;
|
|
begin
|
|
inherited DoEnter;
|
|
Viewer.SetSelAppt(FindApptAtLine(FMousePtInfo.RelLineNum));
|
|
DoViewerEnter;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.DoExit;
|
|
begin
|
|
inherited DoExit;
|
|
FMouseLine := -1;
|
|
end;
|
|
|
|
{
|
|
function TJvTFGVTextControl.LineCount: Integer;
|
|
var
|
|
ACell: TJvTFGlanceCell;
|
|
I: Integer;
|
|
begin
|
|
Result := 0;
|
|
ACell := Viewer.GlanceControl.Cells.Cells[Viewer.Col, Viewer.Row];
|
|
|
|
for I := 0 to ACell.ScheduleCount - 1 do
|
|
Inc(Result, ACell.Schedules[I].ApptCount);
|
|
end;
|
|
}
|
|
|
|
function TJvTFGVTextControl.LineCount: Integer;
|
|
begin
|
|
Result := Viewer.ApptCount;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.SetTopLine(Value: Integer);
|
|
begin
|
|
Viewer.SetTopLine(Viewer.Cell, Value);
|
|
end;
|
|
|
|
function TJvTFGVTextControl.CalcPointInfo(X, Y: Integer): TJvTFGlTxtVwPointInfo;
|
|
begin
|
|
with Result do
|
|
begin
|
|
AbsX := X;
|
|
AbsY := Y;
|
|
AbsLineNum := CalcAbsLineNum(Y);
|
|
RelLineNum := TopLine + AbsLineNum;
|
|
end;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.ViewableLines: Integer;
|
|
var
|
|
aRect: TRect;
|
|
begin
|
|
aRect := GlanceControl.CalcCellBodyRect(Viewer.Cell,
|
|
GlanceControl.CellIsSelected(Viewer.Cell), False);
|
|
|
|
Result := RectHeight(aRect) div CalcLineHeight;
|
|
if RectHeight(aRect) mod CalcLineHeight > 0 then
|
|
Inc(Result);
|
|
end;
|
|
|
|
function TJvTFGVTextControl.AbsToRel(Abs: Integer): Integer;
|
|
begin
|
|
Result := TopLine + Abs;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.RelToAbs(Rel: Integer): Integer;
|
|
begin
|
|
Result := Rel - TopLine;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.DoMouseWheelDown(Shift: TShiftState;
|
|
MousePos: TPoint): Boolean;
|
|
begin
|
|
Result := inherited;
|
|
if not Result and Viewer.CanScrollCell(sdDown) then begin
|
|
Scroll(+1);
|
|
Result := true;
|
|
end;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.DoMouseWheelUp(Shift: TShiftState;
|
|
MousePos: TPoint): Boolean;
|
|
begin
|
|
Result := inherited;
|
|
if not Result and Viewer.CanScrollCell(sdUp) then begin
|
|
Scroll(-1);
|
|
Result := true;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.DoViewerDblClick;
|
|
begin
|
|
if FHasScrolled then
|
|
Exit;
|
|
|
|
Viewer.DoDblClick;
|
|
FWasInDblClick := True;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.DoViewerClick;
|
|
begin
|
|
Viewer.DoClick;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.DoViewerEnter;
|
|
begin
|
|
Viewer.DoEnter;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.DblClick;
|
|
begin
|
|
if FHasScrolled then
|
|
Exit;
|
|
|
|
inherited DblClick;
|
|
DoViewerDblClick;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Appt: TJvTFAppt;
|
|
ticks: Cardinal;
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
SetFocus;
|
|
|
|
// In order not to trigger double clicks when clicking too fast on the
|
|
// little arrows in the list, we keep track of wether or not scrolling
|
|
// occured. But of course, we have to reinitialize this, and the best
|
|
// Place to do it is here, in MouseDown.
|
|
FHasScrolled := False;
|
|
|
|
if PtInRect(ScrollDnBtnRect(ClientRect), Point(X, Y)) then
|
|
Scroll(1)
|
|
else
|
|
if PtInRect(ScrollUpBtnRect(ClientRect), Point(X, Y)) then
|
|
Scroll(-1)
|
|
else
|
|
begin
|
|
Appt := FindApptAtLine(FMousePtInfo.RelLineNum);
|
|
if Assigned(Appt) then
|
|
begin
|
|
if Viewer.SelAppt <> Appt then
|
|
begin
|
|
Viewer.SetSelAppt(Appt);
|
|
Click;
|
|
end;
|
|
end;
|
|
|
|
if PtInRect(FDDBtnRect, Point(X, Y)) and Assigned(Viewer) then
|
|
begin
|
|
EditAppt(Viewer.Cell, FMousePtInfo.RelLineNum, Appt);
|
|
Viewer.LineDDClick(MouseLine);
|
|
end
|
|
else
|
|
begin
|
|
// When the user double clicks in a cell that is not already selected,
|
|
// we are moved to the new place. As a result, the second MouseUp is
|
|
// sent to us, not the grid, which result in a double click not being
|
|
// triggered. In order to trigger the double click, we keep track of
|
|
// the change of location in SetBounds and if we get a MouseUp event
|
|
// in less than the double click time, we know it's a because of a
|
|
// double click and we trigger the appropriate event.
|
|
ticks := GetTickCount64;
|
|
if (ticks - FWasMovedTicks < GetDoubleClickTime) then
|
|
begin
|
|
DoViewerDblClick;
|
|
end;
|
|
FWasMovedTicks := 0;
|
|
|
|
// only start dragging if the mouse down has not happened in the double
|
|
// click window. That's because if we get a MouseDown right after a
|
|
// DoubleClick, then we will never receive the MouseUp. The code below
|
|
// would lead to the start of a drag of an appointment leading to potential
|
|
// problems when clicking again (like dropping an non existent appointment).
|
|
// To avoid this, we keep track of the fact that we went through a double
|
|
// click and do nothing when we get a mouse down right after that.
|
|
if not PtInRect(FDDBtnRect, Point(X, Y)) and Assigned(Appt) and
|
|
not FWasInDblClick then
|
|
Viewer.GlanceControl.BeginDrag(False);
|
|
end;
|
|
end;
|
|
|
|
FWasInDblClick := False;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.MouseUp(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.MouseEnter(Control: TControl);
|
|
begin
|
|
FMouseInControl := True;
|
|
inherited MouseEnter(Control);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.MouseLeave(Control: TControl);
|
|
begin
|
|
FMouseInControl := False;
|
|
inherited MouseLeave(Control);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.Scroll(ADelta: Integer);
|
|
var
|
|
CurrTop: Integer;
|
|
begin
|
|
CurrTop := Viewer.GetTopLine(Viewer.Cell);
|
|
Viewer.SetTopLine(Viewer.Cell, CurrTop + ADelta);
|
|
FHasScrolled := True;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.GetTopLine: Integer;
|
|
begin
|
|
Result := Viewer.GetTopLine(Viewer.Cell);
|
|
end;
|
|
|
|
function TJvTFGVTextControl.ScrollDnBtnRect(aCellRect: TRect): TRect;
|
|
var
|
|
BtnLeft,
|
|
BtnTop: Integer;
|
|
begin
|
|
if TopLine + FullViewableLines - 1 < LineCount - 1 then
|
|
begin
|
|
Result := Rect(0, 0, FScrollDnBtnBMP.Width, FScrollDnBtnBMP.Height);
|
|
BtnLeft := aCellRect.Right - 10 - RectWidth(Result);
|
|
BtnTop := aCellRect.Bottom - RectHeight(Result);
|
|
OffsetRect(Result, BtnLeft, BtnTop);
|
|
end
|
|
else
|
|
Result := Rect(0, 0, 0, 0);
|
|
end;
|
|
|
|
function TJvTFGVTextControl.ScrollUpBtnRect(aCellRect: TRect): TRect;
|
|
var
|
|
BtnLeft: Integer;
|
|
// h: Integer;
|
|
begin
|
|
if TopLine > 0 then
|
|
begin
|
|
(*
|
|
h := RectHeight(Viewer.GlanceControl.TitleRect);
|
|
BtnLeft := aCellRect.Right - 10 - FScrollUpBtnBMP.Width;
|
|
Result := Rect(BtnLeft, aCellRect.Top - h, aCellRect.Right, aCellRect.Top);
|
|
*)
|
|
|
|
Result := Rect(0, 0, FScrollUpBtnBMP.Width, FScrollUpBtnBMP.Height);
|
|
BtnLeft := aCellRect.Right - 10 - RectWidth(Result);
|
|
OffsetRect(Result, BtnLeft, aCellRect.Top);
|
|
end
|
|
else
|
|
Result := Rect(0, 0, 0, 0);
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.SetCanEdit(const Value: Boolean);
|
|
begin
|
|
FCanEdit := Value;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.SetShowDDButton(const Value: Boolean);
|
|
begin
|
|
FShowDDButton := Value;
|
|
end;
|
|
|
|
destructor TJvTFGVTextControl.Destroy;
|
|
begin
|
|
FEditor.Free;
|
|
FScrollUpBtnBMP.Free;
|
|
FScrollDnBtnBMP.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.InitScrollDnBtnBMP;
|
|
begin
|
|
with FScrollDnBtnBMP do
|
|
begin
|
|
Height := 9;
|
|
Width := 16;
|
|
|
|
with Canvas do
|
|
begin
|
|
Pixels[0,0] := clBtnFace;
|
|
Brush.Color := clBtnFace;
|
|
FillRect(Rect(0, 0, Width, Height));
|
|
|
|
Pen.Color := clBlack;
|
|
Polyline([Point(0, 0), Point(Width - 1, 0),
|
|
Point(Width - 1, Height - 1), Point(0, Height - 1),
|
|
Point(0, 0)]);
|
|
|
|
MoveTo(2, 2);
|
|
LineTo(14, 2);
|
|
MoveTo(2, 3);
|
|
LineTo(14, 3);
|
|
MoveTo(7, 4);
|
|
LineTo(13, 4);
|
|
MoveTo(8, 5);
|
|
LineTo(12, 5);
|
|
MoveTo(9, 6);
|
|
LineTo(11, 6);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.InitScrollUpBtnBMP;
|
|
begin
|
|
with FScrollUpBtnBMP do
|
|
begin
|
|
Height := 9;
|
|
Width := 16;
|
|
|
|
with Canvas do
|
|
begin
|
|
Pixels[0,0] := clBtnFace;
|
|
Brush.Color := clBtnFace;
|
|
FillRect(Rect(0, 0, Width, Height));
|
|
|
|
Pen.Color := clBlack;
|
|
Polyline([Point(0, 0), Point(Width - 1, 0),
|
|
Point(Width - 1, Height - 1), Point(0, Height - 1),
|
|
Point(0, 0)]);
|
|
|
|
MoveTo(9, 2);
|
|
LineTo(11, 2);
|
|
MoveTo(8, 3);
|
|
LineTo(12, 3);
|
|
MoveTo(7, 4);
|
|
LineTo(13, 4);
|
|
MoveTo(2, 5);
|
|
LineTo(14, 5);
|
|
MoveTo(2, 6);
|
|
LineTo(14, 6);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{
|
|
procedure TJvTFGVTextControl.DrawScrollDnBtn(ACanvas: TCanvas; aCellRect: TRect);
|
|
var
|
|
aRect: TRect;
|
|
begin
|
|
aRect := ScrollDnBtnRect(aCellRect);
|
|
BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, RectWidth(aRect),
|
|
RectHeight(aRect), FScrollDnBtnBMP.Canvas.Handle, 0, 0, SRCCOPY);
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.DrawScrollUpBtn(ACanvas: TCanvas; aCellRect: TRect);
|
|
var
|
|
aRect: TRect;
|
|
begin
|
|
aRect := ScrollUpBtnRect(aCellRect);
|
|
BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, RectWidth(aRect),
|
|
RectHeight(aRect), FScrollUpBtnBMP.Canvas.Handle, 0, 0, SRCCOPY);
|
|
end;
|
|
}
|
|
|
|
function TJvTFGVTextControl.FullViewableLines: Integer;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
with GlanceControl do
|
|
R := CalcCellBodyRect(Viewer.Cell, CellIsSelected(Viewer.Cell), False);
|
|
Result := RectHeight(R) div CalcLineHeight;
|
|
end;
|
|
|
|
(*
|
|
procedure TJvTFGVTextControl.EditAppt(Col, Row: Integer; Appt: TJvTFAppt);
|
|
var
|
|
EditLine: Integer;
|
|
EditorRect: TRect;
|
|
begin
|
|
EditLine := RelToAbs(GetApptRelLineNum(Appt));
|
|
if not Assigned(Appt) or not CanEdit or
|
|
((EditLine < 0) or (EditLine > AbsLineCount)) then
|
|
Exit;
|
|
|
|
Viewer.EnsureCol(Col);
|
|
Viewer.EnsureRow(Row);
|
|
if (Viewer.Col <> Col) or (Viewer.Row <> Row) then
|
|
Viewer.MoveTo(Col, Row);
|
|
|
|
if Viewer.EditorAlign = eaLine then
|
|
begin
|
|
EditorRect := LineRect(EditLine);
|
|
FEditor.WordWrap := False;
|
|
FEditor.BorderStyle := bsSingle;
|
|
end
|
|
else
|
|
begin
|
|
EditorRect := ClientRect;
|
|
FEditor.WordWrap := True;
|
|
FEditor.BorderStyle := bsNone;
|
|
end;
|
|
|
|
with FEditor do
|
|
begin
|
|
LinkedAppt := Appt;
|
|
Color := Viewer.SelApptAttr.Color;
|
|
Font := Viewer.GlanceControl.SelCellAttr.Font;
|
|
Font.Color := Viewer.SelApptAttr.FontColor;
|
|
BoundsRect := EditorRect;
|
|
|
|
Text := Appt.Description;
|
|
{
|
|
if agoFormattedDesc in Options then
|
|
Text := Appt.Description
|
|
else
|
|
Text := StripCRLF(Appt.Description);
|
|
}
|
|
|
|
{ //Self.Update; // not calling update here increases flicker
|
|
Visible := True;
|
|
SetFocus;
|
|
SelLength := 0;
|
|
SelStart := 0;
|
|
end;
|
|
end;
|
|
}
|
|
*)
|
|
|
|
procedure TJvTFGVTextControl.EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer; Appt: TJvTFAppt);
|
|
var
|
|
EditLine: Integer;
|
|
EditorRect: TRect;
|
|
begin
|
|
//EditLine := RelToAbs(GetApptRelLineNum(Appt));
|
|
EditLine := RelToAbs(RelLine);
|
|
if not Assigned(Appt) or not CanEdit or
|
|
((EditLine < 0) or (EditLine > AbsLineCount)) then
|
|
Exit;
|
|
|
|
Viewer.MoveTo(ACell);
|
|
|
|
if Viewer.EditorAlign = eaLine then
|
|
begin
|
|
EditorRect := LineRect(EditLine);
|
|
FEditor.WordWrap := False;
|
|
FEditor.BorderStyle := bsSingle;
|
|
end
|
|
else
|
|
begin
|
|
EditorRect := ClientRect;
|
|
FEditor.WordWrap := True;
|
|
FEditor.BorderStyle := bsNone;
|
|
end;
|
|
|
|
with FEditor do
|
|
begin
|
|
LinkedAppt := Appt;
|
|
Color := Viewer.SelApptAttr.Color;
|
|
Font := Viewer.GlanceControl.SelCellAttr.Font;
|
|
Font.Color := Viewer.SelApptAttr.FontColor;
|
|
BoundsRect := EditorRect;
|
|
|
|
Text := Appt.Description;
|
|
{
|
|
if agoFormattedDesc in Options then
|
|
Text := Appt.Description
|
|
else
|
|
Text := StripCRLF(Appt.Description);
|
|
}
|
|
|
|
//Self.Update; // not calling update here increases flicker
|
|
Visible := True;
|
|
SetFocus;
|
|
SelLength := 0;
|
|
SelStart := 0;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TJvTFGVTextControl.Editing: Boolean;
|
|
begin
|
|
Result := FEditor.Visible;
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.FinishEditAppt;
|
|
begin
|
|
if Assigned(FEditor.LinkedAppt) then
|
|
FEditor.LinkedAppt.Description := FEditor.Text;
|
|
FEditor.Visible := False;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.FindApptAtLine(RelLineNum: Integer): TJvTFAppt;
|
|
begin
|
|
if Assigned(Viewer) and
|
|
(RelLineNum >= 0) and (RelLineNum < Viewer.ApptCount) then
|
|
Result := Viewer.Appts[RelLineNum]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.GetApptRelLineNum(Appt: TJvTFAppt): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := -1;
|
|
if not Assigned(Appt) then
|
|
Exit;
|
|
|
|
I := 0;
|
|
while (I < Viewer.ApptCount) and (Result = -1) do
|
|
if Viewer.Appts[I] = Appt then
|
|
Result := I
|
|
else
|
|
Inc(I);
|
|
end;
|
|
|
|
function TJvTFGVTextControl.AbsLineCount: Integer;
|
|
begin
|
|
//Result := Lesser(ViewableLines - 1, LineCount - TopLine - 1);
|
|
Result := RectHeight(ClientRect) div CalcLineHeight;
|
|
if RectHeight(ClientRect) mod CalcLineHeight > 0 then
|
|
Inc(Result);
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.MouseAccel(X, Y: Integer);
|
|
var
|
|
Appt: TJvTFAppt;
|
|
begin
|
|
Appt := GetApptAccel(X, Y);
|
|
if Assigned(Appt) then
|
|
Viewer.SetSelAppt(Appt);
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.Click;
|
|
begin
|
|
DoViewerClick;
|
|
end;
|
|
|
|
function TJvTFGVTextControl.GetStartEndString(Appt: TJvTFAppt): string;
|
|
var
|
|
ShowDates: Boolean;
|
|
DateFormat,
|
|
TimeFormat: string;
|
|
begin
|
|
ShowDates := (Trunc(Appt.StartDate) <> Trunc(Viewer.Date)) or
|
|
(Trunc(Appt.EndDate) <> Trunc(Viewer.Date));
|
|
DateFormat := Viewer.GlanceControl.DateFormat;
|
|
TimeFormat := Viewer.GlanceControl.TimeFormat;
|
|
|
|
Result := '';
|
|
if ShowDates then
|
|
Result := FormatDateTime(DateFormat, Appt.StartDate) + ' ';
|
|
|
|
Result := Result + FormatDateTime(TimeFormat, Appt.StartTime) + ' - ';
|
|
|
|
if ShowDates then
|
|
Result := Result + FormatDateTime(DateFormat, Appt.EndDate) + ' ';
|
|
|
|
Result := Result + FormatDateTime(TimeFormat, Appt.EndTime);
|
|
end;
|
|
|
|
function TJvTFGVTextControl.GetApptAccel(X, Y: Integer): TJvTFAppt;
|
|
var
|
|
LocalPt: TPoint;
|
|
begin
|
|
LocalPt := ScreenToClient(Viewer.GlanceControl.ClientToScreen(Point(X, Y)));
|
|
Result := GetApptAt(LocalPt.X, LocalPt.Y);
|
|
end;
|
|
|
|
function TJvTFGVTextControl.GetApptAt(X, Y: Integer): TJvTFAppt;
|
|
var
|
|
PtInfo: TJvTFGlTxtVwPointInfo;
|
|
begin
|
|
PtInfo := CalcPointInfo(X, Y);
|
|
Result := FindApptAtLine(PtInfo.RelLineNum);
|
|
end;
|
|
|
|
procedure TJvTFGVTextControl.DragOver(Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
begin
|
|
inherited DragOver(Source, X, Y, State, Accept);
|
|
if Source is TJvTFControl then
|
|
Viewer.Visible := False;
|
|
end;
|
|
|
|
//=== { TJvTFGlanceTextViewer } ==============================================
|
|
|
|
constructor TJvTFGlanceTextViewer.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FTopLines := TStringList.Create;
|
|
FViewControl := TJvTFGVTextControl.Create(Self);
|
|
FSelApptAttr := TJvTFTxtVwApptAttr.Create(Self);
|
|
FSelApptAttr.OnChange := @SelApptAttrChange;
|
|
FEditorAlign := eaLine;
|
|
FShowStartEnd := True;
|
|
end;
|
|
|
|
destructor TJvTFGlanceTextViewer.Destroy;
|
|
begin
|
|
FViewControl.Free;
|
|
FTopLines.Free;
|
|
FSelApptAttr.OnChange := nil;
|
|
FSelApptAttr.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJvTFGlanceTextViewer.CanScrollCell(ADir: TJvTFVScrollDir): Boolean;
|
|
begin
|
|
with FViewControl do
|
|
case ADir of
|
|
sdUp: Result := TopLine > 0;
|
|
sdDown: Result := TopLine + FullViewableLines < LineCount;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.Change;
|
|
begin
|
|
Refresh;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SetEditorAlign(Value: TJvTFGlTxtVwEditorAlign);
|
|
begin
|
|
FEditorAlign := Value;
|
|
end;
|
|
|
|
function TJvTFGlanceTextViewer.GetDrawInfo(ACell: TJvTFGlanceCell): TJvTFGlTxtVwDrawInfo;
|
|
var
|
|
Attr: TJvTFGlanceCellAttr;
|
|
begin
|
|
if not Assigned(GlanceControl) then
|
|
raise EGlanceViewerError.CreateRes(@RsEGlanceControlNotAssigned);
|
|
|
|
with Result do
|
|
begin
|
|
Cell := ACell;
|
|
Attr := GlanceControl.GetCellAttr(ACell);
|
|
Font := Attr.Font;
|
|
Color := Attr.Color;
|
|
aRect := GlanceControl.CalcCellBodyRect(ACell,
|
|
GlanceControl.CellIsSelected(ACell), False);
|
|
end;
|
|
end;
|
|
|
|
function TJvTFGlanceTextViewer.GetTopLine(ACell: TJvTFGlanceCell): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := FTopLines.IndexOf(GetCellString(ACell));
|
|
if I > -1 then
|
|
Result := PtrInt(FTopLines.Objects[I])
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.LineDDClick(LineNum: Integer);
|
|
begin
|
|
if Assigned(FOnLineDDClick) then
|
|
FOnLineDDClick(Self, LineNum);
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.DoDblClick;
|
|
begin
|
|
if Assigned(FOnDblClick) then
|
|
FOnDblClick(Self);
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.DoClick;
|
|
begin
|
|
if Assigned(FOnClick) then
|
|
FOnClick(Self);
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.DoEnter;
|
|
begin
|
|
if Assigned(FOnEnter) then
|
|
FOnEnter(Self);
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.MouseAccel(X, Y: Integer);
|
|
begin
|
|
inherited MouseAccel(X, Y);
|
|
FViewControl.MouseAccel(X, Y);
|
|
DoClick;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.Notify(Sender: TObject;
|
|
Code: TJvTFServNotifyCode);
|
|
begin
|
|
inherited Notify(Sender, Code);
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.PaintTo(ACanvas: TCanvas; ACell: TJvTFGlanceCell);
|
|
begin
|
|
FViewControl.PaintTo(ACanvas, GetDrawInfo(ACell));
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.ParentReconfig;
|
|
begin
|
|
inherited ParentReconfig;
|
|
FTopLines.Clear;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.Realign;
|
|
begin
|
|
if not Assigned(GlanceControl) then
|
|
Exit;
|
|
|
|
FViewControl.BoundsRect := CalcBoundsRect(Cell);
|
|
if not FViewControl.Replicating then
|
|
SetSelAppt(nil);
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.Refresh;
|
|
begin
|
|
if FViewControl.Parent <> nil then
|
|
FViewControl.Parent.Invalidate;
|
|
{
|
|
if FViewControl.Parent = nil then
|
|
FViewControl.Invalidate
|
|
else
|
|
FViewControl.Parent.Invalidate;
|
|
}
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.ResetTopLines;
|
|
begin
|
|
FTopLines.Clear;
|
|
GlanceControl.Invalidate;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.ScrollCell(ADelta: Integer);
|
|
begin
|
|
FViewControl.Scroll(ADelta)
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SelApptAttrChange(Sender: TObject);
|
|
begin
|
|
//Change;
|
|
FViewControl.Invalidate;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SetGlanceControl(Value: TJvTFCustomGlance);
|
|
begin
|
|
inherited SetGlanceControl(Value);
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
FViewControl.Parent := Value;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SetInplaceEdit(const Value: Boolean);
|
|
begin
|
|
inherited SetInplaceEdit(Value);
|
|
|
|
FViewControl.CanEdit := InPlaceEdit;
|
|
FViewControl.Invalidate;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SetLineSpacing(Value: Integer);
|
|
begin
|
|
//Value := Greater(Value, 0);
|
|
if Value <> FLineSpacing then
|
|
begin
|
|
FLineSpacing := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SetSelAppt(Value: TJvTFAppt);
|
|
begin
|
|
FSelAppt := Value;
|
|
FViewControl.Invalidate;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SetSelApptAttr(Value: TJvTFTxtVwApptAttr);
|
|
begin
|
|
FSelApptAttr.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SetTopLine(ACell: TJvTFGlanceCell; Value: Integer);
|
|
var
|
|
I: Integer;
|
|
CellStr: string;
|
|
begin
|
|
Value := Greater(Value, 0);
|
|
Value := Lesser(Value, ApptCount - 1);
|
|
|
|
// bug fix - this effectively hides the hint window. The showing/hiding
|
|
// of the hint window was causing the viewer to be positioned at the
|
|
// wrong cell due to repainting as the hint window would hide/show.
|
|
GlanceControl.CheckViewerApptHint(-1, -1);
|
|
|
|
CellStr := GetCellString(ACell);
|
|
I := FTopLines.IndexOf(CellStr);
|
|
if I > -1 then
|
|
if Value = 0 then
|
|
FTopLines.Delete(I)
|
|
else
|
|
FTopLines.Objects[I] := TObject(PtrInt(Value))
|
|
else
|
|
if Value <> 0 then
|
|
FTopLines.AddObject(CellStr, TObject(PtrInt(Value)));
|
|
Refresh;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SetVisible(Value: Boolean);
|
|
begin
|
|
// MORE STUFF NEEDS TO BE ADDED HERE!
|
|
FViewControl.Visible := Value;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SetShowStartEnd(Value: Boolean);
|
|
begin
|
|
if Value <> FShowStartEnd then
|
|
begin
|
|
FShowStartEnd := Value;
|
|
if not (csLoading in ComponentState) then
|
|
begin
|
|
GlanceControl.Invalidate;
|
|
FViewControl.Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvTFGlanceTextViewer.GetApptAt(X, Y: Integer): TJvTFAppt;
|
|
begin
|
|
Result := FViewControl.GetApptAt(X, Y);
|
|
end;
|
|
|
|
function TJvTFGlanceTextViewer.CanEdit: Boolean;
|
|
begin
|
|
Result := FViewControl.CanEdit and InPlaceEdit;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer;
|
|
Appt: TJvTFAppt);
|
|
begin
|
|
FViewControl.EditAppt(ACell, RelLine, Appt);
|
|
end;
|
|
|
|
function TJvTFGlanceTextViewer.Editing: Boolean;
|
|
begin
|
|
Result := FViewControl.Editing;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.FinishEditAppt;
|
|
begin
|
|
FViewControl.FinishEditAppt;
|
|
end;
|
|
|
|
function TJvTFGlanceTextViewer.GetCellString(ACell: TJvTFGlanceCell): string;
|
|
begin
|
|
Result := '';
|
|
if Assigned(ACell) then
|
|
begin
|
|
Result := IntToStr(ACell.ColIndex) + ',' + IntToStr(ACell.RowIndex);
|
|
if ACell.IsSubcell then
|
|
Result := Result + 'S';
|
|
end;
|
|
end;
|
|
|
|
function TJvTFGlanceTextViewer.GetShowLineDDButton: Boolean;
|
|
begin
|
|
Result := FViewControl.ShowDDButton;
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.DoDrawAppt(ACanvas: TCanvas;
|
|
DrawInfo: TJvTFGlTxtVwDrawInfo; Appt: TJvTFAppt; Rect: TRect; var Handled: Boolean);
|
|
begin
|
|
if Assigned(FOnDrawAppt) then
|
|
FOnDrawAppt(Self, ACanvas, DrawInfo, Appt, Rect, Handled);
|
|
end;
|
|
|
|
procedure TJvTFGlanceTextViewer.SetShowLineDDButton(const Value: Boolean);
|
|
begin
|
|
FViewControl.ShowDDButton := Value;
|
|
end;
|
|
|
|
//=== { TJvTFGVTxtEditor } ===================================================
|
|
|
|
constructor TJvTFGVTxtEditor.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
ControlStyle := ControlStyle + [csNoDesignVisible];
|
|
{
|
|
ParentCtl3D := False;
|
|
Ctl3D := False;
|
|
}
|
|
end;
|
|
|
|
destructor TJvTFGVTxtEditor.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvTFGVTxtEditor.DoExit;
|
|
begin
|
|
inherited DoExit;
|
|
try
|
|
if not FCancelEdit then
|
|
TJvTFGVTextControl(Owner).FinishEditAppt;
|
|
finally
|
|
FCancelEdit := False;
|
|
Parent.SetFocus;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTFGVTxtEditor.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
|
|
if Key = VK_ESCAPE then
|
|
begin
|
|
FCancelEdit := True;
|
|
Key := 0;
|
|
Visible := False;
|
|
end
|
|
else
|
|
if (Key = VK_RETURN) and (ssCtrl in Shift) then
|
|
TJvTFGVTextControl(Owner).FinishEditAppt;
|
|
end;
|
|
|
|
//=== { TJvTFTxtVwApptAttr } =================================================
|
|
|
|
constructor TJvTFTxtVwApptAttr.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create;
|
|
FColor := clBlue;
|
|
FFontColor := clWhite;
|
|
end;
|
|
|
|
procedure TJvTFTxtVwApptAttr.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TJvTFTxtVwApptAttr then
|
|
begin
|
|
FColor := TJvTFTxtVwApptAttr(Source).Color;
|
|
FFontColor := TJvTFTxtVwApptAttr(Source).FontColor;
|
|
Change;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TJvTFTxtVwApptAttr.Change;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TJvTFTxtVwApptAttr.SetColor(Value: TColor);
|
|
begin
|
|
if Value <> FColor then
|
|
begin
|
|
FColor := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvTFTxtVwApptAttr.SetFontColor(Value: TColor);
|
|
begin
|
|
if Value <> FFontColor then
|
|
begin
|
|
FFontColor := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
|
|
end.
|