dexed/src/u_widget.pas

unit u_widget;

{$I u_defines.inc}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, ActnList, Menus,
  AnchorDocking, u_interfaces, u_dsgncontrols, u_common, u_dialogs;

type

  TTimedUpdateKind = (
    // update timer is diabled.
    tukNone,
    // update timer update only one time, if required, and after a delay
    tukDelay,
    // update tiemr update periodically
    tukLoop
  );

  (**
   * Base type for an UI module.
   *)
  PTDexedWidget = ^TDexedWidget;

  TDexedWidget = class;

  TWidgetDockingState =
  (
    wdsUndocked,  // from docked to undocked
    wdsDocked,    // from undocked to docked
    wdsRedocked   // docked from a site to another
  );

  TWidgetDockingChangedEvent = procedure(sender: TDexedWidget; newState: TWidgetDockingState) of object;

  { TDexedWidget }

  TDexedWidget = class(TForm, IContextualActions)
    toolbar: TDexedToolBar;
    Content: TPanel;
    Back: TPanel;
    contextMenu: TPopupMenu;
  private
    fUpdating: boolean;
    fDelayDur: Integer;
    fLoopInter: Integer;
    fUpdateTimer: TTimer;
    fImperativeUpdateCount: Integer;
    fLoopUpdateCount: Integer;
    fOnDockingChanged: TWidgetDockingChangedEvent;
    fTimerUpdateKind: TTimedUpdateKind;
    procedure setDelayDur(value: Integer);
    procedure setLoopInt(value: Integer);
    procedure updaterAutoProc(Sender: TObject);
    procedure updaterLatchProc(Sender: TObject);
    procedure setTimerUpdateKind(value: TTimedUpdateKind);
  protected
    fIsDockable: boolean;
    fIsModal: boolean;
    fToolBarFlat: boolean;
    fToolBarVisible: boolean;
    fOldSiteParent: TWinControl;
    // TODO-cdocking: find a better way to detect that the docking state changed
    procedure Resize; override;
    // a descendant overrides to implement a periodic update.
    procedure updateLoop; virtual;
    // a descendant overrides to implement an imperative update.
    procedure updateImperative; virtual;
    // a descendant overrides to implement a delayed update.
    procedure updateDelayed; virtual;
    //
    function contextName: string; virtual;
    function contextActionCount: integer; virtual;
    function contextAction(index: integer): TAction; virtual;
    //
    function getIfModal: boolean;
    //
    procedure setToolBarVisible(value: boolean); virtual;
    procedure setToolBarFlat(value: boolean); virtual;
  published
    property updaterByLoopInterval: Integer read fLoopInter write setLoopInt;
    property updaterByDelayDuration: Integer read fDelayDur write setDelayDur;
  public
    constructor create(aOwner: TComponent); override;
    destructor destroy; override;
    // prevent closing when 'locked' is checked in the header context menu
    function closeQuery: boolean; override;
    // restarts the wait period to the delayed update event.
    // if not re-called during 'updaterByDelayDuration' ms then
    // 'UpdateByDelay' is called once.
    procedure beginDelayedUpdate;
    // prevent any pending update.
    procedure stopDelayedUpdate;
    // calls immediattly any pending delayed update.
    procedure forceDelayedUpdate;

    // increments the imperative updates count.
    procedure beginImperativeUpdate;
    // decrements the imperative updates count and call updateImperative() if the
    // counter value is equal to zero.
    procedure endImperativeUpdate;
    // calls updateImperative() immediatly
    procedure forceImperativeUpdate;

    // increment a flag used to indicate if updateLoop has to be called
    procedure IncLoopUpdate;

    procedure showWidget;

    // set if the update based on a timer is enabled.
    property timedUpdateKind: TTimedUpdateKind read fTimerUpdateKind write setTimerUpdateKind;
    // returns true if one of the three updater is processing.
    property updating: boolean read fUpdating;
    // true by default, allow a widget to be docked.
    property isDockable: boolean read fIsDockable;
    // not if isDockable, otherwise a the widget is shown as modal form.
    property isModal: boolean read getIfModal;

    property toolbarFlat: boolean read fToolBarFlat write setToolBarFlat;
    property toolbarVisible: boolean read fToolBarVisible write setToolBarVisible;
    property onDockingChanged: TWidgetDockingChangedEvent read fOnDockingChanged write fOnDockingChanged;
  end;

  (**
   * TDexedWidget list.
   *)
  TWidgetList = class(TFPList)
  private
    function getWidget(index: integer): TDexedWidget;
  public
    procedure addWidget(value: PTDexedWidget);
    property widget[index: integer]: TDexedWidget read getWidget;
  end;

  TWidgetEnumerator = class
    fList: TWidgetList;
    fIndex: Integer;
    function getCurrent: TDexedWidget;
    Function moveNext: boolean;
    property current: TDexedWidget read getCurrent;
  end;

  operator enumerator(aWidgetList: TWidgetList): TWidgetEnumerator;

  function CompareWidgCaption(Item1, Item2: Pointer): Integer;

