tvplanit: Fix size & rotation of header bitmap in printed task list.

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

components/tvplanit/examples/fulldemo/demomain.lfm

@@ -1,7 +1,7 @@
 object MainForm: TMainForm
-  Left = 325
+  Left = 307
   Height = 600
-  Top = 181
+  Top = 312
   Width = 900
   Caption = 'Turbo Power VisualPlanIt Demo'
   ClientHeight = 580
@@ -238,6 +238,8 @@ object MainForm: TMainForm
           DataStore = VpBufDSDataStore1
           ControlLink = VpControlLink1
           Color = clWindow
+          Font.Height = -12
+          ParentFont = False
           AllDayEventAttributes.BackgroundColor = clWindow
           AllDayEventAttributes.EventBorderColor = clGray
           AllDayEventAttributes.EventBackgroundColor = clBtnFace
@@ -248,6 +250,8 @@ object MainForm: TMainForm
           DayHeadAttributes.Font.Height = -13
           DayHeadAttributes.Bordered = True
           DrawingStyle = dsFlat
+          EventFont.Height = -12
+          HeadAttributes.Font.Height = -12
           HeadAttributes.Color = clBtnFace
           LineColor = clGray
           TimeFormat = tf12Hour
@@ -302,6 +306,8 @@ object MainForm: TMainForm
           DataStore = VpBufDSDataStore1
           ControlLink = VpControlLink1
           Color = clWindow
+          Font.Height = -12
+          ParentFont = False
           Align = alClient
           TabStop = True
           TabOrder = 1
@@ -319,6 +325,7 @@ object MainForm: TMainForm
           LineColor = clGray
           MaxVisibleTasks = 250
           TaskHeadAttributes.Color = clSilver
+          TaskHeadAttributes.Font.Height = -12
           DrawingStyle = ds3d
           ShowResourceName = True
         end
@@ -707,6 +714,45 @@ object MainForm: TMainForm
             Width = 100
           end>
         FormatName = 'Events of current week (Week view)'
+      end    
+      item
+        Version = 'v1.04'
+        DayInc = 0
+        DayIncUnits = duDay
+        Elements = <        
+          item
+            Version = 'v1.04'
+            DayOffset = 0
+            DayOffsetUnits = duWeek
+            ElementName = 'TaskList'
+            Height = 100
+            ItemType = itTasks
+            Left = 0
+            Shape.Shape = ustRectangle
+            Top = 0
+            Width = 100
+          end>
+        FormatName = 'Tasks of current week'
+      end    
+      item
+        Version = 'v1.04'
+        DayInc = 0
+        DayIncUnits = duDay
+        Elements = <        
+          item
+            Version = 'v1.04'
+            DayOffset = 0
+            DayOffsetUnits = duDay
+            ElementName = 'TaskList'
+            Height = 100
+            ItemType = itTasks
+            Left = 0
+            Rotation = ra270
+            Shape.Shape = ustRectangle
+            Top = 0
+            Width = 100
+          end>
+        FormatName = 'Tasks of current week (landscape)'
       end>
     Printer.RightMargin = 5
     Printer.TopMargin = 5

components/tvplanit/examples/fulldemo/demomain.pas

@@ -401,6 +401,10 @@ begin
          t1 := StartOfTheWeek(now);
          t2 := t1;     // it all fits on one single page
        end;
+    2: begin  // Tasks of current week
+         t1 := StartOfTheWeek(now);
+         t2 := t1;
+       end;
   end;
   VpPrintPreviewDialog1.ControlLink := VpControlLink1;
   VpPrintPreviewDialog1.Printer := Printer;

components/tvplanit/source/vpcanvasutils.pas

@@ -319,10 +319,18 @@ function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
 function RenderTextToRegion(ACanvas: TCanvas; const Angle: TVpRotationAngle;
   const Viewport: TRect; ARegion: HRGN; AString: string): Integer;
 
+{$IFDEF FPC}
+procedure RotateBitmap(ABitmap: TBitmap; Angle: TVpRotationAngle);
+{$ENDIF}
+procedure ScaleBitmap(ABitmap: TBitmap; Scale: Extended);
+
 
 implementation
 
 uses
+ {$IFDEF FPC}
+  IntfGraphics,
+ {$ENDIF}
   VpMisc;
 
 var
@@ -881,12 +889,11 @@ end;
 procedure TVpExCanvas.BrushCopy(const Dest: TRect; Bitmap: TBitmap;
   const Source: TRect; AColor: TColor);
 begin
-  Unused(Dest, Bitmap);
-  Unused(Source, AColor);
-
   if not Assigned(FCanvas) then
     raise EVpCanvasError.Create(RSNoCanvas);
 
+  FCanvas.BrushCopy(TPSRotateRectangle(Angle, ViewPort, Dest), Bitmap, Source, AColor);
+
 //TODO:  FCanvas.BrushCopy(TPSRotateRectangle(Angle, ViewPort, Dest),
 //                     Bitmap, Source, AColor);
 end;
