{******************************************} { } { FastReport FMX v2.0 } { Checkbox Add-In Object } { } { Copyright (c) 1998-2014 } { by Alexander Tzyganenko, } { Fast Reports Inc. } { } {******************************************} unit FMX.frxChBox; interface {$I fmx.inc} {$I frx.inc} {$I fmx.inc} uses System.Types, System.SysUtils, System.Classes, FMX.Objects, FMX.Controls, FMX.frxClass, FMX.Types, FMX.TabControl, System.UIConsts, System.UITypes, System.Variants {$IFDEF DELPHI19} , FMX.Graphics {$ENDIF} {$IFDEF DELPHI28} , FMX.BaseTypeAliases, FMX.FormTypeAliases {$ENDIF}; type TfrxCheckStyle = (csCross, csCheck, csLineCross, csPlus); TfrxUncheckStyle = (usEmpty, usCross, usLineCross, usMinus); {$I frxFMX_PlatformsAttribute.inc} TfrxCheckBoxObject = class(TComponent) // fake component end; TfrxCheckBoxView = class(TfrxView) private FCheckColor: TAlphaColor; FChecked: Boolean; FCheckStyle: TfrxCheckStyle; FUncheckStyle: TfrxUncheckStyle; FExpression: String; procedure DrawCheck(ARect: TRectF); public constructor Create(AOwner: TComponent); override; procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; procedure GetData; override; class function GetDescription: String; override; published property BrushStyle; property CheckColor: TAlphaColor read FCheckColor write FCheckColor default claBlack; property Checked: Boolean read FChecked write FChecked default True; property CheckStyle: TfrxCheckStyle read FCheckStyle write FCheckStyle; property Color; property Cursor; property DataField; property DataSet; property DataSetName; property Expression: String read FExpression write FExpression; property Frame; property TagStr; property UncheckStyle: TfrxUncheckStyle read FUncheckStyle write FUncheckStyle default usEmpty; property URL; end; implementation uses FMX.frxChBoxRTTI, FMX.frxDsgnIntf, FMX.frxRes; constructor TfrxCheckBoxView.Create(AOwner: TComponent); begin inherited; FChecked := True; Height := fr01cm * 5; Width := fr01cm * 5; FCheckColor := claBlack; end; class function TfrxCheckBoxView.GetDescription: String; begin Result := frxResources.Get('obChBox'); end; procedure TfrxCheckBoxView.DrawCheck(ARect: TRectF); var minVal, dx, dy: Double; begin with FCanvas, ARect do if FChecked then begin if FCheckStyle = csCheck then begin FCanvas.Stroke.Kind := TBrushKind.bkSolid; {$IFDEF Delphi25} FCanvas.Stroke.Cap := TStrokeCap.scRound; {$ELSE} FCanvas.StrokeCap := TStrokeCap.scRound; {$ENDIF} FCanvas.Stroke.Color := FCheckColor; minVal := (Bottom - Top); if (minVal > (Right - Left)) then minVal := (Right - Left); {$IFDEF Delphi25} FCanvas.Stroke.Thickness := minVal/ 6; {$ELSE} FCanvas.StrokeThickness := minVal/ 6; {$ENDIF} dx := (Right - Left) / 2; dy := (Bottom - Top) / 2; DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 20), Top + (dy + minVal / 6)), PointF(Right - (dx ), Bottom - minVal / 6 ), 1); DrawLine( PointF(Left + dx, Bottom - minVal / 6), PointF(Right - (dx - minVal / 3), Top + (dy - minVal / 5)), 1); end else if FCheckStyle = csCross then begin FCanvas.Stroke.Kind := TBrushKind.bkSolid; {$IFDEF Delphi25} FCanvas.Stroke.Cap := TStrokeCap.scRound; {$ELSE} FCanvas.StrokeCap := TStrokeCap.scRound; {$ENDIF} FCanvas.Stroke.Color := FCheckColor; minVal := (Bottom - Top); if (minVal > (Right - Left)) then minVal := (Right - Left); {$IFDEF Delphi25} FCanvas.Stroke.Thickness := minVal/ 6; {$ELSE} FCanvas.StrokeThickness := minVal/ 6; {$ENDIF} dx := (Right - Left) / 2; dy := (Bottom - Top) / 2; DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 20), Top + (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Bottom - (dy - minVal / 4 )), 1); DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 16), Bottom - (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Top + (dy - minVal / 4)), 1); end else if FCheckStyle = csLineCross then begin FCanvas.Stroke.Kind := TBrushKind.bkSolid; FCanvas.Stroke.Color := FCheckColor; {$IFDEF Delphi25} FCanvas.Stroke.Thickness := FFrameWidth; {$ELSE} FCanvas.StrokeThickness := FFrameWidth; {$ENDIF} DrawLine( PointF(Left, Top), PointF(Right, Bottom), 1); DrawLine( PointF(Left, Bottom), PointF(Right, Top), 1); end else if FCheckStyle = csPlus then begin FCanvas.Stroke.Kind := TBrushKind.bkSolid; FCanvas.Stroke.Color := FCheckColor; {$IFDEF Delphi25} FCanvas.Stroke.Thickness := FFrameWidth; {$ELSE} FCanvas.StrokeThickness := FFrameWidth; {$ENDIF} DrawLine( PointF(Left + 3, Top + (Bottom - Top) / 2), PointF(Right - 2, Top + (Bottom - Top) / 2), 1); DrawLine( PointF(Left + (Right - Left) / 2, Top + 3), PointF(Left + (Right - Left) / 2, Bottom - 2), 1); end end else begin if FUncheckStyle = usCross then begin FCanvas.Stroke.Kind := TBrushKind.bkSolid; {$IFDEF Delphi25} FCanvas.Stroke.Cap := TStrokeCap.scRound; {$ELSE} FCanvas.StrokeCap := TStrokeCap.scRound; {$ENDIF} FCanvas.Stroke.Color := FCheckColor; minVal := (Bottom - Top); if (minVal > (Right - Left)) then minVal := (Right - Left); {$IFDEF Delphi25} FCanvas.Stroke.Thickness := minVal/ 6; {$ELSE} FCanvas.StrokeThickness := minVal/ 6; {$ENDIF} dx := (Right - Left) / 2; dy := (Bottom - Top) / 2; DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 20), Top + (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Bottom - (dy - minVal / 4 )), 1); DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 16), Bottom - (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Top + (dy - minVal / 4)), 1); end else if FUncheckStyle = usLineCross then begin FCanvas.Stroke.Kind := TBrushKind.bkSolid; FCanvas.Stroke.Color := FCheckColor; {$IFDEF Delphi25} FCanvas.Stroke.Thickness := FFrameWidth; {$ELSE} FCanvas.StrokeThickness := FFrameWidth; {$ENDIF} DrawLine( PointF(Left, Top), PointF(Right, Bottom), 1); DrawLine( PointF(Left, Bottom), PointF(Right, Top), 1); end else if FUncheckStyle = usMinus then begin FCanvas.Stroke.Kind := TBrushKind.bkSolid; FCanvas.Stroke.Color := FCheckColor; DrawLine(PointF(Left + 3, Top + (Bottom - Top) / 2), PointF(Right - 2, Top + (Bottom - Top) / 2), 1); end end; end; procedure TfrxCheckBoxView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); begin BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); DrawBackground; DrawCheck(RectF(FX, FY, FX1, FY1)); DrawFrame; end; procedure TfrxCheckBoxView.GetData; var v: Variant; begin inherited; if IsDataField then begin v := DataSet.Value[DataField]; if v = Null then v := False; FChecked := v; end else if FExpression <> '' then FChecked := Report.Calc(FExpression); end; initialization StartClassGroup(TFmxObject); ActivateClassGroup(TFmxObject); GroupDescendentsWith(TfrxCheckBoxObject, TFmxObject); frxObjects.RegisterObject1(TfrxCheckBoxView, nil, '', '', 0, 116); finalization frxObjects.UnRegister(TfrxCheckBoxView); end.