summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/corelib/gdi/fpgui_toolkit.lpk8
-rw-r--r--src/corelib/gdi/fpgui_toolkit.pas8
-rw-r--r--src/corelib/x11/fpgui_toolkit.lpk6
-rw-r--r--src/corelib/x11/fpgui_toolkit.pas23
-rw-r--r--src/gui/fpg_readonly.pas159
5 files changed, 185 insertions, 19 deletions
diff --git a/src/corelib/gdi/fpgui_toolkit.lpk b/src/corelib/gdi/fpgui_toolkit.lpk
index dd4289f3..d0e76d44 100644
--- a/src/corelib/gdi/fpgui_toolkit.lpk
+++ b/src/corelib/gdi/fpgui_toolkit.lpk
@@ -31,7 +31,7 @@
<Description Value="fpGUI Toolkit"/>
<License Value="LGPL 2 with static linking exception."/>
<Version Minor="7" Build="1"/>
- <Files Count="87">
+ <Files Count="88">
<Item1>
<Filename Value="..\stdimages.inc"/>
<Type Value="Include"/>
@@ -380,6 +380,10 @@
<Filename Value="..\..\gui\fpg_style_bitmap.pas"/>
<UnitName Value="fpg_style_bitmap"/>
</Item87>
+ <Item88>
+ <Filename Value="..\..\gui\fpg_readonly.pas"/>
+ <UnitName Value="fpg_readonly"/>
+ </Item88>
</Files>
<LazDoc Paths="..\..\..\docs\xml\corelib;..\..\..\docs\xml\corelib\x11;..\..\..\docs\xml\corelib\gdi;..\..\..\docs\xml\gui"/>
<RequiredPkgs Count="1">
@@ -396,4 +400,4 @@
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
-</CONFIG> \ No newline at end of file
+</CONFIG>
diff --git a/src/corelib/gdi/fpgui_toolkit.pas b/src/corelib/gdi/fpgui_toolkit.pas
index c3ab77f2..7ec7e35c 100644
--- a/src/corelib/gdi/fpgui_toolkit.pas
+++ b/src/corelib/gdi/fpgui_toolkit.pas
@@ -18,10 +18,10 @@ uses
fpg_radiobutton, fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree,
fpgui_db, fpg_gdi, fpg_impl, fpg_splitter, fpg_hint, fpg_spinedit,
fpg_extgraphics, fpg_ColorMapping, fpg_ColorWheel, fpg_interface,
- fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils, fpg_OLEDragDrop,
- fpg_stylemanager, fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks,
- fpg_style_bluecurve, fpg_style_bitmap;
+ fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils, fpg_OLEDragDrop,
+ fpg_stylemanager, fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks,
+ fpg_style_bluecurve, fpg_style_bitmap, fpg_readonly;
implementation
-end. \ No newline at end of file
+end.
diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk
index 990af24e..3aa18a60 100644
--- a/src/corelib/x11/fpgui_toolkit.lpk
+++ b/src/corelib/x11/fpgui_toolkit.lpk
@@ -31,7 +31,7 @@
<License Value="LGPL 2 with static linking exception.
"/>
<Version Minor="7" Build="1"/>
- <Files Count="90">
+ <Files Count="91">
<Item1>
<Filename Value="../stdimages.inc"/>
<Type Value="Include"/>
@@ -392,6 +392,10 @@
<Filename Value="../../gui/fpg_style_bitmap.pas"/>
<UnitName Value="fpg_style_bitmap"/>
</Item90>
+ <Item91>
+ <Filename Value="../../gui/fpg_readonly.pas"/>
+ <UnitName Value="fpg_readonly"/>
+ </Item91>
</Files>
<LazDoc Paths="../../../docs/xml/corelib/;../../../docs/xml/corelib/x11/;../../../docs/xml/corelib/gdi/;../../../docs/xml/gui/"/>
<RequiredPkgs Count="1">
diff --git a/src/corelib/x11/fpgui_toolkit.pas b/src/corelib/x11/fpgui_toolkit.pas
index 8f5f99dc..8c66a9a3 100644
--- a/src/corelib/x11/fpgui_toolkit.pas
+++ b/src/corelib/x11/fpgui_toolkit.pas
@@ -8,19 +8,18 @@ interface
uses
fpg_base, fpg_main, fpg_cmdlineparams, fpg_command_intf, fpg_constants,
- fpg_extinterpolation, fpg_imagelist, fpg_imgfmt_bmp, fpg_pofiles,
- fpg_popupwindow, fpg_stdimages, fpg_stringhashlist, fpg_translations,
- fpg_stringutils, fpg_utils, fpg_widget, fpg_wuline, fpg_impl, fpg_x11,
- fpg_netlayer_x11, fpg_keyconv_x11, fpg_xft_x11, fpg_animation, fpg_basegrid,
- fpg_button, fpg_checkbox, fpg_combobox, fpg_customgrid, fpg_dialogs,
- fpg_editcombo, fpg_edit, fpg_form, fpg_gauge, fpg_grid, fpg_hyperlink,
- fpg_iniutils, fpg_label, fpg_listbox, fpg_listview, fpg_memo, fpg_menu,
+ fpg_extinterpolation, fpg_imagelist, fpg_imgfmt_bmp, fpg_pofiles, fpg_popupwindow,
+ fpg_stdimages, fpg_stringhashlist, fpg_translations, fpg_stringutils, fpg_utils,
+ fpg_widget, fpg_wuline, fpg_impl, fpg_x11, fpg_netlayer_x11, fpg_keyconv_x11,
+ fpg_xft_x11, fpg_animation, fpg_basegrid, fpg_button, fpg_checkbox, fpg_combobox,
+ fpg_customgrid, fpg_dialogs, fpg_editcombo, fpg_edit, fpg_form, fpg_gauge, fpg_grid,
+ fpg_hyperlink, fpg_iniutils, fpg_label, fpg_listbox, fpg_listview, fpg_memo, fpg_menu,
fpg_mru, fpg_panel, fpg_popupcalendar, fpg_progressbar, fpg_radiobutton,
- fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree, fpgui_db,
- fpg_splitter, fpg_hint, fpg_spinedit, fpg_extgraphics, fpg_ColorMapping,
- fpg_ColorWheel, fpg_interface, fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils,
- fpg_stylemanager, fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks,
- fpg_style_bluecurve, fpg_style_bitmap;
+ fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree, fpgui_db, fpg_splitter,
+ fpg_hint, fpg_spinedit, fpg_extgraphics, fpg_ColorMapping, fpg_ColorWheel,
+ fpg_interface, fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils, fpg_stylemanager,
+ fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, fpg_style_bluecurve,
+ fpg_style_bitmap, fpg_readonly;
implementation
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.
+
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-27 05:05:17 +0000