callite: Refactor drawing routines to avoid flicker.

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

components/callite/demo2/testCalLite.lpi

@@ -1,15 +1,21 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
     <PathDelim Value="\"/>
     <General>
+      <Flags>
+        <CompatibilityMode Value="True"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="testCalLite"/>
+      <Scaled Value="True"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>

components/callite/demo2/testCalLite.lpr

@@ -9,6 +9,7 @@ uses
 
 begin
   RequireDerivedFormResource := True;
+  Application.Scaled:=True;
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.Run;

components/callite/demo2/umaintestcallite.lfm

@@ -1,10 +1,10 @@
 object Form1: TForm1
   Left = 700
-  Height = 845
+  Height = 746
   Top = 122
   Width = 851
   Caption = 'Examples of the TCalendaLite  component'
-  ClientHeight = 845
+  ClientHeight = 746
   ClientWidth = 851
   Color = clWindow
   Font.CharSet = ANSI_CHARSET
@@ -12,16 +12,16 @@ object Form1: TForm1
   LCLVersion = '2.1.0.0'
   object PSettings: TPanel
     Left = 0
-    Height = 448
+    Height = 432
     Top = 0
     Width = 851
     Align = alTop
-    ClientHeight = 448
+    ClientHeight = 432
     ClientWidth = 851
     TabOrder = 0
     object cgOptions: TCheckGroup
       Left = 24
-      Height = 392
+      Height = 384
       Top = 40
       Width = 160
       AutoFill = True
@@ -34,7 +34,7 @@ object Form1: TForm1
       ChildSizing.ShrinkVertical = crsScaleChilds
       ChildSizing.Layout = cclLeftToRightThenTopToBottom
       ChildSizing.ControlsPerLine = 1