implementation
{$R *.lfm}

uses
  u_observer;

{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TDexedWidget.create(aOwner: TComponent);
var
  i: Integer;
  itm: TmenuItem;
begin
  inherited;
  fToolBarVisible := true;
  fIsDockable := true;

  updaterByLoopInterval := 70;
  updaterByDelayDuration := 500;

  for i := 0 to contextActionCount-1 do
  begin
    itm := TMenuItem.Create(self);
    itm.Action := contextAction(i);
    contextMenu.Items.Add(itm);
  end;
  PopupMenu := contextMenu;

  EntitiesConnector.addObserver(self);
end;

destructor TDexedWidget.destroy;
begin
  fUpdateTimer.Free;
  EntitiesConnector.removeObserver(self);
  inherited;
end;

function TDexedWidget.closeQuery: boolean;
begin
  result := inherited;
  if fIsDockable and (not DockMaster.AllowDragging) and not
    (DockMaster.GetAnchorSite(self).GetTopParent = DockMaster.GetAnchorSite(self)) then
  begin
    result := dlgYesNo('widgets are currently locked, close anyway ?') = mrYes;
  end;
end;

function TDexedWidget.getIfModal: boolean;
begin
  if isDockable then
    result := false
  else
    result := fIsModal;
end;

procedure TDexedWidget.showWidget;
var
  win: TControl;
begin
  if isDockable then
  begin
    win := DockMaster.GetAnchorSite(self);
    if win <> nil then
    begin
      win.Show;
      win.BringToFront;
    end;
  end
  else
  begin
    if isModal then
      ShowModal
    else
    begin
      Show;
      BringToFront;
    end;
  end;
end;

procedure TDexedWidget.setToolBarVisible(value: boolean);
begin
  if fToolBarVisible = value then
    exit;
  toolbar.Visible := value;
  fToolBarVisible := value;
end;

procedure TDexedWidget.setToolBarFlat(value: boolean);
begin
  if fToolBarFlat = value then
    exit;
  toolbar.Flat := value;
  fToolBarFlat := value;
end;

procedure TDexedWidget.Resize;
var
  n: TWinControl = nil;
  s: TAnchorDockHostSite;
begin
  inherited;
  s := DockMaster.GetAnchorSite(self);
  if s.isAssigned then
    n := s.Parent;
  if fOldSiteParent <> n then
  begin
    if fOldSiteParent.isNotAssigned and n.isAssigned and assigned(fOnDockingChanged) then
      fOnDockingChanged(self, wdsDocked)
    else if fOldSiteParent.isAssigned and n.isNotAssigned and assigned(fOnDockingChanged) then
      fOnDockingChanged(self, wdsUndocked)
    else
      fOnDockingChanged(self, wdsRedocked);
    fOldSiteParent := n;
  end;
end;
{$ENDREGION}

{$REGION IContextualActions---------------------------------------------------}
function TDexedWidget.contextName: string;
begin
  result := '';
end;

function TDexedWidget.contextActionCount: integer;
begin
  result := 0;
end;

function TDexedWidget.contextAction(index: integer): TAction;
begin
  result := nil;
end;
{$ENDREGION}

{$REGION Updaters---------------------------------------------------------------}
procedure TDexedWidget.setTimerUpdateKind(value: TTimedUpdateKind);
begin
  if fTimerUpdateKind = value then
    exit;
  fTimerUpdateKind := value;
  if fTimerUpdateKind = tukNone then
  begin
    if fUpdateTimer.isNotAssigned then
      exit;
    FreeAndNil(fUpdateTimer);
  end
  else
  begin
    if fUpdateTimer.isNotAssigned then
      fUpdateTimer := TTimer.Create(nil);
    if fTimerUpdateKind = tukDelay then
    begin
      fUpdateTimer.Enabled := false;
      fUpdateTimer.Interval:= fDelayDur;
    end
    else begin
      fUpdateTimer.Enabled := true;
      fUpdateTimer.Interval:= fLoopInter;
      fUpdateTimer.OnTimer := @updaterAutoProc;
    end;
  end;
end;

procedure TDexedWidget.setDelayDur(value: Integer);
begin
  if value < 100 then
    value := 100;
  if fDelayDur = value then
    exit;
  fDelayDur := value;
  if fUpdateTimer.isAssigned and (fTimerUpdateKind = tukDelay) then
    fUpdateTimer.Interval := fDelayDur;
end;

procedure TDexedWidget.setLoopInt(value: Integer);
begin
  if fLoopInter = value then
    exit;
  fLoopInter := value;
  if fUpdateTimer.isAssigned and (fTimerUpdateKind = tukLoop) then
    fUpdateTimer.Interval := fLoopInter;
end;

procedure TDexedWidget.IncLoopUpdate;
begin
  inc(fLoopUpdateCount);
end;

procedure TDexedWidget.beginImperativeUpdate;
begin
  Inc(fImperativeUpdateCount);
end;

procedure TDexedWidget.endImperativeUpdate;
begin
  Dec(fImperativeUpdateCount);
  if fImperativeUpdateCount > 0 then
    exit;
  fUpdating := true;
  updateImperative;
  fUpdating := false;
  fImperativeUpdateCount := 0;
end;

procedure TDexedWidget.forceImperativeUpdate;
begin
  fUpdating := true;
  updateImperative;
  fUpdating := false;
  fImperativeUpdateCount := 0;
end;

procedure TDexedWidget.beginDelayedUpdate;
begin
  fUpdateTimer.OnTimer := @updaterLatchProc;
  fUpdateTimer.Enabled := true;
end;

procedure TDexedWidget.stopDelayedUpdate;
begin
  fUpdateTimer.OnTimer := nil;
  fUpdateTimer.Enabled := false;
end;

procedure TDexedWidget.forceDelayedUpdate;
begin
  updaterLatchProc(nil);
end;

procedure TDexedWidget.updaterAutoProc(Sender: TObject);
begin
  fUpdating := true;
  if fLoopUpdateCount > 0 then
  	updateLoop;
  fLoopUpdateCount := 0;
  fUpdating := false;
end;

procedure TDexedWidget.updaterLatchProc(Sender: TObject);
begin
  fUpdating := true;
  updateDelayed;
  fUpdating := false;
  fUpdateTimer.OnTimer := nil;
  fUpdateTimer.Enabled:=false;
end;

procedure TDexedWidget.updateLoop;
begin
end;

procedure TDexedWidget.updateImperative;
begin
end;

procedure TDexedWidget.updateDelayed;
begin
end;
{$ENDREGION}

{$REGION TWidgetList----------------------------------------------------------}
function CompareWidgCaption(Item1, Item2: Pointer): Integer;
type
  PWidg = ^TDexedWidget;
begin
  result := AnsiCompareStr(PWidg(Item1)^.Caption, PWidg(Item2)^.Caption);
end;

function TWidgetList.getWidget(index: integer): TDexedWidget;
begin
  result := PTDexedWidget(Items[index])^;
end;

procedure TWidgetList.addWidget(value: PTDexedWidget);
begin
  add(Pointer(value));
end;

function TWidgetEnumerator.getCurrent:TDexedWidget;
begin
  result := fList.widget[fIndex];
end;

function TWidgetEnumerator.moveNext: boolean;
begin
  Inc(fIndex);
  result := fIndex < fList.Count;
end;

operator enumerator(aWidgetList: TWidgetList): TWidgetEnumerator;
begin
  result := TWidgetEnumerator.Create;
  result.fList := aWidgetList;
  result.fIndex := -1;
end;
{$ENDREGION}

end.