Type library editor : array editor

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@219 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2007-07-20 16:13:16 +00:00
parent f36c59e625
commit 2728fb56d8
3 changed files with 324 additions and 0 deletions
--- a/wst/trunk/type_lib_edtr/ufarrayedit.lfm
+++ 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
--- a/wst/trunk/type_lib_edtr/ufarrayedit.lrs
+++ 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
+]);
--- a/wst/trunk/type_lib_edtr/ufarrayedit.pas
+++ 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.
+