-      ClientHeight = 372
+      ClientHeight = 364
       ClientWidth = 156
       Items.Strings = (
         'coBoldDayNames'
@@ -118,7 +118,7 @@ object Form1: TForm1
     object rgLanguage: TRadioGroup
       Left = 200
       Height = 216
-      Top = 216
+      Top = 208
       Width = 160
       AutoFill = True
       Caption = 'Language to use'
@@ -149,7 +149,7 @@ object Form1: TForm1
     end
     object rgStartingDOW: TRadioGroup
       Left = 200
-      Height = 168
+      Height = 160
       Top = 40
       Width = 160
       AutoFill = True
@@ -161,7 +161,7 @@ object Form1: TForm1
       ChildSizing.ShrinkVertical = crsScaleChilds
       ChildSizing.Layout = cclLeftToRightThenTopToBottom
       ChildSizing.ControlsPerLine = 1
-      ClientHeight = 148
+      ClientHeight = 140
       ClientWidth = 156
       Items.Strings = (
         'Sunday'
@@ -177,11 +177,11 @@ object Form1: TForm1
     end
     object GroupBox1: TGroupBox
       Left = 376
-      Height = 392
+      Height = 384
       Top = 40
       Width = 160
       Caption = 'Colors'
-      ClientHeight = 372
+      ClientHeight = 364
       ClientWidth = 156
       TabOrder = 6
       object CbArrowBorder: TColorButton
@@ -490,7 +490,7 @@ object Form1: TForm1
     end
     object SelDateListbox: TListBox
       Left = 560
-      Height = 152
+      Height = 120
       Top = 280
       Width = 274
       Columns = 3
@@ -632,15 +632,15 @@ object Form1: TForm1
       }
       OnClick = sbResetButtonHeightClick
     end
-  end
     object Label1: TLabel
-    Left = 15
+      Left = 562
       Height = 15
-    Top = 818
+      Top = 408
       Width = 34
       Caption = 'Label1'
       ParentColor = False
     end
+  end
   object FontDialog: TFontDialog
     MinFontSize = 0
     MaxFontSize = 0

components/callite/demo2/umaintestcallite.pp

@@ -216,8 +216,6 @@ begin
   copyCal.Languages := demoCal.Languages;
   exit;
 
-
-
   if demoCal.Languages = lgCustom then begin
     demoCal.DayNames := 'S,M,T,W,T,F,S';
     demoCal.MonthNames := 'Ja,Fe,Mr,Ap,Ma,Jn,Jl,Au,Sp,Oc,Nv,Dc';

components/callite/source/calendarlite.pas

@@ -41,7 +41,7 @@ unit CalendarLite;
 interface
 
 uses
-  Classes, SysUtils, LResources, LCLVersion,
+  Classes, SysUtils, LResources, LCLVersion, LMessages,
   Forms, Controls, Graphics, Dialogs, Types, ExtCtrls, Menus;
 
 {$if lcl_fullversion >= 1080000}
@@ -129,6 +129,7 @@ type
   TCalDrawer = class
   private
     FBoundsRect: TRect;
+    FBuffer: TBitmap;
     FCanvas: TCanvas;
     FCellSize: TSize;
     FColPositions: TColArray;
@@ -141,6 +142,7 @@ type
     FTextStyle: TTextStyle;
     procedure CalcSettings;
     procedure DrawArrow(ARect: TRect; AHead: TArrowhead; ADirec: TArrowDirection);
+    procedure DrawBackground;
     procedure DrawDayCells;
     procedure DrawDayLabels;
     procedure DrawTodayRow;
@@ -158,9 +160,12 @@ type
     procedure GotoYear(AYear: word);
     procedure LeftClick(APoint: TPoint; Shift: TShiftState);
     procedure RightClick;
+    procedure SetBoundsRect(ARect: TRect);
   public
-    constructor Create(ACanvas: TCanvas);
+    constructor Create(AOwner: TCalendarLite);
     procedure Draw;
+    property BoundsRect: TRect read FBoundsRect write SetBoundsRect;
+    property Buffer: TBitmap read FBuffer;
   end;
 
 
@@ -195,6 +200,7 @@ type
 
   TCalendarLite = class(TCustomControl)
   private
+    FBufferValid: Boolean;
     FCalDrawer: TCalDrawer;
     FColors: TCalColors;
     FDate: TDateTime;
@@ -270,8 +276,13 @@ type
     procedure MouseLeave; override;
     procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
     function SelMode(Shift: TShiftState): TCalSelMode;
+    procedure SetBiDiMode(AValue: TBiDiMode); override;
+    procedure SetParentBiDiMode(AValue: Boolean); override;
 
     procedure Paint; override;
+    procedure Resize; override;
+    procedure UpdateBiDiMode;
+    procedure UpdateBuffer;
     procedure UseDayName(ADayOfWeek: TDayOfWeek; const AValue: String);
     procedure UseDayNames(const AValue: String);
     procedure UseDisplayTexts(const AValue: String);
@@ -281,7 +292,6 @@ type
     { Hints }
     procedure ShowHintWindow(APoint: TPoint; ADate: TDate);
     procedure HideHintWindow;
-
   public
     constructor Create(anOwner: TComponent); override;
     destructor Destroy; override;
@@ -661,10 +671,12 @@ end;
 
 { TCalDrawer }
 
-constructor TCalDrawer.Create(ACanvas: TCanvas);
+constructor TCalDrawer.Create(AOwner: TCalendarLite);
 begin
   inherited Create;
-  FCanvas:= ACanvas;
+  FBuffer := TBitmap.Create;
+  FOwner := AOwner;
+  FCanvas := FBuffer.Canvas;
   FTextStyle:= DefTextStyle;
 end;
 
@@ -735,6 +747,7 @@ begin
   if not Assigned(FCanvas) then Exit;
   DecodeDate(FOwner.FDate, FThisYear, FThisMonth, FThisDay);
   CalcSettings;
+  DrawBackground;
   DrawTopRow;
   DrawDayLabels;
   DrawTodayRow;
@@ -813,6 +826,18 @@ begin
   end;
 end;
 
+procedure TCalDrawer.DrawBackground;
+begin
+  FBuffer.Canvas.Brush.Color := FOwner.Colors.BackgroundColor;
+  if (coShowBorder in FOwner.Options) then
+  begin
+    FCanvas.Pen.Color := FOwner.FColors.BorderColor;
+    FCanvas.Pen.Style := psSolid;
+    FCanvas.Rectangle(0, 0, FBuffer.Width, FBuffer.Height);
+  end else
+    FBuffer.Canvas.FillRect(0, 0, FBuffer.Width, FBuffer.Height);
+end;
+
 procedure TCalDrawer.DrawDayCells;
 var
   remDays: integer = 0;
@@ -1337,6 +1362,14 @@ begin
   end;
 end;
 
+procedure TCalDrawer.SetBoundsRect(ARect: TRect);
+begin
+  if FBoundsRect = ARect then exit;
+  FBoundsRect := ARect;
+  FBuffer.SetSize(FBoundsRect.Width, FBoundsRect.Height);
+  Draw;
+end;
+
 
 { TCalColors }
 
@@ -1368,6 +1401,7 @@ procedure TCalColors.SetColor(AIndex: Integer; AValue: TColor);
 begin
   if FColors[AIndex] = AValue then exit;
   FColors[AIndex] := AValue;
+  FOwner.FBufferValid := false;
   FOwner.Invalidate;
 end;
 
@@ -1380,7 +1414,7 @@ begin
   FFormatSettings := DefaultFormatSettings;
   FSelDates := TCalDateList.Create;
   FColors := TCalColors.Create(self);
-  Color := clWhite;
+  //Color := clWhite;
   FStartingDayOfWeek:= dowSunday;
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, cx, cy);
@@ -1391,7 +1425,7 @@ begin
   Constraints.MinHeight := ScaleX(DefMinHeight, DESIGNTIME_PPI);
   Constraints.MinWidth := ScaleY(DefMinWidth, DESIGNTIME_PPI);
   {$endif}
