From 2728fb56d8084caa66d7b7b7ba8c4cb7018ef64d Mon Sep 17 00:00:00 2001 From: inoussa Date: Fri, 20 Jul 2007 16:13:16 +0000 Subject: [PATCH] Type library editor : array editor git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@219 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/type_lib_edtr/ufarrayedit.lfm | 129 +++++++++++++++++++ wst/trunk/type_lib_edtr/ufarrayedit.lrs | 37 ++++++ wst/trunk/type_lib_edtr/ufarrayedit.pas | 158 ++++++++++++++++++++++++ 3 files changed, 324 insertions(+) create mode 100644 wst/trunk/type_lib_edtr/ufarrayedit.lfm create mode 100644 wst/trunk/type_lib_edtr/ufarrayedit.lrs create mode 100644 wst/trunk/type_lib_edtr/ufarrayedit.pas diff --git a/wst/trunk/type_lib_edtr/ufarrayedit.lfm b/wst/trunk/type_lib_edtr/ufarrayedit.lfm new file mode 100644 index 000000000..0622883d0 --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufarrayedit.lfm @@ -0,0 +1,129 @@ +object fArrayEdit: TfArrayEdit + Left = 327 + Height = 361 + Top = 131 + Width = 392 + HorzScrollBar.Page = 391 + VertScrollBar.Page = 360 + ActiveControl = Button1 + BorderStyle = bsSizeToolWin + Caption = 'fArrayEdit' + ClientHeight = 361 + ClientWidth = 392 + Position = poMainFormCenter + object Panel1: TPanel + Height = 50 + Top = 311 + Width = 392 + Align = alBottom + ClientHeight = 50 + ClientWidth = 392 + TabOrder = 0 + object Button1: TButton + Left = 216 + Height = 25 + Top = 9 + Width = 75 + Action = actOK + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + TabOrder = 0 + end + object Button2: TButton + Left = 304 + Height = 25 + Top = 9 + Width = 75 + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + end + object PageControl1: TPageControl + Height = 311 + Width = 392 + ActivePage = TabSheet1 + Align = alClient + TabIndex = 0 + TabOrder = 1 + object TabSheet1: TTabSheet + Caption = 'Array definition' + ClientHeight = 285 + ClientWidth = 384 + object Label1: TLabel + Left = 19 + Height = 14 + Top = 21 + Width = 28 + Caption = 'Name' + ParentColor = False + end + object Label2: TLabel + Left = 19 + Height = 14 + Top = 102 + Width = 66 + Caption = 'Element Type' + ParentColor = False + end + object Label3: TLabel + Left = 19 + Height = 14 + Top = 170 + Width = 69 + Caption = 'Element Name' + ParentColor = False + end + object edtName: TEdit + Left = 20 + Height = 23 + Top = 42 + Width = 345 + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + end + object edtElementType: TComboBox + Left = 19 + Height = 21 + Top = 122 + Width = 345 + Anchors = [akTop, akLeft, akRight] + AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] + ItemHeight = 13 + MaxLength = 0 + Style = csDropDownList + TabOrder = 1 + end + object edtEmbedded: TCheckBox + Left = 19 + Height = 13 + Top = 242 + Width = 71 + Caption = 'Embedded' + TabOrder = 2 + end + object edtElementName: TEdit + Left = 19 + Height = 23 + Top = 186 + Width = 345 + Anchors = [akTop, akLeft, akRight] + TabOrder = 3 + Text = 'Item' + end + end + end + object AL: TActionList + left = 215 + top = 185 + object actOK: TAction + Caption = 'OK' + DisableIfNoHandler = True + OnExecute = actOKExecute + OnUpdate = actOKUpdate + end + end +end diff --git a/wst/trunk/type_lib_edtr/ufarrayedit.lrs b/wst/trunk/type_lib_edtr/ufarrayedit.lrs new file mode 100644 index 000000000..ed1831ee3 --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufarrayedit.lrs @@ -0,0 +1,37 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('TfArrayEdit','FORMDATA',[ + 'TPF0'#11'TfArrayEdit'#10'fArrayEdit'#4'Left'#3'G'#1#6'Height'#3'i'#1#3'Top'#3 + +#131#0#5'Width'#3#136#1#18'HorzScrollBar.Page'#3#135#1#18'VertScrollBar.Page' + +#3'h'#1#13'ActiveControl'#7#7'Button1'#11'BorderStyle'#7#13'bsSizeToolWin'#7 + +'Caption'#6#10'fArrayEdit'#12'ClientHeight'#3'i'#1#11'ClientWidth'#3#136#1#8 + +'Position'#7#16'poMainFormCenter'#0#6'TPanel'#6'Panel1'#6'Height'#2'2'#3'Top' + +#3'7'#1#5'Width'#3#136#1#5'Align'#7#8'alBottom'#12'ClientHeight'#2'2'#11'Cli' + +'entWidth'#3#136#1#8'TabOrder'#2#0#0#7'TButton'#7'Button1'#4'Left'#3#216#0#6 + +'Height'#2#25#3'Top'#2#9#5'Width'#2'K'#6'Action'#7#5'actOK'#7'Anchors'#11#5 + +'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#0#0#0#7 + +'TButton'#7'Button2'#4'Left'#3'0'#1#6'Height'#2#25#3'Top'#2#9#5'Width'#2'K'#7 + +'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cance' + +'l'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#1#0#0#0#12'TP' + +'ageControl'#12'PageControl1'#6'Height'#3'7'#1#5'Width'#3#136#1#10'ActivePag' + +'e'#7#9'TabSheet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9 + +'TTabSheet'#9'TabSheet1'#7'Caption'#6#16'Array definition'#12'ClientHeight'#3 + +#29#1#11'ClientWidth'#3#128#1#0#6'TLabel'#6'Label1'#4'Left'#2#19#6'Height'#2 + +#14#3'Top'#2#21#5'Width'#2#28#7'Caption'#6#4'Name'#11'ParentColor'#8#0#0#6'T' + +'Label'#6'Label2'#4'Left'#2#19#6'Height'#2#14#3'Top'#2'f'#5'Width'#2'B'#7'Ca' + +'ption'#6#12'Element Type'#11'ParentColor'#8#0#0#6'TLabel'#6'Label3'#4'Left' + +#2#19#6'Height'#2#14#3'Top'#3#170#0#5'Width'#2'E'#7'Caption'#6#12'Element Na' + +'me'#11'ParentColor'#8#0#0#5'TEdit'#7'edtName'#4'Left'#2#20#6'Height'#2#23#3 + +'Top'#2'*'#5'Width'#3'Y'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'T' + +'abOrder'#2#0#0#0#9'TComboBox'#14'edtElementType'#4'Left'#2#19#6'Height'#2#21 + +#3'Top'#2'z'#5'Width'#3'Y'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#16 + +'AutoCompleteText'#11#22'cbactEndOfLineComplete'#20'cbactSearchAscending'#0 + +#10'ItemHeight'#2#13#9'MaxLength'#2#0#5'Style'#7#14'csDropDownList'#8'TabOrd' + +'er'#2#1#0#0#9'TCheckBox'#11'edtEmbedded'#4'Left'#2#19#6'Height'#2#13#3'Top' + +#3#242#0#5'Width'#2'G'#7'Caption'#6#8'Embedded'#8'TabOrder'#2#2#0#0#5'TEdit' + +#14'edtElementName'#4'Left'#2#19#6'Height'#2#23#3'Top'#3#186#0#5'Width'#3'Y' + +#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#3#4'Text'#6#4 + +'Item'#0#0#0#0#11'TActionList'#2'AL'#4'left'#3#215#0#3'top'#3#185#0#0#7'TAct' + +'ion'#5'actOK'#7'Caption'#6#2'OK'#18'DisableIfNoHandler'#9#9'OnExecute'#7#12 + +'actOKExecute'#8'OnUpdate'#7#11'actOKUpdate'#0#0#0#0 +]); diff --git a/wst/trunk/type_lib_edtr/ufarrayedit.pas b/wst/trunk/type_lib_edtr/ufarrayedit.pas new file mode 100644 index 000000000..8a1718ecc --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufarrayedit.pas @@ -0,0 +1,158 @@ +unit ufarrayedit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, + ComCtrls, StdCtrls, ActnList, + pastree, pascal_parser_intf, edit_helper; + +type + + { TfArrayEdit } + + TfArrayEdit = class(TForm) + actOK : TAction; + AL : TActionList; + Button1 : TButton; + Button2 : TButton; + edtEmbedded : TCheckBox; + edtElementName : TEdit; + edtElementType : TComboBox; + edtName : TEdit; + Label1 : TLabel; + Label2 : TLabel; + Label3 : TLabel; + PageControl1 : TPageControl; + Panel1 : TPanel; + TabSheet1 : TTabSheet; + procedure actOKExecute(Sender : TObject); + procedure actOKUpdate(Sender : TObject); + private + FUpdateType : TEditType; + FObject : TPasArrayType; + FSymbolTable : TwstPasTreeContainer; + private + property UpdateType : TEditType read FUpdateType; + private + procedure LoadFromObject(); + procedure SaveToObject(); + public + function UpdateObject( + var AObject : TPasArrayType; + const AUpdateType : TEditType; + ASymbolTable : TwstPasTreeContainer + ) : Boolean; + end; + +var + fArrayEdit : TfArrayEdit; + +implementation +uses parserutils; + +{ TfArrayEdit } + +procedure TfArrayEdit.actOKUpdate(Sender : TObject); +var + internalName : string; +begin + internalName := ExtractIdentifier(edtName.Text); + TAction(Sender).Enabled := + ( not IsStrEmpty(internalName) ) and + ( not IsStrEmpty(ExtractIdentifier(edtElementName.Text)) ) and + ( edtElementType.ItemIndex >= 0 ) ; +end; + +procedure TfArrayEdit.actOKExecute(Sender : TObject); +begin + ModalResult := mrOK; +end; + +procedure TfArrayEdit.LoadFromObject(); +begin + edtElementType.Clear(); + edtElementType.Items.BeginUpdate(); + try + edtElementType.Items.Clear(); + FillTypeList(edtElementType.Items,FSymbolTable); + finally + edtElementType.Items.EndUpdate(); + end; + if Assigned(FObject) then begin + Self.Caption := FSymbolTable.GetExternalName(FObject); + edtName.Text := FSymbolTable.GetExternalName(FObject); + edtElementName.Text := FSymbolTable.GetArrayItemExternalName(FObject); + edtElementType.ItemIndex := edtElementType.Items.IndexOf(FSymbolTable.GetExternalName(FObject.ElType)); + edtEmbedded.Checked := ( FSymbolTable.GetArrayStyle(FObject) = asEmbeded ); + end else begin + Self.Caption := 'NewArray'; + end; +end; + +procedure TfArrayEdit.SaveToObject(); +var + locObj : TPasArrayType; + typExtName, typIntName : string; + eltExtName, eltIntName : string; + eltType : TPasType; + arrStyle : TArrayStyle; +begin + locObj := nil; + typExtName := ExtractIdentifier(edtName.Text); + typIntName := MakeInternalSymbolNameFrom(typExtName); + eltExtName := ExtractIdentifier(edtElementName.Text); + eltIntName := MakeInternalSymbolNameFrom(eltExtName); + if edtEmbedded.Checked then + arrStyle := asEmbeded + else + arrStyle := asScoped; + eltType := edtElementType.Items.Objects[edtElementType.ItemIndex] as TPasType; + if ( UpdateType = etCreate ) then begin + locObj := FSymbolTable.CreateArray(typIntName,eltType,eltExtName,eltIntName,arrStyle); + FSymbolTable.CurrentModule.InterfaceSection.Declarations.Add(locObj); + FSymbolTable.CurrentModule.InterfaceSection.Types.Add(locObj); + FSymbolTable.CurrentModule.InterfaceSection.Classes.Add(locObj); + FreeAndNil(FObject); + FObject := locObj; + end else begin + locObj := FObject; + if ( eltType <> locObj.ElType ) then begin + if ( locObj.ElType <> nil ) then + locObj.ElType.Release(); + locObj.ElType := eltType; + locObj.ElType.AddRef(); + end; + locObj.Name := typIntName; + FSymbolTable.SetArrayStyle(locObj,arrStyle); + FSymbolTable.SetArrayItemExternalName(locObj,eltExtName); + end; + FSymbolTable.RegisterExternalAlias(locObj,typExtName); +end; + +function TfArrayEdit.UpdateObject( + var AObject : TPasArrayType; + const AUpdateType : TEditType; + ASymbolTable : TwstPasTreeContainer +) : Boolean; +begin + FSymbolTable := ASymbolTable; + FUpdateType := AUpdateType; + FObject := AObject; + LoadFromObject(); + Result := ( ShowModal() = mrOK ); + if Result then begin + SaveToObject(); + if ( AUpdateType = etCreate ) then begin + AObject := FObject; + end; + end; +end; + +initialization + {$I ufarrayedit.lrs} + +end. +