begin process at 2012 02 11 08:38:35
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Compression & Split

 > DELPHI : PROCEDURE SPLIT SIMILAIRE A LA FONCTION EPONYME EN VB

DELPHI : PROCEDURE SPLIT SIMILAIRE A LA FONCTION EPONYME EN VB


 Information sur la source

Note :
Aucune note
Catégorie :Compression & Split Classé sous :SPLIT, STRING, TEXTE, CHAINE, CSV Niveau :Débutant Date de création :11/02/2008 Date de mise à jour :06/03/2009 15:13:10 Vu / téléchargé :10 322 / 376

Auteur : FENETRES

Ecrire un message privé
Commentaire sur cette source (14)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
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

  • 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;
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.

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Historique

11 février 2008 11:39:32 :
Mise à jour : limitation de l'emploi de SetLength
11 février 2008 11:45:33 :
Erreur de manipulation
11 février 2008 12:08:28 :
Optimisation : une seule affectation de la longueur du texte.
11 février 2008 12:24:40 :
Mise à jour précédente erronée.
11 février 2008 15:52:52 :
longueur max = 256
12 février 2008 08:14:20 :
Correction description
12 février 2008 09:09:43 :
Ajout commentaire dans le code source
12 février 2008 13:27:36 :
Modification du titre
18 février 2008 14:41:46 :
Ajout du cas particulier où le caractère de délimitation n'a pas été défini (Delimiter=#0).
18 février 2008 14:45:40 :
Erreur de manip.
06 mars 2008 12:25:14 :
MAJ de la procédure setCursor
26 août 2008 12:04:05 :
Correction grammaticale
03 décembre 2008 16:52:22 :
Zip (sup. des fichiers inutiles)
10 décembre 2008 09:22:14 :
Catégorie
23 décembre 2008 11:09:29 :
Conclusion (allocution de mémoire)
23 décembre 2008 12:00:30 :
Faute de frappe
23 décembre 2008 16:49:32 :
Conclusion
06 mars 2009 15:13:11 :
Correction : " for i:=1 to l do " au lieu de " for i:=0 to l do " L'index 0 d'un string comprend sa longueur ! Curieux... personne n'a relevé l'erreur certes sans incidence fonctionnelle.

 Sources du même auteur

