Ver Mensaje Individual
  #27  
Antiguo 04-05-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 23
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
Pedron,

Cita:
Empezado por Pedron
...habrá una forma en la que pueda comparar varios arreglos a la vez con ese mismo código comparar 2 o mas arreglos y los datos que sean diferentes a esos arreglos pues mandarlos al Memo2...
Revisa este código
Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const

  A1: Array[1..74] of String =  ('db','ALIGN','.ALPHA','ASSUME','.CODE','COMM','COMMENT',
                                 '.CONST','.CREF','.DATA','DB','DD','DF','DOSSEG','DQ',
                                 'DT','DW','ELSE','END','ENDIF','ENDM','ENDP','ENDS','EQU',
                                 '.ERRnn','EVEN','EXITM','EXTRN','.FARDATA','.FARDATA?',
                                 'GROUP','IF','IF1','IF2','IFB','IFDEF','IFDIF','IFE','IFIDN',
                                 'IFNB','IFNDEF','INCLUDE','INCLUDELIB','IRP','IRPC','LABEL',
                                 '.LALL','.LFCOND','.LIST','LOCAL','MACRO','.MODEL','NAME',
                                 'ORG','OUT','PAGE','PROC','PUBLIC','PURGE','.RADIX','RECORD',
                                 'REPT','.SALL','SEGMENT','.SEQ','.SFCOND','.STACK','STRUC',
                                 'SUBTTL','.TFCOND','TITLE','.XALL','.XCREF','.XLIST');

  A2 : Array[1..30] of String = ('AX','BX','CX','DX','AH','AL',
                                 'BH','BL','BP','CH','CL','CS',
                                 'DH','DL','DI','DS', 'GS', 'IP',
                                 'SI','SP','SS', 'ES',
                                 'EAX','EBP','EBX','ECX',
                                 'EDI','EDX','EIP','ESIFE');

  A3 : Array[1..36] of String = ('AND','BYTE','COMMENT','CON','DUP',
                                 'EQ','FAR','GE','GT','HIGH','LE',
                                 'LENGTH','LINE','LOW','LT','MASK',
                                 'MOD','NE','NEAR','NOT','NOTHING',
                                 'OFFSET','OR','PTR','SEG','SHL','SHORT',
                                 'SHR','SIZE','STACK','THIS','TYPE',
                                 'WHILE','WIDTH','WORD','XOR');

var
  Form1: TForm1;

implementation

{$R *.dfm}

function SelectElement(A1, A2, A3 : Array of String; InputList, OutPutList : TStrings) : Boolean;
var
   TokenList : TStringList;
   SelectList : TStringList;
   i, j, k : Integer;
   Token : String;
   AuxStr : String;

begin

   try

      TokenList := TStringList.Create;
      SelectList := TStringList.Create;

      for i := Low(A1) to High(A1) do
         SelectList.Add(A1[i]);

      for i := Low(A2) to High(A2) do
         SelectList.Add(A2[i]);

      for i := Low(A3) to High(A3) do
         SelectList.Add(A3[i]);

      for i := 0 to InputList.Count - 1 do
      begin

         AuxStr := InputList.Strings[i];

         for j := 1 to Length(AuxStr) do
         begin
            if (AuxStr[j] <> ' ') and (AuxStr[j] <> ',') then
               Token := Token + AuxStr[j]
            else
            begin
               TokenList.Add(Token);
               Token := EmptyStr;
            end
         end;

         TokenList.Add(Token);
         Token := EmptyStr;

         for j := TokenList.Count - 1 downto 0 do
            for k := SelectList.Count - 1 downto 0 do
               if TokenList[j] = SelectList.Strings[k] then
               begin
                  TokenList.Delete(j);
                  Break;
               end;

         for j := 0 to TokenList.Count - 1 do
            Token := Token + TokenList[j] + ' ';

         OutPutList.Add(Token);
         Token := EmptyStr;

         TokenList.Clear;

      end;

      TokenList.Free;
      SelectList.Free;

   except

      Result := False;
      Exit;

   end;
   
   Result := True;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
   Msg : String;
   
begin

   Memo2.Clear;

   if SelectElement(A1,A2,A3,Memo1.Lines, Memo2.Lines) then
   begin
      Msg := 'Análisis Sintáctico Concluido Satisfactoriamente';
      MessageDlg(Msg, mtInformation, [mbOK], 0)
   end
   else
   begin
      Msg := 'Error en Análisis Sintáctico';
      MessageDlg(Msg, mtError, [mbOK], 0)
   end

end;

end.
El código anterior en Delphi 7 bajo Windows 7 Professional x32, analiza por medio de una función de selección cada línea de TMemo1, las compara tipo Case Sensitive con un conjunto de arreglos y copia dicha línea a TMemo2 eliminando cualquier ocurrencia encontrada, como se muestra en la siguiente imagen:



Nota: En el ejemplo se utilizaron tres arreglos de comparación para análisis sintáctico, el código se puede expandir para n arreglos de comparación.

Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 04-05-2014 a las 02:10:14.
Responder Con Cita