paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 19:17:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Improvements in HTML code generation

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-10-04 22:59:42 +02:00
parent 7c901cbaae
commit 3412801f31
10 changed files with 174 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/pas2js/components/bootstrapformgen.pas
View File

@ -90,8 +90,6 @@ end;
function TBootstrapFormGenerator.GetRowColEnd(aEntry: TDataFieldEntryItem): String;
begin
Decindent;
Result:=Indent+'</div> <!-- .col -->'+LF;
Decindent;
Result:=Indent+'</div> <!-- .row -->'+Lf;
end;

9
components/pas2js/components/datasettoform.pas
View File

@ -334,13 +334,14 @@ var
begin
With AEntry do
Result:=Indent+Format('<select %s class="%s" %s>',[aBaseAttributes,aClasses, aExtraAttributes])+LF;
Result:=Format('<select %s class="%s" %s>',[aBaseAttributes,aClasses, aExtraAttributes])+LF;
// For the other lines we must manage indent ourselves.
IncIndent;
for I:=0 to aEntry.Items.Count-1 do
begin
S:=GetOptionTag(aEntry,aEntry.Items[i]);
if S<>'' then
Result:=Result+' '+S+LF;
Result:=Result+S+LF;
end;
DecIndent;
Result:=Result+Indent+'</select>'
@ -424,8 +425,8 @@ begin
aExtra:=GetExtraAttributes(aEntry);
aClasses:=GetInputClasses(aEntry);
Case aEntry.InputType of
itSelect : Result:=GetSelectTag(aEntry, aBaseAttributes, aExtra, aClasses);
itTextArea : Result:=GetTextAreaTag(aEntry, aBaseAttributes, aExtra, aClasses);
itSelect : Result:=GetSelectTag(aEntry, aBaseAttributes, aClasses,aExtra);
itTextArea : Result:=GetTextAreaTag(aEntry, aBaseAttributes, aClasses, aExtra);
else
aExtra:=GetExtraAttributes(aEntry);
aClasses:=GetInputClasses(aEntry);

18
components/pas2js/components/frmhtmlactionseditor.lfm
View File

@ -9,14 +9,14 @@ object HTMLActionListEditorForm: THTMLActionListEditorForm
ClientHeight = 315
ClientWidth = 404
KeyPreview = True
Position = poScreenCenter
LCLVersion = '3.99.0.0'
OnClose = ActionListEditorClose
OnCreate = FormCreate
OnHide = FormHide
OnKeyDown = ActionListEditorKeyDown
OnKeyPress = ActionListEditorKeyPress
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '3.99.0.0'
object PanelDescr: TPanel
Left = 0
Height = 26
@ -45,13 +45,13 @@ object HTMLActionListEditorForm: THTMLActionListEditorForm
Width = 404
Align = alClient
ItemHeight = 0
PopupMenu = PopMenuActions
TabOrder = 1
TopIndex = -1
OnClick = lstActionNameClick
OnDblClick = lstActionNameDblClick
OnKeyDown = lstActionNameKeyDown
OnMouseDown = lstActionNameMouseDown
PopupMenu = PopMenuActions
TabOrder = 1
TopIndex = -1
end
object tbActions: TToolBar
Left = 0
@ -102,26 +102,26 @@ object HTMLActionListEditorForm: THTMLActionListEditorForm
Top = 64
object ActDelete: TAction
Category = 'AddDelete'
ShortCut = 46
OnExecute = ActDeleteExecute
OnUpdate = ActDeleteUpdate
ShortCut = 46
end
object ActNew: TAction
Category = 'AddDelete'
OnExecute = ActNewExecute
ShortCut = 45
OnExecute = ActNewExecute
end
object ActMoveUp: TAction
Category = 'MoveUpDown'
ShortCut = 16422
OnExecute = ActMoveUpDownExecute
OnUpdate = ActMoveUpUpdate
ShortCut = 16422
end
object ActMoveDown: TAction
Category = 'MoveUpDown'
ShortCut = 16424
OnExecute = ActMoveUpDownExecute
OnUpdate = ActMoveDownUpdate
ShortCut = 16424
end
object ActPanelDescr: TAction
Category = 'Panels'

67
components/pas2js/components/frmhtmlactionseditor.pas
View File

