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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4811 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/examples/demo/demomain.lfm

@@ -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'

components/tvplanit/packages/laz_visualplanit.lpk

@@ -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"/>

components/tvplanit/source/vpbasepainter.pas

@@ -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.

components/tvplanit/source/vpcontactgrid.pas

@@ -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;

components/tvplanit/source/vpdayviewpainter.pas

@@ -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;
 

components/tvplanit/source/vpmisc.pas

@@ -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;
 {=====}

components/tvplanit/source/vpweekviewpainter.pas

@@ -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