-  Canvas.Brush.Style := bsSolid;
+  //Canvas.Brush.Style := bsSolid;
   TabStop := true;
   SetDefaultDayNames;
 //  FCustomDayNames := GetDayNames;
@@ -1400,8 +1434,7 @@ begin
   SetDefaultDisplayTexts;
   FCustomDisplayTexts := GetDisplayTexts;
   FPopupMenu := TPopupMenu.Create(Self);
-  FCalDrawer := TCalDrawer.Create(Canvas);
+  FCalDrawer := TCalDrawer.Create(Self);
-  FCalDrawer.FOwner:= Self;
   FDblClickTimer := TTimer.Create(self);
   FDblClickTimer.Enabled := false;
   FDblClickTimer.Interval := DBLCLICK_INTERVAL;
@@ -1504,10 +1537,13 @@ begin
   if MonthOf(FDate) <> oldMonth then
     MonthChange;
 
+  FBufferValid := false;
+  {
   with FCalDrawer do begin
     FCanvas.Brush.Color := Colors.BackgroundColor;
     FCanvas.FillRect(FBoundsRect);
   end;
+  }
   Invalidate;
 end;
 
@@ -1628,6 +1664,8 @@ begin
     mbLeft  : FCalDrawer.LeftClick(FClickPoint, FClickShift);
     mbRight : FCalDrawer.RightClick;
   end;
+  FBufferValid := false;
+  Invalidate;
 end;
 
 function TCalendarLite.IsSelected(ADate: TDate): Boolean;
@@ -1737,9 +1775,10 @@ var
 begin
   if Assigned(FCalDrawer) then
   begin
