FastReport_2022_VCL/Source/frxBreakPointsForm.pas

{******************************************}
{                                          }
{             FastReport VCL               }
{         Break Points toolwindow          }
{                                          }
{         Copyright (c) 1998-2021          }
{            by Fast Reports Inc.          }
{                                          }
{******************************************}

unit frxBreakPointsForm;

interface

{$I frx.inc}

uses
  {$IFNDEF FPC}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, fs_iinterpreter, CheckLst, frxSynMemo, frxBaseForm, frxDock
  {$IFDEF FPC}
  ,LCLType, StdCtrls
  {$ELSE}
  , StdCtrls, ToolWin
  {$ENDIF}
{$IFDEF Delphi6}
, Variants, Grids
{$ENDIF};

type
  TfrxBreakPointsForm = class({$IFDEF FPC}TfrxBaseForm{$ELSE}TfrxDockForm{$ENDIF})
    ToolBar1: TToolBar;
    DeleteB: TToolButton;
    EditB: TToolButton;
    ToggleEnableB: TToolButton;
    BreakPGR: TStringGrid;
    EditBtn: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure AddBClick(Sender: TObject);
    procedure DeleteBClick(Sender: TObject);
    procedure EditBClick(Sender: TObject);
    procedure ToggleEnableBClick(Sender: TObject);
    procedure BreakPGRDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure BreakPGRDblClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    FScript: TfsScript;
    FScriptRunning: Boolean;
    FSynMemo: TfrxSyntaxMemo;
    procedure SetSynMemo(const Value: TfrxSyntaxMemo);
    procedure BPListUpdated(Sender: TObject);
  public
    destructor Destroy; override;
    procedure SetColor(const Value: TColor);
    procedure UpdateList;
    procedure UpdateResouces; override;
    procedure UpdateFormPPI(aNewPPI: Integer); override;
    property Script: TfsScript read FScript write FScript;
    property ScriptRunning: Boolean read FScriptRunning write FScriptRunning;
    property SynMemo: TfrxSyntaxMemo read FSynMemo write SetSynMemo;
  end;


implementation
{$IFDEF FPC}
{$R *.lfm}
{$ELSE}
{$R *.DFM}
{$ENDIF}

uses frxRes;
{$IFNDEF FPC}
type
  THackWinControl = class(TWinControl);
{$ENDIF}


procedure TfrxBreakPointsForm.FormCreate(Sender: TObject);
begin
{$IFDEF UseTabset}
  BreakPGR.BevelKind := bkFlat;
{$ELSE}
  BreakPGR.BorderStyle := bsSingle;
{$ENDIF}

  if UseRightToLeftAlignment then
    FlipChildren(True);
end;

procedure TfrxBreakPointsForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F1 then
    frxResources.Help(Self);
end;

procedure TfrxBreakPointsForm.AddBClick(Sender: TObject);
begin
  if FSynMemo = nil then Exit;
  FSynMemo.AddNewBreakPoint;
  UpdateList;
end;

procedure TfrxBreakPointsForm.DeleteBClick(Sender: TObject);
var
  BP: TfrxBreakPoint;
begin
 if BreakPGR.Selection.Top < 1 then Exit;
 BP := TfrxBreakPoint(BreakPGR.Objects[0, BreakPGR.Selection.Top]);
 if BP = nil then Exit;
  if FSynMemo = nil then Exit;
  FSynMemo.DeleteBreakPoint(BP.Line);
  UpdateList;
  FSynMemo.Invalidate;
end;

procedure TfrxBreakPointsForm.EditBClick(Sender: TObject);
var
  BP: TfrxBreakPoint;
begin
 if BreakPGR.Selection.Top < 1 then Exit;
 BP := TfrxBreakPoint(BreakPGR.Objects[0, BreakPGR.Selection.Top]);
 if BP = nil then Exit;
 BP.Condition := InputBox(frxGet(6587), frxGet(6588), BP.Condition);
 BreakPGR.Cells[2, BreakPGR.Selection.Top] := BP.Condition;
 BreakPGR.Invalidate;
end;


procedure TfrxBreakPointsForm.UpdateFormPPI(aNewPPI: Integer);

  procedure AssignToolbarSize(aToolB: TToolBar; aImgList: TImageList);
  begin
    aToolB.ButtonWidth := aImgList.Width;
    aToolB.ButtonHeight := aImgList.Height;
  end;

begin
  inherited;
  Toolbar1.Images := frxResources.MainButtonImages;
  AssignToolbarSize(ToolBar1, frxResources.MainButtonImages);
end;

