521 lines
15 KiB
ObjectPascal
521 lines
15 KiB
ObjectPascal
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ Basic visual controls for Editors }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxGraphicControls;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
{$IFNDEF FPC}Windows, Messages,{$ENDIF}
|
|
{$IFDEF FPC} LCLProc, LMessages,{$ENDIF}
|
|
SysUtils, Variants, Classes, Graphics;
|
|
|
|
type
|
|
TfrxSwithcButtonStyle = (sbOn, sbOff);
|
|
TfrxSwithcButton = Class
|
|
private
|
|
FSwitch: Boolean;
|
|
FWidth: Integer;
|
|
FHeight: Integer;
|
|
FOriginWidth: Integer;
|
|
FOriginHeight: Integer;
|
|
FButtonColor: TColor;
|
|
FFrameColor: TColor;
|
|
FFrameWidth: Integer;
|
|
FFillActivateColor: TColor;
|
|
FFillDeactivateColor: TColor;
|
|
FBitmap: TBitmap;
|
|
FOnStyleBitmap: TBitmap;
|
|
FOffStyleBitmap: TBitmap;
|
|
FBackColor: TColor;
|
|
FNeedUpdate: Boolean;
|
|
FTag: Integer;
|
|
FColorTag: TColor;
|
|
procedure SetOriginHeight(const Value: Integer);
|
|
procedure SetSwitch(const Value: Boolean);
|
|
procedure SetBackColor(const Value: TColor);
|
|
procedure SetFillActivateColor(const Value: TColor);
|
|
procedure SetFillDeactivateColor(const Value: TColor);
|
|
procedure SetFrameColor(const Value: TColor);
|
|
public
|
|
constructor Create; overload;
|
|
constructor Create(aOnStyleBitmap: TBitmap; aOffStyleBitmap: TBitmap); overload;
|
|
destructor Destroy; override;
|
|
procedure Draw(aCanvas: TCanvas; aLeft, aTop: Integer);
|
|
property Switch: Boolean read FSwitch write SetSwitch;
|
|
property ButtonColor: TColor read FButtonColor write FButtonColor;
|
|
property BackColor: TColor read FBackColor write SetBackColor;
|
|
property FrameColor: TColor read FFrameColor write SetFrameColor;
|
|
property FillActivateColor: TColor read FFillActivateColor write SetFillActivateColor;
|
|
property FillDeactivateColor: TColor read FFillDeactivateColor write SetFillDeactivateColor;
|
|
property Width: Integer read FOriginWidth;
|
|
property Height: Integer read FOriginHeight write SetOriginHeight;
|
|
property Tag: Integer read FTag write FTag;
|
|
property ColorTag: TColor read FColorTag write FColorTag;
|
|
end;
|
|
|
|
|
|
TfrxSwitchButtonsPanel = class
|
|
private
|
|
FButtons: TStringList;
|
|
FSwitchOnStyle: TBitmap;
|
|
FSwitchOffStyle: TBitmap;
|
|
FShowCaption: Boolean;
|
|
FShowColors: Boolean;
|
|
FButtonOffsetY: Integer;
|
|
FButtonOffsetX: Integer;
|
|
FColorRectWidth: Integer;
|
|
FColorRectGap: Integer;
|
|
FOnButtonClick: TNotifyEvent;
|
|
FButtonsHeight: Integer;
|
|
FTextWidth: Integer;
|
|
FBackColor: TColor;
|
|
FFont: TFont;
|
|
function GetButton(Index: Integer): TfrxSwithcButton;
|
|
procedure SetShowCaption(const Value: Boolean);
|
|
procedure SetShowColors(const Value: Boolean);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Draw(aCanvas: TCanvas; aLeft, aTop: Integer);
|
|
function CalcHeight: Integer;
|
|
function CalcWidth: Integer;
|
|
function AddButton(sCaption: String): TfrxSwithcButton;
|
|
function IsButtonClicked(X, Y: Integer): TfrxSwithcButton;
|
|
function DoClick(X, Y: Integer): TfrxSwithcButton;
|
|
procedure Clear;
|
|
function Count: Integer;
|
|
procedure SetButtonsHeight(Height: Integer);
|
|
property ShowCaption: Boolean read FShowCaption write SetShowCaption;
|
|
property ShowColors: Boolean read FShowColors write SetShowColors;
|
|
property Button[Index: Integer]: TfrxSwithcButton read GetButton; default;
|
|
property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses {$IFDEF DELPHI16} System.UITypes, {$ENDIF} Types
|
|
{$IFDEF FPC},GraphType, LCLType, LCLIntf, lazhelper{$ENDIF};
|
|
|
|
const MaxTextWidth = 100;
|
|
const DefColorGap = 4;
|
|
|
|
{ TfrxSwithcButton }
|
|
|
|
constructor TfrxSwithcButton.Create;
|
|
begin
|
|
FFrameColor := clGray;
|
|
FButtonColor := clGray;
|
|
FFillActivateColor := clSkyBlue;
|
|
FFillDeactivateColor := clSilver;
|
|
FSwitch := False;
|
|
FBackColor := clWhite;
|
|
FBitmap := nil;
|
|
if not(Assigned(FOffStyleBitmap) and Assigned(FOnStyleBitmap)) then
|
|
FBitmap := TBitmap.Create;
|
|
SetOriginHeight(16);
|
|
FNeedUpdate := True;
|
|
end;
|
|
|
|
constructor TfrxSwithcButton.Create(aOnStyleBitmap, aOffStyleBitmap: TBitmap);
|
|
begin
|
|
FOffStyleBitmap := aOffStyleBitmap;
|
|
FOnStyleBitmap := aOnStyleBitmap;
|
|
Create;
|
|
end;
|
|
|
|
destructor TfrxSwithcButton.Destroy;
|
|
begin
|
|
if Assigned(FBitmap) then
|
|
FreeAndNil(FBitmap);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxSwithcButton.Draw(aCanvas: TCanvas; aLeft, aTop: Integer);
|
|
const
|
|
InnerFrameWidth = 2;
|
|
var
|
|
LG: {$IFDEF FPC}TLogBrush{$ELSE}LOGBRUSH{$ENDIF};
|
|
hP: HPEN;
|
|
OldPen: HGDIOBJ;
|
|
FillColor, SaveBrushColor, SavePenColor: TColor;
|
|
QuarterW, halfW, Offset, ButtonSize, SavePenWidth, FreeSpaceOffset: Integer;
|
|
dBitmap: TBitmap;
|
|
|
|
procedure DrawArcFrame(Canvas: TCanvas; Left, Top: Integer; OffSetX, OffSetY: Integer);
|
|
begin
|
|
Canvas.Arc(Left + OffSetX, Top + OffSetY, Left + halfW - OffSetX,
|
|
Top + FHeight - OffSetY, Left + QuarterW, Top, Left + QuarterW,
|
|
Top + FHeight - OffSetX);
|
|
Canvas.Arc(Left + halfW + OffSetX, Top + OffSetY, Left + FWidth - OffSetX,
|
|
Top + FHeight - OffSetY, Left + FWidth - QuarterW, Left + FWidth,
|
|
Left + FWidth - QuarterW, Top + OffSetX);
|
|
Canvas.MoveTo(Left + QuarterW, Top + OffSetY + 1);
|
|
Canvas.LineTo(Left + FWidth - QuarterW, Top + OffSetY + 1);
|
|
|
|
Canvas.MoveTo(Left + QuarterW, Top + FHeight - OffSetY - 1);
|
|
Canvas.LineTo(Left + FWidth - QuarterW, Top + FHeight - OffSetY - 1);
|
|
end;
|
|
|
|
procedure DrawOn(Canvas: TCanvas; Left, Top: Integer);
|
|
begin
|
|
FreeSpaceOffset := FFrameWidth * 4 div 3;
|
|
if FreeSpaceOffset < 4 then FreeSpaceOffset := 4;
|
|
|
|
LG.lbStyle := BS_SOLID;
|
|
LG.lbColor := FFrameColor;
|
|
LG.lbHatch := 0;
|
|
hP := ExtCreatePen(PS_GEOMETRIC or PS_ENDCAP_ROUND, FFrameWidth,
|
|
LG, 0, nil);
|
|
try
|
|
OldPen := SelectObject(Canvas.Handle, hP);
|
|
Canvas.Pen.Width := FFrameWidth;
|
|
Canvas.Pen.Color := FFrameColor;
|
|
|
|
halfW := FWidth div 2;
|
|
QuarterW := FWidth div 4;
|
|
|
|
DrawArcFrame(Canvas, Left, Top, 0, 0);
|
|
SelectObject(Canvas.Handle, OldPen);
|
|
OldPen := SelectObject(Canvas.Handle, hP);
|
|
Canvas.Pen.Width := InnerFrameWidth;
|
|
Offset := FFrameWidth div 2 + FreeSpaceOffset;
|
|
Canvas.Pen.Color := FillColor;
|
|
DrawArcFrame(Canvas, Left, Top, Offset, Offset);
|
|
Canvas.Brush.Color := FillColor;
|
|
Canvas.FloodFill(Left + halfW, Top + FHeight div 2,
|
|
Canvas.Pixels[Left + halfW, Top + FHeight div 2], fsSurface);
|
|
SelectObject(Canvas.Handle, OldPen);
|
|
|
|
Canvas.Pen.Width := InnerFrameWidth;
|
|
Canvas.Brush.Color := FButtonColor;
|
|
Canvas.Pen.Color := FButtonColor;
|
|
|
|
ButtonSize := FHeight - Offset * 2;
|
|
if FillColor = FFillDeactivateColor then
|
|
Canvas.Ellipse(Left + Offset, Top + Offset, Left + Offset + ButtonSize,
|
|
Top + Offset + ButtonSize)
|
|
else
|
|
Canvas.Ellipse(Left + FWidth - Offset - ButtonSize, Top + Offset,
|
|
Left + FWidth - Offset, Top + Offset + ButtonSize);
|
|
|
|
finally
|
|
DeleteObject(hP);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawOnBitmap(aBitmap: TBitmap);
|
|
begin
|
|
aBitmap.Canvas.Brush.Color := FBackColor;
|
|
aBitmap.Canvas.FillRect(Rect(0, 0, aBitmap.Width, aBitmap.Height));
|
|
DrawOn(aBitmap.Canvas, FFrameWidth div 2, FFrameWidth div 2);
|
|
end;
|
|
|
|
begin
|
|
FillColor := FFillActivateColor;
|
|
if not Switch then
|
|
FillColor := FFillDeactivateColor;
|
|
|
|
SaveBrushColor := aCanvas.Brush.Color;
|
|
SavePenColor := aCanvas.Pen.Color;
|
|
SavePenWidth := aCanvas.Pen.Width;
|
|
try
|
|
if FNeedUpdate then
|
|
begin
|
|
if Assigned(FOffStyleBitmap) and Assigned(FOnStyleBitmap) then
|
|
begin
|
|
FillColor := FFillActivateColor;
|
|
DrawOnBitmap(FOnStyleBitmap);
|
|
FillColor := FFillDeactivateColor;
|
|
DrawOnBitmap(FOffStyleBitmap);
|
|
end
|
|
else
|
|
DrawOnBitmap(FBitmap);
|
|
FNeedUpdate := False;
|
|
end;
|
|
dBitmap := FBitmap;
|
|
|
|
if Assigned(FOffStyleBitmap) and Assigned(FOnStyleBitmap) then
|
|
begin
|
|
dBitmap := FOffStyleBitmap;
|
|
if Switch then
|
|
dBitmap := FOnStyleBitmap;
|
|
end;
|
|
|
|
SetStretchBltMode(aCanvas.Handle, MAXSTRETCHBLTMODE);
|
|
StretchBlt(aCanvas.Handle, aLeft, aTop, FOriginWidth, FOriginHeight, dBitmap.Canvas.Handle, 0,0,
|
|
dBitmap.Width, dBitmap.Height, SRCCOPY);
|
|
finally
|
|
aCanvas.Brush.Color := SaveBrushColor;
|
|
aCanvas.Pen.Color := SavePenColor;
|
|
aCanvas.Pen.Width := SavePenWidth;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxSwithcButton.SetBackColor(const Value: TColor);
|
|
begin
|
|
if Value <> FBackColor then
|
|
FNeedUpdate := True;
|
|
FBackColor := Value;
|
|
end;
|
|
|
|
procedure TfrxSwithcButton.SetFillActivateColor(const Value: TColor);
|
|
begin
|
|
if Value <> FFillActivateColor then
|
|
FNeedUpdate := True;
|
|
FFillActivateColor := Value;
|
|
end;
|
|
|
|
procedure TfrxSwithcButton.SetFillDeactivateColor(const Value: TColor);
|
|
begin
|
|
if Value <> FFillDeactivateColor then
|
|
FNeedUpdate := True;
|
|
FFillDeactivateColor := Value;
|
|
end;
|
|
|
|
procedure TfrxSwithcButton.SetFrameColor(const Value: TColor);
|
|
begin
|
|
if Value <> FFrameColor then
|
|
FNeedUpdate := True;
|
|
FFrameColor := Value;
|
|
end;
|
|
|
|
procedure TfrxSwithcButton.SetOriginHeight(const Value: Integer);
|
|
begin
|
|
if Value = FOriginHeight then Exit;
|
|
FNeedUpdate := True;
|
|
if Value < 8 then
|
|
FOriginHeight := 8
|
|
else
|
|
FOriginHeight := Value;
|
|
FOriginWidth := FOriginHeight * 2;
|
|
FHeight := FOriginHeight * 2;
|
|
if FHeight < 64 then FHeight := 64;
|
|
|
|
FFrameWidth := FHeight div 10;
|
|
FWidth := FHeight * 2;
|
|
if Assigned(FBitmap) then
|
|
begin
|
|
FBitmap.Width := FWidth + FFrameWidth;
|
|
FBitmap.Height := FHeight + FFrameWidth;
|
|
end;
|
|
if Assigned(FOffStyleBitmap) and Assigned(FOnStyleBitmap) then
|
|
begin
|
|
FOffStyleBitmap.Width := FWidth + FFrameWidth;
|
|
FOffStyleBitmap.Height := FHeight + FFrameWidth;
|
|
FOnStyleBitmap.Width := FWidth + FFrameWidth;
|
|
FOnStyleBitmap.Height := FHeight + FFrameWidth;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxSwithcButton.SetSwitch(const Value: Boolean);
|
|
begin
|
|
if (Value <> FSwitch) and not(Assigned(FOffStyleBitmap) and Assigned(FOnStyleBitmap)) then
|
|
FNeedUpdate := True;
|
|
FSwitch := Value;
|
|
end;
|
|
|
|
{ TfrxSwitchButtonsPanel }
|
|
|
|
function TfrxSwitchButtonsPanel.AddButton(sCaption: String): TfrxSwithcButton;
|
|
var
|
|
w: Integer;
|
|
begin
|
|
Result := TfrxSwithcButton.Create(FSwitchOnStyle, FSwitchOffStyle);
|
|
if FButtons.Count = 0 then
|
|
Result.Height := FButtonsHeight
|
|
else
|
|
Result.FOriginHeight := FButtonsHeight;
|
|
FButtons.AddObject(sCaption, Result);
|
|
Result.BackColor := FBackColor;
|
|
if FShowColors then
|
|
FColorRectWidth := Result.Height div 2; //colored square
|
|
if (sCaption = '') or not FShowCaption then Exit;
|
|
FFont.Height := -((FButtonsHeight * 2) div 3);
|
|
FSwitchOnStyle.Canvas.Font.Assign(FFont);
|
|
w := FSwitchOnStyle.Canvas.TextWidth(sCaption);
|
|
if w > FTextWidth then FTextWidth := w;
|
|
if FTextWidth > MaxTextWidth then FTextWidth := MaxTextWidth;
|
|
end;
|
|
|
|
function TfrxSwitchButtonsPanel.CalcHeight: Integer;
|
|
begin
|
|
Result := FButtonOffsetY;
|
|
if FButtons.Count > 0 then
|
|
Result := (Result + TfrxSwithcButton(FButtons.Objects[0]).Height) * FButtons.Count;
|
|
Inc(Result, FButtonOffsetY + 4);
|
|
end;
|
|
|
|
function TfrxSwitchButtonsPanel.CalcWidth: Integer;
|
|
begin
|
|
Result := FButtonOffsetX * 2 + FTextWidth + FColorRectWidth + FColorRectGap;
|
|
if FButtons.Count > 0 then
|
|
Result := Result + TfrxSwithcButton(FButtons.Objects[0]).Width;
|
|
end;
|
|
|
|
procedure TfrxSwitchButtonsPanel.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FButtons.Count - 1 do
|
|
FButtons.Objects[i].Free;
|
|
FButtons.Clear;
|
|
FSwitchOnStyle.FreeImage;
|
|
FSwitchOffStyle.FreeImage;
|
|
end;
|
|
|
|
function TfrxSwitchButtonsPanel.Count: Integer;
|
|
begin
|
|
Result := FButtons.Count;
|
|
end;
|
|
|
|
constructor TfrxSwitchButtonsPanel.Create;
|
|
begin
|
|
FButtons := TStringList.Create;
|
|
FSwitchOnStyle := TBitmap.Create;
|
|
FSwitchOffStyle := TBitmap.Create;
|
|
FButtonOffsetY := 2;
|
|
FButtonOffsetX := 10;
|
|
FColorRectWidth := 0;
|
|
FButtonsHeight := 16;
|
|
FColorRectGap := 0;
|
|
FBackColor := clWhite;
|
|
FFont := TFont.Create;
|
|
FFont.Name := 'Arial';
|
|
end;
|
|
|
|
destructor TfrxSwitchButtonsPanel.Destroy;
|
|
begin
|
|
Clear;
|
|
FreeAndNil(FFont);
|
|
FreeAndNil(FButtons);
|
|
FreeAndNil(FSwitchOnStyle);
|
|
FreeAndNil(FSwitchOffStyle);
|
|
inherited;
|
|
end;
|
|
|
|
function TfrxSwitchButtonsPanel.DoClick(X, Y: Integer): TfrxSwithcButton;
|
|
var
|
|
btn: TfrxSwithcButton;
|
|
begin
|
|
btn := IsButtonClicked(X, Y);
|
|
if btn <> nil then
|
|
begin
|
|
btn.Switch := not btn.Switch;
|
|
if Assigned(OnButtonClick) then
|
|
OnButtonClick(btn);
|
|
end;
|
|
Result := btn;
|
|
end;
|
|
|
|
procedure TfrxSwitchButtonsPanel.Draw(aCanvas: TCanvas; aLeft, aTop: Integer);
|
|
var
|
|
i, w, h: Integer;
|
|
btn: TfrxSwithcButton;
|
|
aRect: TRect;
|
|
begin
|
|
w := CalcWidth;
|
|
h := CalcHeight;
|
|
aCanvas.Brush.Color := FBackColor;
|
|
aCanvas.Pen.Color := clBlack;
|
|
aCanvas.Pen.Style := psSolid;
|
|
aCanvas.Pen.Width := 2;
|
|
aCanvas.FillRect(Rect(aLeft, aTop, aLeft + w, aTop + h));
|
|
aCanvas.Rectangle(aLeft, aTop, aLeft + w, aTop + h);
|
|
|
|
for i := 0 to FButtons.Count - 1 do
|
|
begin
|
|
btn := TfrxSwithcButton(FButtons.Objects[i]);
|
|
Inc(aTop, FButtonOffsetY);
|
|
aCanvas.Brush.Color := btn.ColorTag;
|
|
aCanvas.Pen.Color := clBlack;
|
|
aCanvas.Pen.Style := psSolid;
|
|
aCanvas.Pen.Width := 1;
|
|
aRect := Rect(aLeft + FButtonOffsetX,
|
|
aTop + (btn.Height div 2 - FColorRectWidth div 2),
|
|
aLeft + FButtonOffsetX + FColorRectWidth,
|
|
aTop + (btn.Height div 2 + FColorRectWidth div 2));
|
|
aCanvas.FillRect(aRect);
|
|
aCanvas.Rectangle(aRect.Left, aRect.Top, aRect.Right, aRect.Bottom);
|
|
aCanvas.Brush.Color := FBackColor;
|
|
aRect := Rect(aRect.Right + FColorRectGap, aTop, aRect.Right + FColorRectGap
|
|
+ FTextWidth, aTop + btn.Height);
|
|
aCanvas.Font.Assign(FFont);
|
|
aCanvas.TextRect(aRect, aRect.Left, aRect.Top, FButtons[i]);
|
|
btn.Draw(aCanvas, aLeft + w - btn.Width - FButtonOffsetX, aTop);
|
|
aTop := aTop + btn.Height;
|
|
end;
|
|
end;
|
|
|
|
function TfrxSwitchButtonsPanel.GetButton(Index: Integer): TfrxSwithcButton;
|
|
begin
|
|
Result := TfrxSwithcButton(FButtons.Objects[index]);
|
|
end;
|
|
|
|
function TfrxSwitchButtonsPanel.IsButtonClicked(X, Y: Integer): TfrxSwithcButton;
|
|
var
|
|
i, w, bX, bY: Integer;
|
|
btn: TfrxSwithcButton;
|
|
begin
|
|
btn := nil;
|
|
w := CalcWidth;
|
|
for i := 0 to FButtons.Count - 1 do
|
|
begin
|
|
btn := TfrxSwithcButton(FButtons.Objects[i]);
|
|
bX := w - btn.Width - FButtonOffsetX;
|
|
bY := (FButtonOffsetY + btn.Height) * i + FButtonOffsetY;
|
|
if (X >= bX) and (X <= bX + btn.Width) and (Y >= bY) and
|
|
(Y <= bY + btn.Height) then break;
|
|
btn := nil;
|
|
end;
|
|
Result := btn;
|
|
end;
|
|
|
|
procedure TfrxSwitchButtonsPanel.SetButtonsHeight(Height: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FButtonsHeight = Height then Exit;
|
|
for i := 0 to FButtons.Count - 1 do
|
|
if i = 0 then
|
|
begin
|
|
Button[i].Height := Height;
|
|
FButtonsHeight := Button[i].Height;
|
|
end
|
|
else
|
|
Button[i].Height := FButtonsHeight;
|
|
if FShowColors then
|
|
FColorRectWidth := Height div 2; //colored square
|
|
FFont.Height := -((FButtonsHeight * 2) div 3);
|
|
end;
|
|
|
|
procedure TfrxSwitchButtonsPanel.SetShowCaption(const Value: Boolean);
|
|
begin
|
|
FShowCaption := Value;
|
|
if not FShowCaption then FTextWidth := 0;
|
|
end;
|
|
|
|
procedure TfrxSwitchButtonsPanel.SetShowColors(const Value: Boolean);
|
|
begin
|
|
FShowColors := Value;
|
|
if not FShowColors then
|
|
begin
|
|
FColorRectWidth := 0;
|
|
FColorRectGap := 0;
|
|
end
|
|
else
|
|
FColorRectGap := DefColorGap;
|
|
end;
|
|
|
|
end.
|