Mis en ligne 16/11/20 :
Dernière version compilée le lun 22 fév 2021
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.
(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
listbox
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;
- 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;
- Si l’item source est facile à argumenter puisqu’il s’agit de l’ITEM cliqué et pointé par ItemIndex
- 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.
Téléchargement
Modifications
- 22/02/2021 : Ajout Menu : recherche à partir du Nom et du Nom prénom (filtre tous les patients ayant e même nom +- même prénom)
- 29/11/2020 : Ajout Menu Affichage “Toujours en avant”
Articles similaires
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.
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.