Source avec Zip Source avec une capture DELPHI : SHA-1 EN MODE CHIFFREMENT (SHACAL)
Source avec Zip Source avec une capture DELPHI - AJOUT DE POLICES (APP. CONSOLE)
Source avec Zip Source avec une capture DELPHI - CREATION D'UNE COLLECTION D'ENREGISTREMENTS SAGE (T...
Source avec Zip Source avec une capture DELPHI - CHEMIN D'ACCÈS DE STYLE ELLIPTIQUE (GET PATH ELLIPS...
Source avec Zip Source avec une capture DELPHI - CRÉATION D'UNE FEUILLE DE CALCUL EXCEL (CONTRÔLE TO...

 Sources de la même categorie

Source avec Zip Source avec une capture UPXHELPER V1.1.1 par Christophe67
FONCTION SPLIT par crackspider7676
Source avec Zip STREAMZIP par simonpelloquin
Source avec Zip MAKE CAB + CHECKLISTBOX par simonpelloquin
Source avec Zip Source avec une capture COMPRESSEUR JPEG par Gimli

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture STREAM STRINGWRITER... UNE MICRO-LIBRAIRIE POUR ÉCRIRE DES C... par LaDentDeLait
Source avec Zip COMBINAISONS DE STRINGS par askil2000
LIBRAIRIE DE FONCTIONS DE GESTION DE SOUS-CHAINES. par MAURICIO
Source avec Zip DISTANCE LEVENSHTEIN (DISTANCE ENTRE DEUX CHAINES) par DevNul
Source avec Zip COMPOSANT DE SPLIT par Harvester_

Commentaires et avis

Commentaire de FENETRES le 11/02/2008 10:57:20

L'utilisation de SetLength limite la longueur du tableau à 255 éléments. "NewLength doit avoir une valeur comprise entre 0 et 255".

Commentaire de FENETRES le 11/02/2008 11:27:12

Par suite, il est possible de réduite l'emploi de setLength en déclarant d'abord la longueur maximum (255) puis la longueur effective trouvée (k).

Commentaire de FENETRES le 11/02/2008 15:55:50

Erratum :
   la longueur maximum du tableau dynamique est naturellement de 256 éléments.

Commentaire de pascal99 le 12/02/2008 10:28:47

Bonjour,
si mes souvenirs de VB sont bons, split est une fonction et delimiter une string (il peut etre compose de plusieurs caracteres) dont la valeur par defaut est l'espace.

Ce serait bien de modifier votre procedure en fonction.

Bons codes

Commentaire de FENETRES le 12/02/2008 11:08:55

Split(expression[, delimiter[, limit[, compare]]])

Alors, effectivement, vos souvenirs sont bons. Je n'ai pas le temps actuellement de surcharger cette méthode et d'écrire une procédure réellement semblable. Mais je vous promets de m'y atteler dès que possible.

Commentaire de FENETRES le 13/02/2008 14:51:59

La conversion de la procédure en fonction donnerait la signature suivante :

function Split(const Delimiter: char; DelimitedText: string): TStrArray;

Il n'y a donc pas de quoi fouetter un chat pas plus que l'élargissement du caractère de délimitation à un type string. L'ajout d'autres paramètres ne présente pas à mon point de vue un trés grand intérêt. C'est pourquoi, après réflexion et correction du titre, je ne  pense pas surcharger la méthode présentée.

Cordialement,

Commentaire de FENETRES le 05/03/2008 11:40:02

En aparté, vous pouvez notez la manière de récupérer un curseur système différent d'un curseur Delphi :

procedure TfrmDemo.frmDemoOnActivate(Sender: TObject);
  procedure setCursor(hWnd:integer; lpCursorName:PAnsiChar);
  var
    hCur:integer;
  begin
    try
      hCur:=LoadCursor(0, lpCursorName);
      SetClassLong(hWnd, GCL_HCURSOR, hCur);
    finally
      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;

Commentaire de Renfield le 05/03/2008 22:56:48 administrateur CS

    try
      hCur:=LoadCursor(0, lpCursorName);
      SetClassLong(hWnd, GCL_HCURSOR, hCur);
    finally
      DestroyCursor(hCur);
    end;

.... je codes en VB, pas en Delphi, mais... je trouve étrange de constater, à la leccture de ce code, que les API semblent générer des exceptions....

Commentaire de FENETRES le 06/03/2008 09:42:14

Bonjour l'artiste,

   Je ne comprends pas ta remarque car cette procédure ne génère aucune exception (Delphi7 ou 2007). D'ailleurs, il s'agit d'une transcription en Pascal d'une proc. très connue par les programmeurs VB. Il faudrait détailler le contexte et son usage.

Commentaire de Renfield le 06/03/2008 09:47:35 administrateur CS

je parle du try finally
est-ce réellement indiqué ici, dans la mesure ou tu ne fait qu'utiliser des APIs

au pire, elles renverront des codes indiquant une erreur...


enfin, y'a pas lieu de s'attarder là, j'ai juste vu passer ce commentaire sur la source, ca m'a intrigué.

Commentaire de FENETRES le 06/03/2008 09:56:02

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+,

Commentaire de FENETRES le 06/03/2008 10:21:05

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.




Commentaire de FENETRES le 06/03/2008 11:51:09

Note : les déclarations des l'API utilisées se trouve dans l'unité Windows.

Commentaire de FENETRES le 06/03/2008 12:08:56


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;

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Split String [ par oregon ] Bonsoir, a tous je suis un peux bloqué sur un projet. Enfaite j'aimerai diviser une string en 4 ou 2 enfin peux importe afin de les séparer sans delim Transformer un fichier texte en une chaine [ par CelineC ] J'ai un super pb!Je commence en Delphi.....J'arrive à récupérer un fichier texte et l'afficher dans une boite memo.Le problème c que j'aimerais transf envoyer/intercepter une chaine au systeme [ par slachz ] Bonjour ! j'aimerais savoir comment envoyer du texte d'une appli a une autre zone de texte (&#224; la mani&#232;re du clavier virtuelle windows). j'ai Manipuler le texte d'une string! [ par ELCouz ] Cher Membres Delphifr,J'aimerais effectué deux opérations bien simple...voici mon texte example qui est contenu dans la string X1234texte non-fixe, al Vérifier le contenu d'une chaine de type string [ par Komona ] Bonjour,Je me tourne à vous à la suite d'une paire d'heures de recherche sur un sujet qui (je l'espère) pourra facilement être réglé via vos connais chaine vide (longueur variable) dans un fichier texte. [ par Ibadissene ] Merci de l'interet que vous porterez à ma question. La dernière fois j'ai omis de spécifier le langage de programmation : c'est delphi 5. Je reposerai Remplacement de caractères pour chaques lettres [ par tony1239456 ] Bonjour, je voudrais savoir si il existe une fonction permettant de remplacer des caract&#232;res dans une chaine diff&#233;rents pour chaques lettres Formatage d'un string [ par titiyo ] bonjoursen fait jai un chaine de 10 espace et je veut rentre dedant toto sans augenter la taille de ma chaine resulta qui a comme longeur 10:chaine1 : Enlever les accents d'un texte etc... [ par lomig ] Bonjour, je suis à la recherche d'un algo me permettant de transformerune chaine de caractere afin d'en enlever les eventuelles erreurs.Imaginons une longueur d'une chaine de texte (Len en VB) [ par Saeko ] comment connaitre la longueur d'une chaîne de texte ? y a-t-il un équivalent Delphi à l'instruction 'Len' de VB ?Merci d'avanceSaeko


Nos sponsors


Sondage...

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,702 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales