Commit fd402cf8 authored by Bruno Agrizzi's avatar Bruno Agrizzi

Inserção da funcionalidade no menu.

parent 06555be3
ituOQLParams.pas(7,22) Note: Fixed character case of unit "acuOQl" to "acuOQL". ituCadastrarFormulario.pas Note: Changed encoding from cp1252 to UTF-8
ituOQLParams.pas Note: Replaced unit "Mask" with "MaskEdit" in uses section. ituCadastrarFormulario.pas Note: Changed encoding from cp1252 to UTF-8
ituOQLParams.pas Note: Replaced unit "Windows" with "LCLIntf, LCLType, LMessages" in uses section. ituCadastrarFormulario.pas Note: Replaced unit "Mask" with "MaskEdit" in uses section.
ituOQLParams.pas(1,19) Note: Added MODE Delphi syntax modifier after unit name. ituCadastrarFormulario.pas Note: Replaced unit "Windows" with "LCLIntf, LCLType, LMessages" in uses section.
ituCadastrarFormulario.pas(1,29) Note: Added MODE Delphi syntax modifier after unit name.
ituCadastrarFormulario.pas Note: Removed property "Strings.Strings".
ituCadastrarFormulario.pas Note: Removed property "BevelKind".
ituCadastrarFormulario.pas Note: Removed property "BevelInner".
ituCadastrarFormulario.pas Note: Removed property "TextHeight".
ituCadastrarFormulario.pas Note: Removed property "PixelsPerInch".
ituCadastrarFormulario.pas Note: Removed property "DesignSize".
ituCadastrarFormulario.pas Note: Removed property "OldCreateOrder".
ituCadastrarFormulario.pas Note: Removed property "Font.Style".
ituCadastrarFormulario.pas Note: Removed property "Font.Name".
ituCadastrarFormulario.pas Note: Removed property "Font.Height".
ituCadastrarFormulario.pas Note: Removed property "Font.Color".
ituCadastrarFormulario.pas Note: Removed property "Font.Charset".
ituCadastrarFormulario.pas Note: Removed property "Color".
ituCadastrarFormulario.pas Note: Removed property "ClientWidth".
ituCadastrarFormulario.pas Note: Removed property "ClientHeight".
ituCadastrarFormulario.pas Note: Removed property "Caption".
ituCadastrarFormulario.pas Note: Removed property "Top".
ituCadastrarFormulario.pas Note: Removed property "Left".
: Conversion Ready. : Conversion Ready.
object itCadastrarFormulario: TitCadastrarFormulario
Left = 0
Top = 0
Caption = 'Cadastrar Formul'#225'rio'
ClientHeight = 600
ClientWidth = 1035
Color = clBtnHighlight
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Trebuchet MS'
Font.Style = []
OldCreateOrder = True
DesignSize = (
1035
600)
PixelsPerInch = 96
TextHeight = 16
object scrlbxTudo: TScrollBox
Left = 0
Top = 8
Width = 1038
Height = 596
HorzScrollBar.Tracking = True
VertScrollBar.Tracking = True
Anchors = [akLeft, akTop, akRight, akBottom]
BorderStyle = bsNone
TabOrder = 0
object btnDown: TJvSpeedButton
Left = 760
Top = 149
Width = 70
Height = 25
Caption = 'Desce'
HotTrackFont.Charset = DEFAULT_CHARSET
HotTrackFont.Color = clWindowText
HotTrackFont.Height = -11
HotTrackFont.Name = 'Trebuchet MS'
HotTrackFont.Style = []
OnClick = btnDownClick
end
object btnUp: TJvSpeedButton
Left = 685
Top = 149
Width = 70
Height = 25
Caption = 'Sobe'
HotTrackFont.Charset = DEFAULT_CHARSET
HotTrackFont.Color = clWindowText
HotTrackFont.Height = -11
HotTrackFont.Name = 'Trebuchet MS'
HotTrackFont.Style = []
OnClick = btnUpClick
end
object lblCodigo: TLabel
Left = 16
Top = 17
Width = 52
Height = 18
Caption = 'C'#211'DIGO:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentFont = False
end
object lblExibirCampos: TLabel
Left = 16
Top = 106
Width = 55
Height = 18
Caption = 'CAMPOS:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentFont = False
end
object lblOrdem: TLabel
Left = 684
Top = 130
Width = 43
Height = 18
Caption = 'ORDEM:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Trebuchet MS'
Font.Style = []
ParentFont = False
end
object lblTipoAtributo: TLabel
Left = 684
Top = 234
Width = 98
Height = 18
Caption = 'TIPO DO CAMPO: '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Trebuchet MS'
Font.Style = []
ParentFont = False
end
object lblNovoCampo: TLabel
Left = 360
Top = 100
Width = 81
Height = 18
Caption = 'NOVO CAMPO:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Trebuchet MS'
Font.Style = []
ParentFont = False
end
object btnAdd: TJvSpeedButton
Left = 596
Top = 95
Width = 70
Height = 25
Caption = 'Adicionar'
HotTrackFont.Charset = DEFAULT_CHARSET
HotTrackFont.Color = clWindowText
HotTrackFont.Height = -11
HotTrackFont.Name = 'Trebuchet MS'
HotTrackFont.Style = []
OnClick = btnAddClick
end
object cbbTipo: TComboBox
Left = 685
Top = 255
Width = 145
Height = 24
Hint = 'Tipo'
BevelInner = bvNone
BevelKind = bkFlat
Style = csDropDownList
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Trebuchet MS'
Font.Style = []
ItemHeight = 16
ParentFont = False
TabOrder = 3
OnChange = cbbTipoChange
end
object chkRequerido: TJvCheckBox
Left = 684
Top = 188
Width = 96
Height = 18
Caption = 'OBRIGAT'#211'RIO'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Trebuchet MS'
Font.Style = []
ParentFont = False
TabOrder = 2
OnClick = chkRequeridoClick
LinkedControls = <>
HotTrackFont.Charset = DEFAULT_CHARSET
HotTrackFont.Color = clWindowText
HotTrackFont.Height = -12
HotTrackFont.Name = 'Trebuchet MS'
HotTrackFont.Style = []
end
object edtCodigo: TJvEdit
Left = 74
Top = 16
Width = 143
Height = 24
BevelKind = bkFlat
BorderStyle = bsNone
Enabled = False
TabOrder = 0
end
object lstAtributos: TValueListEditor
Left = 685
Top = 285
Width = 289
Height = 145
Strings.Strings = (
'=')
TabOrder = 4
OnValidate = lstAtributosValidate
ColWidths = (
144
139)
end
object lvCampos: TJvListView
Left = 16
Top = 130
Width = 650
Height = 300
BevelInner = bvNone
BevelOuter = bvRaised
BevelKind = bkFlat
BorderStyle = bsNone
Checkboxes = True
Columns = <
item
Caption = 'Nome'
Width = 350
end
item
Caption = 'Obrigat'#243'rio'
Width = 100
end
item
Caption = 'ID'
Width = 100
end
item
Caption = 'Tipo'
Width = 100
end>
ColumnClick = False
Ctl3D = False
FlatScrollBars = True
GridLines = True
HideSelection = False
ReadOnly = True
RowSelect = True
TabOrder = 1
ViewStyle = vsReport
OnClick = lvCamposClick
OnSelectItem = lvCamposSelectItem
AutoSelect = False
ColumnsOrder = '0=350,1=100,2=100,3=100'
SortOnClick = False
Groups = <>
ExtendedColumns = <
item
end
item
end
item
end
item
end>
end
object btnSalvar: TButton
Left = 521
Top = 448
Width = 145
Height = 49
Caption = 'SALVAR'
TabOrder = 5
OnClick = btnSalvarClick
end
object btnCancelar: TButton
Left = 685
Top = 448
Width = 145
Height = 49
Caption = 'CANCELAR'
TabOrder = 6
OnClick = btnCancelarClick
end
object edtCampo: TJvEdit
Left = 447
Top = 95
Width = 143
Height = 25
BevelKind = bkFlat
BorderStyle = bsNone
TabOrder = 7
OnKeyPress = edtCampoKeyPress
end
end
end
unit ituCadastrarFormulario;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
ituVCLUIController, ituUIController, StdCtrls, Dialogs, JvExControls,
JvSpeedButton, ComCtrls, JvExComCtrls, JvListView, ExtCtrls, Mask, JvExMask,
JvToolEdit, JvBaseEdits, JvExStdCtrls, JvCheckBox, JvEdit, JvCombobox, utuMessage,
Grids, ValEdit;
type
TitCadastrarFormulario = class(itInterfaceForm)
lblCodigo: TLabel;
lblOrdem: TLabel;
lvCampos: TJvListView;
lblExibirCampos: TLabel;
btnUp: TJvSpeedButton;
btnDown: TJvSpeedButton;
chkRequerido: TJvCheckBox;
edtCodigo: TJvEdit;
cbbTipo: TComboBox;
lblTipoAtributo: TLabel;
lstAtributos: TValueListEditor;
scrlbxTudo: TScrollBox;
btnSalvar: TButton;
btnCancelar: TButton;
edtCampo: TJvEdit;
lblNovoCampo: TLabel;
btnAdd: TJvSpeedButton;
procedure lstAtributosClear;
procedure lstAtributosFill(piType: string);
procedure btnCancelarClick(Sender: TObject);
procedure btnUpClick(Sender: TObject);
procedure btnDownClick(Sender: TObject);
procedure lvCamposSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure chkRequeridoClick(Sender: TObject);
procedure lvCamposClick(Sender: TObject);
procedure btnSalvarClick(Sender: TObject);
procedure cbbTipoChange(Sender: TObject);
procedure lstAtributosValidate(Sender: TObject; ACol, ARow: Integer;
const KeyName, KeyValue: string);
procedure btnAddClick(Sender: TObject);
procedure edtCampoKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
itCadastrarFormulario = class(itInterface)
private
fTypesField : utField;
fFieldTypeList : utField;
fIdCount : Integer;
procedure ObterAtributosSuccess (piRequest : acRequest);
procedure EditarSuccess (piRequest : acRequest);
procedure IncluirSuccess (piRequest : acRequest);
procedure SalvarSuccess (piRequest : acRequest);
{ Private declarations }
public
procedure Initialize; override;
procedure Finalize; override;
end;
implementation
uses
ituInterfaceFactory, acuObject;
const
__STRING = 1;
__NUMBER = 2;
__BOOLEAN = 3;
{$R *.dfm}
{ itCadastrarCliente }
procedure itCadastrarFormulario.Initialize;
var
lRequest : acRequest;
begin
inherited;
fIdCount := 0;
Screen.Cursor := crHourGlass;
self.InterfaceForm := TitCadastrarFormulario.Create(Application);
if Self.ContextObject.OperationCode = '5' then {Novo}
begin
lRequest := Self.NewRequest('RM_OBTER_CONTEXTO', ObterAtributosSuccess);
lRequest.Message.RootField.AddField('Definition').AddAttribute('OID').AsString := Self.ContextObject.ObjectID;
lRequest.Post;
end
else if Self.ContextObject.OperationCode = '3' then {Editar}
begin
lRequest := Self.NewRequest('RM_OBTER_CONTEXTO', ObterAtributosSuccess);
lRequest.Message.RootField.AddField('Form').AddAttribute('OID').AsString := Self.ContextObject.ObjectID;
lRequest.Post;
end
else
raise Exception.Create('Operao invlida.');
Self.InterfaceForm.Show;
TitCadastrarFormulario(Self.InterfaceForm).lvCamposClick(nil);
fFieldTypeList := utField.Create;
end;
procedure itCadastrarFormulario.ObterAtributosSuccess(piRequest: acRequest);
var
lClassAttField, lFieldItem: utField;
lItem: TListItem;
lEnum : acEnumerator;
lClassAttribute : string;
begin
inherited;
with TitCadastrarFormulario(Self.InterfaceForm) do
begin
fTypesField := piRequest.Response.RootField.ExtractField(piRequest.Response.RootField.FieldByName('Types'));
if piRequest.Response.RootField.HasField('ClassAttributes') then
begin
lClassAttField := piRequest.Response.RootField.FieldByName('ClassAttributes');
lvCampos.Items.Clear;
lEnum := lClassAttField.ChildFields.GetEnumerator;
try
while not lEnum.EOL do {preenche a listView com os atributos da classe }
begin
lFieldItem := lEnum.Current as utField;
lClassAttribute := lFieldItem.AttributeByName('name').AsString;
fIdCount := lFieldItem.AttributeByName('id').AsInteger;
fFieldTypeList.AddField(lClassAttribute); //fieald para armazenar os attributos de cada campo
lItem := lvCampos.Items.Add;
lItem.Caption := lClassAttribute;
with lItem.SubItems do
begin
Add('N'); //requerido
Add(IntToStr(fIdCount)); //ID
Add(''); //tipo
Add(''); //tipo index
end;
lEnum.MoveNext;
end;
finally
lEnum.Free;
end;
end;
cbbTipo.Items.Clear;
lEnum := fTypesField.ChildFields.GetEnumerator;
try
while not lEnum.EOL do {preenche a comboBox com os tipos de field }
begin
lFieldItem := lEnum.Current as utField;
cbbTipo.AddItem(lFieldItem.Name, Pointer(lFieldItem.AttributeByName('OID').AsInteger));
lEnum.MoveNext;
end;
finally
lEnum.Free;
end;
end;
if Self.ContextObject.OperationCode = '5' then {Novo}
Self.NewRequest('RM_INCLUIR', IncluirSuccess).Post
else if Self.ContextObject.OperationCode = '3' then {Editar}
Self.NewRequest('RM_EDITAR', EditarSuccess).Post;
end;
procedure itCadastrarFormulario.IncluirSuccess(piRequest: acRequest);
var
lCode : string;
begin
try
lCode := piRequest.Response.RootField.FieldByName('Form').AttributeByName('OID').AsString;
TitCadastrarFormulario(Self.InterfaceForm).edtCodigo.Text := lCode;
finally
TitCadastrarFormulario(Self.InterfaceForm).Enabled := True;
Screen.Cursor := crDefault;
end;
end;
procedure itCadastrarFormulario.EditarSuccess(piRequest: acRequest);
var
lFieldItem : utField;
lCode, lFieldName : string;
lEnum : acEnumerator;
lItem: TListItem;
lPosition, lIndex, lId : Integer;
begin
try
lCode := piRequest.Response.RootField.FieldByName('Form').AttributeByName('code').AsString;
TitCadastrarFormulario(Self.InterfaceForm).edtCodigo.Text := lCode;
lEnum := piRequest.Response.RootField.FieldByName('Form').FieldByName('Fields').ChildFields.GetEnumerator;
try
while not lEnum.EOL do {preenche a comboBox com os tipos de field }
begin
lFieldItem := lEnum.Current as utField;
lFieldName := lFieldItem.AttributeByName('name').AsString;
lId := lFieldItem.AttributeByName('id').AsInteger;
if lId > fIdCount then fIdCount := lId;
with TitCadastrarFormulario(Self.InterfaceForm) do
begin
lItem := lvCampos.FindCaption(0, lFieldName, False, True, False);
if lItem = nil then
begin
lItem := lvCampos.Items.Add;
lItem.Caption := lFieldName;
lItem.SubItems.Add('');
lItem.SubItems.Add('');
lItem.SubItems.Add('');
end;
lItem.Checked := True;
lItem.SubItems[0] := lFieldItem.AttributeByName('required').AsString;
lItem.SubItems[1] := lFieldItem.AttributeByName('id').AsString;
lItem.SubItems[2] := lFieldItem.FieldByName('Type').AttributeByName('name').AsString;
lPosition := lFieldItem.AttributeByName('order').AsInteger;
lIndex := lItem.Index;
while lIndex > lPosition do
begin
lvCampos.MoveUp(lIndex, False);
lIndex := lIndex - 1;
end;
while lIndex < lPosition do
begin
lvCampos.MoveDown(lIndex, False);
lIndex := lIndex + 1;
end;
end;
lFieldItem.Name := lFieldName;
if not fFieldTypeList.HasField(lFieldName) then fFieldTypeList.AddField(lFieldName);
fFieldTypeList.FieldByName(lFieldName).Assign(lFieldItem);
lEnum.MoveNext;
end;
finally
lEnum.Free;
end;
finally
TitCadastrarFormulario(Self.InterfaceForm).Enabled := True;
Screen.Cursor := crDefault;
end;
end;
procedure TitCadastrarFormulario.btnSalvarClick(Sender: TObject);
var
lRequest : acRequest;
lFormField, lFieldField, lTypeField : utField;
i, lOrder : Integer;
begin
try
with itCadastrarFormulario(Self.Controller) do
begin
lRequest := NewRequest('RM_SALVAR', SalvarSuccess);
lFormField := lRequest.Message.RootField.AddField('Form');
lFormField.AddAttribute('code').AsString := edtCodigo.Text;
lFormField := lFormField.AddField('Fields');
lOrder := 0;
for i := 0 to lvCampos.Items.Count - 1 do
begin
if lvCampos.Items[i].Checked then
begin
if lvCampos.Items[i].SubItems[2] = '' then
raise Exception.Create('O campo ''' + lvCampos.Items[i].Caption + ''' deve possuir um tipo');
lFieldField := lFormField.AddField('Field');
lFieldField.AddAttribute('name').AsString := lvCampos.Items[i].Caption;
lFieldField.AddAttribute('order').AsInteger := lOrder;
lFieldField.AddAttribute('required').AsBoolean := (lvCampos.Items[i].SubItems[0] = 'S');
lFieldField.AddAttribute('id').AsInteger := StrToInt(lvCampos.Items[i].SubItems[1]);
lTypeField := lFieldField.AddField('Type');
lTypeField.Assign(fFieldTypeList.FieldByName(lvCampos.Items[i].Caption).FieldByName('Type'));
lOrder := lOrder + 1;
end;
end;
if not lFormField.HasField('Field') then
raise Exception.Create('O formulrio deve possuir pelo menos um campo, use as CheckBoxes para escolhe-los.');
lRequest.Post;
end;
except
raise;
end;
end;
procedure itCadastrarFormulario.SalvarSuccess(piRequest: acRequest);
begin
ShowMessage('Formulrio cadastrado com sucesso.');
TitCadastrarFormulario(Self.InterfaceForm).Close;
end;
procedure TitCadastrarFormulario.btnAddClick(Sender: TObject);
var
lItem : TListItem;
begin
if edtCampo.Text <> '' then
begin
with itCadastrarFormulario(Self.Controller) do
begin
fIdCount := fIdCount + 1;
fFieldTypeList.AddField(edtCampo.Text);
end;
lItem := lvCampos.Items.Add;
lItem.Caption := edtCampo.Text;
lItem.Checked := True;
with lItem.SubItems do
begin
Add('N'); //requerido
Add(IntToStr(itCadastrarFormulario(Self.Controller).fIdCount)); //ID
Add(''); //tipo
Add(''); //tipo index
end;
edtCampo.Clear;
end;
end;
procedure TitCadastrarFormulario.edtCampoKeyPress(Sender: TObject; var Key: Char);
begin
if Ord(Key) = VK_RETURN then
begin
btnAdd.Click;
end;
end;
procedure TitCadastrarFormulario.btnCancelarClick(Sender: TObject);
begin
Self.Close;
end;
procedure TitCadastrarFormulario.btnDownClick(Sender: TObject);
var
lIndex : Integer;
begin
lIndex := lvCampos.Selected.Index;
lvCampos.MoveDown(lIndex);
end;
procedure TitCadastrarFormulario.btnUpClick(Sender: TObject);
var
lIndex : Integer;
begin
lIndex := lvCampos.Selected.Index;
lvCampos.MoveUp(lIndex);
end;
procedure TitCadastrarFormulario.cbbTipoChange(Sender: TObject);
var
lField, lTypeField : utField;
begin
lvCampos.Selected.SubItems[2] := cbbTipo.Text;
//lvCampos.Selected.SubItems[3] := IntToStr(cbbTipo.ItemIndex);
with itCadastrarFormulario(Self.Controller) do
begin
lField := fFieldTypeList.FieldByName(lvCampos.Selected.Caption);
if lField.HasField('Type') then
lField.RemoveField(lField.FieldByName('Type'));
lTypeField := lField.AddField('Type');
lTypeField.AddAttribute('name').AsString := cbbTipo.Text;
lTypeField.AddAttribute('OID').AsInteger := Integer(cbbTipo.Items.Objects[cbbTipo.ItemIndex]);
end;
if cbbTipo.ItemIndex <> -1 then
begin
lstAtributosFill(cbbTipo.Text);
end;
end;
procedure TitCadastrarFormulario.lstAtributosFill(piType: string);
var
lEnum : acEnumerator;
lFieldItem, lTypeField :utField;
lValue, lAttribute : string;
lIndex : Integer;
begin
lstAtributosClear;
lEnum := itCadastrarFormulario(Self.Controller).fTypesField.FieldByName(piType).FieldByName('Attributes').ChildFields.GetEnumerator;
try
while not lEnum.EOL do {preenche a ValueList com os atributos do tipo de field }
begin
lFieldItem := lEnum.Current as utField;
lAttribute := lFieldItem.Name;
lValue := '';
if itCadastrarFormulario(Controller).fFieldTypeList.FieldByName(lvCampos.Selected.Caption).HasField('Type') then
begin
lTypeField := itCadastrarFormulario(Controller).fFieldTypeList.FieldByName(lvCampos.Selected.Caption).FieldByName('Type');
if lTypeField.HasField(lAttribute) then
lValue := lTypeField.FieldByName(lAttribute).AttributeByName('value').AsString;
end;
lIndex := lstAtributos.InsertRow(lAttribute, lValue, True);
lstAtributos.Strings.Objects[lIndex - 1] := Pointer(lFieldItem.AttributeByName('OID').AsInteger);
if lFieldItem.AttributeByName('type').AsInteger = __BOOLEAN then
begin
lstAtributos.ItemProps[lAttribute].EditStyle := esPickList;
lstAtributos.ItemProps[lAttribute].PickList.Add('True');
lstAtributos.ItemProps[lAttribute].PickList.Add('False');
end;
lEnum.MoveNext;
end;
finally
lEnum.Free;
end;
end;
procedure TitCadastrarFormulario.lstAtributosClear;
var
i : Integer;
begin
if lstAtributos.RowCount > 2 then
for i := lstAtributos.RowCount-1 downto 1 do
lstAtributos.DeleteRow(i)
else
lstAtributos.Values[lstAtributos.Keys[1]] := '';
end;
procedure TitCadastrarFormulario.lstAtributosValidate(Sender: TObject; ACol,
ARow: Integer; const KeyName, KeyValue: string);
var
lField, lAttributeField, lTypeField : utField;
lOID, lAttributeType, lIntValue : Integer;
lOK, lBoolValue: Boolean;
lMessage : string;
begin
if (lvCampos.SelCount > 0) and (lvCampos.Selected.SubItems[2] <> '') then
begin
with itCadastrarFormulario(Self.Controller) do
begin
lTypeField := fTypesField.FieldByName(lvCampos.Selected.SubItems[2]);
lAttributeType := lTypeField.FieldByName('Attributes').FieldByName(KeyName).AttributeByName('type').AsInteger;
lOK := True;
if lAttributeType = __NUMBER then
begin
lOK := TryStrToInt(KeyValue, lIntValue);
lMessage := 'Atributo ' + KeyName + ' deve ser do tipo INTEGER';
end
else if lAttributeType = __BOOLEAN then
begin
lOK := TryStrToBool(KeyValue, lBoolValue);
lMessage := 'Atributo ''' + KeyName + ''' deve ser do tipo BOOLEAN';
end;
if KeyValue <> '' then
begin
if lOK then
begin
lOID := Integer(lstAtributos.Strings.Objects[lstAtributos.Strings.IndexOfName(KeyName)]);
lField := fFieldTypeList.FieldByName(lvCampos.Selected.Caption).FieldByName('Type');
if lField.HasField(KeyName) then
begin
lAttributeField := lField.FieldByName(KeyName);
lAttributeField.AttributeByName('OID').AsInteger := lOID;
lAttributeField.AttributeByName('value').AsString := KeyValue;
end
else
begin
lAttributeField := lField.AddField(KeyName);
lAttributeField.AddAttribute('OID').AsInteger := lOID;
lAttributeField.AddAttribute('value').AsString := KeyValue;
end;
end
else
begin
// lstAtributos.Col := ACol;
// lstAtributos.Row := ARow;
lstAtributos.Values[KeyName] := '';
MessageDlg(lMessage, mtError, [mbOK], 0);
// raise Exception.Create(lMessage);
end;
end
else
begin
lField := fFieldTypeList.FieldByName(lvCampos.Selected.Caption).FieldByName('Type');
if lField.HasField(KeyName) then
lField.RemoveField(lField.FieldByName(KeyName));
end;
end;
end;
end;
procedure TitCadastrarFormulario.chkRequeridoClick(Sender: TObject);
begin
if chkRequerido.Checked = True
then lvCampos.Selected.SubItems[0] := 'S'
else lvCampos.Selected.SubItems[0] := 'N';
end;
procedure TitCadastrarFormulario.lvCamposClick(Sender: TObject);
begin
if lvCampos.SelCount = 0 then
begin
chkRequerido.Enabled := False;
btnUp.Enabled := False;
btnDown.Enabled := False;
cbbTipo.Enabled := False;
lblOrdem.Enabled := False;
lblTipoAtributo.Enabled := False;
lstAtributos.Enabled := False;
lstAtributosClear;
end
else
begin
chkRequerido.Enabled := True;
btnUp.Enabled := True;
btnDown.Enabled := True;
cbbTipo.Enabled := True;
lblOrdem.Enabled := True;
lblTipoAtributo.Enabled := True;
lstAtributos.Enabled := True;
end;
end;
procedure TitCadastrarFormulario.lvCamposSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
begin
if Selected then
begin
if Item.SubItems[0] = 'N' then
chkRequerido.Checked := False
else
chkRequerido.Checked := True;
if Item.SubItems[2] = '' then
begin
cbbTipo.ItemIndex := -1;
lstAtributosClear;
end
else
begin
cbbTipo.ItemIndex := cbbTipo.Items.IndexOf(Item.SubItems[2]);
lstAtributosFill(Item.SubItems[2]);
end;
end;
end;
procedure itCadastrarFormulario.Finalize;
begin
inherited;
if Assigned(fTypesField) then
fTypesField.Free;
end;
initialization
gInterfaceFactory.RegisterClass(1371, itCadastrarFormulario);
finalization
gInterfaceFactory.UnRegisterClass(1371);
end.
...@@ -174,23 +174,25 @@ ...@@ -174,23 +174,25 @@
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<FormatVersion Value="2"/> <FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams> </RunParams>
<RequiredPackages Count="4"> <RequiredPackages Count="5">
<Item1> <Item1>
<PackageName Value="evoumlintf"/> <PackageName Value="JvStdCtrlsLazR"/>
</Item1> </Item1>
<Item2> <Item2>
<PackageName Value="curio"/> <PackageName Value="evoumlintf"/>
</Item2> </Item2>
<Item3> <Item3>
<PackageName Value="SynEdit"/> <PackageName Value="curio"/>
</Item3> </Item3>
<Item4> <Item4>
<PackageName Value="LCL"/> <PackageName Value="SynEdit"/>
</Item4> </Item4>
<Item5>
<PackageName Value="LCL"/>
</Item5>
</RequiredPackages> </RequiredPackages>
<Units Count="29"> <Units Count="31">
<Unit0> <Unit0>
<Filename Value="CurioAddIn.dpr"/> <Filename Value="CurioAddIn.dpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
...@@ -362,6 +364,17 @@ ...@@ -362,6 +364,17 @@
<Filename Value="odbc_dsn_win.pas"/> <Filename Value="odbc_dsn_win.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit28> </Unit28>
<Unit29>
<Filename Value="ituCadastrarDefinicao.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="itCadastrarDefinicao"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit29>
<Unit30>
<Filename Value="cxuCadastroDefinicaoClasse.pas"/>
<IsPartOfProject Value="True"/>
</Unit30>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
......
...@@ -37,6 +37,8 @@ type ...@@ -37,6 +37,8 @@ type
class procedure ActionMenu_OQLV2; class procedure ActionMenu_OQLV2;
class procedure ActionMenu_CXOQLV2; class procedure ActionMenu_CXOQLV2;
class procedure ActionMenu_DynamoDefinition;
procedure ListOwnedClasses( piPackage : IUMLPackage ; piObjectList : TInterfaceList ; piStringList : TStringList); procedure ListOwnedClasses( piPackage : IUMLPackage ; piObjectList : TInterfaceList ; piStringList : TStringList);
procedure ListOwnedUseCases ( piPackage : IUMLPackage ; piObjectList : TInterfaceList ; piStringList : TStringList); procedure ListOwnedUseCases ( piPackage : IUMLPackage ; piObjectList : TInterfaceList ; piStringList : TStringList);
...@@ -51,9 +53,9 @@ implementation ...@@ -51,9 +53,9 @@ implementation
uses uses
InstantCode, SysUtils, Mostra_Processamento, utuStateMachine, fCodeGen, Controls, Forms, InstantCode, SysUtils, Mostra_Processamento, utuStateMachine, fCodeGen, Controls, Forms,
fModelMappingsGenerationOptions, fXSDEditor, ituDataBaseLogin, formMemo, fModelMappingsGenerationOptions, fXSDEditor, ituDataBaseLogin, formMemo,
cxuCadastroClasse, cxuCadastroCasoDeUso, cxuCadastroClasse, cxuCadastroCasoDeUso, ituCadastrarDefinicao, ituCadastrarFormulario,
utuMessage, uCadastroCasoDeUso, uCadastroClasse, ituServiceParameters, ituExplorerV2, utuMessage, uCadastroCasoDeUso, uCadastroClasse, ituServiceParameters, ituExplorerV2,
Registry, uRTFEditor, ituXSDExplorer, ituExportUnits, ituOQLExplorerV2; Registry, uRTFEditor, ituXSDExplorer, ituExportUnits, ituOQLExplorerV2, cxuCadastroDefinicaoClasse;
//procedure TDelphiAddInObj.NotifyUpdate(piMsg: string); //procedure TDelphiAddInObj.NotifyUpdate(piMsg: string);
//begin //begin
...@@ -170,6 +172,7 @@ begin ...@@ -170,6 +172,7 @@ begin
17: ActionMenu_ExportUseCases; 17: ActionMenu_ExportUseCases;
18: ActionMenu_OQLV2; 18: ActionMenu_OQLV2;
19: ActionMenu_CXOQLV2; 19: ActionMenu_CXOQLV2;
20: ActionMenu_DynamoDefinition;
end; end;
except except
on E: Exception do on E: Exception do
...@@ -460,6 +463,42 @@ begin ...@@ -460,6 +463,42 @@ begin
lOQLExplorer.ShowModal; lOQLExplorer.ShowModal;
end; end;
class procedure TDelphiAddInObj.ActionMenu_DynamoDefinition;
var lDynamoDef: TitCadastrarFormulario;
lSession: cxSession;
lCadastroDefinicaoClasseUC: cxCadastroDefinicaoClasse;
lModel: IModel;
lUMLPackageAux: IUMLPackage;
begin
//lDynamoDef := TitCadastrarFormulario.Create(nil);
//lDynamoDef.Show;
lDynamoDef := nil;
lSession := GetServiceSession;
if Assigned(lSession) then
begin
lModel := gStarUMLApp.SelectionManager.GetSelectedModelAt(0);
lCadastroDefinicaoClasseUC := cxCadastroDefinicaoClasse.Create(lSession);
try
lDynamoDef := TitCadastrarFormulario.Create(nil, lCadastroDefinicaoClasseUC, Nil);
try
if lModel.QueryInterface(IUMLPackage, lUMLPackageAux) = S_OK then
begin
lDynamoDef.ClassPackage := lModel as IUMLPackage;
end;
lDynamoDef.Show;
//if lDynamoDef.ShowModal = mrok then
// gStarUMLApp.SelectInModelExplorer(lCadClasse.UMLClass);
finally
lDynamoDef.Free;
end;
finally
lCadastroDefinicaoClasseUC.Free;
end;
end;
end;
class procedure TDelphiAddInObj.ActionMenu_ExportDiagramClasses; class procedure TDelphiAddInObj.ActionMenu_ExportDiagramClasses;
var var
......
unit cxuCadastroDefinicaoClasse;
interface
uses cxuUseCase, utuMessage;
type
cxCadastroDefinicaoClasse = class(cxUseCase)
protected
function GetUseCaseCode: String; override;
public
procedure rmObtemContexto(piField: utField; const piResponseField: utField = nil);
procedure rmIncluiObjeto(piField: utField; const piResponseField: utField = nil);
procedure rmExcluiObjeto(piField: utField; const piResponseField: utField = nil);
procedure rmEditaObjeto(piField: utField; const piResponseField: utField = nil);
procedure rmSalvaObjeto(piField: utField; const piResponseField: utField = nil);
procedure rmConsultaObjeto(piField: utField; const piResponseField: utField = nil);
end;
implementation
{ cxCadastroDefinicaoClasse }
procedure cxCadastroDefinicaoClasse.rmObtemContexto(piField: utField; const piResponseField: utField);
var lRequestMessage: mxRequestMessage;
lResponseMessage: mxAnswerMessage;
begin
lRequestMessage := self.NewRequest('RM_OBTEM_CONTEXTO', piField);
try
lResponseMessage := self.Session.SendRequest(lRequestMessage);
try
if assigned(piResponseField) then piResponseField.Assign(lResponseMessage.RootField);
finally
lResponseMessage.free;
end;
finally
lRequestMessage.Free;
end;
end;
procedure cxCadastroDefinicaoClasse.rmSalvaObjeto(piField: utField; const piResponseField: utField);
var lRequestMessage: mxRequestMessage;
lResponseMessage: mxAnswerMessage;
begin
lRequestMessage := self.NewRequest('RM_SALVA_OBJETO', piField);
try
lResponseMessage := self.Session.SendRequest(lRequestMessage);
try
if assigned(piResponseField) then piResponseField.Assign(lResponseMessage.RootField);
finally
lResponseMessage.free;
end;
finally
lRequestMessage.Free;
end;
end;
procedure cxCadastroDefinicaoClasse.rmExcluiObjeto(piField: utField; const piResponseField: utField);
var lRequestMessage: mxRequestMessage;
lResponseMessage: mxAnswerMessage;
begin
lRequestMessage := self.NewRequest('RM_EXCLUI_OBJETO', piField);
try
lResponseMessage := self.Session.SendRequest(lRequestMessage);
try
if assigned(piResponseField) then piResponseField.Assign(lResponseMessage.RootField);
finally
lResponseMessage.free;
end;
finally
lRequestMessage.Free;
end;
end;
procedure cxCadastroDefinicaoClasse.rmIncluiObjeto(piField: utField; const piResponseField: utField);
var lRequestMessage: mxRequestMessage;
lResponseMessage: mxAnswerMessage;
begin
lRequestMessage := self.NewRequest('RM_INCLUI_OBJETO', piField);
try
lResponseMessage := self.Session.SendRequest(lRequestMessage);
try
if assigned(piResponseField) then piResponseField.Assign(lResponseMessage.RootField);
finally
lResponseMessage.free;
end;
finally
lRequestMessage.Free;
end;
end;
procedure cxCadastroDefinicaoClasse.rmConsultaObjeto(piField: utField; const piResponseField: utField);
var lRequestMessage: mxRequestMessage;
lResponseMessage: mxAnswerMessage;
begin
lRequestMessage := self.NewRequest('RM_CONSULTA_OBJETO', piField);
try
lResponseMessage := self.Session.SendRequest(lRequestMessage);
try
if assigned(piResponseField) then piResponseField.Assign(lResponseMessage.RootField);
finally
lResponseMessage.free;
end;
finally
lRequestMessage.Free;
end;
end;
procedure cxCadastroDefinicaoClasse.rmEditaObjeto(piField: utField; const piResponseField: utField);
var lRequestMessage: mxRequestMessage;
lResponseMessage: mxAnswerMessage;
begin
lRequestMessage := self.NewRequest('RM_EDITA_OBJETO', piField);
try
lResponseMessage := self.Session.SendRequest(lRequestMessage);
try
if assigned(piResponseField) then piResponseField.Assign(lResponseMessage.RootField);
finally
lResponseMessage.free;
end;
finally
lRequestMessage.Free;
end;
end;
function cxCadastroDefinicaoClasse.GetUseCaseCode: String;
begin
result := '3565';
end;
end.
object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
Left = 2084 Left = 795
Height = 515 Height = 515
Top = 331 Top = 263
Width = 376 Width = 376
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'Model Mappings options' Caption = 'Model Mappings options'
...@@ -12,7 +12,7 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions ...@@ -12,7 +12,7 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
OnShow = FormShow OnShow = FormShow
ParentFont = True ParentFont = True
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '2.0.2.0' LCLVersion = '2.1.0.0'
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 56 Height = 56
...@@ -265,46 +265,21 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions ...@@ -265,46 +265,21 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
end end
object OpenDialog1: TOpenDialog object OpenDialog1: TOpenDialog
Filter = '.pas|*.pas' Filter = '.pas|*.pas'
left = 184 Left = 184
top = 24 Top = 24
end end
object ImageList1: TImageList object ImageList1: TImageList
left = 255 Left = 255
top = 15 Top = 15
Bitmap = { Bitmap = {
4C69010000001000000010000000000000000000000000000000000000000000 4C7A010000001000000010000000E20000000000000078DA63601878A0646061
0000000000000000000000000000000000000000000000000000000000000000 C1641A12CA601A0AC12621A18AFA1616C4EA572F5FB18A69E1FFFF0C0BA078FE
0000000000000000000000000000000000000000000000000000000000000000 FFFFCE4B1F3C26DA8CEC55ABE07A0960B645FFFF979FFEFB1FA77EA03B9816E1
0000000000000000000000000000000000000000000000000000000000000000 C7BA1BB1EB6759F2FFBFF2B1FFFF354E11C69157FEFE37F7058619927EDE75C4
0000000000000000000000000000000000002230383802355455003555550035 E90561EBF3FFFE2BB8A3EA17DD4EBC7EDFCBFFFF1BF920F43302FD2DBD9778FD
555500345455212F383800000000000000000000000000000000000000000000 B1D781711480D0CFB2F4FF7FF983C4EB57EA58BE0A39FC385602C58E12AFDFA9
0000000000000000000000000000000000002777A8AA02A1FFFF00A0FFFF00A0 7F055CBF79DD8A55D21BFFFD573BF6EFBFC609C2D8E2CCBFFF9EE9058530FD3A
FFFF009FFFFF43A5E0E3212F3838000000000000000000000000000000000000 C61616C27621A1BC0EC144615957A8BF070100002DAF7BBC
000000000000000000000000000000000000006BAAAA00A0FFFF00A0FFFF00A0
FFFF00A0FFFF00A0FFFF00A0FFFF00A0FFFF00A0FFFF00A0FFFF00A0FFFF06A2
FFFF77CBFDFF000000000000000000000000006BAAAA00A0FFFF00A0FFFF00A1
FFFF02A2FFFF02A2FFFF02A2FFFF02A2FFFF02A2FFFF02A2FFFF02A2FFFF02A2
FFFF2DB1FDFF000000000000000000000000006BAAAA00A0FFFF04A4FFFF23C6
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF59D4FDFF374D545500000000006BAAAA00A0FFFF0DAEFFFF28CA
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF3BCFFEFF2047545500000000006BAAAA00A0FFFF15B7FFFF28CA
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF4DD3FFFF324C545500000000006BAAAA01A1FFFF1BBDFFFF28CA
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF5DD7FFFF4350545500000000006BAAAA04A5FFFF1FC1FFFF28CA
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF2288A7AA0000000000000000006BAAAA08A9FFFF22C5FFFF28CA
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF428FA8AA0000000000000000377EA8AA1BB1FEFF26C6FEFF28C8
FEFF28C8FEFF28C8FEFF28C8FEFF28C8FEFF28C8FEFF28C8FEFF28C8FEFF28C8
FEFF38CCFEFF4967707100000000000000002C333838133E54550D4053550D40
53550D4053550D4053550D4053550D4053550D4053550D4053550D4053550D40
53551D4554550000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
} }
BitmapAdv = { BitmapAdv = {
4C69010000004C7A010000001800000018000000E00000000000000078DA6360 4C69010000004C7A010000001800000018000000E00000000000000078DA6360
......
object itCadastrarDefinicao: TitCadastrarDefinicao
Left = 0
Height = 240
Top = 0
Width = 320
ClientHeight = 240
ClientWidth = 320
LCLVersion = '2.1.0.0'
object pnPrincipal: TPanel
Left = 0
Height = 589
Top = 0
Width = 993
ClientHeight = 589
ClientWidth = 993
Color = 15855852
ParentColor = False
TabOrder = 0
object lblClasses: TLabel
Left = 350
Height = 18
Top = 192
Width = 132
Caption = 'CLASSES DO SISTEMA:'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object lblUC: TLabel
Left = 345
Height = 18
Top = 120
Width = 157
Caption = 'CÓDIGO DO CASO DE USO:'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object lblClasseDoSistema: TLabel
Left = 329
Height = 18
Top = 430
Width = 189
Caption = 'ADICIONAR CLASSE AO SISTEMA'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object lblCodigoDaClasse: TLabel
Left = 368
Height = 18
Top = 502
Width = 114
Caption = 'CÓDIGO DA CLASSE'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object lblConexao: TLabel
Left = 54
Height = 18
Top = 30
Width = 132
Caption = 'STRING DE CONEXÃO:'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object edtUC: TEdit
Left = 254
Height = 23
Top = 144
Width = 360
TabOrder = 0
end
object lvClass: TListView
Left = 254
Height = 174
Top = 216
Width = 360
Columns = <
item
Caption = 'NOME'
Width = 356
end>
ColumnClick = False
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Trebuchet MS'
GridLines = True
HideSelection = False
ParentFont = False
ParentShowHint = False
ReadOnly = True
RowSelect = True
TabOrder = 1
ViewStyle = vsReport
end
object edtAddClass: TEdit
Left = 254
Height = 23
Top = 454
Width = 360
TabOrder = 2
end
object chkManual: TCheckBox
Left = 638
Height = 22
Top = 488
Width = 165
Caption = 'Adicionar Manualmente'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
OnClick = chkManualClick
ParentFont = False
TabOrder = 3
end
object edtCodigoDaClasse: TEdit
Left = 254
Height = 23
Top = 526
Width = 360
TabOrder = 4
end
object btnConectar: TButton
Left = 838
Height = 25
Top = 54
Width = 105
Caption = 'OBTER CLASSES'
OnClick = btnConectarClick
TabOrder = 5
end
object edtConexao: TEdit
Left = 54
Height = 26
Top = 54
Width = 750
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
ParentFont = False
TabOrder = 6
Text = 'ServerName=localhost;portNumber=7777;systemCode=38;username=administrador;password='
end
end
object pnMenuSuperior: TPanel
Left = 0
Height = 0
Top = 0
Width = 993
ClientHeight = 0
ClientWidth = 993
TabOrder = 1
object jvGradientSuperior: TPanel
Left = 0
Height = 0
Top = 0
Width = 993
TabOrder = 0
end
object FlowPanel1: TFlowPanel
Left = 0
Height = 0
Top = 0
Width = 993
Color = clWindow
ControlList = <>
FlowLayout = tlTop
FlowStyle = fsLeftRightTopBottom
ParentColor = False
TabOrder = 1
object sbNovo: TSpeedButton
Left = 0
Height = 0
Top = 0
Width = 0
end
object sbSalvar: TSpeedButton
Left = 0
Height = 0
Top = 0
Width = 0
end
object sbEditar: TSpeedButton
Left = 0
Height = 0
Top = 0
Width = 0
end
object sbExcluir: TSpeedButton
Left = 0
Height = 0
Top = 0
Width = 0
end
object sbSair: TSpeedButton
Left = 0
Height = 0
Top = 0
Width = 0
end
end
end
object pnDivisor: TPanel
Left = 0
Height = 0
Top = 0
Width = 993
TabOrder = 2
end
end
unit ituCadastrarDefinicao;
{$MODE Delphi}
interface
uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, utuMessage, StdCtrls, ComCtrls,
ExtCtrls, Buttons;
type
{ TitCadastrarDefinicao }
TitCadastrarDefinicao = class(TForm)
FlowPanel1: TFlowPanel;
jvGradientSuperior: TPanel;
lblClasses: TLabel;
lblUC: TLabel;
edtUC: TEdit;
lvClass: TListView;
edtAddClass: TEdit;
chkManual: TCheckBox;
lblClasseDoSistema: TLabel;
edtCodigoDaClasse: TEdit;
lblCodigoDaClasse: TLabel;
btnConectar: TButton;
edtConexao: TEdit;
lblConexao: TLabel;
pnDivisor: TPanel;
pnMenuSuperior: TPanel;
pnPrincipal: TPanel;
sbEditar: TSpeedButton;
sbExcluir: TSpeedButton;
sbNovo: TSpeedButton;
sbSair: TSpeedButton;
sbSalvar: TSpeedButton;
procedure FormShow(Sender: TObject);
procedure chkManualClick(Sender: TObject);
procedure btnConectarClick(Sender: TObject);
private
public
end;
implementation
uses
acuObject, Dialogs, MaskUtils, DateUtils;
{$R *.lfm}
procedure TitCadastrarDefinicao.FormShow(Sender: TObject);
begin
inherited;
// itCadastrarDefinicao(self.Controller).NewRequest('RM_OBTER_CLASSES', itCadastrarDefinicao(Self.Controller).SendToInterface).Post;
// Self.Enabled := False;
edtConexao.ReadOnly := False;
btnConectar.Enabled := True;
edtAddClass.Enabled := False;
edtCodigoDaClasse.Enabled := False;
end;
procedure TitCadastrarDefinicao.btnConectarClick(Sender: TObject);
//var
// lRequest : acRequest;
begin
inherited;
//
// itCadastrarDefinicao(self.Controller).NewRequest('RM_OBTER_CLASSES', itCadastrarDefinicao(Self.Controller).SendToInterface).Post;
// Self.Enabled := False;
// Screen.Cursor := crHourGlass;
// lRequest := itCadastrarDefinicao(self.Controller).NewRequest('RM_OBTER_CLASSES', itCadastrarDefinicao(Self.Controller).SendToInterface);
// lRequest.Message.RootField.AddAttribute('stringConnection').AsString := edtConexao.Text;
// lRequest.Post;
end;
procedure TitCadastrarDefinicao.chkManualClick(Sender: TObject);
begin
inherited;
if chkManual.Checked = True then
begin
lvClass.Enabled := False;
lvClass.ReadOnly := True;
edtAddClass.Enabled := True;
edtCodigoDaClasse.Enabled := True;
btnConectar.Enabled := False;
edtConexao.Enabled := False;
end
else
begin
lvClass.Enabled := True;
lvClass.ReadOnly := True;
edtAddClass.Enabled := False;
edtAddClass.Clear;
edtCodigoDaClasse.Enabled := False;
edtCodigoDaClasse.Clear;
// btnConectar.Enabled := True;
edtConexao.Enabled := True;
end;
end;
{
//Loads context dat to GUI
procedure itCadastrarDefinicao.SendToInterface(piRequest: acRequest);
var
lClassField, lFieldItem: utField;
lItem: TListItem;
lEnum : acEnumerator;
begin
inherited;
try
lClassField := piRequest.Response.RootField.FieldByName('Classes');
lEnum := lClassField.ChildFields.GetEnumerator;
with TitCadastrarDefinicao(Self.InterfaceForm) do
begin
lvClass.Items.Clear;
try
while not lEnum.EOL do
begin
lFieldItem := lEnum.Current as utField;
lItem := lvClass.Items.Add;
lItem.Caption := lFieldItem.AttributeByName('name').AsString;
lItem.Data := Pointer(lFieldItem.AttributeByName('code').AsInteger);
lEnum.MoveNext;
end;
finally
lEnum.Free;
end;
btnConectar.Enabled := False;
end;
finally
TitCadastrarDefinicao(Self.InterfaceForm).Enabled := True;
end;
end;
//Loads Context object data to GUI
procedure itCadastrarDefinicao.GetTargetObjectsData(piRequest: acRequest);
var
lFieldDefinition: utField;
i: Integer;
lItemName: TListItem;
// lEnum : acEnumerator;
begin
inherited;
if piRequest.Response.RootField.HasField('Definition') then
begin
with Self.InterfaceForm as TitCadastrarDefinicao do
begin
//GUI Component <--- piRequest Fields
//Inicializar Componentes
edtUC.Text := '';
//Carregar
lFieldDefinition := piRequest.Response.RootField.FieldByName('Definition');
if lFieldDefinition.HasAttribute('OID')
then fOID := lFieldDefinition.AttributeByName('OID').AsString;
if lFieldDefinition.HasAttribute('UC')
then edtUC.Text := lFieldDefinition.AttributeByName('UC').AsString;
if lFieldDefinition.HasAttribute('code') then
begin
for i := 0 to lvClass.Items.Count - 1 do
begin
if (lvClass.Items[i] as TListItem).Data = Pointer(lFieldDefinition.AttributeByName('code').AsInteger)
then
begin
lvClass.Items[i].Checked := True;
lvClass.Items[i].Selected := True;
lvClass.Items[i].MakeVisible(False);
lvClass.Items[i].Focused := True;
lvClass.Selected.MakeVisible(True);
lvClass.ItemFocused := lvClass.Items[i];
lvClass.SetFocus;
Break;
end;
end;
// lvClass.Selected.MakeVisible(True);
lItemName := lvClass.FindCaption(0, lFieldDefinition.AttributeByName('name').AsString, False, True, False);
if lItemName = nil then
begin
edtAddClass.Text := lFieldDefinition.AttributeByName('name').AsString;
edtCodigoDaClasse.Text := lFieldDefinition.AttributeByName('code').AsString;
end;
end;
end;
end;
Screen.Cursor := crDefault;
end;
//Saves GUI state to Object
procedure itCadastrarDefinicao.SaveFromInterface(piRequest: acRequest);
var
// lRequest : acRequest;
lDefinitionField : utField;
lItemName: TListItem;
begin
inherited;
with Self.InterfaceForm as TitCadastrarDefinicao do
begin
//GUI Component ---> piRequest Fields
if (Assigned(lvClass.Selected)) and (chkManual.Checked = False) then
begin
lDefinitionField := piRequest.Message.RootField.AddField('Definition');
lDefinitionField.AddField('Class').AddAttribute('code').AsInteger := Integer(lvClass.Selected.Data);
lDefinitionField.FieldByName('Class').AddAttribute('name').AsString := lvClass.Selected.Caption;
if edtUC.Text <> '' then
lDefinitionField.AddField('UC').AddAttribute('code').AsString := edtUC.Text;
end
else if (chkManual.Checked = True) and (edtAddClass.Text <> '') and (edtCodigoDaClasse.Text <> '') then
begin
lDefinitionField := piRequest.Message.RootField.AddField('Definition');
lDefinitionField.AddField('Class').AddAttribute('code').AsInteger := StrToInt(edtCodigoDaClasse.Text);
lDefinitionField.FieldByName('Class').AddAttribute('name').AsString := edtAddClass.Text;
if edtUC.Text <> '' then
lDefinitionField.AddField('UC').AddAttribute('code').AsString := edtUC.Text;
lItemName := lvClass.FindCaption(0, edtAddClass.Text, False, True, False);
if lItemName <> nil then
raise Exception.Create('Já existe uma classe no sistema com este nome. Selecione através da lista ou altere o nome digitado.');
end
else
raise Exception.Create('Preencha todos os campos.');
end;
Screen.Cursor := crDefault;
end;
}
end.
object itCadastrarFormulario: TitCadastrarFormulario
Left = 463
Height = 550
Top = 256
Width = 1000
ClientHeight = 550
ClientWidth = 1000
LCLVersion = '2.1.0.0'
object scrlbxTudo: TScrollBox
Left = 0
Height = 908
Top = 0
Width = 1718
HorzScrollBar.Page = 975
HorzScrollBar.Tracking = True
VertScrollBar.Page = 498
VertScrollBar.Tracking = True
Anchors = [akTop, akLeft, akRight, akBottom]
BorderStyle = bsNone
ClientHeight = 908
ClientWidth = 1718
TabOrder = 0
object Panel1: TPanel
Left = 0
Height = 908
Top = 0
Width = 1718
Align = alClient
ClientHeight = 908
ClientWidth = 1718
TabOrder = 0
object edtCampo: TEdit
Left = 447
Height = 23
Top = 95
Width = 142
AutoSize = False
OnKeyPress = edtCampoKeyPress
TabOrder = 0
end
object btnCancelar: TButton
Left = 685
Height = 49
Top = 448
Width = 145
Caption = 'CANCELAR'
OnClick = btnCancelarClick
TabOrder = 1
end
object btnSalvar: TButton
Left = 521
Height = 49
Top = 448
Width = 145
Caption = 'SALVAR'
OnClick = btnSalvarClick
TabOrder = 2
end
object lvCampos: TListView
Left = 16
Height = 300
Top = 130
Width = 650
Checkboxes = True
Columns = <
item
Caption = 'Nome'
Width = 350
end
item
Caption = 'Obrigatório'
Width = 100
end
item
Caption = 'ID'
Width = 100
end
item
Caption = 'Tipo'
Width = 100
end>
ColumnClick = False
GridLines = True
HideSelection = False
ReadOnly = True
RowSelect = True
TabOrder = 3
ViewStyle = vsReport
OnClick = lvCamposClick
OnSelectItem = lvCamposSelectItem
end
object lstAtributos: TValueListEditor
Left = 685
Height = 145
Top = 285
Width = 289
FixedCols = 0
RowCount = 2
TabOrder = 4
OnValidate = lstAtributosValidate
ColWidths = (
144
141
)
end
object edtCodigo: TEdit
Left = 74
Height = 23
Top = 64
Width = 143
AutoSize = False
Enabled = False
TabOrder = 5
end
object chkRequerido: TCheckBox
Left = 684
Height = 22
Top = 188
Width = 96
Caption = 'OBRIGATÓRIO'
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Trebuchet MS'
OnClick = chkRequeridoClick
ParentFont = False
TabOrder = 6
end
object cbbTipo: TComboBox
Left = 685
Height = 24
Hint = 'Tipo'
Top = 255
Width = 145
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Trebuchet MS'
ItemHeight = 16
OnChange = cbbTipoChange
ParentFont = False
Style = csDropDownList
TabOrder = 7
end
object btnAdd: TSpeedButton
Left = 596
Height = 25
Top = 95
Width = 70
Caption = 'Adicionar'
OnClick = btnAddClick
end
object lblNovoCampo: TLabel
Left = 360
Height = 18
Top = 100
Width = 81
Caption = 'NOVO CAMPO:'
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Trebuchet MS'
ParentColor = False
ParentFont = False
end
object btnUp: TSpeedButton
Left = 685
Height = 25
Top = 149
Width = 70
Caption = 'Sobe'
OnClick = btnUpClick
end
object lblCodigo: TLabel
Left = 16
Height = 18
Top = 65
Width = 52
Caption = 'CÓDIGO:'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object lblExibirCampos: TLabel
Left = 16
Height = 18
Top = 106
Width = 55
Caption = 'CAMPOS:'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object lblOrdem: TLabel
Left = 684
Height = 18
Top = 130
Width = 43
Caption = 'ORDEM:'
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Trebuchet MS'
ParentColor = False
ParentFont = False
end
object lblTipoAtributo: TLabel
Left = 684
Height = 18
Top = 234
Width = 98
Caption = 'TIPO DO CAMPO: '
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Trebuchet MS'
ParentColor = False
ParentFont = False
end
object btnDown: TSpeedButton
Left = 760
Height = 25
Top = 149
Width = 70
Caption = 'Desce'
OnClick = btnDownClick
end
object lblClasseName: TLabel
Left = 88
Height = 18
Top = 24
Width = 65
Caption = 'ClassName'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object lblClassIDO: TLabel
Left = 192
Height = 18
Top = 24
Width = 52
Caption = 'ClassIDO'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Trebuchet MS'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
end
end
end
unit ituCadastrarFormulario;
{$MODE Delphi}
interface
uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, StdCtrls, Dialogs, JvExControls, ComCtrls, ExtCtrls, Buttons,
MaskEdit, JvBaseEdits, JvCheckBox, utuMessage, Grids, ValEdit, StarUMLintf,
cxuCadastroDefinicaoClasse;
type
{ TitCadastrarFormulario }
TitCadastrarFormulario = class(TForm)
lblCodigo: TLabel;
lblClasseName: TLabel;
lblClassIDO: TLabel;
lblOrdem: TLabel;
lvCampos: TListView;
lblExibirCampos: TLabel;
btnUp: TSpeedButton;
btnDown: TSpeedButton;
chkRequerido: TCheckBox;
edtCodigo: TEdit;
cbbTipo: TComboBox;
lblTipoAtributo: TLabel;
lstAtributos: TValueListEditor;
Panel1: TPanel;
scrlbxTudo: TScrollBox;
btnSalvar: TButton;
btnCancelar: TButton;
edtCampo: TEdit;
lblNovoCampo: TLabel;
btnAdd: TSpeedButton;
procedure lstAtributosClear;
procedure lstAtributosFill(piType: string);
procedure btnCancelarClick(Sender: TObject);
procedure btnUpClick(Sender: TObject);
procedure btnDownClick(Sender: TObject);
procedure lvCamposSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure chkRequeridoClick(Sender: TObject);
procedure lvCamposClick(Sender: TObject);
procedure btnSalvarClick(Sender: TObject);
procedure cbbTipoChange(Sender: TObject);
procedure lstAtributosValidate(Sender: TObject; ACol, ARow: Integer;
const KeyName, KeyValue: string);
procedure btnAddClick(Sender: TObject);
procedure edtCampoKeyPress(Sender: TObject; var Key: Char);
private
fFieldTypeList : utField;
fUMLClass: IUMLClass;
fcxCadastroDefinicaoClasse: cxCadastroDefinicaoClasse;
fClassPackage: IUMLPackage;
procedure Initialize;
public
Constructor Create(Sender: TComponent; piCadastroClasse: cxCadastroDefinicaoClasse; piUMLClass: IUMLCLass); reintroduce;
property FieldTypeList: utField read fFieldTypeList write fFieldTypeList;
property UMLClass: IUMLClass read fUMLClass write fUMLClass;
property ClassPackage: IUMLPackage read fClassPackage write fClassPackage;
end;
//itCadastrarFormulario = class(itInterface)
//private
// fTypesField : utField;
// fFieldTypeList : utField;
// fIdCount : Integer;
//
// procedure ObterAtributosSuccess (piRequest : acRequest);
// procedure EditarSuccess (piRequest : acRequest);
// procedure IncluirSuccess (piRequest : acRequest);
// procedure SalvarSuccess (piRequest : acRequest);
// { Private declarations }
//public
// procedure Initialize; override;
// procedure Finalize; override;
//end;
implementation
uses
acuObject;
const
__STRING = 1;
__NUMBER = 2;
__BOOLEAN = 3;
{$R *.lfm}
{ itCadastrarCliente }
constructor TitCadastrarFormulario.Create(Sender: TComponent; piCadastroClasse: cxCadastroDefinicaoClasse; piUMLClass: IUMLCLass);
begin
inherited Create(sender);
if assigned(piUMLClass) then
begin
fUMLClass := piUMLClass;
lblClassIDO.Caption := fUMLClass.GetTaggedValueAsString('DBMappings', 'DBClassMap', 'DBIDO');
lblClasseName.Caption := fUMLClass.GetTaggedValueAsString('DBMappings', 'DBClassMap', 'Table');
end;
fcxCadastroDefinicaoClasse := piCadastroClasse;
//self.Initialize;
end;
procedure TitCadastrarFormulario.Initialize;
//var
// lRequest : acRequest;
begin
//inherited;
//Screen.Cursor := crHourGlass;
//self.InterfaceForm := TitCadastrarFormulario.Create(Application);
//if Self.ContextObject.OperationCode = '5' then {Novo}
//begin
// lRequest := Self.NewRequest('RM_OBTER_CONTEXTO', ObterAtributosSuccess);
// lRequest.Message.RootField.AddField('Definition').AddAttribute('OID').AsString := Self.ContextObject.ObjectID;
// lRequest.Post;
//end
//else if Self.ContextObject.OperationCode = '3' then {Editar}
//begin
// lRequest := Self.NewRequest('RM_OBTER_CONTEXTO', ObterAtributosSuccess);
// lRequest.Message.RootField.AddField('Form').AddAttribute('OID').AsString := Self.ContextObject.ObjectID;
// lRequest.Post;
//end
//else
// raise Exception.Create('Operao invlida.');
//Self.InterfaceForm.Show;
//
//TitCadastrarFormulario(Self.InterfaceForm).lvCamposClick(nil);
//fFieldTypeList := utField.Create;
end;
(*
procedure itCadastrarFormulario.ObterAtributosSuccess(piRequest: acRequest);
var
lClassAttField, lFieldItem: utField;
lItem: TListItem;
lEnum : acEnumerator;
lClassAttribute : string;
begin
inherited;
with TitCadastrarFormulario(Self.InterfaceForm) do
begin
fTypesField := piRequest.Response.RootField.ExtractField(piRequest.Response.RootField.FieldByName('Types'));
if piRequest.Response.RootField.HasField('ClassAttributes') then
begin
lClassAttField := piRequest.Response.RootField.FieldByName('ClassAttributes');
lvCampos.Items.Clear;
lEnum := lClassAttField.ChildFields.GetEnumerator;
try
while not lEnum.EOL do {preenche a listView com os atributos da classe }
begin
lFieldItem := lEnum.Current as utField;
lClassAttribute := lFieldItem.AttributeByName('name').AsString;
fIdCount := lFieldItem.AttributeByName('id').AsInteger;
fFieldTypeList.AddField(lClassAttribute); //fieald para armazenar os attributos de cada campo
lItem := lvCampos.Items.Add;
lItem.Caption := lClassAttribute;
with lItem.SubItems do
begin
Add('N'); //requerido
Add(IntToStr(fIdCount)); //ID
Add(''); //tipo
Add(''); //tipo index
end;
lEnum.MoveNext;
end;
finally
lEnum.Free;
end;
end;
cbbTipo.Items.Clear;
lEnum := fTypesField.ChildFields.GetEnumerator;
try
while not lEnum.EOL do {preenche a comboBox com os tipos de field }
begin
lFieldItem := lEnum.Current as utField;
cbbTipo.AddItem(lFieldItem.Name, Pointer(lFieldItem.AttributeByName('OID').AsInteger));
lEnum.MoveNext;
end;
finally
lEnum.Free;
end;
end;
if Self.ContextObject.OperationCode = '5' then {Novo}
Self.NewRequest('RM_INCLUIR', IncluirSuccess).Post
else if Self.ContextObject.OperationCode = '3' then {Editar}
Self.NewRequest('RM_EDITAR', EditarSuccess).Post;
end;
procedure itCadastrarFormulario.IncluirSuccess(piRequest: acRequest);
var
lCode : string;
begin
try
lCode := piRequest.Response.RootField.FieldByName('Form').AttributeByName('OID').AsString;
TitCadastrarFormulario(Self.InterfaceForm).edtCodigo.Text := lCode;
finally
TitCadastrarFormulario(Self.InterfaceForm).Enabled := True;
Screen.Cursor := crDefault;
end;
end;
procedure itCadastrarFormulario.EditarSuccess(piRequest: acRequest);
var
lFieldItem : utField;
lCode, lFieldName : string;
lEnum : acEnumerator;
lItem: TListItem;
lPosition, lIndex, lId : Integer;
begin
try
lCode := piRequest.Response.RootField.FieldByName('Form').AttributeByName('code').AsString;
TitCadastrarFormulario(Self.InterfaceForm).edtCodigo.Text := lCode;
lEnum := piRequest.Response.RootField.FieldByName('Form').FieldByName('Fields').ChildFields.GetEnumerator;
try
while not lEnum.EOL do {preenche a comboBox com os tipos de field }
begin
lFieldItem := lEnum.Current as utField;
lFieldName := lFieldItem.AttributeByName('name').AsString;
lId := lFieldItem.AttributeByName('id').AsInteger;
if lId > fIdCount then fIdCount := lId;
with TitCadastrarFormulario(Self.InterfaceForm) do
begin
lItem := lvCampos.FindCaption(0, lFieldName, False, True, False);
if lItem = nil then
begin
lItem := lvCampos.Items.Add;
lItem.Caption := lFieldName;
lItem.SubItems.Add('');
lItem.SubItems.Add('');
lItem.SubItems.Add('');
end;
lItem.Checked := True;
lItem.SubItems[0] := lFieldItem.AttributeByName('required').AsString;
lItem.SubItems[1] := lFieldItem.AttributeByName('id').AsString;
lItem.SubItems[2] := lFieldItem.FieldByName('Type').AttributeByName('name').AsString;
lPosition := lFieldItem.AttributeByName('order').AsInteger;
lIndex := lItem.Index;
while lIndex > lPosition do
begin
lvCampos.MoveUp(lIndex, False);
lIndex := lIndex - 1;
end;
while lIndex < lPosition do
begin
lvCampos.MoveDown(lIndex, False);
lIndex := lIndex + 1;
end;
end;
lFieldItem.Name := lFieldName;
if not fFieldTypeList.HasField(lFieldName) then fFieldTypeList.AddField(lFieldName);
fFieldTypeList.FieldByName(lFieldName).Assign(lFieldItem);
lEnum.MoveNext;
end;
finally
lEnum.Free;
end;
finally
TitCadastrarFormulario(Self.InterfaceForm).Enabled := True;
Screen.Cursor := crDefault;
end;
end;
*)
procedure TitCadastrarFormulario.btnSalvarClick(Sender: TObject);
var
//lRequest : acRequest;
lFormField, lFieldField, lTypeField : utField;
i, lOrder : Integer;
begin
try
{with itCadastrarFormulario(Self.Controller) do
begin
lRequest := NewRequest('RM_SALVAR', SalvarSuccess);
lFormField := lRequest.Message.RootField.AddField('Form');
lFormField.AddAttribute('code').AsString := edtCodigo.Text;
lFormField := lFormField.AddField('Fields');
lOrder := 0;
for i := 0 to lvCampos.Items.Count - 1 do
begin
if lvCampos.Items[i].Checked then
begin
if lvCampos.Items[i].SubItems[2] = '' then
raise Exception.Create('O campo ''' + lvCampos.Items[i].Caption + ''' deve possuir um tipo');
lFieldField := lFormField.AddField('Field');
lFieldField.AddAttribute('name').AsString := lvCampos.Items[i].Caption;
lFieldField.AddAttribute('order').AsInteger := lOrder;
lFieldField.AddAttribute('required').AsBoolean := (lvCampos.Items[i].SubItems[0] = 'S');
lFieldField.AddAttribute('id').AsInteger := StrToInt(lvCampos.Items[i].SubItems[1]);
lTypeField := lFieldField.AddField('Type');
lTypeField.Assign(fFieldTypeList.FieldByName(lvCampos.Items[i].Caption).FieldByName('Type'));
lOrder := lOrder + 1;
end;
end;
if not lFormField.HasField('Field') then
raise Exception.Create('O formulrio deve possuir pelo menos um campo, use as CheckBoxes para escolhe-los.');
lRequest.Post;
end;}
except
raise;
end;
end;
//procedure itCadastrarFormulario.SalvarSuccess(piRequest: acRequest);
//begin
// ShowMessage('Formulrio cadastrado com sucesso.');
// TitCadastrarFormulario(Self.InterfaceForm).Close;
//end;
procedure TitCadastrarFormulario.btnAddClick(Sender: TObject);
var
lItem : TListItem;
begin
if edtCampo.Text <> '' then
begin
//with itCadastrarFormulario(Self.Controller) do
//begin
// fIdCount := fIdCount + 1;
// fFieldTypeList.AddField(edtCampo.Text);
//end;
//
//lItem := lvCampos.Items.Add;
//lItem.Caption := edtCampo.Text;
//lItem.Checked := True;
//
//with lItem.SubItems do
//begin
// Add('N'); //requerido
// Add(IntToStr(itCadastrarFormulario(Self.Controller).fIdCount)); //ID
// Add(''); //tipo
// Add(''); //tipo index
//end;
edtCampo.Clear;
end;
end;
procedure TitCadastrarFormulario.edtCampoKeyPress(Sender: TObject; var Key: Char);
begin
if Ord(Key) = VK_RETURN then
begin
btnAdd.Click;
end;
end;
procedure TitCadastrarFormulario.btnCancelarClick(Sender: TObject);
begin
Self.Close;
end;
procedure TitCadastrarFormulario.btnDownClick(Sender: TObject);
var
lIndex : Integer;
begin
lIndex := lvCampos.Selected.Index;
//lvCampos.MoveDown(lIndex);
end;
procedure TitCadastrarFormulario.btnUpClick(Sender: TObject);
var
lIndex : Integer;
begin
lIndex := lvCampos.Selected.Index;
//lvCampos.MoveUp(lIndex);
end;
procedure TitCadastrarFormulario.cbbTipoChange(Sender: TObject);
var
lField, lTypeField : utField;
begin
lvCampos.Selected.SubItems[2] := cbbTipo.Text;
//lvCampos.Selected.SubItems[3] := IntToStr(cbbTipo.ItemIndex);
{with itCadastrarFormulario(Self.Controller) do
begin
lField := fFieldTypeList.FieldByName(lvCampos.Selected.Caption);
if lField.HasField('Type') then
lField.RemoveField(lField.FieldByName('Type'));
lTypeField := lField.AddField('Type');
lTypeField.AddAttribute('name').AsString := cbbTipo.Text;
lTypeField.AddAttribute('OID').AsInteger := Integer(cbbTipo.Items.Objects[cbbTipo.ItemIndex]);
end; }
if cbbTipo.ItemIndex <> -1 then
begin
lstAtributosFill(cbbTipo.Text);
end;
end;
procedure TitCadastrarFormulario.lstAtributosFill(piType: string);
var
lEnum : acEnumerator;
lFieldItem, lTypeField :utField;
lValue, lAttribute : string;
lIndex : Integer;
begin
lstAtributosClear;
(*lEnum := itCadastrarFormulario(Self.Controller).fTypesField.FieldByName(piType).FieldByName('Attributes').ChildFields.GetEnumerator;
try
while not lEnum.EOL do {preenche a ValueList com os atributos do tipo de field }
begin
lFieldItem := lEnum.Current as utField;
lAttribute := lFieldItem.Name;
lValue := '';
if itCadastrarFormulario(Controller).fFieldTypeList.FieldByName(lvCampos.Selected.Caption).HasField('Type') then
begin
lTypeField := itCadastrarFormulario(Controller).fFieldTypeList.FieldByName(lvCampos.Selected.Caption).FieldByName('Type');
if lTypeField.HasField(lAttribute) then
lValue := lTypeField.FieldByName(lAttribute).AttributeByName('value').AsString;
end;
lIndex := lstAtributos.InsertRow(lAttribute, lValue, True);
lstAtributos.Strings.Objects[lIndex - 1] := Pointer(lFieldItem.AttributeByName('OID').AsInteger);
if lFieldItem.AttributeByName('type').AsInteger = __BOOLEAN then
begin
lstAtributos.ItemProps[lAttribute].EditStyle := esPickList;
lstAtributos.ItemProps[lAttribute].PickList.Add('True');
lstAtributos.ItemProps[lAttribute].PickList.Add('False');
end;
lEnum.MoveNext;
end;
finally
lEnum.Free;
end; *)
end;
procedure TitCadastrarFormulario.lstAtributosClear;
var
i : Integer;
begin
if lstAtributos.RowCount > 2 then
for i := lstAtributos.RowCount-1 downto 1 do
lstAtributos.DeleteRow(i)
else
lstAtributos.Values[lstAtributos.Keys[1]] := '';
end;
procedure TitCadastrarFormulario.lstAtributosValidate(Sender: TObject; ACol,
ARow: Integer; const KeyName, KeyValue: string);
var
lField, lAttributeField, lTypeField : utField;
lOID, lAttributeType, lIntValue : Integer;
lOK, lBoolValue: Boolean;
lMessage : string;
begin
if (lvCampos.SelCount > 0) and (lvCampos.Selected.SubItems[2] <> '') then
begin
(*with itCadastrarFormulario(Self.Controller) do
begin
lTypeField := fTypesField.FieldByName(lvCampos.Selected.SubItems[2]);
lAttributeType := lTypeField.FieldByName('Attributes').FieldByName(KeyName).AttributeByName('type').AsInteger;
lOK := True;
if lAttributeType = __NUMBER then
begin
lOK := TryStrToInt(KeyValue, lIntValue);
lMessage := 'Atributo ' + KeyName + ' deve ser do tipo INTEGER';
end
else if lAttributeType = __BOOLEAN then
begin
lOK := TryStrToBool(KeyValue, lBoolValue);
lMessage := 'Atributo ''' + KeyName + ''' deve ser do tipo BOOLEAN';
end;
if KeyValue <> '' then
begin
if lOK then
begin
lOID := Integer(lstAtributos.Strings.Objects[lstAtributos.Strings.IndexOfName(KeyName)]);
lField := fFieldTypeList.FieldByName(lvCampos.Selected.Caption).FieldByName('Type');
if lField.HasField(KeyName) then
begin
lAttributeField := lField.FieldByName(KeyName);
lAttributeField.AttributeByName('OID').AsInteger := lOID;
lAttributeField.AttributeByName('value').AsString := KeyValue;
end
else
begin
lAttributeField := lField.AddField(KeyName);
lAttributeField.AddAttribute('OID').AsInteger := lOID;
lAttributeField.AddAttribute('value').AsString := KeyValue;
end;
end
else
begin
// lstAtributos.Col := ACol;
// lstAtributos.Row := ARow;
lstAtributos.Values[KeyName] := '';
MessageDlg(lMessage, mtError, [mbOK], 0);
// raise Exception.Create(lMessage);
end;
end
else
begin
lField := fFieldTypeList.FieldByName(lvCampos.Selected.Caption).FieldByName('Type');
if lField.HasField(KeyName) then
lField.RemoveField(lField.FieldByName(KeyName));
end;
end;*)
end;
end;
procedure TitCadastrarFormulario.chkRequeridoClick(Sender: TObject);
begin
if chkRequerido.Checked = True
then lvCampos.Selected.SubItems[0] := 'S'
else lvCampos.Selected.SubItems[0] := 'N';
end;
procedure TitCadastrarFormulario.lvCamposClick(Sender: TObject);
begin
if lvCampos.SelCount = 0 then
begin
chkRequerido.Enabled := False;
btnUp.Enabled := False;
btnDown.Enabled := False;
cbbTipo.Enabled := False;
lblOrdem.Enabled := False;
lblTipoAtributo.Enabled := False;
lstAtributos.Enabled := False;
lstAtributosClear;
end
else
begin
chkRequerido.Enabled := True;
btnUp.Enabled := True;
btnDown.Enabled := True;
cbbTipo.Enabled := True;
lblOrdem.Enabled := True;
lblTipoAtributo.Enabled := True;
lstAtributos.Enabled := True;
end;
end;
procedure TitCadastrarFormulario.lvCamposSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
begin
if Selected then
begin
if Item.SubItems[0] = 'N' then
chkRequerido.Checked := False
else
chkRequerido.Checked := True;
if Item.SubItems[2] = '' then
begin
cbbTipo.ItemIndex := -1;
lstAtributosClear;
end
else
begin
cbbTipo.ItemIndex := cbbTipo.Items.IndexOf(Item.SubItems[2]);
lstAtributosFill(Item.SubItems[2]);
end;
end;
end;
//procedure itCadastrarFormulario.Finalize;
//begin
// inherited;
// if Assigned(fTypesField) then
// fTypesField.Free;
//end;
end.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment