Delphi : procedure split similaire a la fonction eponyme en vb

Soyez le premier à donner votre avis sur cette source.

Vue 13 706 fois - Téléchargée 788 fois

Description

Découpe une chaîne délimitée en ses éléments pour remplir un tableau dynamique passé en paramètre. Un type formel doit être déclaré pour le tableau dynamique (cf. demo en pièce jointe). Par suite, cette source est utilisable à partir de la version 4 de Delphi.

Source / Exemple :


procedure Split(const Delimiter: char; DelimitedText: string; var StrArray: TStrArray);
var
  i, j, l: cardinal;
  k: byte;
begin
  { Fill the dynamic array with the items of a text delimited }
  if (DelimitedText=EmptyStr) then begin
    SetLength(StrArray, 1);
    StrArray[0]:=EmptyStr;
  end else if (Delimiter=#0) then begin
    SetLength(StrArray, 1);
    StrArray[0]:=DelimitedText;
  end else begin
    l:=Length(DelimitedText);
    if (Copy(DelimitedText, l, 1)<>Delimiter) then begin
      DelimitedText:=DelimitedText + Delimiter;
      l:=l+1;
    end;
    SetLength(StrArray, 256);
    k:=0;j:=0;
    for i:=1 to l do
      if (DelimitedText[i]=Delimiter) then begin
        inc(k);
        strArray[k-1]:=Copy(DelimitedText, j+1, i-(j+1));
        j:=i;
      end;
    SetLength(StrArray, k);
  end;
end;

Conclusion :


Vous noterez qu'il n'a pas été nécessaire d'instancier un TStringList ou d'ajouter une quelconque dépendance pour écrire cette procédure.

Rappel : le compilateur Delphi assure une gestion évoluée des tableaux dynamiques. Avec un autre compilateur, il vous faudra vérifier la libération de la mémoire allouée au tableau dynamique.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

var i: integer;
.......
with TStringList.Create do
try
  StrictDelimited:= True; 
  Delimiter:= ';';
  DelimitedText:= 'poux;cailloux;genoux;hiboux;;';  
  for i:= 0 to Count-1 do
     ShowMessage(Strings[i]); 
finally
  Free;
end;
Messages postés
196
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009

Procédure revue et corrigée (toute exception sera silencieuse).

procedure TfrmDemo.frmDemoOnActivate(Sender: TObject);
procedure setCursor(hWnd:integer; lpCursorName:PAnsiChar);
var
hCur:integer;
begin
hCur:=LoadCursor(0, lpCursorName);
if (hcur<>0) then begin
SetClassLong(hWnd, GCL_HCURSOR, hCur);
DestroyCursor(hCur);
end;
end;
begin
//Déclare et affiche le caractère de délimitation
Delimiter:=';';
lblDelimiter.Caption:= 'Delimiter: "' + Delimiter + '"';
//Curseur des boutons
setCursor(btnSplit.Handle, IDC_HAND);
setCursor(btnClose.Handle, IDC_HAND);
end;
Messages postés
196
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009

Note : les déclarations des l'API utilisées se trouve dans l'unité Windows.
Messages postés
196
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009

Pour information des lecteurs, voici les spécifications complètes de l'API qui a fait l'objet de la remarque fondée de notre ami Renfield.

Declaration:
Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As String) As Long

Parameters:
· hInstance
Identifies an instance of the module whose executable file contains the cursor to be loaded.

· lpCursorName
Points to a null-terminated string that contains the name of the cursor resource to be loaded. Alternatively, this parameter can consist of the resource identifier in the low-order word and zero in the high-order word. The MAKEINTRESOURCE macro can also be used to create this value.
To use one of the Win32 predefined cursors, the application must set the hInstance parameter to NULL and the lpCursorName parameter to one the following values:
IDC_APPSTARTING
Standard arrow and small hourglass
IDC_ARROW
Standard arrow
IDC_CROSS
Crosshair
IDC_IBEAM
Text I-beam
IDC_ICON
Obsolete for applications marked version 4.0 or later.
IDC_NO
Slashed circle
IDC_SIZE
Obsolete for applications marked version 4.0 or later. Use IDC_SIZEALL.
IDC_SIZEALL
Four-pointed arrow
IDC_SIZENESW
Double-pointed arrow pointing northeast and southwest
IDC_SIZENS
Double-pointed arrow pointing north and south
IDC_SIZENWSE
Double-pointed arrow pointing northwest and southeast
IDC_SIZEWE
Double-pointed arrow pointing west and east
IDC_UPARROW
Vertical arrow
IDC_WAIT
Hourglass

Return values :
If the function succeeds, the return value is the handle of the newly loaded cursor.
If the function fails, the return value is NULL. To get extended error information, call GetLastError.
Messages postés
196
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009

Le "finally" est toujours exécuté même si une exception est levée. Dans ce cas, effectivement, il n'est pas vraiment nécessaire.

A+,
Afficher les 15 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.