You've already forked lazarus-ccr
Type library editor : array editor
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@219 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
129
wst/trunk/type_lib_edtr/ufarrayedit.lfm
Normal file
129
wst/trunk/type_lib_edtr/ufarrayedit.lfm
Normal file
@ -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
|
||||||
37
wst/trunk/type_lib_edtr/ufarrayedit.lrs
Normal file
37
wst/trunk/type_lib_edtr/ufarrayedit.lrs
Normal file
@ -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
|
||||||
|
]);
|
||||||
158
wst/trunk/type_lib_edtr/ufarrayedit.pas
Normal file
158
wst/trunk/type_lib_edtr/ufarrayedit.pas
Normal file
@ -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.
|
||||||
|
|
||||||
Reference in New Issue
Block a user