procedure TfrxBreakPointsForm.UpdateList;
var
  i: Integer;
  BP: TfrxBreakPoint;
  sList: TStrings;
begin
  BreakPGR.RowCount := 1;
  BreakPGR.RowCount := FSynMemo.BreakPoints.Count + 1;
  if BreakPGR.RowCount = 1 then
  begin
    {$IFDEF FPC}
    BreakPGR.RowCount := 2;
    BreakPGR.Rows[1].Clear;
    {$ELSE}
    BreakPGR.Rows[1].Clear;
    BreakPGR.RowCount := 2;
    {$ENDIF}
  end;
  BreakPGR.FixedRows := 1;
  // TODO move to resources
  BreakPGR.Cells[0, 0] := frxGet(6586);
  BreakPGR.Cells[1, 0] := frxGet(5202);
  BreakPGR.Cells[2, 0] := frxGet(4601);
  for i := 0 to FSynMemo.BreakPoints.Count - 1 do
  begin
    BP := TfrxBreakPoint(FSynMemo.BreakPoints.Objects[i]);
    sList := BreakPGR.Rows[i + 1];
    sList.BeginUpdate;
    sList.Clear;
    sList.AddObject(BoolToStr(BP.Enabled), BP);
    sList.AddObject(IntToStr(BP.Line), BP);
    sList.AddObject(BP.Condition, BP);
    sList.EndUpdate;
  end;
end;

procedure TfrxBreakPointsForm.UpdateResouces;
begin
  inherited;
  Caption := frxGet(2482);
  DeleteB.Hint := frxGet(5902);
  EditB.Hint := frxGet(5903);
end;

procedure TfrxBreakPointsForm.SetColor(const Value: TColor);
begin
  BreakPGR.Color := Value;
{$IFDEF Delphi19}
  BreakPGR.StyleElements := [seFont, seBorder];
{$ENDIF}
  BreakPGR.Options := BreakPGR.Options + [goColSizing];
end;

procedure TfrxBreakPointsForm.SetSynMemo(const Value: TfrxSyntaxMemo);
begin
  if Assigned(Value) then
    Value.BreakPoints.OnChange := BPListUpdated
  else if (Value = nil) and Assigned(FSynMemo) then
    FSynMemo.BreakPoints.OnChange := nil;
  FSynMemo := Value;
end;

procedure TfrxBreakPointsForm.BPListUpdated(Sender: TObject);
begin
  UpdateList;
end;

destructor TfrxBreakPointsForm.Destroy;
begin
  if Assigned(FSynMemo) and Assigned(FSynMemo.BreakPoints) then
    FSynMemo.BreakPoints.OnChange := nil;
  inherited;
end;

procedure TfrxBreakPointsForm.ToggleEnableBClick(Sender: TObject);
var
  BP: TfrxBreakPoint;
begin
 if BreakPGR.Selection.Top < 1 then Exit;
 BP := TfrxBreakPoint(BreakPGR.Objects[0, BreakPGR.Selection.Top]);
 if BP = nil then Exit;
 BP.Enabled := not BP.Enabled;
 BreakPGR.Invalidate;
 if Assigned(SynMemo) then
  SynMemo.Invalidate;
end;

procedure TfrxBreakPointsForm.BreakPGRDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  BP: TfrxBreakPoint;
  aScale: Single;
begin
  if ACol > 0 then Exit;
  BP := TfrxBreakPoint(BreakPGR.Objects[ACol, ARow]);
  if BP = nil then Exit;
  //BreakPGR.Canvas.Brush.Color := BreakPGR.Color;
  //BreakPGR.Canvas.FillRect(Rect);
  if BP.Enabled then
  begin
    BreakPGR.Canvas.Brush.Color := $005353FF;
    BreakPGR.Canvas.Pen.Color := clRed;
  end
  else
  begin
    BreakPGR.Canvas.Brush.Color := clGray;
    BreakPGR.Canvas.Pen.Color := clBlack;
  end;
  aScale := CurrentFormPPI / 96;
  BreakPGR.Canvas.Ellipse(Round(Rect.Left + 2 * aScale), Round(Rect.Top + 3 * aScale), Round(Rect.Left + 13 * aScale), Round(Rect.Top +  14 * aScale));
end;

procedure TfrxBreakPointsForm.BreakPGRDblClick(Sender: TObject);
begin
 if BreakPGR.Selection.Left > 0 then Exit;
 ToggleEnableBClick(nil);
end;

procedure TfrxBreakPointsForm.FormResize(Sender: TObject);
begin
  BreakPGR.ColWidths[2] := BreakPGR.Width -  BreakPGR.ColWidths[0] -  BreakPGR.ColWidths[1];
end;

end.