@ -121,13 +121,31 @@ Function GetActionsWithoutID(aList : THTMLCustomElementActionList; aMissing : TF
implementation
uses strpas2jscomponents, Types, idehtml2class, idehtmltools, frmselecthtmlactions;
uses db, strpas2jscomponents, typinfo, Types, idehtml2class, idehtmltools, frmselecthtmlactions;
{$R *.lfm}
var
EditorForms : TFPList = nil;
Function GetDatasourceList(aComp : TComponent) : TDatasourceArray;
var
I,aCount : Integer;
begin
aComp:=aComp.Owner;
aCount:=0;
SetLength(Result,aComp.ComponentCount);
For I:=0 to aComp.ComponentCount-1 do
if aComp.Components[i] is TDatasource then
begin
Result[aCount]:=aComp.Components[i] as TDatasource;
Inc(aCount);
end;
SetLength(Result,aCount);
end;
procedure InitFormsList;
begin
EditorForms:=TFPList.Create;
@ -218,17 +236,47 @@ begin
end;
end;
function CreateActionFromTag(aEditor: TComponentEditor;aList: THTMLCustomElementActionList; aEl : TelementInfo) : THTMLCustomElementAction;
var
aAction : THTMLCustomElementAction;
aName : string;
DS : TDataset;
begin
Result:=Nil;
if aEl.ActionClass=Nil then
exit;
aAction:=aList.NewAction(aList.Owner,aEl.ActionClass);
aName:='act'+HTMLTools.TagToIdentifier(aEl.ElementID);
if aList.Owner.FindComponent(aName)<>Nil then
aName:=aEditor.Designer.CreateUniqueComponentName(aName);
aAction.Name:=aName;
aAction.ElementID:=aEl.ElementID;
if aEl.DataSource<>Nil then
if IsPublishedProp(aAction,'Datasource') then
begin
SetObjectProp(aAction,'Datasource',aEl.DataSource);
if (aEl.InputName<>'') and IsPublishedProp(aAction,'FieldName') then
begin
DS:=aEl.Datasource.DataSet;
If DS.FindField(aEl.InputName)<>Nil then
SetStrProp(aAction,'FieldName',aEl.InputName);
end;
end;
end;
function CreateMissingActions(aEditor: TComponentEditor;
aList: THTMLCustomElementActionList; PreferDB : Boolean = False): Integer;
Var
aName, FN : String;
FN : String;
I : Integer;
Tags : TElementInfoList;
aEl : TElementInfo;
aAction : THTMLCustomElementAction;
aMissing : TFPList;
aHook : TPropertyEditorHook;
DS : TDatasourceArray;
begin
Result:=-1;
@ -254,22 +302,17 @@ begin
exit;
end;
// Now select
if SelectHTMLActionClasses(Tags,PreferDB,aMissing) then
DS:=GetDatasourceList(aList);
if SelectHTMLActionClasses(Tags,DS,PreferDB,aMissing) then
begin
DeleteActionsWithoutID(aEditor,aMissing);
Result:=0;
aEditor.Designer.ClearSelection;
For I:=0 to Tags.Count-1 do
begin
aEl:=Tags[i];
if aEl.ActionClass=Nil then
aAction:=CreateActionFromTag(aEditor,aList,Tags[i]);
if aAction=Nil then
continue;
aAction:=aList.NewAction(aList.Owner,aEl.ActionClass);
aName:='act'+HTMLTools.TagToIdentifier(aEl.ElementID);
if aList.Owner.FindComponent(aName)<>Nil then
aName:=aEditor.Designer.CreateUniqueComponentName(aName);
aAction.Name:=aName;
aAction.ElementID:=aEl.ElementID;
aHook:=aEditor.Designer.PropertyEditorHook;
if assigned(aHook) then
aHook.PersistentAdded(aAction,True);

30
components/pas2js/components/frmselecthtmlactions.lfm
View File

@ -6,16 +6,16 @@ object frmSelectHTMLActionClasses: TfrmSelectHTMLActionClasses
Caption = 'Add HTML Actions'
ClientHeight = 412
ClientWidth = 514
LCLVersion = '3.99.0.0'
OnClose = FormClose
OnCreate = FormCreate
LCLVersion = '3.99.0.0'
object pnlTop: TPanel
Left = 0
Height = 34
Height = 42
Top = 0
Width = 514
Align = alTop
ClientHeight = 34
ClientHeight = 42
ClientWidth = 514
TabOrder = 0
object cbUseDBAware: TCheckBox
@ -24,8 +24,18 @@ object frmSelectHTMLActionClasses: TfrmSelectHTMLActionClasses
Top = 6
Width = 127
Caption = 'Use Data Actions'
OnChange = cbUseDBAwareChange
TabOrder = 0
OnChange = cbUseDBAwareChange
end
object cbDatasources: TComboBox
Left = 224
Height = 30
Top = 4
Width = 152
ItemHeight = 0
Style = csDropDownList
TabOrder = 1
OnChange = cbDatasourcesChange
end
end
object bpHTMLActions: TButtonPanel
@ -46,8 +56,8 @@ object frmSelectHTMLActionClasses: TfrmSelectHTMLActionClasses
end
object PCAddRemove: TPageControl
Left = 0
Height = 328
Top = 34
Height = 320
Top = 42
Width = 514
ActivePage = TSAdd
Align = alClient
@ -55,11 +65,11 @@ object frmSelectHTMLActionClasses: TfrmSelectHTMLActionClasses
TabOrder = 2
object TSAdd: TTabSheet
Caption = 'Add actions'
ClientHeight = 298
ClientHeight = 290
ClientWidth = 504
object VLEClasses: TValueListEditor
Left = 0
Height = 298
Height = 290
Top = 0
Width = 504
Align = alClient
@ -81,11 +91,11 @@ object frmSelectHTMLActionClasses: TfrmSelectHTMLActionClasses
end
object TSRemove: TTabSheet
Caption = 'Remove actions'
ClientHeight = 298
ClientHeight = 290
ClientWidth = 504
object clbRemove: TCheckListBox
Left = 0
Height = 242
Height = 234
Top = 56
Width = 504
Align = alClient

48
components/pas2js/components/frmselecthtmlactions.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
ButtonPanel, stub.htmlactions, idehtml2class, ValEdit, ComCtrls, CheckLst;
ButtonPanel, stub.htmlactions, idehtml2class, ValEdit, ComCtrls, CheckLst, db;
type
@ -15,9 +15,11 @@ type
TElementInfo = Class(TTagInfoItem)
private
FActionClass: THTMLCustomElementActionClass;
FDataSource: TDatasource;
Public
Procedure Assign(aSource : TPersistent); override;
Property ActionClass : THTMLCustomElementActionClass Read FActionClass Write FActionClass;
Property DataSource : TDatasource Read FDataSource Write FDataSource;
end;
{ TElementInfoList }
@ -30,18 +32,22 @@ type
Property Infos[aIndex : Integer] : TElementInfo Read GetInfo; default;
end;
TDatasourceArray = array of TDatasource;
{ TfrmSelectHTMLActionClasses }
TfrmSelectHTMLActionClasses = class(TForm)
bpHTMLActions: TButtonPanel;
cbUseDBAware: TCheckBox;
clbRemove: TCheckListBox;
cbDatasources: TComboBox;
Label1: TLabel;
PCAddRemove: TPageControl;
pnlTop: TPanel;
TSAdd: TTabSheet;
TSRemove: TTabSheet;
VLEClasses: TValueListEditor;
procedure cbDatasourcesChange(Sender: TObject);
procedure cbUseDBAwareChange(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
@ -60,13 +66,14 @@ type
procedure SetTags(AValue: TElementInfoList);
public
procedure AddDatasource(DS : TDatasource);
Property PreferDB : Boolean Read FPreferDB Write SetPreferDB;
Property Tags : TElementInfoList Read FTags Write SetTags;
// On entry, list of actions that can be removed. On close, actions that should actually be removed.
Property RemoveList : TFPList Read FRemoveList Write SetRemoveList;
end;
Function SelectHTMLActionClasses(aTags : TElementInfoList; aPreferDB : Boolean; aRemoveList : TFPList) : Boolean;
Function SelectHTMLActionClasses(aTags : TElementInfoList; Datasources : TDatasourceArray; aPreferDB : Boolean; aRemoveList : TFPList) : Boolean;
implementation
@ -75,13 +82,18 @@ uses strutils, p2jselementactions, stub.data.HTMLActions, strpas2jscomponents;
{$R *.lfm}
Function SelectHTMLActionClasses(aTags : TElementInfoList; aPreferDB : Boolean; aRemoveList : TFPList) : Boolean;
Function SelectHTMLActionClasses(aTags : TElementInfoList; Datasources : TDatasourceArray; aPreferDB : Boolean; aRemoveList : TFPList) : Boolean;
var
DS : TDataSource;
begin
With TfrmSelectHTMLActionClasses.Create(Application) do
try
PreferDB:=aPreferDB;
Tags:=aTags;
for DS in Datasources do
AddDatasource(DS);
RemoveList:=aRemoveList;
Result:=ShowModal=mrOK
finally
@ -129,6 +141,22 @@ begin
AllocateDefaultClasses;
end;
procedure TfrmSelectHTMLActionClasses.cbDatasourcesChange(Sender: TObject);
var
I : Integer;
DS : TDatasource;
begin
I:=cbDatasources.ItemIndex;
if I=-1 then
DS:=Nil
else
DS:=cbDatasources.Items.Objects[I] as TDatasource;
For I:=0 to FTags.Count-1 do
FTags[i].DataSource:=DS;
end;
procedure TfrmSelectHTMLActionClasses.FormClose(Sender: TObject;
var CloseAction: TCloseAction);
@ -180,7 +208,14 @@ begin
Result:=THTMLElementAction;
if PreferDB then
if {%H-}IndexText(aEl.TagName,['input','select','textarea'])<>-1 then
Result:=TDBHTMLInputElementAction
begin
if SameText(aEl.TagName,'input') and (IndexText(aEl.TagName,['submit','reset'])<>-1) then
Result:=TDBHTMLButtonElementAction
else
Result:=TDBHTMLInputElementAction
end
else if SameText(aEl.TagName,'button') then
Result:=TDBHTMLButtonElementAction
else
Result:=TDBHTMLElementAction;
end;
@ -245,5 +280,10 @@ begin
AllocateDefaultClasses;
end;
procedure TfrmSelectHTMLActionClasses.AddDatasource(DS: TDatasource);
begin
cbDatasources.Items.AddObject(DS.Name,DS);
end;
end.

16
components/pas2js/components/pas2jsrestcmd.pas
View File

@ -147,16 +147,24 @@ procedure TIDEPas2JSRestCommandHandler.CheckDataset(Sender: TObject);
Var
DS : TSQLDBRestDataset;
MDOK,OK : Boolean;
MDOK,OK,HaveFields : Boolean;
begin
DS:=GetDataset;
OK:=(DS<>Nil) and (DS.Connection<>Nil) and (DS.ResourceName<>'');
MDOK:=OK and (DS.Connection.MetaDataResourceName<>'');
mnuCompRestSection.Enabled:=OK;
if OK then
begin
MDOK:=OK and (DS.Connection.MetaDataResourceName<>'');
HaveFields:=((DS.FieldDefs.Count>0) or (DS.Fields.Count>0));
end
else
begin
MDOK:=False;
HaveFields:=False;
end;
CmdShowData.Enabled:=OK ;
CmdGetParamDefs.Enabled:=OK;
CmdGenHTML.Enabled:=OK and ((DS.FieldDefs.Count>0) or (DS.Fields.Count>0));
CmdGenHTML.Enabled:=OK and HaveFields;
CmdGetFieldDefs.Enabled:=MDOK;
end;

2
components/pas2js/components/pas2jsrestutils.pas
View File

@ -167,7 +167,7 @@ Var
begin
Buf:=TLocalBufDataset.Create(Self);
try
LoadDataset(Buf,AConnection,aConnection.ConnectionsResourceName);
if not LoadDataset(Buf,AConnection,aConnection.ConnectionsResourceName) then exit;
Buf.Open;
While not Buf.EOF do
begin

30
components/pas2js/components/stubs/stub.bootstraptablewidget.pas
View File

@ -56,6 +56,7 @@ type
{ TBSActionColumn }
{ TBSColumnAction }
TBSActionClickEvent = Procedure(Sender : TObject; Event : TJSObject; aRowData : TJSObject; aRowIndex : Integer) of Object;
TBSColumnAction = class(TCollectionItem)
private
@ -63,11 +64,15 @@ type
FButtonType: TColumnButtonType;
FButtonURL: string;
FButtonURLTarget: string;
FExtraAttributes: String;
FExtraAttributes: string;
FName: string;
FOnClick: TBSActionClickEvent;
Protected
function GetDisplayName: string; override;
Public
procedure Assign(Source: TPersistent); override;
Published
Property Name : string Read FName Write FName;
property ButtonType: TColumnButtonType read FButtonType write FButtonType;
// When buttontype is btCustom, use the following class (in <i class="">)
Property ButtonIconClass: String Read FButtonIconClass Write FButtonIconClass;
@ -76,7 +81,9 @@ type
// Target of button URL
property ButtonURLTarget: string read FButtonURLTarget write FButtonURLTarget;
// Add extra attributes to the contents of the column if needed
property ExtraAttributes: String read FExtraAttributes write FExtraAttributes;
property ExtraAttributes: string read FExtraAttributes write FExtraAttributes;
// When clicked
Property OnClick : TBSActionClickEvent Read FOnClick Write FOnClick;
end;
{ TBSColumnActionList }
@ -88,12 +95,14 @@ type
Public
Property Actions[aIndex : Integer] : TBSColumnAction Read GetAction Write SetAction;
end;
TBSColumnClickEvent = Procedure(Sender : TObject; Event : TJSObject; aRowData : TJSObject; aRowIndex : Integer) of Object;
TBSTableColumn = class(TCollectionItem)
private
FActions: TBSColumnActionList;
FFieldName: string;
FFormatting: string;
FOnButtonClick: TBSColumnClickEvent;
FSelectable: Boolean;
FTitle: string;
FRenderMode: TColumnRenderMode;
@ -168,6 +177,8 @@ type
property ExtraAttributes: String read FExtraAttributes write FExtraAttributes;
// Selectable ? This is a native bootstrap-table select column
Property Selectable : Boolean Read FSelectable Write FSelectable;
// On click. Sender will be this column
Property OnButtonClick : TBSColumnClickEvent Read FOnButtonClick Write FOnButtonClick;
end;
@ -336,7 +347,7 @@ end;
constructor TStylingClasses.Create(aWidget: TCustomDBBootstrapTableWidget);
begin
FWidget:=aWidget;
ButtonClass:='btn btn-secondary btn-sm btn-outline';
ButtonClass:='btn btn-outline-secondary btn-sm';
EditClass:='bi bi-pencil';
DeleteClass:='bi bi-trash';
InfoClass:='bi bi-info-circle';
@ -364,6 +375,13 @@ end;
{ TBSColumnAction }
function TBSColumnAction.GetDisplayName: string;
begin
Result:=FName;
if Result='' then
Result:=inherited GetDisplayName;
end;
procedure TBSColumnAction.Assign(Source: TPersistent);
var
aSource: TBSColumnAction absolute Source;
@ -375,6 +393,8 @@ begin
ButtonURL:=aSource.ButtonURL;
ButtonType:=aSource.ButtonType;
ButtonIconClass:=aSource.ButtonIconClass;
Name:=aSource.Name;
OnClick:=aSource.OnClick;
end else
inherited Assign(Source);
end;
@ -417,6 +437,8 @@ begin
Formatting := Src.Formatting;
OnGetSortValue := Src.OnGetSortValue;
ExtraAttributes := Src.ExtraAttributes;
Selectable:=Src.Selectable;
FOnButtonClick:=Src.OnButtonClick;
Actions:=Src.Actions;
end
else

2
components/pas2js/components/stubs/stub.bootstrapwidgets.pas
View File

@ -114,6 +114,7 @@ Type
FFocus: Boolean;
FKeyBoard: Boolean;
FOnHide: TOnModalHideEvent;
FOnShow: TNotifyEvent;
FShowOnRender: Boolean;
FTemplate: String;
FTemplateLoader: TCustomTemplateLoader;
@ -136,6 +137,7 @@ Type
Property TemplateName : String Read FTemplateName Write SetTemplateName;
Property TemplateLoader : TCustomTemplateLoader Read FTemplateLoader Write SetTemplateLoader;
Property OnHide : TOnModalHideEvent Read FOnHide Write FOnHide;
Property OnShow : TNotifyEvent Read FOnShow Write FOnShow;
Property References : TModalReferences Read GetModalReferences Write SetModalReferences;
end;