diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm index 4b1fb4716..fc1d29848 100644 --- a/components/tvplanit/examples/fulldemo/demomain.lfm +++ b/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 diff --git a/components/tvplanit/examples/fulldemo/demomain.pas b/components/tvplanit/examples/fulldemo/demomain.pas index a0bfab4d0..ada70e5da 100644 --- a/components/tvplanit/examples/fulldemo/demomain.pas +++ b/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; diff --git a/components/tvplanit/source/vpcanvasutils.pas b/components/tvplanit/source/vpcanvasutils.pas index f0be831b9..ffbd78bb0 100644 --- a/components/tvplanit/source/vpcanvasutils.pas +++ b/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; diff --git a/components/tvplanit/source/vptasklistpainter.pas b/components/tvplanit/source/vptasklistpainter.pas index 5cac99afb..f1f8eb480 100644 --- a/components/tvplanit/source/vptasklistpainter.pas +++ b/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; - Y := Rec.Top + TextMargin; - W := RowHeight - TextMargin * 2; // correct: The checkbox is square, its width is determined by the row height + tm := Round(Textmargin * Scale); + + 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 + 1), + Point(X + 1, Y + W - 3), + 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 - TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Top); - TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom); - TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Top+1); - TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Bottom); - TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Top); - TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom-1); - 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-2); - TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Top-1); - TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Bottom-1); - TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top); - end; + with RenderCanvas do begin + { \ } + TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Top); // center + TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom); + TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Top); // upper + TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom-1); + TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Top+1); // lower + TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Bottom); + { / } + TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-1); // center + TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1); + TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-2); // upper + TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Top-1); + TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Bottom-1); // lower + TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top); end; csCheck: {check} begin - dx := WidthOf(CR) div 4; - dy := HeightOf(CR) div 4; + dx := WidthOf(CR) div 3; + dy := HeightOf(CR) div 3; with RenderCanvas do begin - TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom - dy); - TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left + dx, CR.Bottom); - TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top + 2); + TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-dy); + TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left+dx, CR.Bottom); + TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1); - TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom - dy - 1); - TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left + dx, CR.Bottom - 1); - TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top + 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.Right-1, CR.Top-1); - TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom - dy - 2); - TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left + dx, CR.Bottom - 2); + TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-dy+1); + 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 - HeadRect.Left := HeadRect.Left + Bmp.Width + TextMargin; + // RenderCanvas.Draw(GlyphRect.TopLeft.x, GlyphRect.TopLeft.y, Bmp); //soner added + HeadRect.Left := HeadRect.Left + w + TextMargin; end; finally Bmp.Free;