ChercheDossier

2
Dernière version compilée le Dim 29/11/2020 voir MAJ

CHERCHE DOSSIER

Permet de lister rapidement les sous-dossiers d’un dossier racine, en tapant ces premières lettres.

 

A quoi ça sert ?

  • Chacun des patients a un dossier Windows à son nom où son rangés ses différents fichiers de formats divers (documents, images, messages…)
  • Si retrouver un nom de fichier ou même le contenu d’un fichier à partir de l’explorateur de Windows est relativement convivial, retrouver simplement un DOSSIER parmi des milliers est plus acrobatique.

Comment ça marche ?

(1) Le premier champ désigne le dossier global ou sont rangés tous les dossiers patients

  • Ici DATA par exemple
  • Ce dossier est désigné une fois pour toute, et sera repointé à chaque ouverture

(2) Dans le second champ on tape le début du nom du dossier correspondant au nom du patient.

  • Par exemple DUPO

(3) La liste nous donne toutes les occurrences de cette sélection :

  • Il suffit de double cliquer sur une des entrées de la liste pour ouvrir le dossier.
  • A noter que pour des raisons logistiques personnelles, le nom du dossier cliqué est automatiquement placé dans le presse papier

CODE SOURCE

  • Ecrit en PASCAL Objet dans l’éditeur Delphi

Module Rechercher Dossier
  • Axé autour de la fonction FindFirst de la Bibliothèque Sysutils. avec le paramètre faDirectory, qui tourne en boucle “Until” avec FindNext,
  • Tant qu’il existe des occurrences, FindNext retourne 0,  et place le nom du dossier trouvé dans la propriété SearchResult.Name qui s’ajoute à la liste.
  • Lorsque la dernière occurrence est passée, FindNext retourne un entier non nul (code erreur) ce qui déclenche la sortie de la boucle Repeat…Until
  • FindClose prend alors le relais pour libérer les ressources mobilisées par FindFirst.
procedure TForm1.BTN_ChercherExecute(Sender: TObject);

var
searchResult: TSearchRec;
DOSSIER: string;

begin
if length(Edit1.Text) < 2 then
exit;

DOSSIER := IncludeTrailingPathDelimiter(JvDirectory_DATA.Text) + Edit1.Text;

ListBox1.Clear;

if findfirst(DOSSIER + '*', faDirectory, searchResult) = 0 then
begin
repeat
ListBox1.Items.Add(searchResult.Name);
until FindNext(searchResult) <> 0;

FindClose(searchResult);
end;

panel_liste.Caption := format('%d dossier(s) trouvé(s) commençant par "%s"',
[ListBox1.Items.count, Edit1.Text]);
end;
Déplacer un dossier / Drag & Drop
  • A partir d’une
listbox
  • Prérequis :
DragMode = dmAutomatic
  • ListBox1MouseDown
    • Cet événement se produit lorsqu’on appuie sur le bouton gauche de la souris
    • Le nom de l’item est récupéré et associé au nom du répertoire pour construire le chemin complet du dossier pointé
if ListBox1.ItemIndex <> -1 then
_DOSSIER_PATIENT := IncludeTrailingPathDelimiter(JvDirectory_DATA.Text) +
ListBox1.Items[ListBox1.ItemIndex];

 

