1 files changed, 159 insertions, 0 deletions
diff --git a/src/gui/fpg_readonly.pas b/src/gui/fpg_readonly.pas
new file mode 100644
index 00000000..dcdee723
--- /dev/null
+++ b/src/gui/fpg_readonly.pas
@@ -0,0 +1,159 @@
+{
+    fpGUI  -  Free Pascal GUI Toolkit
+
+    Copyright (C) 2006 - 2011 See the file AUTHORS.txt, included in this
+    distribution, for details of the copyright.
+
+    See the file COPYING.modifiedLGPL, included in this distribution,
+    for details about redistributing fpGUI.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Description:
+      A component that can set all components on a form and embedded
+      containers as read-only or not. There are various events that
+      fire during the process, to allow for maximum flexibility.
+}
+
+unit fpg_readonly;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes
+ ;
+
+type
+  TfpgOnChangeReadOnlyEvent = procedure(pSender: TObject; pReadOnly: boolean) of object;
+  TfpgOnProcessEvent = procedure(pSender: TObject; var pReadOnly, pProcess: boolean) of object;
+  TfpgOnProcessFrmEvent = procedure(pFrame: TComponent; var pProcessDetails: boolean) of object;
+  TfpgOnGetParentEvent = procedure(var pParent: TComponent) of object;
+
+
+  TfpgReadOnly = class(TComponent)
+  private
+    FReadOnly: boolean;
+    FOnChange: TfpgOnChangeReadOnlyEvent;
+    FOnProcess: TfpgOnProcessEvent;
+    FEnabled: boolean;
+    FOnProcessFrm: TfpgOnProcessFrmEvent;
+    FProcessContainer: boolean;
+    FOnGetParent: TfpgOnGetParentEvent;
+    procedure   SetEnabled(const AValue: boolean);
+  protected
+    function    GetReadOnly: boolean; virtual;
+    procedure   SetReadOnly(const AValue: boolean); virtual;
+    procedure   SetComponentsReadOnly(pReadOnly: boolean); virtual;
+    function    GetParentForm: TComponent;
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property    ReadOnly: boolean read GetReadOnly write SetReadOnly default false;
+    property    Enabled: boolean read FEnabled write SetEnabled default false;
+    property    ProcessContainer: boolean read FProcessContainer write FProcessContainer default false;
+    property    OnChange: TfpgOnChangeReadOnlyEvent read FOnChange write FOnChange;
+    property    OnProcess: TfpgOnProcessEvent read FOnProcess write FOnProcess;
+    property    OnProcessFrm: TfpgOnProcessFrmEvent read FOnProcessFrm write FOnProcessFrm;
+    property    OnGetParent: TfpgOnGetParentEvent read FOnGetParent write FOnGetParent;
+  end;
+
+
+implementation
+
+uses
+  fpg_main
+  ,fpg_form
+  ,fpg_widget
+  ,TypInfo
+  ;
+
+{ TfpgReadOnly }
+
+constructor TfpgReadOnly.Create(AOwner: TComponent);
+begin
+  inherited;
+  FReadOnly := false;
+  FEnabled := false;
+  FProcessContainer := false;
+end;
+
+function TfpgReadOnly.GetParentForm: TComponent;
+begin
+  result := self;
+  while true do
+  begin
+    if (result is TfpgForm) and
+      ((result.Owner is TfpgApplication) or
+      (result.Owner = nil)) then
+      Break; //==>
+    result := result.Owner;
+  end;
+  if Assigned(FOnGetParent) then
+    FOnGetParent(result);
+end;
+
+function TfpgReadOnly.GetReadOnly: boolean;
+begin
+  Result := FReadOnly;
+end;
+
+procedure TfpgReadOnly.SetComponentsReadOnly(pReadOnly: boolean);
+  procedure _SetComponentsReadOnly(pParent: TComponent);
+  var
+    i: integer;
+    lComponent: TComponent;
+    lReadOnly, lProcess: boolean;
+  begin
+    if pParent=nil then
+      Exit; //==>
+    for i := 0 to pParent.ComponentCount - 1 do
+    begin
+      lComponent := pParent.Components[i];
+      if lComponent = self then
+        Continue; //==>
+      if IsPublishedProp(lComponent, 'ReadOnly') then
+      begin
+        lReadOnly := pReadOnly;
+        lProcess := True;
+        if Assigned(FOnProcess) then
+          FOnProcess(lComponent, lReadOnly, lProcess);
+        if lProcess then
+          SetOrdProp(lComponent, 'ReadOnly', Ord(lReadOnly));
+      end;
+      if (lComponent is TfpgWidget) and TfpgWidget(lComponent).IsContainer then
+      begin
+        lProcess := FProcessContainer; // Now lProcess is: can I go Deep?
+        if Assigned(FOnProcessFrm) then
+          FOnProcessFrm(lComponent, lProcess);
+        if lProcess then
+          _SetComponentsReadOnly(lComponent);
+      end;
+    end;
+  end;
+begin
+  _SetComponentsReadOnly(GetParentForm);
+end;
+
+procedure TfpgReadOnly.SetEnabled(const AValue: boolean);
+begin
+  FEnabled := AValue;
+end;
+
+procedure TfpgReadOnly.SetReadOnly(const AValue: boolean);
+begin
+  if not FEnabled then
+    Exit; //==>
+  if FReadOnly = AValue then
+    Exit; //==>
+  FReadOnly := AValue;
+  SetComponentsReadOnly(FReadOnly);
+  if Assigned(FOnChange) then
+    FOnChange(Self, FReadOnly);
+end;
+
+end.
+