-    if ParentColor then
+    if not FBufferValid then
-      Colors.BackgroundColor := Parent.Color;
+      UpdateBuffer;
-
+    Canvas.Draw(0, 0, FCalDrawer.Buffer);
+(*
     if ParentFont then
     begin
       if (Parent.Font <> FCalDrawer.FCanvas.Font)
@@ -1755,6 +1794,9 @@ begin
              FCalDrawer.FTextStyle.RightToLeft := False;
     end;
 
+    if ParentColor then
+      Canvas.Brush.Color := Parent.Color
+    else
       Canvas.Brush.Color:= Colors.BackGroundColor;
     Canvas.FillRect(ClientRect);
     if (coShowBorder in FOptions) then
@@ -1769,11 +1811,25 @@ begin
     if (coShowBorder in FOptions) then InflateRect(r, -1, -1);
     FCalDrawer.FBoundsRect:= r;
     FCalDrawer.Draw;
+    *)
   end;
 
   inherited Paint;
 end;
 
+procedure TCalendarLite.Resize;
+begin
+  FBufferValid := false;
+  inherited;
+end;
+
+procedure TCalendarLite.UpdateBuffer;
+begin
+  FCalDrawer.BoundsRect:= ClientRect;
+  FCalDrawer.Draw;
+  FBufferValid := true;
+end;
+
 procedure TCalendarLite.PopulateHolidayPopupMenu;
 var
   item: TMenuItem;
@@ -1879,6 +1935,7 @@ procedure TCalendarLite.SetButtonHeight(const AValue: Integer);
 begin
   if FButtonHeight = AValue then exit;
   FButtonHeight := AValue;
+  FBufferValid := false;
   Invalidate;
 end;
 
@@ -1886,6 +1943,7 @@ procedure TCalendarLite.SetButtonWidth(const AValue: Integer);
 begin
   if FButtonWidth = AValue then exit;
   FButtonWidth := AValue;
+  FBufferValid := false;
   Invalidate;
 end;
 
@@ -1922,6 +1980,8 @@ begin
   DateChange;
   if MonthOf(FDate) <> oldMonth then
     MonthChange;
+  FBufferValid := false;
+  FBufferValid := false;
   Invalidate;
 end;
 
@@ -2078,6 +2138,12 @@ begin
     Result := smNextSingle;
 end;
 
+procedure TCalendarLite.SetBiDiMode(AValue: TBiDiMode);
+begin
+  inherited;
+  UpdateBiDiMode;
+end;
+
 procedure TCalendarLite.SetMultiSelect(AValue: Boolean);
 begin
   if AValue = FMultiSelect then
@@ -2088,10 +2154,17 @@ begin
   FPrevDate := FDate;
 end;
 
+procedure TCalendarLite.SetParentBiDiMode(AValue: Boolean);
+begin
+  inherited;
+  UpdateBiDiMode;
+end;
+
 procedure TCalendarLite.SetStartingDayOfWeek(AValue: TDayOfWeek);
 begin
   if FStartingDayOfWeek = AValue then Exit;
   FStartingDayOfWeek := AValue;
+  FBufferValid := false;
   Invalidate;
 end;
 
@@ -2105,6 +2178,7 @@ begin
   end;
   if Length(FCalDrawer.FRowPositions) <> LastRow+1 then
     SetLength(FCalDrawer.FRowPositions, LastRow+1);
+  FBufferValid := false;
   Invalidate;
 end;
 
@@ -2112,6 +2186,7 @@ procedure TCalendarLite.SetWeekendDays(AValue: TDaysOfWeek);
 begin
   if FWeekendDays = AValue then Exit;
   FWeekendDays := AValue;
+  FBufferValid := false;
   Invalidate;
 end;
 
@@ -2125,6 +2200,16 @@ begin
   InternalClick;
 end;
 
+procedure TCalendarLite.UpdateBiDiMode;
+begin
+  case (BiDiMode = bdLeftToRight) of
+    False: if not FCalDrawer.FTextStyle.RightToLeft then
+             FCalDrawer.FTextStyle.RightToLeft := True;
+    True : if FCalDrawer.FTextStyle.RightToLeft then
+            FCalDrawer.FTextStyle.RightToLeft := False;
+  end;
+end;
+
 procedure TCalendarlite.UseDayName(ADayOfWeek: TDayOfWeek; const AValue: String);
 var
   p: Integer;