_DOSSIER_PATIENT Variable globale, récupérant le chemin complet du dossier
JvDirectory_DATA Composant JEDI “jvDirectoryEdit pour Delphi définissant le DOSSIER RACINE (Peut être remplacé par le “Nom du Dossier”
IncludeTrailingPathDelimiter Met ou pas le caractère \  dans le nom du chemin (comme on ne sait jamais s’il est inclut ou pas)
  • ListBox1DragOver
    • Cet événement se produit lorsqu’on maintient la souris enfoncée sur un Item de la Liste et qu’on commence à bouger tout en maintenant la souris appuyée. (DRAG)
 ListBox_DragOver(ListBox1, Sender, X, Y, State, Accept);
  • La procédure ListBox_DragOver est développée ici :
    • Elle dessine une ligne de 2 pixels sous l’item cliqué
    • Puis suit le mouvement de la souris jusqu’à l’item de destination
    • Je l’ai placée dans un Module dédié aux fonctions drag and drop, mais on peut l’inclure dans les procédures  de la fiche.
      • procedure Tform1.ListBox_DragOver
procedure ListBox_DragOver(ListBox: TListBox; Sender: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

Var
NumItem: Integer;
Var
Rect: TRect;

Begin

If (Sender = ListBox) Then
Begin
Accept := True;
If (State = dsDragMove) Then
Begin

NumItem := ListBox.ItemAtPos(Point(X, Y), False); // Recupère l'element en XY

// Trace une ligne sous le drag souris
With ListBox.Canvas Do
Begin
Pen.Style := psDot;
Pen.Mode := pmNot;
Pen.Width := 2;

If Ligne_Afficher Then
Begin // Si la ligne est déjà affichée, on l'efface
Rect := ListBox.ItemRect(OldItem); // Trouve le Rect de l'ancien élément
MoveTo(Rect.Left, Rect.Top);
LineTo(Rect.Right, Rect.Top);
End;

Rect := ListBox.ItemRect(NumItem); // Trouve le Rect du nouvel élément
MoveTo(Rect.Left, Rect.Top);
LineTo(Rect.Right, Rect.Top);
OldItem := NumItem;
Ligne_Afficher := True;
End;
End;

If (State = dsDragLeave) Then // On sort de la ListBox1 avec le curseur
With ListBox.Canvas Do
Begin
Pen.Style := PSSOLID;
Pen.Mode := pmNot;
Pen.Width := 2;

If Ligne_Afficher Then
Begin // la ligne est affichée, on l'efface
Rect := ListBox.ItemRect(OldItem);
MoveTo(Rect.Left, Rect.Top);
LineTo(Rect.Right, Rect.Top);
End;
Ligne_Afficher := False;

End;
End;

End;
Lire plus ...
Fermer
  • Enfin ListBox1DragDrop
    • Correspond à l’événement cible du Drag And Drop au moment ou la souris est relâchée (DROP) sur la cible.
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);

var
Item_SOURCE, Item_CIBLE: string;
// i: Integer;
begin

// recupere les valeur de Source et cible
If not GetLisbox_SourceCible(ListBox1, Sender, X, Y, Item_SOURCE, Item_CIBLE)
then
Begin
MessageDLG('Vous devez placer la barre "SOUS" le Nom de la destination',
MTinformation, [mbOK], 0);
exit;
end;

if MessageDLG(format('%sDéplacer tout vers ->%s', [Item_SOURCE + cr + cr,
cr + cr + Item_CIBLE]), mtConfirmation, mbOKCancel, 0) = mrCancel then
exit;

Item_SOURCE := IncludeTrailingPathDelimiter(JvDirectory_DATA.Text) +
Item_SOURCE;
Item_CIBLE := IncludeTrailingPathDelimiter(JvDirectory_DATA.Text) +
Item_CIBLE;

// i := ListBox1.ItemIndex;
Folder_MoveDir(Item_SOURCE, Item_CIBLE);

BTN_Chercher.Execute;

if ListBox1.Items.count > 0 then
ListBox1.ItemIndex := 0;

end;
  • Qui fait appel à la fonction GetLisbox_SourceCible
function GetLisbox_SourceCible(ListBox: TListBox; Sender: TObject; X, Y: Integer; var Item_SOURCE: string;
var Item_CIBLE: string): Boolean;
var
ITEM_A, ITEM_B: Integer;
Begin

Result := True;

ITEM_A := TListBox(Sender).itemIndex; // source
If ITEM_A = -1 then
Result := False
else
begin
Item_SOURCE := TListBox(Sender).Items[ITEM_A];

If (Sender = ListBox) Then
begin
ITEM_B := ListBox.ItemAtPos(Point(X, Y), False) - 1;
if ITEM_B = -1 then
Result := False
else
begin

Item_CIBLE := ListBox.Items[ITEM_B];
ListBox.MultiSelect := True; // si pas fait avant
ListBox.Selected[ITEM_A] := True;
ListBox.Selected[ITEM_B] := True;
end;
end;
end;

End;
  1. Si l’item source est facile à argumenter puisqu’il s’agit de l’ITEM cliqué et pointé par ItemIndex
  2. L’Item cible correspond au simple survol de la souris, et peut être pointé par l’instruction ListBox.ItemAtPos(Point(X, Y), False), Point(X,Y) désignant les cordonnées de la souris.
Afficher plus
Afficher moins

 

Téléchargement

Modifications
  • 29/11/2020 : Ajout Menu Affichage “Toujours en avant”

More from my site

2 commentaires

  1. Bluegyn Bluegyn

    VERSION DU 20.11

    * Ajout au menu de l’option copier le nom du dossier dans le presse papier

    * Ajout de la fonction “DÉPLACER UN DOSSIER” afin de fusionner 2 dossiers du même patient
    – Le déplacement se fait à souris à partir de la liste
    – Il suffit de tirer le dossier à déplacer vers le dossier à remplir.

  2. Bluegyn Bluegyn

    Version du 21/11/2020

    – Ajout de la fonction de mémorisation des recherches précédentes
    – Permet de revenir facilement sur un dossier antérieur

    Le champ de saisie est simplement transformé en Liste de Saisie
    – Chaque nouvelle entrée (validée) est mémorisée et peut être retrouvée en déroulant la liste.
    – NB : Seules les 10 dernières entrées sont mémorisées à la fermeture du programme (pour ne pas saturer la liste), et seront donc disponibles par défaut à chaque nouveau lancement.

Laisser un commentaire