@@ -1767,6 +1774,80 @@ begin
     Result := #0;                                                        
 end;                                                                     
 
+{$IFDEF FPC}
+procedure RotateBitmap(ABitmap: TBitmap; Angle: TVpRotationAngle);
+Var
+  bmp: TBitmap;
+  tmpIntfImg2, tmpIntfImg: TLazIntfImage;
+  imgHandle, imgMaskHandle: HBitmap;
+  i, j: integer;
+Begin
+  if Angle = ra0 then
+    exit;
+
+  tmpIntfImg2 := TLazIntfImage.Create(0, 0);
+  try
+    bmp := TBitmap.Create;
+    try
+      tmpIntfImg := TLazIntfImage.Create(0, 0);
+      try
+        if Angle in [ra90, ra270] then begin
+          bmp.Width := ABitmap.Height;
+          bmp.Height := ABitmap.Width;
+          tmpIntfImg.LoadFromBitmap(bmp.Handle, bmp.MaskHandle);
+          tmpIntfImg2.LoadFromBitmap(ABitmap.Handle, ABitmap.MaskHandle);
+          if Angle = ra90 then
+            for i:=0 to ABitmap.Width-1 do
+              for j:=0 to ABitmap.Height-1 do
+                tmpIntfImg.Colors[ABitmap.Height-1-j, i] := tmpIntfImg2.Colors[i, j]
+          else
+            for i:=0 to ABitmap.Width-1 do
+              for j:=0 to ABitmap.Height-1 do
+                tmpIntfImg.Colors[j, ABitmap.Width-1-i] := tmpIntfImg2.Colors[i, j];
+        end else
+        if Angle = ra180 then begin
+          bmp.Width := ABitmap.Width;
+          bmp.Height := ABitmap.Height;
+          tmpIntfImg.LoadFromBitmap(bmp.Handle, bmp.MaskHandle);
+          tmpIntfImg2.LoadFromBitmap(ABitmap.Handle, ABitmap.MaskHandle);
+          for i:=0 to ABitmap.Width-1 do
+            for j:=0 to ABitmap.Height-1 do
+              tmpIntfImg.Colors[ABitmap.Width-1-i, ABitmap.Height-1-j] := tmpIntfImg2.Colors[i, j];
+        end;
+        tmpIntfImg.CreateBitmaps(imgHandle, imgMaskHandle, false);
+        bmp.Handle := ImgHandle;
+        bmp.MaskHandle := ImgMaskHandle;
+      finally
+        tmpIntfImg.Free;
+      end;
+      ABitmap.Assign(bmp);
+    finally
+      bmp.Free;
+    end;
+  finally
+    tmpIntfImg2.Free;
+  end;
+end;
+{$ENDIF}
+
+procedure ScaleBitmap(ABitmap: TBitmap; Scale: Extended);
+var
+  bmp: TBitmap;
+  w, h, left, top: integer;
+begin
+  bmp := TBitmap.Create;
+  try
+    w := Round(ABitmap.Width * Scale);
+    h := Round(ABitmap.Height * Scale);
+    bmp.Width := w;
+    bmp.Height := h;
+    bmp.Canvas.CopyRect(Rect(0, 0, w, h), ABitmap.Canvas, Rect(0, 0, ABitmap.Width, ABitmap.Height));
+    ABitmap.Assign(bmp);
+  finally
+    Bmp.free;
+  end;
+end;
+
 
 initialization                                                           
   VpRotatedCanvas := TVpExCanvas.Create;

components/tvplanit/source/vptasklistpainter.pas

@@ -7,7 +7,7 @@ interface
 uses
   SysUtils, LCLType, LCLIntf,
   //SysUtils, LCLType, LCLIntf, Types,
-  Classes, Graphics,
+  Classes, Graphics, Types,
   //VpConst,
   VPBase, //VpData,
   VpTaskList, VpBasePainter;
@@ -91,10 +91,14 @@ var
   W: Integer;    // width of the checkbox
   X, Y: Integer; // Coordinates
   dx, dy: Integer;
+  tm: Integer;   // Scaled text margin;
+  d2: Integer;   // 2*Scale
 begin
-  X := Rec.Left + TextMargin;
+  tm := Round(Textmargin * Scale);
-  Y := Rec.Top + TextMargin;
+
-  W := RowHeight - TextMargin * 2;    // correct: The checkbox is square, its width is determined by the row height
+  X := Rec.Left + tm;
+  Y := Rec.Top + tm;
+  W := RowHeight - tm * 2;    // correct: The checkbox is square, its width is determined by the row height
 
   { draw check box }
   case FTaskList.DrawingStyle of
@@ -120,63 +124,68 @@ begin
         // left and top lines
         RenderCanvas.Pen.Color := RealCheckBoxColor;
         TPSPolyLine(RenderCanvas, Angle, RenderIn, [
-          Point(X + 1, Y + W - 3),
+          Point(X + 1,     Y + W - 3),
-          Point(X + 1, Y + 1),
+          Point(X + 1,     Y + 1),
           Point(X + W - 2, Y + 1)
         ]);
         // right and bottom lines
         RenderCanvas.Pen.Color := RGB(128, 152, 176);
         TPSPolyLine(RenderCanvas, Angle, RenderIn, [
-          Point(X + 1, Y + W - 2),
+          Point(X + 1,     Y + W - 2),
           Point(X + W - 2, Y + W - 2),
-          Point(X+W-2, Y)
+          Point(X + W - 2, Y)
         ]);
       end;
   end;
 
   { build check rect }
-  CR := Rect(X + 3, Y + 3, X + W - 3, Y + W - 3);
+  d2 := Round(2*Scale);
+  if Scale > 1 then
+    CR := Rect(X + d2, Y + d2, X + W - d2, Y + W - d2)
+  else
+    CR := Rect(X + 3, Y + 3, X + W - 3, Y + W - 3);
   if Checked then begin
     RenderCanvas.Pen.Color := RealCheckColor;
+    // Instead of using Pen.Width = 3 we paint 3x - looks better
     case FTaskList.DisplayOptions.CheckStyle of
       csX: {X}
-        begin
+        with RenderCanvas do begin
-          with RenderCanvas do begin
+          { \ }
-            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Top);
+          TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Top);        // center
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom);
+          TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom);
-            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Top+1);
+          TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Top);      // upper
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Bottom);
+          TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom-1);
-            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Top);
+          TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Top+1);      // lower
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom-1);
+          TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Bottom);
-            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-1);
+          { / }
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1);
+          TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-1);   // center
-            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-2);
+          TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1);
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Top-1);
+          TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-2);   // upper
-            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Bottom-1);
+          TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Top-1);
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top);
+          TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Bottom-1); // lower
-          end;
+          TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top);
         end;
       csCheck: {check}
         begin
-          dx := WidthOf(CR) div 4;
+          dx := WidthOf(CR) div 3;
-          dy := HeightOf(CR) div 4;
+          dy := HeightOf(CR) div 3;
           with RenderCanvas do begin
-            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom - dy);
+            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-dy);
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left + dx, CR.Bottom);
+            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left+dx, CR.Bottom);
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top + 2);
+            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1);
 
-            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom - dy - 1);
+            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Bottom-dy);
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left + dx, CR.Bottom - 1);
+            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left+ dx, CR.Bottom-1);
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top + 1);
+            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Top-1);
 
-            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom - dy - 2);
+            TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-dy+1);
-            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left + dx, CR.Bottom - 2);
+            TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left+dx, CR.Bottom+1);
             TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top);
           end;
         end;
     end;
   end; {if checked}
-  result := CR;
+  result := Rect(X, Y, X + W, Y + W);  //CR;
 end;
 
 procedure TVpTaskListPainter.DrawBorders;
@@ -239,6 +248,7 @@ var
   GlyphRect: TRect;
   HeadStr: string;
   delta: Integer;
+  w, h: Integer;
 begin
   RenderCanvas.Brush.Color := TaskHeadAttrColor;
   RenderCanvas.Font.Assign(FTaskList.TaskHeadAttributes.Font);
@@ -274,13 +284,30 @@ begin
     try
       Bmp.LoadFromResourceName(HINSTANCE, 'VPCHECKPAD'); //soner changed: Bmp.Handle := LoadBaseBitmap('VPCHECKPAD');
       if Bmp.Height > 0 then begin
+        w := Round(Bmp.Width * Scale);
+        h := Round(Bmp.Height * Scale);
+
         GlyphRect.TopLeft := Point(HeadRect.Left + TextMargin, HeadRect.Top + TextMargin);
-        GlyphRect.BottomRight := Point(GlyphRect.Left + Bmp.Width, GlyphRect.Top + Bmp.Height);
+        GlyphRect.BottomRight := Point(GlyphRect.Left + w, GlyphRect.Top + h);
+
+        {$IFDEF FPC}
+        RotateBitmap(Bmp, Angle);
+        {$ENDIF}
+
+        TPSStretchDraw(RenderCanvas, Angle, RenderIn, GlyphRect, Bmp);
+        {
+        RenderCanvas.BrushCopy(
+          TPSRotateRectangle(Angle, RenderIn, GlyphRect),
+          Bmp,
+          Rect(0, 0, Bmp.Width, Bmp.Height),
+          Bmp.Canvas.Pixels[0, Bmp.Height-1]
+        );
+         }
 //TODO:          RenderCanvas.BrushCopy (TPSRotateRectangle (Angle, RenderIn, GlyphRect),
 //                                  Bmp, Rect(0, 0, Bmp.Width, Bmp.Height),
 //            Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
-        RenderCanvas.Draw(GlyphRect.TopLeft.x, GlyphRect.TopLeft.y, Bmp); //soner added
+       // RenderCanvas.Draw(GlyphRect.TopLeft.x, GlyphRect.TopLeft.y, Bmp); //soner added
-        HeadRect.Left := HeadRect.Left + Bmp.Width + TextMargin;
+        HeadRect.Left := HeadRect.Left + w + TextMargin;
       end;
     finally
       Bmp.Free;