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

tvplanit: Move drawing code of TVpContactGrid to separate unit (VpContactGridPainter). Split off some shared code to TVpBasePainter.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4811 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-06-23 11:53:21 +00:00
parent ba2e8bce22
commit 9b8ce7a12b
8 changed files with 2331 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/tvplanit/examples/demo/demomain.lfm
View File

@ -25,9 +25,9 @@ object MainForm: TMainForm
Height = 532
Top = 48
Width = 780
ActivePage = TabEvents
ActivePage = TabContacts
Align = alClient
TabIndex = 0
TabIndex = 2
TabOrder = 0
object TabEvents: TTabSheet
Caption = 'Events'

6
components/tvplanit/packages/laz_visualplanit.lpk
View File

@ -32,7 +32,7 @@ Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower S
Contributor(s): "/>
<Version Major="1" Release="4"/>
<Files Count="68">
<Files Count="69">
<Item1>
<Filename Value="../source/vpalarmdlg.lfm"/>
<Type Value="LFM"/>
@ -306,6 +306,10 @@ Contributor(s): "/>
<Filename Value="../source/vpbasepainter.pas"/>
<UnitName Value="VpBasePainter"/>
</Item68>
<Item69>
<Filename Value="../source/vpcontactgridpainter.pas"/>
<UnitName Value="VpContactGridPainter"/>
</Item69>
</Files>
<i18n>
<EnableI18N Value="True"/>

49
components/tvplanit/source/vpbasepainter.pas
View File

@ -22,6 +22,20 @@ type
StopLine: Integer;
UseGran: TVpGranularity;
DisplayOnly: Boolean;
protected
RealWidth: Integer;
RealHeight: Integer;
RealLeft: Integer;
RealRight: Integer;
RealTop: Integer;
RealBottom: Integer;
SaveBrushColor: TColor;
SavePenStyle: TPenStyle;
SavePenColor: TColor;
procedure InitPenBrush; virtual;
procedure SavePenBrush; virtual;
procedure RestorePenBrush; virtual;
procedure SetMeasurements; virtual;
public
constructor Create(ARenderCanvas: TCanvas);
procedure RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle;
@ -31,6 +45,9 @@ type
implementation
uses
VpCanvasUtils;
{ TBasePainter }
constructor TVpBasePainter.Create(ARenderCanvas: TCanvas);
@ -38,6 +55,14 @@ begin
RenderCanvas := ARenderCanvas;
end;
procedure TVpBasePainter.InitPenBrush;
begin
RenderCanvas.Pen.Style := psSolid;
RenderCanvas.Pen.Width := 1;
RenderCanvas.Pen.Mode := pmCopy;
RenderCanvas.Brush.Style := bsSolid;
end;
procedure TVpBasePainter.RenderToCanvas(ARenderIn: TRect;
AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime;
AStartLine, AStopLine: Integer; AGranularity: TVpGranularity;
@ -56,4 +81,28 @@ begin
// call the old RenderToCanvas method here...
end;
procedure TVpBasePainter.RestorePenBrush;
begin
RenderCanvas.Pen.Style := SavePenStyle;
RenderCanvas.Brush.Color := SaveBrushColor;
RenderCanvas.Pen.Color := SavePenColor;
end;
procedure TVpBasePainter.SavePenBrush;
begin
SavePenStyle := RenderCanvas.Pen.Style;
SaveBrushColor := RenderCanvas.Brush.Color;
SavePenColor := RenderCanvas.Pen.Color;
end;
procedure TVpBasePainter.SetMeasurements;
begin
RealWidth := TPSViewportWidth(Angle, RenderIn);
RealHeight := TPSViewportHeight(Angle, RenderIn);
RealLeft := TPSViewportLeft(Angle, RenderIn);
RealRight := TPSViewportRight(Angle, RenderIn);
RealTop := TPSViewportTop(Angle, RenderIn);
RealBottom := TPSViewportBottom(Angle, RenderIn);
end;
end.

17
components/tvplanit/source/vpcontactgrid.pas
View File

@ -267,7 +267,7 @@ type
implementation
uses
SysUtils, Math, Forms, Dialogs, VpContactEditDlg;
SysUtils, Math, Forms, Dialogs, VpContactEditDlg, VpContactGridPainter;
(*****************************************************************************)
@ -599,6 +599,20 @@ procedure TVpContactGrid.RenderToCanvas (RenderCanvas : TCanvas;
StopLine : Integer;
UseGran : TVpGranularity;
DisplayOnly : Boolean);
var
painter: TVpContactGridPainter;
begin
cgPainting := true;
painter := TVpContactGridPainter.Create(Self, RenderCanvas);
try
painter.RenderToCanvas(RenderIn, Angle, Scale, RenderDate, StartLine,
StopLine, UseGran, DisplayOnly);
finally
painter.Free;
cgPainting := false;
end;
end;
(*
var
SaveBrushColor : TColor;
SavePenStyle : TPenStyle;
@ -1811,6 +1825,7 @@ begin
cgPainting := false;
end;
{=====}
*)
{ Introduced to support the buttonbar component !!.02}
function TVpContactGrid.SelectContactByName(const Name: String): Boolean;

2210
components/tvplanit/source/vpcontactgridpainter.pas Normal file
View File

File diff suppressed because it is too large Load Diff

76
components/tvplanit/source/vpdayviewpainter.pas
View File

@ -36,12 +36,6 @@ type
Drawn: Boolean;
ScrollBarOffset: Integer;
EventCount: Integer;
RealWidth: Integer;
RealHeight: Integer;
RealLeft: Integer;
RealRight: Integer;
RealTop: Integer;
RealBottom: Integer;
DayWidth: Integer;
RealNumDays: Integer;
Rgn: HRGN;
@ -91,9 +85,11 @@ type
procedure DrawRowHeader(R: TRect);
procedure FreeBitmaps;
procedure GetIcons(Event: TVpEvent);
procedure InitColors;
procedure InitializeEventRectangles;
procedure ScaleIcons(EventRect: TRect);
procedure SetMeasurements;
procedure SetMeasurements; override;
public
constructor Create(ADayView: TVpDayview; ARenderCanvas: TCanvas);
@ -1515,28 +1511,8 @@ begin
CustomH := dvBmpCustom.Height;
end;
procedure TVpDayViewPainter.InitializeEventRectangles;
var
I : Integer;
procedure TVpDayViewPainter.InitColors;
begin
EventCount := 0;
with TVpDayViewOpener(FDayView) do
for I := 0 to pred(Length(dvEventArray)) do begin
dvEventArray[I].Rec.Left := -1;
dvEventArray[I].Rec.Top := -1;
dvEventArray[I].Rec.Right := -1;
dvEventArray[I].Rec.Bottom := -1;
dvEventArray[I].Event := nil;
end;
end;
procedure TVpDayViewPainter.RenderToCanvas(ARenderIn: TRect;
AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime;
AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean);
begin
inherited;
// Here begins the original routine...
if DisplayOnly then begin
BevelShadow := clBlack;
BevelHighlight := clBlack;
@ -1568,6 +1544,33 @@ begin
ADEventAttrBkgColor := FDayView.AllDayEventAttributes.EventBackgroundColor;
ADEventBorderColor := FDayView.AllDayEventAttributes.EventBorderColor;
end;
end;
procedure TVpDayViewPainter.InitializeEventRectangles;
var
I : Integer;
begin
EventCount := 0;
with TVpDayViewOpener(FDayView) do
for I := 0 to pred(Length(dvEventArray)) do begin
dvEventArray[I].Rec.Left := -1;
dvEventArray[I].Rec.Top := -1;
dvEventArray[I].Rec.Right := -1;
dvEventArray[I].Rec.Bottom := -1;
dvEventArray[I].Event := nil;
end;
end;
procedure TVpDayViewPainter.RenderToCanvas(ARenderIn: TRect;
AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime;
AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean);
begin
inherited;
// Here begins the original routine...
InitColors;
SavePenBrush;
InitPenBrush;
SetMeasurements;
@ -1579,11 +1582,6 @@ begin
else
ScrollBarOffset := 14;
// dvPainting := true; -- moved to TVpDayView
SavePenStyle := RenderCanvas.Pen.Style;
SaveBrushColor := RenderCanvas.Brush.Color;
SavePenColor := RenderCanvas.Pen.Color;
Rgn := CreateRectRgn(RenderIn.Left, RenderIn.Top, RenderIn.Right, RenderIn.Bottom);
try
SelectClipRgn(RenderCanvas.Handle, Rgn);
@ -1730,15 +1728,12 @@ begin
end;
{ Reinstate RenderCanvas settings }
RenderCanvas.Pen.Style := SavePenStyle;
RenderCanvas.Brush.Color := SaveBrushColor;
RenderCanvas.Pen.Color := SavePenColor;
RestorePenBrush;
finally
SelectClipRgn(RenderCanvas.Handle, 0);
DeleteObject(Rgn);
end;
// dvPainting := false; -- moved to TVpDayView
end;
procedure TVpDayViewPainter.ScaleIcons(EventRect: TRect);
@ -1774,12 +1769,7 @@ end;
procedure TVpDayViewPainter.SetMeasurements;
begin
RealWidth := TPSViewportWidth(Angle, RenderIn);
RealHeight := TPSViewportHeight(Angle, RenderIn);
RealLeft := TPSViewportLeft(Angle, RenderIn);
RealRight := TPSViewportRight(Angle, RenderIn);
RealTop := TPSViewportTop(Angle, RenderIn);
RealBottom := TPSViewportBottom(Angle, RenderIn);
inherited;
TVpDayViewOpener(FDayView).dvCalcColHeadHeight(Scale);
end;

4
components/tvplanit/source/vpmisc.pas
View File

@ -136,9 +136,9 @@ procedure StripString(var Str: string);
begin
if Length (Str) < 1 then
Exit;
while not (Str[1] in ['A'..'Z', 'a'..'z', '0'..'9']) do
while (Length(Str) > 0) and (not (Str[1] in ['A'..'Z', 'a'..'z', '0'..'9'])) do
delete(Str, 1, 1);
while not (Str[Length(Str)] in ['A'..'Z', 'a'..'z', '0'..'9']) do
while (Length(Str) > 0) and (not (Str[Length(Str)] in ['A'..'Z', 'a'..'z', '0'..'9'])) do
delete(Str, Length(Str), 1);
end;
{=====}

45
components/tvplanit/source/vpweekviewpainter.pas
View File

@ -20,12 +20,6 @@ type
DayRectHeight: Integer;
StrLn: Integer;
StartDate: TDateTime;
RealWidth: Integer;
RealHeight: Integer;
RealLeft: Integer;
RealRight: Integer;
RealTop: Integer;
RealBottom: Integer;
ADEventsRect: TRect;
Rgn: HRGN;
DotDotDotColor: TColor;
@ -47,7 +41,8 @@ type
procedure DrawBorders;
procedure DrawDays;
procedure DrawHeader;
procedure SetMeasurements;
procedure InitColors;
procedure SetMeasurements; override;
public
constructor Create(AWeekView: TVpWeekView; ARenderCanvas: TCanvas);
@ -575,13 +570,8 @@ begin
);
end;
procedure TVpWeekViewPainter.RenderToCanvas(ARenderIn: TRect;
AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime;
AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean);
procedure TVpWeekViewPainter.InitColors;
begin
inherited;
// Here begins the original routine...
if DisplayOnly then begin
BevelHighlightColor := clBlack;
BevelShadowColor := clBlack;
@ -608,16 +598,17 @@ begin
ADEventBorderColor := FWeekView.AllDayEventAttributes.EventBorderColor;
end;
DotDotDotColor := clBlack;
end;
// wvPainting := true; --- moved to TVpWeekView
SavePenStyle := RenderCanvas.Pen.Style;
SaveBrushColor := RenderCanvas.Brush.Color;
SavePenColor := RenderCanvas.Pen.Color;
procedure TVpWeekViewPainter.RenderToCanvas(ARenderIn: TRect;
AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime;
AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean);
begin
inherited;
RenderCanvas.Pen.Style := psSolid;
RenderCanvas.Pen.Width := 1;
RenderCanvas.Pen.Mode := pmCopy;
RenderCanvas.Brush.Style := bsSolid;
InitColors;
SavePenBrush;
InitPenBrush;
Rgn := CreateRectRgn(RenderIn.Left, RenderIn.Top, RenderIn.Right, RenderIn.Bottom);
try
@ -644,20 +635,12 @@ begin
DeleteObject(Rgn);
end;
RenderCanvas.Pen.Style := SavePenStyle;
RenderCanvas.Brush.Color := SaveBrushColor;
RenderCanvas.Pen.Color := SavePenColor;
// wvPainting := false; --- moved to TVpWeekView
RestorePenBrush;
end;
procedure TVpWeekViewPainter.SetMeasurements;
begin
RealWidth := TPSViewportWidth(Angle, RenderIn);
RealHeight := TPSViewportHeight(Angle, RenderIn);
RealLeft := TPSViewportLeft(Angle, RenderIn);
RealRight := TPSViewportRight(Angle, RenderIn);
RealTop := TPSViewportTop(Angle, RenderIn);
RealBottom := TPSViewportBottom(Angle, RenderIn);
inherited;
with TVpWeekViewOpener(FWeekView) do
if RenderDate = 0 then