Introduction▲
Avec Turbo Pascal for Windows ou Turbo C++ for Windows, on peut créer un éditeur de texte en quelques fonctions avec des bibliothèques qui sont spécifiquement programmées pour ce faire.
Par contre, avec Turbo Pascal 7 pour MS-DOS, pour programmer un éditeur de texte, il vous faut écrire toutes les fonctions nécessaires : le mouvement du curseur de droite à gauche, de haut en bas, remonter/descendre une ligne, insérer un caractère, effacer un caractère à gauche, à droite, créer un nouveau fichier, ouvrir un fichier, sauvegarder le fichier, marquer un bloc, copier/coller un bloc, etc.
Sur internet, vous pouvez trouver beaucoup d'« éditeurs de texte » mais il est difficile d'en trouver le code source détaillé de toutes les fonctions.
Programmer, ce n'est pas toujours simple : il faut penser logiquement, par étapes, envisager toutes les possibilités des actions ; cela demande une grande attention, une grande rigueur. Mais à ces complications s'ajoute encore l'apprentissage d'une syntaxe extrêmement ardue, qui ne supporte pas la moindre faute, à la virgule près. Programmer un éditeur de texte est un travail long et pas facile, mais avant tout, pour étudier l'algorithme d'un éditeur il faut l'avoir dans la tête, et savoir ce que vous allez faire, ce que l'éditeur va faire comme commandes. Un éditeur de texte simple c'est pour écrire du texte brut, mais il peut faire des tâches supplémentaires, comme un commande pour insérer la date ou afficher une table de verbe, ou traduire un mot, etc.
À l'époque où l'on programmait avec le système MS-DOS, Turbo Pascal était le langage idéal pour programmer ; de nos jours, la programmation MS-DOS est du passé. Maintenant, on programme en « 32 bits ou 64 bits » avec Windows et le langage C++ ou Delphi. Mais c'est une programmation beaucoup plus abstraite et difficile à comprendre.
Pour programmer, il faut aussi avoir certaines qualités et le programmeur doit se concentrer sur le problème à résoudre. Avoir beaucoup de patience car un programme ne marche pas toujours du premier coup. Il faut avoir de la logique, savoir réfléchir calmement, etc.
La démarche de conception d'un programme▲
Concevoir un programme pour résoudre un problème donné, c'est donc suivre la démarche de cette figure :
Dans ce schéma, les phases d'Analyse et de Traduction sont des opérations intellectuelles humaines, alors que les phases de Compilation et d'Exécution sont réalisées automatiquement par la machine. Le programme source et le programme exécutable sont deux versions numériques du même algorithme.
Le programme source est écrit en langage évolué, alors que le programme exécutable est le résultat de sa compilation. En général, quand on achète un logiciel dans le commerce, c'est uniquement le programme exécutable (illisible, même pour informaticien) qui est fourni. Quand le code source est aussi fourni, on parle de « logiciel libre », puisque tout informaticien peut alors lire le programme (à condition qu'il connaisse le langage dans lequel il est écrit) et le modifier s'il le souhaite.
Une erreur syntaxique est une faute d'écriture (l'équivalent d'une faute d'orthographe ou de grammaire en français) ; elle est signalée par le compilateur quand celui-ci ne sait pas comment interpréter certaines instructions du programme source. Ces erreurs, quasiment inévitables même par les programmeurs expérimentés, proviennent d'un non-respect des préconisations (draconiennes !) du langage de haut niveau utilisé pour le programme source.
Par exemple, oublier de commencer un programme par BEGIN, oublier de le terminer par END ou ne pas séparer deux instructions élémentaires en Pascal par le symbole « ; » constituent des fautes de syntaxe.
Une erreur sémantique, beaucoup plus grave, provient d'une mauvaise conception de la méthode suivie pour résoudre le problème. C'est alors l'algorithme lui-même qui doit être modifié, ce qui oblige à remettre en cause les partis pris de la phase d'analyse.
L'étude d'un éditeur de texte▲
À mesure que la taille d'un logiciel s'accroît, sa création devient de plus en plus délicate. Programmer un éditeur texte ne peut pas se résoudre en quelques lignes savantes après dix minutes de réflexion. La programmation structurée permet d'améliorer l'organisation et l'écriture du programme, en facilitant sa compréhension et sa modification, et d'augmenter sa fiabilité.
Un éditeur de texte est un projet qui peut prendre des mois de réflexion et de programmation. Un des moyens utilisés pour mieux maîtriser la complexité du logiciel est de constituer un ensemble de routines, de parties de programme ayant pour fonction la réalisation d'une tâche précise, en général simple. Ces routines viennent en fait compléter les instructions du langage de développement avec de nouvelles fonctions ou procédures. La mise au point est moins erratique et la fiabilité obtenue meilleure.
Dites-vous qu'il faudra écrire des centaines de procédures et fonctions, que le passage d'une à l'autre ne doit pas planter le programme, que la moindre variable ou appel à une procédure peut provoquer une confusion dans la pile si cela est mal interprété, et que cela peut planter le programme.
Méthode▲
Il faut écrire procédure par procédure et tester chacune de plusieurs façons, jusqu'à ce que la fonction soit correcte, et par la suite pourra être incluse dans le programme principal de l'éditeur.
Dans l'éditeur, une procédure principale permettra d'entrer les données au clavier et visualiser les résultats sur l'écran de l'éditeur.
Certaines routines sont stockées dans des fichiers différents, ce qui permet de les utiliser directement en les insérant dans l'unité correspondante avec une directive Include, comme ceci :
Sélectionnez
{$I file_ecrire.pas}
Cette méthode permet une souplesse maximale pour créer les unités.
Le nom du fichier contenant la(les) routine(s) peut être le même que la procédure avec l'extension (.PAS ou .BLC) comme bloc à inclure. Le fichier peut être placé dans un répertoire particulier.
Tester un programme▲
C'est se mettre à la place de l'utilisateur et imaginer tout ce qui peut faire comme erreurs. Et une erreur ne doit pas planter le programme ; celui-ci doit afficher un message d'erreur, en lui indiquant l'erreur et, dans certains cas, ce que l'utilisateur doit faire pour poursuivre.
Tester un programme peut parfois peut pendre autant de temps que de le programmer !
Les erreurs de programmation▲
Quand le programme fait une erreur et vous n'arrivez pas trouver d'où elle peut provenir, bien qu'elle soit parfois devant vos yeux, parce que votre cerveau est fatigué, laissez-la pour demain et vous aurez plus de chances de la trouver plus facilement.
Un ordinateur exécute les taches qu'on lui programme logiquement ; si les tâches ne sont pas dans un ordre logique et structuré, l'ordinateur plantera. Par contre, le cerveau de l'homme bien souvent ne réfléchit pas toujours logiquement, mais réfléchit à sa convenance, pour la raison qu'il possède une fonction appelée l'orgueil, et ne veut inconsciemment pas admettre qu'il se trompe ou que son raisonnement est erroné.
La méthode « copier/coller »
Si vous employez cette méthode en faisant un « copier/coller » de sources trouvées çà et là, et si vous arrivez à compiler le programme, il peut fonctionner si vous respectez l'ordre de la compilation/exécution. Mais dites-vous qu'avec cette méthode « copier/coller », vous n'arriverez pas à progresser et surtout vous n'aurez rien appris aux fonctions nécessaires pour programmer un éditeur de texte.
Par contre, si vous testez procédure par procédure avec une petite démo, alors vous arriverez à comprendre son fonctionnement, et cela vous donnera la possibilité de le modifier ou peut-être l'améliorer, en ajoutant de nouvelles fonctions.
Programmer un éditeur de texte▲
Une telle application nécessite beaucoup de réflexion et de la logique. Le corps de l'éditeur doit disposer au minimum de variables globales, buffer, l'écran, des caractères de contrôle divers.
Fonctions principales de l'éditeur▲
On doit pouvoir déplacer le curseur à l'intérieur de la fenêtre du texte à l'écran à l'aide des combinaisons de touches du clavier ou de la souris : aller au début de la ligne, aller à la fin de la ligne, une page d'écran vers le haut, une page d'écran vers le bas, un caractère à droite, un caractère à gauche, une ligne vers le haut, une ligne vers le bas, écrire un caractère (mode insertion actif ou non), effacer un caractère à droite et à gauche, insérer une ligne vierge, sélectionner un bloc pour copier et coller, insérer un fichier extérieur sur l'éditeur, sauvegarder un bloc dans un fichier, aller au menu général de l'éditeur ou aller à un menu bien déterminé, etc.
Le buffer de l'éditeur▲
Le buffer est comme une grande feuille sur laquelle on va écrire du texte. C'est un tableau de chaînes de caractères. Sa taille est définie par une constante.
Déclaration du buffer dans l'unité Type_Buf▲
Sélectionnez
Interface {*Types publics du Buffer pour l'éditeur*}
Const
Max_Buffer=51200; {*constante 50ko actuellement*}
Type
Edit_Buffer = Array[1..Max_Buffer+512] of Char; {*tableau du buffer de l'éditeur*}
Buf_Ptr = ^Edit_Buffer; {*conversion dans un pointeur*}
var
Buffer : Buf_Ptr; {*Pointeur du Buffer de l'Editeur*}
Implementation
Begin
Buffer:=Nil;
End.
NIL▲
Le mot réservé NIL est une valeur constante particulière permettant de neutraliser un pointeur ; il ne pointe ainsi vers rien.
NIL est compatible avec tous les pointeurs.
GetMem▲
La procédure GetMem crée une nouvelle variable dynamique de la taille indiquée et place son adresse dans une variable de type pointeur.
Déclaration :
Sélectionnez
Procedure GetMem (var P: pointer; Taille: Word);
Description :
P est une variable d'un type pointeur quelconque. Taille est une expression spécifiant la taille en octets de la variable dynamique à allouer.
La variable ainsi créée peut être référencée par P^. Une erreur d'exécution est signalée si la place disponible dans le tas n'est pas suffisante pour allouer la nouvelle variable (il est possible d'éviter ainsi une erreur d'exécution avec MaxAvail).
Restriction :
La plus grande taille de bloc mémoire qu'il est possible d'allouer en toute sécurité dans le tas en une seule opération est 65528 octets (64 Ko).
Création du buffer en mémoire▲
Sélectionnez
if MaxAvail < (Max_Buffer+512) then
begin
GetMem(Buffer,Max_Buffer+512);
Fillchar(Buffer^,Max_Buffer+512,' '); {** remplissage du buffer d'espaces #32 **}
Buffer^[1]:=#26; {** ^Z = #26 signifie la fin du buffer **}
end;
Procédures en langage assembleur▲
Le langage assembleur est très puissant ; c'est l'unique langage qui permette d'accéder à toute la puissance d'un processeur.
En principe, on peut écrire n'importe quel programme en assembleur, mais quand ils sont assez longs on peut obtenir une meilleure gestion avec un langage plus évolué comme le Pascal ou le C. Un langage évolué permet de prendre du recul et on peut employer cette analogie de voir la forêt plutôt que les arbres qui la composent.
Il faut dans ce cas, lier des sous-programmes en langage assembleur aux programmes en langage évolué, sous forme de fichiers objets (.OBJ), prêts à être liés.
La pile et le tas▲
Une pile est une structure de données qui sert au stockage provisoire des informations. Un programme peut commander ce stockage par l'instruction PUSH (empiler) ; il peut aussi provoquer la récupération des informations par l'instruction POP (dépiler).
La structure de données de la pile met en ordre de façon spéciale les données qui y ont été stockées. Un élément retiré d'une pile (dépilé) est toujours le dernier qui a été mis (empilé). On appelle cela une structure LIFO (« Last In, First Out » ; dernier entré, premier à sortir). Si on empile deux éléments, « A » d'abord, « B » ensuite, la première fois qu'on dépile on récupère « B » et à l'opération suivante, on récupère « A ».
Un ordinateur réalise une pile au moyen d'une zone de stockage réservée à cet effet et d'un pointeur appelé pointeur de pile. Le programme utilise celui-ci pour garder trace de la dernière adresse de la pile utilisée pour introduire une information.
En Turbo Pascal, la taille de la pile par défaut de 16 Ko est plus que suffisante pour la plupart des applications. Mais on peut spécifier la taille que l'on désire, pourvu que celle-ci soit comprise entre 1 Ko (pour les petits programmes) et 64 Ko (pour un programme faisant un usage intensif de la récursivité).
À chaque appel à New et GetMem, le stockage est effectué dynamiquement sur le tas - en commençant à partir du bas. L'espace est libéré par les routines Dispose, Release et FreeMem.
Les tailles de la pile et du tas peuvent être ajustées par la directive de compilation $M. La directive $M n'a aucun effet sur les unités.
Sélectionnez
{$M Stack size, heapmin, heapmax}
- Stack size indique la taille du segment de pile (16 Ko = 16 * 1024 = 16384 octets) ;
- Heapmin et Heapmax sont les tailles minimale et maximale du tas (en octets).
Dans le programme de l'éditeur EDIT13.PAS, on initialise la quantité de la pile au début du programme :
Sélectionnez
{$M 16384,0,655360}
C'est sur la pile que sont déposées les adresses des fonctions appelées.
Turbo Pascal et les liens avec les fichiers objets▲
La directive {$L …} est utilisée afin de faire le lien avec du code écrit en Assembleur, pour les sous-programmes déclarés comme externes. Le fichier doit être un fichier objet (.OBJ). La directive {$L nomfichier} demande au compilateur de lier le fichier nommé avec le programme ou l'unité en cours de compilation.
Exemple :
Sélectionnez
{$L Win_Asm.OBJ}
{$L Miniscul.OBJ}
{$L Uppers.Obj}
{$L SCREEN.OBJ}
{*Effectue une sauvegarde par octets de la région délimitée*}
Procedure ReadBuf(X1,Y1,X2,Y2:Byte;Var Buf);
External {Win_Box};
{*Dessine une image par octets sauvegardée par GetImage*}
Procedure WriteBuf(X1,Y1,X2,Y2:Byte;Var Buf);
External {Win_Box};
{*dessine un Rectangle aux coordonnées, le cadre peut être simple ou double*}
Procedure Rectangle(x1,y1,x2,y2:Byte;Var Cadre:CadreChars);
External {Win_Box};
{*inverse la région de l’écran délimitée par les coordonnées*}
Procedure HighBox(x1,y1,X2,Y2,Colori:Byte);
External {Win_Box};
{*remplit un rectangle avec un caractère déterminé (code ASCII)*}
Procedure BoxFill(x1,y1,X2,Y2:Byte;Ch:Char);
External {Win_Box};
Les routines external en langage assembleur doivent respecter certaines règles pour pouvoir fonctionner correctement :
Sélectionnez
;;*********************************************;;ExemplerésultatsurfonctiontypeString;;*********************************************CODE
SEGMENTBYTEPUBLICASSUMECS:CODEUppers
PROCNEAR;;FonctionUppers(S:String):String;StrResul
EQUDWORDPTR[BP+8]PUBLICUppersPUSHBPMOVBP,SPPUSHDSLDSSI,[BP+4];;chargel'adressedelachaîneLESDI,StrResul;;Chargel'adressedurésultatCLD;;indicateurdedirectionà0LODSB;;chargelalongueurdelachaîneSTOSB;;copiedansrésultatMOVCL,AL;;longueurdelachaînedansCXXORCH,CH;;metCHàzéroJCXZ@@1;;SautsiCX=0@@
2:LODSB;;chargecaractèredansAL,incrémenteSICMPAL,'a';;sautsicaractèredifférentdeJB@@3CMPAL,'z';;l'intervalle'a'à'z'JA@@3SUBAL,'a'-'A';;convertitenmajuscule@@
3:STOSB;;copiedansrésultatLOOP@@2;;boucletantquecxdifférentdezéro@@
1:POPDS;;dépileDSPOPBP;;dépileBPRet4;;retourdepile6octetsUppers
ENDP;;findeprocédureCODE
ENDSEND
Raccourcis de l'éditeur▲
Les raccourcis de éditeur (dits aussi accélérateurs) sont des combinaisons de deux ou de trois touches qui sont équivalentes à une commande du menu/éditeur sans nécessiter l'accès au menu. Les raccourcis pour les commandes suivantes de l'éditeur EDIT13 sont :
Mouvements du curseur
| Raccourci | Action |
| Ctrl-D ou Flèche Droite | Caractère à droite |
| Ctrl-A ou Ctrl-Flèche G. | Mot à gauche |
| Ctrl-F ou Ctrl-Flèche D. | Mot à droite |
| Ctrl-E ou Flèche Haut | Ligne précédente |
| Ctrl-X ou Flèche Bas | Ligne suivante |
| Ctrl-W | Défilement arrière |
| Ctrl-Z | Défilement avant |
| Ctrl-R ou PgUp | Page précédente |
| Ctrl-C ou PgDn | Page suivante |
| Ctrl-Q R ou Ctrl-PgUp | Début fichier |
| Ctrl-Q C ou Ctrl-PgDn | Fin fichier |
Insertion et Suppression
| Ctrl-V ou Inser | Insertion Oui/Non |
| Ctrl-Y | Suppression 1 ligne |
| Ctrl-H ou Backspace | Suppression caractère à gauche |
| Ctrl-G ou Suppr | Suppression caractère au curseur |
| Ctrl-K Y | Suppression bloc |
Commandes de blocs de texte
| Ctrl-K B | Marque début de bloc |
| Ctrl-K K | Marque fin de bloc |
| Shift + @ | Option Début Bloc |
| Shift + curseur | Définir le Bloc |
| Ctrl-K C | Copie du bloc |
| Ctrl-K Y | Suppression de bloc |
| Ctrl-K R | Lecture Bloc disque |
| Crtl-K W | Écriture Bloc disque |
| Ctrl-K H | Montre/Cache Bloc |
Raccourcis pour Menus
| Alt-F | Menu FILE |
| Alt-E | Menu EDIT |
| Alt-O | Menu OPTIONS |
| Alt-L | Menu LANG |
| Alt-M | Menu MATHS |
| F10 | Menu général de l'éditeur |
| Alt-X | Sortie de l'éditeur (Fin) |
| Ctrl-F9 | Insère la date courante |
| F1 | Help |
| F10 | Calculatrice |
| ESC | Fin ou termine |
Raccourcis Actions
| F1 | Active le système d'aide |
| F1 | sur aide index d'aide |
| F2 | Sauvegarde le fichier en cours |
| F3 | Charge un nouveau fichier |
| F7 | Suggestion Traduction Ang/Fran |
| F8 | Suggestion Traduction Fra/Ang |
| Ctrl-F1 | Place disponible dans l'éditeur |
| Alt-F2 | Change couleur du texte sur Edit |
| Alt-F3 | Chargement d'un des 8 derniers fichiers (liste Pick) |
| ALT-F6 | Alterne entre les deux derniers Fichiers |
| Alt-F7 | Ouverture du calculateur |
| Alt-F8 | Ouvre une boîte des codes ASCII |
| Alt-F9 | Ouvre une boîte des codes ASCII |
| Alt-F10 | Calculatrice |
| Ctrl-F10 | Ouvre la boîte de calcul de formule |
| Ctrl-F1 | Nombre de décimales |
Calculateur fonctions mathématiques
| PI(0) | 3.141592654 |
| ABS(nombre) | Valeur absolue |
| TAN(nombre) | Tangente |
| ATAN(nombre) | Arc tangente |
| COS(nombre) | Cosinus |
| EXP(nombre) | Exponentielle de nombre |
| LN(nombre) | Logarithme de nombre |
| ROUND(nombre) | Arrondi au réel le plus proche |
| SIN(nombre) | Sinus |
| SQRT(nombre) | Racine carrée de nombre |
| SQR(nombre) | Carré de nombre |
| TRUNC(nombre) | Enlever la partie décimale |
| RADIA(nombre) | Transformer en radians |
| ARSIN(nombre) | Arc sinus |
| ARCOS(nombre) | Arc cosinus |
| INT(nombre) | Retourne la partie entière |
| FRAC(nombre) | Retourne la partie fractionnaire |
| F2 | Save evaluate 1 |
| F3 | Save evaluate 2 |
| F4 | Save evaluate 3 |
| F5 | Evaluate 1 |
| F6 | Evaluate 2 |
| F7 | Evaluate 3 |
| Ctrl-F8 | copie de formule Evaluate |
Emploi de la souris dans l'éditeur▲
Depuis l'éditeur, cliquez sur le bouton droit de la souris pour sélectionner le menu choisi. Sélection dans le menu avec la souris, pour sélectionner une commande avec le clic gauche. Une fois sélectionné, pour ouvrir la sélection, positionnez-y la flèche de la souris, puis cliquez sur le bouton droit.
La sélection ne pourra s'ouvrir que si la souris se trouve sur la ligne en surbrillance. Pour fermer la sélection en cours avec la souris, appuyez sur le bouton gauche plus le bouton droit ; cela est équivalent à [Echap ou ESC], équivalent à [Ascii=#27].
Dans certaines parties des menus ou sous-menus, la souris ne fonctionne pas. Servez-vous des touches du clavier.
Dans n'omporte quelle partie de l'éditeur, la touche [Echap ou ESC] annule toujours l'opération en cours. La touche [Entrée] valide toujours une opération. Les touches du curseur permettent de se déplacer vers le haut, vers le bas, à gauche et à droite etc. La touche F10 ouvre toujours le menu général de l'éditeur.
Dans l'éditeur, vous ne trouverez pas de barre de défilement haut/bas et droite/gauche. Cette fonction est assurée par les bordures de l'éditeur elles-mêmes. Positionnez la souris sur la ligne et :
- la ligne Haut remonte le curseur ;
- la ligne Droite déplace le curseur à droite ;
- la ligne Bas descend le curseur ;
- la ligne Gauche déplace le curseur à gauche.
Codes ASCII (DOS) & ANSI (Windows)▲
Le MS-DOS emploie la page de code 850 Multilingue Latin I.
La page de code 850 est une page de code définie par IBM et qui est utilisée en Europe occidentale avec le système DOS et d'autres systèmes de la même époque. C'est une extension de l'ASCII sur 8 bits, partiellement compatible avec la page de code 437 dont elle est dérivée et qu'elle modifie. Elle est encore utilisée dans les fenêtres de type console ou invite de commandes sur les systèmes Microsoft Windows en Europe occidentale.
Table de codage standard Jeu de caractères codés ISO/CEI 646 (variante de la norme ANSI X3.4:1986 des États-Unis, alias US-ASCII) :
La page de code Windows-1252 ou CP1252 est un jeu de caractères, utilisé historiquement par défaut sur le système d'exploitation Microsoft Windows en anglais et dans les principales langues d'Europe de l'Ouest (dont le français).
Le tableau suivant montre Windows-1252. Les numéros 81, 8D, 8F, 90, et 9D ne sont pas utilisés et sont signalés par la couleur vert pâle. Les changements par rapport à ISO-8859-1 sont signalés par la couleur jaune :
Pour remédier au problème de l'existence de ces deux systèmes de codage sur EDIT13, il suffit d'écrire deux fonctions pour convertir les codes ASCII. Cela permet par exemple de lire un fichier créé par le Bloc-notes de Windows avec Turbo Pascal 7 pour le Dos. Dans la table ASCII, les codes 80h (128) jusque FFh (255) sont les caractères spéciaux ou accentués.
Turbo Pascal for Windows (TPW) peut lire les fichiers créés par le Bloc-notes de Windows mais il ne convertit pas les codes ASCII (128 à 255) MS-DOS 850 Multilingue Latin I des fichiers Turbo Pascal 7.
La gestion de fichiers▲
Il y a deux possibilités pour ouvrir un fichier. Par défaut, l'éditeur emploie le code Windows-1252. Utilisez le menu « FILE », pour ouvrir un fichier la sélection « LOAD » ou F3 et pour sauvegarder le fichier « SAVE » ou F2.
Si vous voulez ouvrir un fichier au format DOS avec code 850 multilingue latin I, sur le menu « EDIT » il y a deux sélections : pour ouvrir un fichier, « Load file DOS » et, pour sauvegarder un fichier, « Save file DOS ».
L' éditeur a été créé avec Turbo Pascal 7 donc le texte du buffer est en code DOS 850 multilingue latin I.
C'est l'unité ASCII qui transforme la ouverture et sauvegarde des fichiers, quel que soit le format.
Exemple 1 :
Vous pouvez ouvrir un fichier au format Windows et le sauvegarder au format DOS, ou vous pouvez ouvrir un fichier DOS et le sauvegarder au format Windows.
Mais l'éditeur est programmé par défaut avec le format code ASCII Windows. Si vous ouvrez un fichier (avec « LOAD » du menu « FILE ») au format DOS, les caractères spéciaux (àéèêîù etc) ne sont pas convertis au format Windows et si vous le sauvegardez (avec F2 ou « SAVE » du menu « FILE »), l'éditeur ne les convertit pas au format Windows.
Exemple 2 :
Pour pas modifier le code du fichier : si c'est un fichier DOS, il faut l'ouvrir avec le menu « EDIT » « Load file DOS » et le sauvegarder avec « Save file DOS » ; si c'est un fichier Windows, ouvrez-le avec le menu « FILE » « Load » ou F3, et sauvegardez-le avec « SAVE » ou F2.
Fonctions de conversion des tables ASCII MS-DOS et Windows de l'éditeur▲
Sélectionnez
unit Ascii;
interface
{---------------------------------------------------------------------}
{ convertit le code Windows ISO-8859-1 en code 850 Multilingue Latin I}
{ retourne les caractères de 128 a 255 }
{ cette fonction est employée pour sauvegarder les fichiers }
{---------------------------------------------------------------------}
fonction Code_ASCII_ANSI(_ss:char):char;
{---------------------------------------------------------------------}
{ procédure employée pour sauvegarder les fichiers, convertit le code }
{ Ascii en code ANSI Windows }
{---------------------------------------------------------------------}
Procédure Save_Fichier_win(D_isque,NeimeFic:String);
{--------------------------------------------------------------------------}
{ convertit le code code 850 Multilingue Latin I en code Windows ISO-8859-1}
{ Retourne les caractère de 128 a 255 }
{ Cette fonction est employée pour sauvegarder les fichiers Dos en fichiers}
{ compatibles ANSI Windows ISO-8859-1, les fichiers peuvent être lus par }
{ le bloc-notes de Windows }
{--------------------------------------------------------------------------}
function Code_ASCII_DOS(_ss:char):char;
{----------------------------------------------------------------------------}
{ Procédure employée pour ouvrir les fichiers code ANSI Windows et convertir }
{ en code Ascii 850 Multilingue Latin I }
{----------------------------------------------------------------------------}
Procedure Load_Fichier_Disque_win(Reper,Neime:String);
implementation
begin
code ……
end.
 | Sur Windows : Démarrer | Exécuter - ouvrir :
Sur MS-DOS :
|
Architecture de l'éditeur▲
Sélectionnez
{$N+}
{$M 16384,0,655360} {*réservation taille de la pile interne*}
PROGRAM EDIT13;
Uses {*Déclaration des unités contenant des procédures & fonctions*}
Label ErreurFin; {*Les labels sont utilisés comme cibles pour des instructions GOTO*}
{*Déclaration des constantes publiques*}
Const
DelayMouse:integer=2000;
Disk_Dur_C:string[70]=' ';
…… etc.
{*Déclaration des variables publiques*}
Var STOP : boolean;
StrDate : string;
…… etc.
{*Déclaration de procédures & fonctions*}
{*Procédures diverses*}
Procédures P_Edit {*procédure principale*}
Label Key_Fin; {*label interne à la procédure*}
var x1,y1 : byte;
KeyChoix : word;
…… etc.
Début
……
……
Fin_début;{*end P_edit*}
Début_Programme {**Début du Programme EDIT13**}
Stop:=false;
Si InitMouse Alors Affiche('Mouse active..');
Sinon
Goto ErreurFin; {*erreur fin du programme*}
{*Initialisation des variables de l'éditeur EDIT13**}
Extension :='.txt';
Fin_Programme:=False;
……etc.
{*Initialisation variable répertoire actif*}
GetDir(0,Disq);
Disque_2:=Disq[1]+Disq[2];
Si Disq[length(Disq)]<>'\' Alors Repertoire:=Disq+'\'
Sinon Repertoire:=Disq;
{*Initialise des derniers fichiers employes*}
Init_PicK;
{*Activation des pointeurs en mémoire virtuelle*}
size_plus:=512;
size_Plus:=size_plus+Size_Buf_Texte; {*taille*}
GetMem(BufTexte,size_plus); {*activation*}
……
…… etc.
{*Initialise le fichier/variable dernière utilisation*}
Init_Color(Repertoire+'FILES\EDIT13.INI');
Init_Pick_Mode(1);
Initialiser; {*Initialise variables début programme*}
Affiche_Menu;{*affiche l'éditeur*}
info_debut_program(10,8);
Execute_File; {*ouvre le dernier fichier utilisé*}
StyleMouse(2,14); {position du pointeur de la souris*}
P_Edit; {*Procédures principales de l'éditeur*}
{*Sauvegarde sur fichier init variable dernière utilisation*}
Init_Pick_Mode(0);
ErreurFin:
{*Supprime les pointeurs de la mémoire virtuelle*}
Si BufTexte<> NIL Alors FreeMem(BufTexte,size_plus);
……
……
etc.
TextAttr:=7;
Clrscr;
Halt(1);
Fin_programme_edit13. {*fin du programme de l'éditeur*}
Principales procédures de l'éditeur▲
Sélectionnez
Procedure Change_Inser_Mode;
Procedure Initialiser;
Procedure Affiche_Menu;
Procedure Load_Fichier_Disque(Reper,Neime:String);
Procedure Load_Fichier_Disque_win(Reper,Neime:String);
Procedure Save_Fichier_Win(D_isque,NeimeFic:String);
Procedure Save_Fichier_Disque(D_isque,NeimeFic:String);
Procedure Efface_Block;
Procedure Defini_Bloc;
Procedure Init_Page;
Procedure Positione_Curseur(X1:byte);
Procedure Fin__Ligne_X;
Procedure Debut__Ligne_X;
Procedure Avance_Page_X_de_1;
Procedure Recule_Page_X_de_1;
Procedure Curseur__FinLigne;
Procedure Premiere_page_Debut(Pose:Word);
Procedure Change_Une_Page_Bas(Pose:Word;FindLines:Word);
Procedure Change_Une_Page_Haut(Code:Char);
Procedure Lecture_Une_Ligne_Bas(Pose:Word;code:Char);
Procedure Lecture_Une_Ligne_Haut(Pose:Word);
Procedure Curseur_Droite;
Procedure Curseur_Gauche;
Procedure Debut_ligne_Gauche;
Procedure Curseur___bas;
Procedure Curseur_Haut;
Procedure Avance_Une_Page;
Procedure Recule_Une_Page;
Procedure Fin_du_Fichier;
Procedure Debut_Du_Fichier;
Procedure Save_Ligne_Curseur(Poss:Word);
Procedure Load_Ligne_Curseur(Poss:Word);
Procedure Del_Gauche;
Procedure Del_Droite;
Procedure Del_FinLigne;
Procedure Del_Line;
Procedure Tab_Deplace;
Procedure Inserer_Ligne;
Procedure Inser_Char(Car:Char);
Procedure Avance_Page;
Procedure Recule_Page;
Procedure mot_suivan(pos:Word);
Procedure mot_Avan(pos:Word);
Procedure Donne_Position_XY(Var x,y:Word;Pose:Word;mode:Char);
Procedure Control_Longueur_DE_Lignes(Poss,Pose2:Word);
Function Erreur_file_Toolarge(Nom:String;Sizee:Longint;Code:Char ):Boolean;
Function Erreur_limite_Buf(code:char):Boolean;
Function FileExists(F,N : String) : Boolean;
Function _Fichiers_Dir(Var Directori:String; Texte_Load:String):String;
Procedure Change_Directori(RR:String);
Procedure Write_Block_Fic;
Procedure Block_Load_Fic;
Procedure CtrL_K;
Function Verify_Reper(Var Reper,S:String):Boolean;
Function Verify_Rep_Fic(Var Reper,Neime:String):Boolean;
Procedure CopyBlock__B(Debut_Pos,decale:Word);
Procedure CopyCopyBlock(decale:Word);
Procedure Coup_block;
Procedure LireTexte(Reper,Neime:String);
Function Selecte_Attr(Attribut:Word):Word;
Procedure Change_Attribut;
Procedure Cherche_Marque(pos:Word);
Procedure Change_Block(Signe:Char;Poss:Word;Deplace:integer);
Procedure Shift_Bloc(xxw:Word);
Procedure Cherche_position_de_XY(PosePose:Word);
Procedure Dir_Nom_Help;
Procedure Change_Repertoire_Langage(Fond__Box:byte);
Unites du programme éditeur de texte EDIT13▲
Unit Type_Buf▲
Sélectionnez
{========================================================}
{ EDit13 version 4.002e units buffers d'éditeur de texte }
{ Copyright (S) 1997-2012 programmeur du logiciel A.Ara }
{ Licence d'utilisation accord dans un but démonstratif }
{ la vente du logiciel et interdite. }
{ Numéro de série 00-441-7441-B21111946bb }
{========================================================}
{$O+,F+}
Unit Type_Buf;
Interface {**Types publics buffers de l'éditeur**}
Const
Max_Buffer=51200; {50ko buf actuel}
Max_Buffer_Copy=5120; {5ko}
Type
Str12 = String[12];
{**pointeur de liste de fichiers Load dir**}
ListePtr = ^L_ptr;
L_Ptr = Record
Num:Integer;
Nom:Str12;
Avan,Suivan:ListePtr;
End;
{**pointeur buffer de l'éditeur**}
Edit_Buffer = Array[1..Max_Buffer+512] of Char;
Buf_Ptr = ^Edit_Buffer;
{**pointeur buffer pour la copy de block ou lignes**}
Copy_Edit_Buffer = Array[1..Max_Buffer_Copy+512] of Char;
Copy_Buf_Ptr = ^Edit_Buffer;
{**buffer de ligne de messages**}
Ligne__Copy = Array[1..254] of char;
Ligne_Copy = ^Ligne__Copy;
Var
Buffer : Buf_Ptr; {*Buffer de l'Editeur *}
Copy__Buffer : Copy_Buf_Ptr; {*Buffer de Blocs Copy *}
CopyLigne : Ligne_Copy; {*ligne du curseur *}
Implementation
Begin
Buffer:=Nil;
Copy__Buffer:=Nil;
CopyLigne:=Nil;
End.
Unit Buff_Tex▲
Sélectionnez
{$O+,F+}
Unit Buff_Tex;
Interface
{====================================================}
{* pointeur du buffer file aide (help) de l'éditeur *}
{====================================================}
Const Size_Buf_Texte= 30720;
Type
Buf___Ptr = Array[1..Size_Buf_Texte] of char;
Var
size_plus : word;
BufTexte : ^Buf___Ptr;
Implementation
End.
Unit Buffs▲
Sélectionnez
{$O+,F+}
Unit Buffs;
Interface
{===============================================================}
{*declaration des pointeurs publiques pour le menu de l'editeur*}
{===============================================================}
Var
LinePtr :Pointer; {*buffer de une ligne pour mesajes*}
SizeLinePtr :Word; {*Buffer de une Ligne*}
Menu_Buf : Pointer; {*buffer Menu*}
Size_Menu_Buf : Word;
Sub_Buf : pointer; {*Sub menus Buffer}
Size_Sub_Buf : Word;
BuffDir : Pointer; {*buffer Dir*}
SizeDir : Word;
Buff_cal : Pointer; {*buffer calcul*}
SizeCal : Word;
Implementation
End.
Unit CrtKey▲
Sélectionnez
{========================================================}
{ EDit13 version 4.002e unit Crtkey d'éditeur de texte }
{ Copyright (S) 1997-2012 programmeur du logiciel A.Ara }
{ Licence d'utilisation accord dans un but demonstratif }
{ la vente du logiciel et interdite. }
{ Numero de serie 00-441-7441-B21111946bb }
{========================================================}
{*Modification l'ensemble constantes Letters et touches de l'editeur*}
{$O+,F+}
Unit CrtKey;
Interface
CONST
Ordinateur486:Boolean=TRUE;
Letre : set of Char = ['A'..'Z', 'a'..'z', '{'..'¯',#27];
Number : set of Char = ['0'..'9',#27];
Qui_Nom: set of char = ['Y','y','N','n',#27];
Cherche_Letre :Set Of Char =['A'..'Z','a'..'z','0'..'9','%'];
Cherche_Letre_texte :Set Of Char =['A'..'Z','a'..'z','0'..'9'];
NULL = 0;
SOH = 1;
BS = 8;
CD1 = 17;
VT = 11;
FF = 12;
CR = 13;
ESC = 27;
HT = 9;
SI = 3840;
F1 = 15104; F2 = 15360; F3 = 15616; F4 = 15872;
F5 = 16128; F6 = 16384; F7 = 16640; F8 = 16896;
F9 = 17152; F10 = 17408;
CtrlF1 = 24064; CtrlF2 = 24320; CtrlF3 = 24576; CtrlF4 = 24832;
CtrlF5 = 25088; CtrlF6 = 25344; CtrlF7 = 25600; CtrlF8 = 25856;
CtrlF9 = 26112; CtrlF10 = 26368;
Ctrl_T = 20;
AltF1 = 26624; AltF2 = 26880; AltF3 = 27136; AltF4 = 27392;
AltF5 = 27648; AltF6 = 27904; AltF7 = 28160; AltF8 = 28416;
AltF9 = 28672; AltF10 = 28928;
CtrlAltF1 = 26624; CtrlAltF2 = 26880; CtrlAltF3 = 27136;
CtrlAltF4 = 27392; CtrlAltF5 = 27648; CtrlAltF6 = 27904;
CtrlAltF7 = 28160; CtrlAltF8 = 28416; CtrlAltF9 = 28672;
CtrlAltF10 = 28928;
{ *Inser* *debut* *page Haut* *page haut Ctrl*}
InsKey = 20992; HomeKey = 18176; PgUpKey = 18688; CtrlPgUp = 33792;
DelKey = 21248; EndKey = 20224; PgDnKey = 20736; CtrlPgDn = 30208;
{ *Suppr* *Fin* *page bas* *page bas Ctrl*}
{*key Fleche H*} UpKey = 18432;
{*key Fleche G*} LeftKey = 19200;
{*key fleche D*} RightKey = 19712;
{*key Fleche B*} DownKey = 20480;
{*fleche G ctrl*} CtrlLeftKey = 29440;
{*fleche D ctrl*} CtrlRightKey = 29696;
{*Alt-X *} AltX = 11520;
Alt_F = 8448;
Alt_L = 9728;
Alt_E = 4608;
Alt_H = 8960;
Alt_B = 12288;
Alt_O = 6144;
Alt_D = 8192;
Alt_G = 8704;
Alt_M = 12800;
Alt_C = 11776;
Alt_T = 5120;
AutoKey =253;
Type CharSet = set of Char;
Function GetKey : Word;
Implementation
Uses Crt;
{==================================================================}
{ Sortie: Renvoie la valeur de la touche et gere les codes étendus }
{==================================================================}
Function GetKey : Word;
var Ch : char;
begin
Ch := ReadKey;
if Ord(Ch) = NULL then {*Caractere étendu*}
GetKey := Word(Ord(ReadKey)) shl 8
else
GetKey := Ord(Ch); {*Caractere normal*}
end; {*ends GetKey*}
End.
Unit Get_Key▲
Sélectionnez
{==============================================================}
{* Unit Getkey: KeyBoard:Byte; Renvoie la valeur de la touche *}
{* et gere les codes étendus Shift Ctrl Alt F1 à F10 *}
{==============================================================}
{$O+,F+}
Unit Get_Key;
Interface
Const Shift_D:Boolean=False;
Shift_G:Boolean=False;
Ctrl:Boolean=False; {*press key Ctrl*}
Alt:Boolean=False; {*press key Alt*}
Inser_mode:Boolean=True; {*press key Inser*}
Key_Code:Boolean=False; {*code clavier etendue*}
Function KeyBoard:byte;
Procedure Beep;
Implementation
uses crt,Dos;
var Reg_DOS:Registers;
Procedure Beep; {*Genere un bip grave*}
begin
Sound(4071);
Delay(50);
NoSound;
end;{*ends Beep*}
Function KeyBoard:Byte;
var ch:Char;
begin
Reg_DOS.AX:=$0C00;
MsDos(Reg_DOS);
ch:=Readkey;
if Mem[0:$417] and 128 = 128 Then Inser_Mode:=True
Else Inser_mode:=False;
if Mem[0:$417] and 8 = 8 Then Alt :=True
Else Alt:=False;
if Mem[0:$417] and 4 = 4 Then Ctrl:=True
Else Ctrl:=False;
if Mem[0:$417] and 2 = 2 Then Shift_G:=True
Else Shift_G:=False;
if Mem[0:$417] and 1 = 1 Then Shift_D:=True
Else Shift_D:=False;
if (ch = #0) then
begin
KeyBoard:=Ord(Readkey);
Key_Code:=True;
end
else
begin
KeyBoard:=ord(ch);
Key_Code:=False;
end;
End; {*ends keyBoard*}
End.
Unit Inser_ch▲
Le mode INSERT permet d'insérer les caractères entrés au clavier à la position du curseur. Le texte à la droite du curseur est déplacé automatiquement vers la droite pour faire place au texte inséré.
Le mode NON-INSERT permet d'entrer directement un caractère nouveau sur un ancien texte à la position du curseur. Ceci est surtout pour la modification et la suppression de texte.
L'insertion d'un bloc d'autres applications récupère les données provenant d'un autre fichier texte, sans nécessité de le rentrer au clavier. L'exportation permet d'écrire un bloc sur un nouveau fichier texte.
Sélectionnez
{*-----------------------------------------------------------------------------------*}
{* Unite Inser_ch.blc, Erreur Line pleine demamde de insertion de une nouvelle ligne *}
{* et position du curseur au debut de ligne *}
{*-----------------------------------------------------------------------------------*}
Procedure Erreur_Inser; {* Erreur de limite de Ligne *}
Begin
Putxy(2,3,'Line too long inserted - CR canteen: (Y / N) ');
Repeat
Ch:=ReadKey;
Until Upcase(Ch) in ['Y','N'];
if Upcase(Ch)='Y' Then
Begin
Inserer_Ligne;
Positione_Curseur(X);
End;
End;{*ensd*}
{*--------------------------------------------------------------------*}
{* Entrée : caractere ASCII, Insere un caractere a la fin de la ligne *}
{*--------------------------------------------------------------------*}
Procedure Inserer_Char_Fin_Ligne(Ch:Char);
Begin
Decalage:=(X_Curseur-End_Ligne)+1;
{*Insere le caractere dans le buffer*}
Inc(End_Ligne,Decalage);
{*Affichage du caracter a l'ecran*}
Curseur_Droite;
End;{*ends de Inserer_Char__fin_Ligne*}
{*-------------------------------------------------------------------*}
{* le mode: Inser Mode actif, insere un caractere ASCII sur la ligne *}
{* et déplace le texte de la ligne de une position à droite *}
{*-------------------------------------------------------------------*}
Procedure Inserer_Char(Ch:Char);
Variable i:Byte;
Commencer
Si X_curseur < Max_colones Alors
Début
Readbuf(E_CurseurX+1,Y_curseur+3,Max_CurseurX,Y_curseur+3,LinePtr^);
Writebuf(E_CurseurX+2,Y_curseur+3,Max_CurseurX,Y_curseur+3,LinePtr^);
Fin;
ScreenPtr^[Y_curseur+3,E_curseurX+1].data:=Ch;
{**deplace de 1 a droite a partir de X_curseur**}
{**jusque la fin de ligne, Inser le caractere a la place de Curseur**}
Déplacer (CopyLigne^[X_curseur],CopyLigne^[X_curseur+1],(End_ligne-X_curseur)+1);
CopyLigne^[X_curseur]:=Ch;
Inserer 1 à (End_ligne);
Inserer 1 à (Fin_Ligne[Y_Curseur].ecran);
Déplacer(ScreenPage^[Y_curseur+3,X_curseur],ScreenPage^[Y_curseur+3,X_curseur+1],
(Max_colones-X_curseur)*2);
ScreenPage^[Y_curseur+3,X_curseur].data:=Ch;
Curseur_Droite;
Modif_Ligne:=True;
Fin_procedure; {*fin Inserer_Char*}
Unit Var_1▲
Sélectionnez
{========================= EDIT13 ======================}
{*EDit13 version 4.002e units buffers d'éditeur de texte*}
{*Copyright (S) 1997-2012 programmeur du logiciel A.Ara *}
{*Licence d'utilisation accord dans un but demonstratif *}
{*la vente du logiciel et interdite. *}
{*Numero de serie 00-441-7441-B21111946bb *}
{========================================================}
{$O+,F+}
Unit Var_1;
Interface {*Types publiques de Variables destines a l'editeur edit13*}
Const max_colones = 154;
Longueur_Lignes = Max_colones-1;
Fleches = Chr(24)+Chr(25)+Chr(27)+chr(26);
FlechesHB = Chr(24)+Chr(25);
mode_ANSI : boolean = false;
Type Position_Fin_Lignes = Record
Buf:Word;
Ecran:Byte;
End;
Var
Extension:String[4];
_Save_Fichier:Boolean;
Ins_Ok:Boolean; {*si ins_ok = false le buffer et plein*}
Langage:String[4];
Change_Find:Boolean;
Max_Pick:Byte;
Max_Limite:Word;
Fin_Programme:Boolean;
Max_CurseurX:Byte; {*position max de ecran Horizontale*}
Max_CurseurY:Byte; {*position max de verticale*}
Debut_Page_Marque_Bloc:Word; {*debut de page ou se trouve debutblock*}
Line_Bloc:Word; {*line de la page du debutBloc*}
SuppBlock:Boolean; {*suprime le block dans l'editeur*}
CopierBlock:Boolean; {*copier le block dans l'editeur*}
{*****************Retours de menus*****************}
Retur0,Retur1,Retur2,Retur3,Retur4,Retur5:Byte;
ReturVerbe,Retur6:Byte;
ReturCNC:Byte;
longligne:Byte; {*nonbre de caracteres de la ligne du Buffer*}
End_Ligne:Byte;
Pos_Ligne:Word; {*position de la ligne de travail*}
Modif_Ligne:Boolean; {*True si la ligne … ete modifie *}
Change_de_Ligne:Boolean;
Debut_Page: Word; {*position dans le buffer du 1ø caractere de page*}
Fin_page : Word; {*pos Buffer dernier caractere+1 derniere ligne*}
X_curseur :Byte; {*position du curseur X actuelle *}
E_CurseurX:Byte; {*position du curseur dans l'ecran*}
Y_curseur :Byte; {*position du curseur Y actuelle *}
FinY :Byte; {*position de Y derniere ligne *}
Line_Curseur:Word; {*conte les lignes du Fichier *}
StrFind :String; {*chaine de recherche *}
Remplace :String; {*chaine de remplacement de recherche}
Contelines:Word; {*contage de lignes pour find *}
Disque_2:String[2]; {*nom du disque de travail C: ou a:*}
NomFic:String; {*Nom du fichier*}
Disque_Nom:String; {*Nom du disque ou Repertoire du Fichier}
DebutBlock : Word; {*debut Block marque *}
FinBlock : Word; {*fin Block marque *}
Fin_Buffer : Word; {*Fin Buffer *}
Marque_bloc: Boolean; {*bloc marque *}
Max_Block : Word; {*cantite du bloc marque*}
Copy_Exemples:Boolean;
DebutDAF :Word;
FinDAF :Word;
BlockDAF :Word;
{=========================================================}
{ Fin_Ligne[y..].Buf Contien la position du buffer }
{ de denier caractere+1 de la ligne qui et egale chr(13) }
{ }
{ Fin_Ligne[y..].Ecran la position de ecran de dernier }
{ caractere+1 affiche }
{=========================================================}
Fin_Ligne:Array[1..50] Of Position_Fin_Lignes;
{*Declarations de M_Edit1.pas Menus general*}
NotOutEspace:Boolean;
TexteLoad :String; {*texte pour load fichier menu file*}
Texte_Dire :String; {*Directorie Actuel*}
Disque_Dire:String; {*Repertoire du fichier en cours*}
Repertoire :String; {*Repertoire actuel utilise*}
BlockNeime :String; {*Nom Fic du Bloc pour ReadBloc/WriteBloc*}
BlockRepe :String; {*Repertoire du Bloc pour ReadBloc/WriteBloc*}
NeimeAttr :String; {*Nom fic et repertoire fic change Attribut*}
ReperAttr :String;
Disq :String;
Nom_Fichier:String[12];
Disque_help:String;
Nom_Help :String;
X_Pick :Byte;
Y_Pick :Byte;
Page_Pick :Word;
Line_Pick :Word;
Implementation
Begin
NotOutEspace:=True;
Fin_Programme:=False;
Max_Pick:=1;
Max_Limite:=30700;
Ins_Ok:=True; {*si ins_ok = false le buffer et plein*}
Langage:='PAS:';
Change_Find:=False;
Debut_Page_Marque_Bloc:=1; {*debut de page ou se trouve debutblock*}
Line_Bloc:=1; {*line de la page du debutBloc*}
SuppBlock:=False; {*suprime le block dans l'editeur*}
CopierBlock:=False; {*copier le block dans l'editeur*}
X_Pick:=1;
Y_Pick:=1;
Page_Pick:=1;
Line_Pick:=1;
Max_CurseurX:=78; {*position max de ecran Horizontale*}
Max_CurseurY:=21; {*position max de verticale*}
Pos_Ligne:=1; {*numero de ligne actul*}
Modif_Ligne:=False; {*True si la ligne … ete modifie*}
Change_de_Ligne:=False;
Debut_Page:=1; {*position dans le buffer du 1ø caractere 1ø ligne*}
Fin_page :=1; {*pos Buffer dernier caractere+1 derniere ligne*}
X_curseur :=1; {*position du curseur X actuelle*}
E_CurseurX:=1;
Y_curseur :=1; {*position du curseur Y actuelle*}
FinY :=1; {*position de Y derniere ligne de la page*}
Line_Curseur:=1; {*conte les lignes du fichier*}
StrFind :=''; {*chaine de recherche*}
Remplace :=''; {*chaine de remplacement de recherche*}
Contelines:=0; {*contage de lignes pour find*}
Disque_2:='';
NomFic:='NONAME.???'; {*Nom du fichier*}
Disque_Nom:=''; {*Nom du disque ou Repertoire du Fichier*}
TexteLoad :=''; {*texte pour load fichier menu file*}
Texte_Dire :=''; {*Directorie Actuel*}
Disque_Dire:=''; {*Repertoire du fichier en cours*}
Repertoire :=''; {*Repertoire actuel utilise*}
BlockNeime :=''; {*Nom Fic du Bloc pour ReadBloc/WriteBloc*}
BlockRepe :=''; {*Repertoire du Bloc pour ReadBloc/WriteBloc*}
NeimeAttr :=''; {*Nom fic et repertoire fic change Attribut*}
ReperAttr :='';
Disq :='';
Nom_Fichier:='';
Disque_help:='';
Nom_Help :='';
X_Pick :=1;
Y_Pick :=1;
Page_Pick :=1;
Line_Pick :=1;
DebutBlock:=0; {*debut Block marque*}
FinBlock :=0; {*fin Block marque*}
Fin_Buffer:=1;
Marque_bloc:=False; {*bloc marque*}
Max_Block:=0;
Retur0:=1;
Retur1:=3;
Retur2:=3;
Retur3:=3;
Retur4:=3;
Retur5:=3;
Retur6:=3;
ReturVerbe:=5;
ReturCNC:=6;
Copy_Exemples:=False;
DebutDAF :=0;
FinDAF :=0;
BlockDAF :=0;
End.
Programme principal▲
Sélectionnez
{==================Programm Edit13.pas===================}
{*Edit13 version 4.002e units buffers d'éditeur de texte*}
{*Copyright (S) 1997-2012 programmeur du logiciel A.Ara *}
{*Licence d'utilisation accord dans un but demonstratif *}
{*la vente du logiciel et interdite. *}
{*Numero de serie 00-441-7441-B21111946bb *}
{========================================================}
{$N+}
{$M 16384,0,655360}
PROGRAM EDIT13;
Uses Overlay,init13, {*unite INIT13 initialise les overlais*}
Crt,Dos,
Buff_Tex, {ok}
Buffs, {ok}
Box13, {ok}
Get_Key, {ok}
H_HElp, {ok}
Var_1, {ok}
Type_Buf, {ok}
C_Read, {ok}
H_Aide, {ok}
U_Pick, {ok}
H_Calcul, {ok}
Gaff2011, {ok}
CrtKey, {ok}
Types_11, {ok}
NN_Tinst, {ok}
Recher, {ok}
F_Calcul, {ok}
NUMMOUSE, {ok}
H_Maths, {ok}
Traduc, {ok Traduction Fran‡ais Anglais voir bas page infos *}
Menu_2, {ok utilitaire de fichier MenuEdi.pas *}
Ascii, {ok load/save files conversion code ANSI Dos/windows *}
Udate; {ok}
{$O Buff_tex}
{$O Buffs}
{$O Box13}
{$O Get_Key}
{$O H_Help}
{$O Var_1}
{$O Type_Buf}
{$O C_Read}
{$O H_AIDE}
{$O U_Pick}
{$O H_Calcul}
{$O Gaff2011}
{$O CrtKey}
{$O Types_11}
{$O NN_Tinst}
{$O Recher}
{$O F_Calcul}
{$O NUMMOUSE}
{$O H_Maths}
{$O Traduc}
{$O Menu_2}
{$O Ascii}
{$O Udate}
Label ErreurFin,ErreurNomOriginal;
Const ExtraSize =37888;
Mouse1 =256; {*255+1*}
Mouse2 =257; {*2+255*}
Mouse3 =258; {*3+255*}
DelayMouse:integer=2000;
Disk_Dur_C:string[70]=' ';
{===============================================================}
{ largueur del editeur Maximun 154 colones (Max_curseurX*2)-2 }
{===============================================================}
Var
f_f_f_f : FILE;
StrCalcul : string;
StrResult : string;
ix,iy : Word;
CurseurDebutX : byte;
Find_Valeur : byte;
Sxx1,Sxx2 : string;
Erreur1 : integer;
Entree1 : boolean;
S_etat : string[5];
STR20 : string;
Nxx1,Nbr2 : integer;
PoseMot : Word;
X_Car : char;
Rep_Fic : string;
ST2,Rep_Hlp : string;
STOP : boolean;
StrDate : string;
Options_Remplace : string; {*U-et-N*}
{========sur Menu_2.pas============}
{* NbrLignes : Word; *}
{* FondBox : byte; *}
{* Function P_New:byte; Forward; *}
{* {sI P_Teste.blc} *}
{* Shif_Blo.Pas sur Type11.pas *}
{==================================}
Procedure P_Save(yy:byte;typeform:string); Forward;
Procedure Execute_File;Forward;
{$I Finds2.pas} {*block de remplacement*}
{$I Finds1.pas} {*block de recherche*}
{$i Dx1.pas} {*Dictionaire traduction de un bloc*}
Procedure CtrL_Q;
var n,Key1:byte;
begin
Putxy(2,3,'^Q');
Posxy(4,3);
Key1:=KeyBoard;
Putxy(2,3,' ');
Case Key1 Of
{F} 6,102,70: Cherche_Bas(63);
{A} 1,97,65: Cherche_Bas(98);
{C} 99,3: Fin_DU_Fichier;
{R} 114,18: Debut_DU_Fichier;
49,50,51,52: if Not Key_Code then {*marqueur de 1..4*}
begin
Case Key1 Of
49: n:=1;
50: n:=2;
51: n:=3;
52: n:=4;
end;
if (Pose_Marque[n]>0) And
(Pose_Marque[n]<=Fin_Buffer) then
Cherche_Marque(Pose_Marque[n])
else
if Pose_Marque[n]>Fin_Buffer then
Pose_Marque[n]:=0;
end;
end; {*case*}
end; {*ends CtrL-Q*}
{$i MenuEdi.pas} {*fichier insere menu de editeur*}
Procedure Change_Fichier_Avan;
var Fin:boolean;
begin
Fin:=False;
if _Save_Fichier then
begin
TextAttr:=Menu_Color;
if P_New<>69 then Fin:=True;
TextAttr:=Edit_Color;
if (Not _Save_Fichier) and (NomFic<>'NONAME.???') then
begin
Tab[1].Rtime:=FileDate(Tab[1].NomR+Tab[1].NomF);
if X_Curseur<=Fin_ligne[Y_Curseur].ecran then
Tab[1].PosX:=X_Curseur
else
Tab[1].PosX:=Fin_ligne[Y_Curseur].ecran;
Tab[1].PosY:=Y_Curseur;
Tab[1].PageDebut:=Debut_Page;
Tab[1].Ligne:=Line_Curseur;
Tab[1].Marque:=Pose_Marque;
end;
end;
if Not Fin then
begin
TextAttr:=Edit_Color;
Initialiser;
BoxFill(2,4,79,CrtGetMaxY-1,' ');
NomFic:=Tab[2].NomF;
Disque_Nom:=Tab[2].NomR;
if NomFic<>'NONAME.???' then
begin
Load_Fichier_Disque_win(Disque_Nom,NomFic);
end;
if NomFic<>'NONAME.???' then
begin
Reinit_Pick(Disque_Nom,NomFic);
if X_curseur<Max_curseurX then E_curseurX:=X_curseur
else E_curseurX:=Max_curseurX-1;
if Debut_Page>=Fin_Buffer then
begin
Debut_Page:=1;
Y_curseur:=1;
Line_Curseur:=1;
X_curseur:=1;E_curseurX:=1;
end;
Premiere_Page_Debut(Debut_Page);
if (Y_curseur>FinY) then
begin
Dec(Line_Curseur,(Y_curseur-FinY));
Y_curseur:=FinY;
end;
end;
end;
end; {*ends Change_Fichier_Avan*}
Function LireMotXX:string;
var S:string;
Pose:Word;
begin
Pose:=0;
ix:=0;
if X_curseur<Fin_Ligne[Y_curseur].ecran then
begin
S:='';
pose:=(Fin_ligne[Y_curseur].buf-Fin_ligne[Y_curseur].ecran)+X_curseur;
ix:=0;
if Pose>Fin_Buffer then Pose:=Fin_Buffer;
if pose>1 then
begin
while (POSE>1) And (Buffer^[pose-1] In Cherche_Letre_texte) DO
begin
Dec(Pose);
Inc(ix);
end;
PoseMOt:=Pose;
end
else
Pose:=1;
if Pose>Fin_Buffer then Pose:=Fin_Buffer;
while (Pose<Fin_Buffer) And (Buffer^[pose] In cherche_Letre_texte) DO
begin
if Buffer^[pose] In cherche_Letre_texte then S:=S+Buffer^[pose];
Inc(pose);
end;
if s='' then PoseMot:=0;
LireMotXX:=S;
end
else
begin
LireMotxx:='';
PoseMot:=0;
end;
end; {*ends LireMotXX*}
{$i FuncEdit.pas} {*fuctions de P_Edit*}
Procedure P_Edit;
Label Key_Fin;
var x1,y1:byte;
KeyChoix:Word;
Info_Pick2:Reg_Pick;
Action_function:byte;
begin
Action_function:=0;
{R1} Repeat
Window(1,1,80,CrtGetMaxY);
Window(2,4,79,CrtGetMaxY-1);
{*Mouse*}
WindowMouse(1,1,CrtGetMaxX,CrtGetMaxY);
Mousexy(3,3);
if (((Find_Valeur in[63,98,62]) And (StrFind<>'')) OR (Find_Valeur=255)) then
begin
Case Find_Valeur Of
{Cherche} 63: Cherche_Bas(163);
{Remplace} 98: Cherche_Bas(198);
{Ctrl-L} 62: begin
if StrFind<>'' then
begin
Beep;
ConteLines:=0;
Cherche_Bas(62);
end;
end;
end; {*ends case*}
Find_Valeur:=0;
end;
{R2} Repeat
TextAttr:=Etat_Color;
if Line_Curseur=0 then Line_Curseur:=1;
Str(Line_Curseur:5,S_etat);
Putxy(11,3,S_Etat);
Str(X_Curseur:2,S_Etat);
Putxy(23,3,S_etat+' ');
if Inser_Mode then Putxy(28,3,'Insert')
else Putxy(28,3,' ');
PutXy(58,3,' ');
PutXy(58,3,Disque_2+NomFic);
TextAttr:=Edit_Color;
Gotoxy(E_CurseurX,Y_curseur);
{*ends etat*}
if change_de_ligne then
Pos_ligne:=(Fin_Ligne[Y_Curseur].buf-Fin_ligne[Y_Curseur].ecran)+1;
DisplayMouse;
KeyChoix:=GetKeyMouseWord;
MasKMouse;
if (Shift_G OR Shift_D) And ((KeyChoix=RightKey) OR (KeyChoix=DownKey)) then
begin
Shift_Bloc(KeyChoix);
Goto Key_Fin;
end
else
{case1} Case KeyChoix OF
{*Alt-F9*} AltF9: Begin {*table ASCII 850 latin 1*}
Window(1,1,80,CrtGetMaxY);
ReadBuf(36,4,37+41,4+18,BuffDir^);
TableAscii(37,4);
WriteBuf(36,4,37+41,4+18,BuffDir^);
Window(2,4,79,CrtGetMaxY-1);
Goto Key_Fin;
End;
{*Alt-F8*} AltF8: Begin {*table ASCII 850 latin 1*}
ReadBuf(36,4,37+41,4+18,BuffDir^);
TableAscii_win(37,4);
WriteBuf(36,4,37+41,4+18,BuffDir^);
Goto Key_Fin;
End;
{*Alt-F10*} AltF10: begin
TextAttr:=Menu_Color;
ReadBuf(50,4,52+26,5+11,BuffDir^);
BoxColor(52,5,52+26,5+11,FondBox);
Calculatrice(50,4,Calculatrice_S2,Calculatrice_S3,Calculatrice_Total,Calculatrice_TotalM);
WriteBuf(50,4,52+26,5+11,BuffDir^);
TextAttr:=Edit_Color;
Goto Key_Fin;
end;
32..255: begin
Inser_char(Chr(KeyChoix));
{*Si mouse se trouve sur position de inserer*}
if (MouseY-3=Y_curseur) and (MouseX=X_curseur) then
Mousexy(MouseX-1,MouseY);
Goto Key_Fin;
end;
{del-G} BS: begin
if (X_Curseur<=Fin_Ligne[Y_Curseur].ecran) then
Del_Gauche
else Curseur_Gauche;
Goto Key_Fin;
end;
{tab->} HT: begin
Tab_Deplace;
Goto Key_Fin;
end;
{Suppr} 7,DelKey: begin
{Ctrl-G} if (X_Curseur<Fin_Ligne[Y_Curseur].ecran) then
Del_Droite
else
if (X_Curseur=Fin_Ligne[Y_Curseur].ecran) then
begin
if ((Fin_Ligne[Y_Curseur].ecran+
Fin_Ligne[Y_Curseur+1].ecran)<Max_Colones) And
(Y_curseur<FinY) then
begin
if Modif_Ligne then
begin
Save_ligne_Curseur(Pos_Ligne);
Change_de_Ligne:=True;
end;
Curseur___Bas;
Debut_Ligne_Gauche;
Gotoxy(E_CurseurX,Y_curseur);
Del_Gauche;
end;
end
else
if (Fin_Ligne[Y_curseur].Buf<Fin_Buffer) then
Del_FinLigne;
Goto Key_Fin;
end;
CtrlAltF2: begin
if GetTexte=15 then Edit_Color:=GetFond shl 4 + GetFond+1
else
Edit_Color:=GetFond shl 4 + GetTexte+1;
BoxColor(2,4,Max_curseurX+1,Max_curseurY+3,Edit_Color);
for y1:=1 To Max_curseurY+3 DO
for x1:=1 To Max_Colones DO
ScreenPage^[y1,x1].Attrib:=Edit_Color;
FondBox:=Edit_Color-(((Edit_Color And $70) shr 4) * 16);
Fond__Box:=FondBox;
Goto Key_Fin;
end;
CtrlF1: begin
if Erreur_Limite_Buf(' ') then
begin
end;
Goto Key_Fin;
end;
{<-} LeftKey: begin
Curseur_Gauche;
Goto Key_Fin;
end;
{->} RightKey: begin
Curseur_Droite;
Goto Key_Fin;
end;
{debut} HomeKey: begin
Debut_Ligne_Gauche;
Goto Key_Fin;
end;
{fin} endKey: begin
Curseur__FinLigne;
Goto Key_Fin;
end;
{inser} InsKey: begin
if Mem[0:$417] And 128 = 128 then Inser_Mode:=True
else
Inser_mode:=False;
Goto Key_Fin;
end;
{Ctrl-S} 19 : begin
Curseur_Gauche;
Goto Key_Fin;
end;
{Ctrl-D} 4: begin
Curseur_Droite;
Goto Key_Fin;
end;
{Ctrl-V} 22: begin
Change_Inser_Mode;
Goto Key_Fin;
end;
end; {*ends Case1 No Save ligne*}
{*Save Ligne Actuel*}
if Modif_Ligne then
begin
Save_ligne_Curseur(Pos_Ligne);
Change_de_Ligne:=True;
end;
if (KeyChoix=Mouse1) And (MouseY>=2) then
begin
if MouseY=2 then
begin
Lecture_Une_Ligne_Haut(Debut_page);
end
else
if MouseY>3 then
begin
y1:=MouseY-3;
if (y1>=1) And (y1<Max_curseurY) then
begin
if y1>FinY then y1:=FinY;
x1:=MouseX;
if y1>Y_curseur then
inc(Line_Curseur,(y1-Y_curseur))
else
if y1< Y_curseur then Dec(Line_Curseur,Y_curseur-y1);
Y_curseur:=y1;
if (x1>1) And (x1<Max_curseurX) then
begin
x1:=x1+(X_curseur-E_curseurX)-1;
Positione_curseur(x1);
end
else
if x1>Max_CurseurX then
begin
if X_Curseur<Max_curseurX then
Positione_curseur(Max_curseurX-1);
Curseur_Droite;
end
else
if x1<=1 then
begin
if E_CurseurX>1 then
Positione_curseur((X_curseur-E_curseurX)+1);
Curseur_Gauche;
end;
end
else
if (y1=Max_curseurY+1) then
begin
Lecture_Une_Ligne_Bas(Fin_page,' ');
end;
end;
Goto Key_Fin;
end {*ends mouse*}
else
{*Menus avec mouse*}
if (KeyChoix=Mouse2) And (MouseY=1) And (Mbox(5,1,44,1)) then
begin
Case MouseX Of
5..8: KeyChoix:=Alt_F; {File}
13..16: KeyChoix:=Alt_E; {Edit}
21..27: KeyChoix:=Alt_O; {Options}
32..35: KeyChoix:=Alt_L; {Lang}
40..44: KeyChoix:=Alt_M; {Maths}
else KeyChoix:=0;
end;
Delay(DelayMouse);
Goto Key_Fin;
end {*mouse menus*}
else
{Case2} Case KeyChoix OF
F1: Help_Keys;
{Entree} CR: Inserer_Ligne;
{Ctrl-A} 1:mot_Avan((Fin_Ligne[Y_Curseur].buf-
(Fin_Ligne[Y_curseur].Ecran-1))+X_curseur);
{Ctrl-F} 6:begin
if X_curseur=Fin_Ligne[Y_curseur].ecran-1 then
Curseur__FinLigne
else
mot_suivan((Fin_Ligne[Y_Curseur].buf-
Fin_Ligne[Y_curseur].Ecran)+X_curseur+1);
end; {*ends*}
{Ctrl-E} 5: Curseur_Haut;
{Ctrl-X} 24: Curseur___Bas;
{Ctrl-R} 18: Recule_Page;
{Ctrl-C} 3: Avance_Page;
{Ctrl-W} 23: Lecture_Une_Ligne_Haut(Debut_page);
{Ctrl-Z} 26: Lecture_Une_Ligne_Bas(Fin_page,' ');
{Ctrl-N} 14: Inserer_Ligne;
{Ctrl-K} 11: Ctrl_K;
{Ctrl-Q} 17: Ctrl_Q;
{Ctrl-Y} 25: if (Y_Curseur<FinY) OR
((FinY>1) And (Fin_Ligne[Y_Curseur].ecran>1)) then
Del_Line;
{Ctrl-L} 12: if StrFind<>'' then
begin
Beep;
ConteLines:=0;
Cherche_Bas(62);
end; {*ends Ctrl-L*}
{fleche-H} UpKey: Curseur_haut;
{fleche-B} DownKey: Curseur___Bas;
{ctrl ->} CtrlRightKey: begin
if X_curseur=Fin_Ligne[Y_curseur].ecran-1 then
Curseur__FinLigne
else
mot_suivan((Fin_Ligne[Y_Curseur].buf-
Fin_Ligne[Y_curseur].Ecran)+X_curseur+1);
end;
{ctrl <-} CtrlLeftKey: Mot_Avan((Fin_Ligne[Y_Curseur].buf-
(Fin_Ligne[Y_curseur].Ecran-1))+X_curseur);
{BB} PgDnKey: Avance_Page;
{HH} PgUpKey: Recule_Page;
{ctrl BB} CtrlPgUP: Debut_DU_Fichier;
{ctrl HH} CtrlPgDn: Fin_DU_Fichier;
{F2} F2: begin
P_Save(7,'WIN');
if (Not _Save_Fichier) and (NomFic<>'NONAME.???') then
begin
Tab[1].Rtime:=FileDate(Tab[1].NomR+Tab[1].NomF);
Tab[1].PosX:=X_Curseur;
Tab[1].PosY:=Y_Curseur;
Tab[1].PageDebut:=Debut_Page;
Tab[1].Ligne:=Line_Curseur;
Tab[1].Marque:=Pose_Marque;
end;
end;
{alt-F6} AltF6: begin
if (Not _Save_Fichier) and (NomFic<>'NONAME.???') then
begin
Tab[1].Rtime:=FileDate(Tab[1].NomR+Tab[1].NomF);
Tab[1].PosX:=X_Curseur;
Tab[1].PosY:=Y_Curseur;
Tab[1].PageDebut:=Debut_Page;
Tab[1].Ligne:=Line_Curseur;
Tab[1].Marque:=Pose_Marque;
end;
Change_Fichier_Avan;
end;
Alt_C: begin
if (BlockDAF>0) And (Copy_Exemples) then
begin
Open_line;
PutXy(2,3,' Insert copy (Y/N) ');
Repeat
X_Car:=Readkey;
Until Upcase(X_Car) in['Y','N',#27];
Close_Line;
if Upcase(X_Car)='Y' then
begin
ix:=(Fin_Ligne[Y_Curseur].buf-Fin_ligne[Y_Curseur].ecran)+X_Curseur;
if ix >= Fin_Buffer then
begin
Positione_Curseur(Fin_Ligne[Y_Curseur].ecran);
end;
CopyCopyBlock(BlockDAF);
end;
end
else
begin
DebutDAF:=0;
FinDAF:=0;
BlockDAF:=0;
Copy_Exemples:=False;
end;
Goto Key_Fin;
end;
{Traducteur} F6: begin
if (Max_Block>0) And (FinBlock > DebutBlock) And
(FinBlock < Fin_Buffer) And (DebutBlock>=1) then
begin
ReadBuf(20,CrtGetMaxY-12,56,CrtGetMaxY-9,BuffDir^);
TextAttr:=Menu_Color;
BoxFill(20,CrtGetMaxY-12,56,CrtGetMaxY-9,' ');
Rectangle(20,CrtGetMaxY-12,56,CrtGetMaxY-9,Simple);
Putxy(23,CrtGetMaxY-11,'Traduction un bloc Anglais [A]');
Putxy(23,CrtGetMaxY-10,'Traduction un bloc Fran‡ais [F]');
Repeat
ix:=KeyBoard;
Until (ix in[65,97,70,102,27]); {A,a,F,f,echap}
textAttr:=Edit_Color;
WriteBuf(20,CrtGetMaxY-12,56,CrtGetMaxY-9,BuffDir^);
if ix = 27 then Goto Key_Fin;
Sxx1:=StrFind;
Sxx2:=Remplace;
Cherche_position_de_XY(DebutBlock);
case ix of
65,97: Traduire_Dictionnaire_Un_Bloc_('A');
70,102: Traduire_Dictionnaire_Un_Bloc_('F');
end;
Cherche_position_de_XY(DebutBlock);
StrFind:=Sxx1;
Remplace:=Sxx2;
end;
Goto Key_Fin;
end; {*ends F6*}
{Traducteur} F7,F8: begin
{mot} Window(1,1,80,CrtGetMaxY);
Sxx1:=StrFind;
Sxx2:=Remplace;
StrFind:=LireMotxx;
Case KeyChoix of
F8: X_Car:='F';
F7: X_Car:='A';
end;
if StrFind<>'' then
begin
ix:=E_CurseurX-ix;
Highbox(ix+1,Y_curseur+3,ix+Length(StrFind),Y_Curseur+3,1);
end;
if Y_Curseur>=(CrtGetMaxY-15) then
Str20:=SuggestioneDictionaire(36,1,X_Car,StrFind)
else
Str20:=SuggestioneDictionaire(36,CrtGetMaxY-11,X_Car,StrFind);
if StrFind<>'' then
Highbox(ix+1,Y_curseur+3,ix+Length(StrFind),Y_Curseur+3,1);
Window(1,1,80,CrtGetMaxY);
Window(2,4,79,CrtGetmaxY-1);
if (Str20<>'') And (PoseMot>0) then
begin
Remplace:=Str20;
Change_Find:=True;
Cherche_Position(PoseMot);
Change_Find:=False;
end
else
if Str20<>'' then
begin
for ix:=1 TO Length(Str20) Do
Inser_char(Str20[iX]);
end;
StrFind:=Sxx1;
Remplace:=Sxx2;
ix:=0;
Goto Key_Fin;
end; {*ends F7 et F8*}
CtrlF8: begin
X_Car:=' ';
if StrCalcul<>'' then
begin
Open_Line;
PutXy(2,3,' Insert formule [Y/N] ');
Repeat
X_Car:=Readkey;
Until Upcase(X_Car) in['Y','N',#27];
Close_Line;
end;
if (Upcase(X_Car) ='Y') And (StrCalcul<>'') then
begin
Nxx1:=Length(StrCalcul);
for ix:=1 To Nxx1 Do
Inser_char(StrCalcul[ix]);
if StrResult<>'' then
begin
Inser_char(' ');
Inser_char('=');
Inser_char(' ');
Nxx1:=Length(StrResult);
for ix:=1 To Nxx1 Do
Inser_char(StrResult[ix]);
end;
end;
Goto Key_Fin;
end; {*ends Ctrl-F8 insere le resulta calcule*}
CtrlF9: begin
X_Car:=' ';
Open_Line;
PutXy(2,3,' Insert date [Y/N] ');
Repeat
X_Car:=Readkey;
Until Upcase(X_Car) in['Y','N',#27];
Close_Line;
if (Upcase(X_Car) ='Y') And (StrCalcul<>'') then
begin
StrDate:=Donne_Date_heure;
Nxx1:=Length(StrDate);
for ix:=1 to Nxx1 Do
Inser_char(StrDate[ix]);
end;
Goto Key_Fin;
end; {*ends Ctrl-F9 insere la date*}
CtrlF10: begin
{*Evaluate formule Mathes*}
Action_function:=1;
Goto Key_Fin;
end; {*ends Ctrl-F10*}
AltF7: begin
Action_function:=2;
Goto Key_Fin;
end; {*ends Alt-F7*}
{Alt-X } AltX: begin
if _Save_Fichier then
begin
TextAttr:=Menu_Color;
if P_New = 69 then Fin_programme:=True;
TextAttr:=Edit_Color;
end
else Fin_Programme:=True;
end;{*ends Alt-X**}
end; {*ends de case2*}
Key_Fin:
{R2} Until (KeyChoix = F10) OR (KeyChoix= F3) OR (Fin_programme) OR
(KeyChoix=Alt_F) OR (KeyChoix=Alt_L) OR (KeyChoix=Alt_E) OR
(KeyChoix=Alt_O) OR (KeyChoix=AltF3) OR (KeyChoix=Alt_M) OR
(Action_function>0);
TextAttr:=Menu_Color;
Window(1,1,80,CrtGetMaxY);
if Action_function>0 then
begin
Appel_fuction(Action_function);{*Evaluate formule Mathes*}
Action_function:=0;
end
else
if KeyChoix = F10 then
begin
Appel_Menu(Retur0); {*Menu_General*}
end
else
if KeyChoix = F3 then
begin
Retur1:=61; {*Menu_File(61)*}
Appel_Menu(1);
end
else
begin
Case KeyChoix Of
Alt_F: Appel_Menu(1); {Menu_File}
Alt_E: Appel_Menu(2); {Menu Edit}
Alt_O: Appel_Menu(3); {Menu_Options}
Alt_L: Appel_Menu(4); {menu Langages}
Alt_M: Appel_Menu(5); {menu Maths}
AltF3: begin
Retur1:=106; {Menu_File}
Appel_Menu(1);
end;
end; {*ends case*}
end;
{R1} Until Fin_Programme;
TextAttr:=7;
ClearBufKey;
Clrscr;
if (Not _Save_Fichier) And (CrtGetMaxY=25) then
begin
if (NomFic=Tab[1].NomF) And (Disque_Nom=Tab[1].NomR) And
(NomFic<>'NONAME.???') then
begin
Tab[1].Rtime:=FileDate(Tab[1].NomR+Tab[1].NomF);
Tab[1].PosX:=X_Curseur;
Tab[1].PosY:=Y_Curseur;
Tab[1].PageDebut:=Debut_Page;
Tab[1].Ligne:=Line_Curseur;
Tab[1].Marque:=Pose_Marque;
end;
end;
end;{*ends P_Edit*}
Procedure Init_Pick_Mode(mode:byte);
Label ErrorFin;
var RR:Reg_Pick;
i:byte;
Sn:string[20];
Attr:Word;
Err:integer;
f:File;
begin
Assign(f,Repertoire+'FILES\EDIT13.PCK');
{$i-}
GetFattr(f,Attr);
{$I+}
if (DosError=0) And (Attr And $01 = $01) then
begin
{$I-}
SetFattr(f,$20);
{$I+}
Erreur1:=DosError;
end;
Assign(f,Repertoire+'FILES\EDIT13.PCK');
{$i-}
GetFattr(f,Attr);
{$I+}
if (DosError=0) And (Attr And $01 = $01) then
begin
{$I-}
SetFattr(f,$20);
{$I+}
end;
if Mode=1 then
begin
Assign(Libre10,Repertoire+'FILES\EDIT13.PCK');
{$I-}
Reset(Libre10);
{$I+}
Erreur1:=IoResult;
if Erreur1=0 then
begin
Max_Pick:=0;
i:=1;
while Not Eof(Libre10) DO
begin
{$I-}
Read(Libre10,RR);
{$I+}
Erreur1:=Ioresult;
if Erreur1<>0 then
begin
Close(Libre10);
Init_Pick;
Goto ErrorFin;
end;
if i<=10 then
begin
if RR.NomF<>'' then Inc(Max_Pick);
Tab[i]:=RR;
end
else
if i=11 then
begin
{**************
Nom7:=RR.NomF;
Reper7:=RR.NomR;
***************}
end
else
if i=12 then
begin
{****************
RR.NomF; Libre...
RR.NomR; Libre...
****************}
end
else
if i=13 then
begin
Nom_Help:=RR.NomF;
Disque_help:=RR.NomR;
end
else
if i=14 then
begin
Langage:=RR.NomF;
Extension:=RR.NomR;
end;
if i=15 then
begin
Dic_Nom8:=RR.NomF;
{*RR.NomR*} {*Libre... Disponible*}
end;
if (i=16) And (Max_Block>0) then
begin
{*RR.NomF*} {*Disponible*}
{*RR.NomR*} {*Disponible*}
end;
if i=17 then
begin
if RR.NomF='486' then Ordinateur486:=True {Ordinateur 486}
else Ordinateur486:=False;
Sauvegarde:=RR.NomR;
end;
if i=18 then
begin
StrCalcul:=RR.NomR;
{$R-}
Val(RR.NomF,Nxx1,Err);
{$R+}
if (Err=0) then
begin
Veille:=Nxx1;
end
else
Veille:=10;
end;
if i=19 then
begin
Calculatrice_S2:=RR.nomF;
{$R-}
Val(RR.NomR,Calculatrice_Total,Err);
{$R+}
if (Err<>0) then
begin
Calculatrice_Total:=0;
end;
end;
if i=20 then
begin
Calculatrice_S3:=RR.nomF;
{$R-}
Val(RR.NomR,Calculatrice_TotalM,Err);
{$R+}
if (Err<>0) then
begin
Calculatrice_TotalM:=0;
end;
end;
if i=21 then
begin
{Dic_Nom7:=RR.nomF;}
Dic_Nom8:=RR.nomR;
end;
Inc(i);
end;
Close(Libre10);
end
else Goto ErrorFin;
end {*mode=1*}
else
if Mode = 0 then
begin
Assign(Libre10,Repertoire+'FILES\EDIT13.PCK');
{$I-}
ReWrite(Libre10);
{$I+}
Erreur1:=IoResult;
if Erreur1 = 0 then
begin
for i:=1 TO 10 DO
begin
RR:=Tab[i];
{$I-}
Write(Libre10,RR);
{$I+}
Erreur1:=IOresult;
if Erreur1<>0 then
begin
Close(Libre10);
Goto ErrorFin;
end;
end;
{$I-}
RR.posX:=0;
RR.posY:=0;
RR.pageDebut:=0;
RR.Ligne:=0;
RR.RTime:=0;
RR.NomF:=''; {*Nom7;*}
RR.NomR:=''; {*Reper7;*}
Write(Libre10,RR);
RR.NomF:=''; {*Nom8;*}
RR.NomR:=''; {*Reper8;*}
Write(Libre10,RR);
RR.NomF:=Nom_help;
RR.NomR:=Disque_Help;
Write(Libre10,RR);
RR.NomF:=Langage;
RR.NomR:=Extension;
Write(Libre10,RR);
RR.NomF:=Dic_nom8;
RR.NomR:=''; {*Disponible*}
Write(Libre10,RR);
RR.NomF:=''; {*Disponible*}
RR.NomR:=''; {*Disponible*}
Write(Libre10,RR);
if Ordinateur486 then RR.NomF:='486' {*mouse Ordinateur*}
else RR.NomF:='386';
RR.NomR:=Sauvegarde;
Write(Libre10,RR);
Str(Veille,Sn);
RR.nomF:=Sn;
RR.NomR:=StrCalcul;
Write(Libre10,RR);
RR.nomF := Calculatrice_S2;
Str(Calculatrice_Total:9:3,Sn);
RR.nomR := Sn;
Write(Libre10,RR);
RR.nomF := Calculatrice_S3;
Str(Calculatrice_TotalM:10:3,Sn);
RR.nomR := Sn;
Write(Libre10,RR);
RR.nomF :=Dic_Nom7;
RR.nomR :=Dic_Nom8;
Write(Libre10,RR);
{$I+}
Erreur1:=Ioresult;
if Erreur1<> 0 then
begin
Close(Libre10);
Goto ErrorFin;
end;
Close(Libre10);
end;
end; {*moode=0*}
ErrorFin:
end;{*ends*}
Function Examine_DEcode(NomA,NomB:string):boolean;
var Nom1:string;
i :byte;
car :char;
begin
Nom1:='';
for i:=1 To Length(NomA) DO
begin
Car:=NomA[i];
if Car=chr(33) then Nom1:=Nom1+' '
else
Nom1:=Nom1+Chr(Ord(Car)+10);
end;
if Nom1<>NomB then Examine_DEcode:=False
else Examine_DEcode:=True;
end; {*ends*}
Procedure Execute_File;
var Entree:boolean;
Snom,Sreper:string;
begin
SNom:='';Sreper:='';
Entree:=False;
if ParamStr(1)<>'' then
begin
Snom:=ParamStr(1);
Entree:=Verify_Rep_Fic(Sreper,Snom);
end;
if (Entree) And (FileExists(Sreper,Snom)) then
begin
Disque_Nom:=Sreper;
NomFic:=Snom;
TextAttr:=Edit_Color;
Initialiser;
BoxFill(2,4,79,CrtGetMaxY-1,' ');
Window(1,1,80,CrtGetMaxY);
Window(2,4,79,CrtGetMaxY-1);
{============================================}
{ Utilite: chargement du disque le fichier }
{ transfome code ANSI win en Code DOS }
{============================================}
Load_Fichier_Disque_win(Disque_Nom,NomFic);
if (NomFic<>'NONAME.???') And (NomFic<>'') then
begin
Reinit_Pick(Disque_Nom,NomFic);
if X_curseur<Max_curseurX then E_curseurX:=X_curseur
else E_curseurX:=Max_curseurX-1;
Window(1,1,80,CrtGetMaxY);
Window(2,4,79,CrtGetMaxY-1);
BoxFill(2,4,79,CrtGetMaxY-1,' ');
Premiere_Page_Debut(Debut_Page);
end;
Window(1,1,80,CrtGetMaxY);
end
else
if (Tab[1].NomF<>'NONAME.???') And (Tab[1].NomF<>'') And
(FileExists(Tab[1].NomR,Tab[1].NomF)) then
begin
TextAttr:=Edit_Color;
Initialiser;
BoxFill(2,4,79,CrtGetMaxY-1,' ');
Window(1,1,80,CrtGetMaxY);
Window(2,4,79,CrtGetMaxY-1);
NomFic:=Tab[1].NomF;
Disque_Nom:=Tab[1].NomR;
Load_Fichier_Disque_win(Disque_Nom,NomFic);
if (NomFic<>'NONAME.???') And (NomFic<>'') then
begin
if Tab[1].Rtime = FileDate(Tab[1].NomR+Tab[1].NomF) then
begin
if (Tab[1].PageDebut < Fin_Buffer) And (Tab[1].PageDebut> 0) then
begin
Debut_Page:=Tab[1].PageDebut;
CurseurDebutX:=Tab[1].posX;
Y_Curseur:=Tab[1].posY;
X_curseur:=1;E_curseurX:=1;
Line_Curseur:=Tab[1].Ligne;
Pose_Marque:=Tab[1].marque;
end
else
begin
Debut_Page:=1;
Tab[1].PageDebut:=1;
CurseurDebutX:=1;
Tab[1].posX:=1;
Y_Curseur:=1;
Tab[1].posY:=1;
X_curseur:=1;E_curseurX:=1;
Line_Curseur:=1;
Tab[1].Ligne:=1;
Pose_Marque[1]:=0;
Pose_Marque[2]:=0;
Pose_Marque[3]:=0;
Pose_Marque[4]:=0;
end;
Window(1,1,80,CrtGetMaxY);
Window(2,4,79,CrtGetMaxY-1);
BoxFill(2,4,79,CrtGetMaxY-1,' ');
Premiere_Page_Debut(Debut_Page);
Window(1,1,80,CrtGetMaxY);
end
else
begin
Debut_Page:=1;
X_curseur:=1;
E_curseurX:=1;
CurseurDebutX:=1;
Y_Curseur:=1;
Line_Curseur:=1;
Pose_Marque[1]:=0;
Pose_Marque[2]:=0;
Pose_Marque[3]:=0;
Pose_Marque[4]:=0;
Window(1,1,80,CrtGetMaxY);
end;
end; {*NomFic<>NONAME.???*}
end
else
begin
Initialiser;
NomFic:='NONAME.???';
Window(1,1,80,CrtGetMaxY);
end;
end;{*ends*}
begin
{*Debut Program EDIT13*}
{*controle disk*}
GetDir(0,Disq);
if Disq[length(Disq)]<>'\' then Repertoire:=Disq+'\'
else Repertoire:=Disq;
Repertoire:='';
Titres_Color := 120;
Menu_Color := 112;
Dir_Color := 112;
Etat_Color := 23;
Edit_Color := 30;
Error_Color := 52;
Etat_Color := 22;
Help_Color := 120;
BX := 3;
Block_Color := 120;
Marque_Color := 56;
char_Color := 4;
Stop:=false;
if InitMouse then
begin
Writeln('Mouse active..');
end
else
begin
{**Goto ErreurFin;**}
end;
{*Initialise EDIT13*}
Calculatrice_Total :=0;
Calculatrice_TotalM:=0;
Calculatrice_S2 :='';
Calculatrice_S3 :='';
ReturCNC:=7;
StrFind:='';
Remplace:='';
Options_Remplace:='u';
Extension:='.txt';
StrCalcul:='';
StrResult:='';
Find_Valeur:=0;
Fin_Programme:=False;
Copy__Buffer:=Nil;
CurseurDebutX:=1;
X_Curseur:=1;
E_curseurX:=1;
Y_curseur:=1;
Debut_Page:=1;
Line_Curseur:=1;
Fin_Buffer:=0;
GetDir(0,Disq);
Disque_2:=Disq[1]+Disq[2];
if Disq[length(Disq)]<>'\' then Repertoire:=Disq+'\'
else Repertoire:=Disq;
Texte_Dire:='*.*';
Disque_Dire:=Repertoire;
Repertoire:=Repertoire;
Disque_Nom:=Repertoire;
BlockNeime:='';
BlockRepe:=Repertoire;
NeimeAttr:='*.*'; {*Nom fic et repertoire change Attribut*}
ReperAttr:=Repertoire;
Rep_Fic:=Repertoire;
Rep_Hlp:=Repertoire;
nom_ini:=Repertoire+'Maths.INI';
Dic_nom2:=Repertoire+'FILES\1FraAng2.Idx';
Dic_nom3:=Repertoire+'FILES\2AngFra1.idx';
Dic_nom1:=Repertoire+'FILES\FranAngl.Dic';
Dic_nom4:=Repertoire+'FILES\Inconu.Dic';
Dic_nom8:=Repertoire+'FILES\ED_Notes.Fic';
Dic_nom7:=Repertoire+'FILES\ED_Phras.fic';
if Repertoire[length(Repertoire)]<>'\' then
Disque_Help:=Repertoire+'\DONNES\'
else
Disque_Help:=Repertoire+'DONNES\';
Init_PicK;
SuppBlock:=False; {*suprime le block dans l'editeur*}
CopierBlock:=False; {*Copy le block dans l'editeur*}
Marque_bloc:=False;
size_plus:=512;
size_Plus:=size_plus+Size_Buf_Texte;
GetMem(BufTexte,size_plus);
{**buffs.pas**}
if MaxAvail< SizeOF(ScreenPageXX) then Goto ErreurFin;
GetMem(ScreenPage,SizeOf(ScreenPageXX));
{**buffs.pas**}
GetMem(Buffer,Max_Buffer+512);
Fillchar(Buffer^,Max_Buffer+512,' ');
Buffer^[1]:=#26; {^Z}
{**Type_Buf.pas**}
GetMem(Copy__Buffer,Max_Buffer_Copy+512);
Fillchar(Copy__Buffer^,Max_Buffer_Copy+512,' ');
Copy__Buffer^[1]:=#26;{^Z} {*marque de fin de Bloc vide*}
{**buffs.pas**}
GetMem(CopyLigne,(Max_curseurX+3)*2);
{**buffs.pas**}
Size_Menu_buf:=CrtSize(1,1,37,24);
GetMeM(Menu_Buf,Size_Menu_Buf);
{**buffs.pas**}
Size_Sub_buf:= CrtSize(1,1,80,10);
GetMem(Sub_Buf,Size_Sub_Buf);
{**buffs.pas**}
SizeLinePtr:= CrtSize(1,1,Max_CurseurX+2,2)*2;
GetMem(LinePtr,SizelinePtr);
{**buffs.pas**}
SizeDir:= CrtSize(1,1,80,25);
GetMem(BuffDir,SizeDir);
{**buffs.pas special pour calculator**}
SizeCal:= CrtSize(1,1,81,26);
GetMem(Buff_cal,SizeCal);
{*HeapStatus*}
Init_Color(Repertoire+'FILES\EDIT13.INI');
Init_Pick_Mode(1);
{=================Infos===========================}
{* DelayPose:=25; se trouve sur type_11.pas *}
{* Opertion_Tempo et Tempo se trouve Var_Num.pas *}
{=================================================}
DelayPose:=25; {*Editeur*}
DelayMouse:=100; {*vitese de Mousse*}
Tempo__Mouse:=Round(DelayMouse)+1;
Nom_Help:='*.Hlp';
TexteLoad:='*'+extension;
NomFic:='NONAME.???';
Clrscr;
{*Initialise variables debut program*}
Initialiser;
FondBox:=Edit_Color-(((Edit_Color And $70) shr 4) * 16);
Fond__Box:=FondBox;
Affiche_Menu;
info_debut_program(10,8);
Modif_Ligne:=False;
change_de_ligne:=True;
TextAttr:=Edit_Color;
BoxFill(2,4,79,CrtGetMaxY-1,' ');
Execute_File;
positione_Curseur(CurseurDebutX);
Copy_Exemples:=False;
Stop:=False;
if (Sauvegarde<>'OUI') And (Sauvegarde<>'NON') then Sauvegarde:='OUI';
TextAttr:=Edit_Color;
StyleMouse(2,14);
Help_Color:=Menu_Color;
BX:=7;
P_Edit;
TextAttr:=7;
Clrscr;
Init_Pick_Mode(0);
ErreurFin:
Window(1,1,80,CrtGetMaxY);
if CrtGetMaxY=50 then ScreenLine25;
Window(1,1,80,CrtGetMaxY);
{*suprime les pointeurs de la memoire*}
if BufTexte<>nil then
begin
{ writeln('1 : va etre suprime !!');
X_Car:=readkey;}
FreeMem(BufTexte,size_plus);
end;
if ScreenPage<>nil then
begin
{ writeln('2 : va etre suprime !!');
X_Car:=readkey;}
FreeMem(ScreenPage,SizeOf(ScreenPageXX));
end;
if Buffer<>nil then
begin
{ writeln('3 : va etre suprime !!');
X_Car:=readkey;}
FreeMem(Buffer,Max_Buffer+512);
end;
if Copy__Buffer<>nil then
begin
{ writeln('4 : va etre suprime !!');
X_Car:=readkey;}
FreeMem(Copy__Buffer,Max_Buffer_Copy+512);
end;
if CopyLigne<>nil then
begin
{ writeln('5 : va etre suprime !!');
X_Car:=readkey;}
FreeMem(CopyLigne,(Max_curseurX+3)*2);
end;
if Menu_Buf<>nil then
begin
{ writeln('6 : va etre suprime !!');
X_Car:=readkey;}
FreeMem(Menu_Buf,Size_Menu_Buf);
end;
if Sub_Buf<>nil then
begin
{ writeln('7 : va etre suprime !!');
X_Car:=readkey;}
FreeMem(Sub_Buf,Size_Sub_Buf);
end;
if LinePtr<>nil then
begin
{ writeln('8 : va etre suprime !!');
X_Car:=readkey;}
FreeMem(LinePtr,SizelinePtr);
end;
if BuffDir<>nil then
begin
{ writeln('9 : va etre suprime !!');
X_Car:=readkey;}
FreeMem(BuffDir,SizeDir);
end;
if Buff_cal<>nil then
begin
{ writeln('10 : va etre suprime !!');
X_Car:=readkey;}
FreeMem(Buff_cal,SizeCal);
end;
TextAttr:=7;
Clrscr;
Halt(1);
end. {*ends programme Edit13*}
{=======================================================}
{ unite ASCII.pas }
{ converti le code Ascii en code ANSI windows 19/72011 }
{ Procedure Save_Fichier_win(D_isque,NeimeFic:String) }
{=======================================================}
{=======================================================}
{ Utilite: chargement du disque le fichier }
{ transfome code ANSI win en Code DOS OK. }
{ Procedure Load_Fichier_Disque_win(Rep,Neime:String); }
{=======================================================}
{============ infos unite Traduc.pas ===================}
{* B_langa2.blc }
{* Procedure Change_Repertoire_Langage(Fond__Box:byte); }
{* Disque_Help:=Repertoire+'DONNES\'; }
{*======================================================}
{=======================================================}
{ Procedure Change_Nom_Fic_Notes(n:byte); }
{ ends block Change_p.pas - inserere sur B_notes.pas }
{ file: of B_notes.pas : $i Change_p.pas }
{ Procedure Lire_Phrases(x1,y1:byte;NeimeFile:string); }
{=======================================================}
{=======================================================}
{ Case Y Of }
{ 11: Dic_Nom8:=Repertoire+'FILES\ED_Notes.Fic'; }
{ 12: Dic_Nom8:=Repertoire+'FILES\ED_Num.Fic'; }
{ 13: Dic_Nom8:=Repertoire+'FILES\ED_Maths.Fic'; }
{ 14: Dic_Nom7:=Repertoire+'FILES\ED_Phras.fic'; }
{ 15: Dic_Nom7:=Repertoire+'FILES\ED_PhNum.Fic'; }
{ 16: Dic_Nom7:=Repertoire+'FILES\ED_PhMat.Fic'; }
{ end; }
{=======================================================}
{=======================================================}
{ Procedure Change_Nom_Fic_Notes(n:byte); }
{ ends block Change_p.pas - inserere sur B_notes.pas }
{=======================================================}
{=====================================================================}
{ $F: Forcer Appels FAR (Force Far Calls Switch) }
{ Cette bascule contr“le le modŠle d'appel qui doit ˆtre utilisé pour }
{ les appels de procédures et de fonctions qui suivent la bascule. }
{ }
{ Syntaxe: {$F+} ou {$F-} }
{ Implicite: {$F-} }
{ Type: Local }
{ Commande EDI: Options|Compiler|Force Far Calls }
{ }
{ L'état $F+ Les procédures et fonctions compilées dans }
{ l'état {$F+} utilisent toujours le modŠle d'appel FAR. }
{ L'état $F- Sous l'effet de {$F-},Turbo Pascal sélectionne le type }
{ d'appel ainsi: }
{ - type long (FAR) si la procédure ou la fonction est déclarée dans }
{ la partie INTERFACE d'une unité }
{ - type court (NEAR) dans tous les autres cas. }
{ Note importante : Si vous utilisez le }
{ mécanisme de recouvrement de partiels }
{ (overlays), placez un {$F+} au début de chaque module }
{ (programme et unités) afin d'obéir au besoin d'appels longs. }
{ Les variables de type sous-programme (procedural variables) doivent }
{ être aussi à appel long (FAR). }
{=====================================================================}
Menu de l'éditeur▲
Sélectionnez
{=================EDIT13 MenuEdi.pas=====================}
{*EDit13 version 4.002e units buffers d'éditeur de texte*}
{*Copyright (S) 1997-2012 programmeur du logiciel A.Ara *}
{*Licence d'utilisation accord dans un but demonstratif *}
{*la vente du logiciel et interdite. *}
{*MenuEdi.pas Numero de serie 00-441-7441-B21111946bb *}
{========================================================}
Function P_Load(yy:byte):string;
Var Nom:string[12];
Entree:boolean;
begin
Nom:='';
Readbuf(6,yy,52,yy+2,Sub_Buf^);
BoxFill(6,yy,52,yy+2,' ');
Rectangle (6,yy,52,yy+2,Simple);
Putxy(21,yy,' Load File Name ');
TexteLoad:='*'+Extension;
if Uppers(Disque_Nom) <> Uppers(Repertoire) Then
TexteLoad:=Disque_Nom+TexteLoad;
Entree:=ReadBox(8,yy+1,TexteLoad,43,80);
Writebuf(6,yy,52,yy+2,Sub_Buf^);
csoff;
if Entree Then Entree:=Verify_Rep_Fic(Disque_Nom,TexteLoad);
if Entree Then
begin
if Pos('*',TexteLoad)>0 Then
Nom:=_Fichiers_Dir(Disque_Nom,TexteLoad)
else
if TexteLoad<>'' Then
begin
if Not FileExists(Disque_Nom,TexteLoad) Then
begin
Entree:=Erreur_Critique(2,TexteLoad);
Entree:=False;
TexteLoad:='*'+Extension;
Nom:='';
end
else
begin
Nom:=TexteLoad;
TexteLoad:='*'+Extension;
end;
end
else Entree:=False;
if (Entree) And (Nom<>'') Then
begin
if _Save_Fichier Then {*sauvegarde fichier actuel*}
begin
if P_New=69 Then
begin
NomFic:=Nom;
P_load:=Nom;
end
else P_Load:=''; {*opperation anulle*}
end
else
begin {*pas necasire sauvegarder*}
NomFic:=Nom;
P_load:=Nom;
end;
end {*nom<>''*}
else
P_Load:=''; {*fichier sans Nom*}
end {*entree*}
else
P_Load:=''; {*opperation Anule*}
end; {*ends*}
Function P_Directory(Code:byte):string;
Var Entree:boolean;
Nom:string;
begin
Readbuf(6,9,52,11,Sub_buf^);
BoxFill(6,9,52,11,' ');
Rectangle (6,9,52,11,Simple);
Putxy(21,9,' Enter File Name ');
if Texte_Dire='' Then Texte_Dire:='*.*';
if Disque_Dire<>Repertoire Then Texte_Dire:=Disque_Dire+Texte_Dire;
Entree:=ReadBox(8,10,Texte_Dire,43,80);
Writebuf(6,9,52,11,Sub_buf^);
csoff;
if (Pos('.',Texte_Dire) >0) Then
Nom:='*'+Copy(Texte_Dire,Pos('.',Texte_Dire),Length(Texte_Dire));
if Entree Then Entree:=Verify_Rep_Fic(Disque_Dire,Texte_Dire);
if (Nom='') And (Texte_Dire<>'') Then
Nom:='*'+Copy(Texte_Dire,Pos('.',Texte_Dire),Length(Texte_Dire));
if (Entree) Then
begin
if (POS('*',Texte_Dire)>0) Then
Texte_Dire:=_Fichiers_Dir(Disque_dire,Texte_Dire)
else
if Texte_Dire<>'' Then
begin
if Not FileExists(Disque_Dire,Texte_Dire) Then
begin
Entree:=Erreur_Critique(2,Texte_Dire);
Entree:=False;
end;
end
else Entree:=False;
end;
if Not Entree Then
begin
if Texte_Dire='' Then Texte_Dire:='*.*';
if Disque_Dire='' Then Disque_Dire:=Repertoire;
end
else
if Disque_Dire='' Then Disque_Dire:=Repertoire;
if Entree Then
begin
if Texte_Dire<>'' Then
begin
if _Save_Fichier Then {*sauvegarde fichier actuel*}
begin
if P_New=69 Then
begin
NomFic:=Texte_Dire;
Disque_Nom:=Disque_Dire;
P_Directory:=Texte_Dire;
end
else P_Directory:=''; {*opperation anulle*}
end
else
begin {*pas necasire sauvegarder*}
NomFic:=Texte_Dire;
P_Directory:=Texte_Dire;
Disque_Nom:=Disque_Dire;
end;
end
else
P_Directory:=''; {*fichier sans Nom*}
end
else
P_Directory:=''; {*opperation Anule*}
if Nom='' Then Nom:='*.*';
Texte_Dire:=Uppers(Nom);
end;
Procedure P_Change_Dir;
Var Entree: boolean;
SR : string;
begin
Entree:=False;
SR:=Repertoire;
Readbuf(6,10,52,12,Sub_Buf^);
BoxFill(6,10,52,12,' ');
Rectangle (6,10,52,12,Simple);
Putxy(21,10,' New Directory ');
Entree:=ReadBox(8,11,SR,43,80);
WriteBuf(6,10,52,12,Sub_Buf^);
if Entree Then Change_Directori(SR);
csoff;
end;
Procedure P_Save(yy:byte;typeform:string);
var SR,SN :string;
NomError :string[4];
Entree :boolean;
n,Color :byte;
Ch :Char;
begin
if (NomFic='NONAME.???') Then
begin
Color:=TextAttr;
TextAttr:=Menu_Color;
Entree:=False;
Readbuf(6,yy,52,yy+2,Sub_Buf^);
BoxFill(6,yy,52,yy+2,' ');
Rectangle(6,yy,52,yy+2,Simple);
Putxy(21,yy,' Rename Noname ');
SR:=Disque_Nom;
SN:=NomFic;
Entree:=ReadBox(8,yy+1,SN,43,80);
Writebuf(6,yy,52,yy+2,Sub_buf^);
Csoff;
if (Entree) And (Uppers(SN) = 'PRN') Then
begin
Entree:=False;
end
else
if (Entree) Then
begin
Entree:=Verify_Rep_Fic(SR,SN);
if Entree Then
begin
SN:=Uppers(SN);
NomError:=Copy(SN,1,4);
if NomError = 'PRN.' Then
begin
Entree:=False;
SN:='';
SR:='';
TextAttr:=Color;
exit;
end;
end;
end;
if Entree Then Entree:=(Uppers(SN)<>'NONAME.???');
if Entree Then
begin
if SN='' Then SN:='*'+extension;
if (Pos('*',SN)>0) Then SN:=_Fichiers_Dir(SR,SN);
if SN='' Then
begin
TextAttr:=Color;
Exit;
end;
if FileExists(SR,SN) Then
begin
Readbuf(6,yy,52,yy+2,Sub_Buf^);
BoxFill(6,yy,52,yy+2,' ');
Rectangle (6,yy,52,yy+2,Simple);
Putxy(25,yy,' Verify ');
Putxy(12,yy+1,'Overwrite '+SN+'? (Y/N)');
Csoff;
Repeat
Ch:=Readkey;
Until (Ord(Ch)=27) OR (Upcase(Ch) in['Y','N']);
Writebuf(6,yy,52,yy+2,Sub_buf^);
if Upcase(Ch)='Y' Then
begin
if SR='' Then Disque_Nom:=Repertoire
else Disque_Nom:=SR;
NomFic:=SN;
if typeform='DOS' then
begin
{===================================================}
{ save le code Ascii origine 850 Multiligue Latin I }
{===================================================}
Save_Fichier_Disque(Disque_Nom,NomFic);
end
else
if typeform='WIN' then
begin
Save_Fichier_win(Disque_Nom,NomFic);
{========================================================}
{ Save ANSI Win 1252 Table Character List }
{ ANSI stands for American National Standards Institute. }
{ standard ASCII character set (values 32 to 127), }
{ plus an extended character set (values 128 to 255). }
{ The ANSI character set is used by Windows end refers }
{ to the codepage 1252 known as "Latin 1 Windows". }
{========================================================}
{ converti le code Ascii en code ANSI windows code 1252 }
{========================================================}
end;
end
end {*file existe*}
else
begin
if Entree Then Entree:=Verify_Reper(SR,SN);
if Entree Then
begin
if SR='' Then Disque_Nom:=Repertoire;
NomFic:=SN;
if typeform='DOS' then
begin
{===================================================}
{ save le code Ascii origine 850 Multiligue Latin I }
{===================================================}
Save_Fichier_Disque(Disque_Nom,NomFic);
end
else
if typeform='WIN' then
begin
Save_Fichier_win(Disque_Nom,NomFic);
{========================================================}
{ Save ANSI Win 1252 Table Character List }
{ ANSI stands for American National Standards Institute. }
{ standard ASCII character set (values 32 to 127), }
{ plus an extended character set (values 128 to 255). }
{ The ANSI character set is used by Windows end refers }
{ to the codepage 1252 known as "Latin 1 Windows". }
{========================================================}
{ converti le code Ascii en code ANSI windows code 1252 }
{========================================================}
end;
end;
end;
end; {*Entree*}
TextAttr:=Color;
end {*end fic=Noname..*}
else
begin
if typeform='DOS' then
begin
{===================================================}
{ save le code Ascii origine 850 Multiligue Latin I }
{===================================================}
Save_Fichier_Disque(Disque_Nom,NomFic);
end
else
if typeform='WIN' then
begin
Save_Fichier_win(Disque_Nom,NomFic);
{=========================================================}
{ Save ANSI Win 1252 Table Character List 1 }
{ ANSI stands for American National Standards Institute. }
{ standard ASCII character set (values 32 to 127), }
{ plus an extended character set (values 128 to 255). }
{ The ANSI character set is used by Windows end refers to }
{ the codepage 1252 known as "Latin 1 Windows". }
{=========================================================}
{ converti le code Ascii en code ANSI windows code 1252 }
{=========================================================}
end;
end;
CsOff;
end;
Function P_Pick_Load:string;
Var SR,SN:string;
Entree:boolean;
begin
Readbuf(6,5,52,7,Sub_buf^);
BoxFill(6,5,52,7,' ');
Rectangle (6,5,52,7,Simple);
Putxy(21,5,' Load File Name ');
SN:='*.*';
SR:=Repertoire;
Entree:=ReadBox(8,6,SN,43,80);
Writebuf(6,5,52,7,Sub_buf^);
Csoff;
if Entree Then Entree:=Verify_Rep_Fic(SR,SN);
if (Entree) Then
begin
if SR='' Then SR:=Repertoire;
if POS('*',SN)>0 Then SN:=_Fichiers_Dir(SR,SN)
else
if SN<>'' Then
begin
if Not FileExists(SR,SN) Then
begin
Entree:=Erreur_Critique(2,SN);
Entree:=False;
SN:='';
end;
end;
if (Entree) And (SN<>'') Then
begin
if _Save_Fichier Then {*sauvegarde fichier actuel*}
begin
if P_New=69 Then
begin
NomFic:=SN;
Disque_Nom:=SR;
P_Pick_load:=SN;
end
else P_Pick_Load:=''; {*opperation anulle*}
end
else
begin {*pas necasire sauvegarder*}
NomFic:=SN;
Disque_Nom:=SR;
P_Pick_Load:=SN;
end;
end {*sn<>''*}
else
P_Pick_load:=''; {*fichier sans Nom*}
end {*entree*}
else
P_Pick_Load:=''; {*opperation Anule*}
end;
{=============================}
{* save file forme ascii win *}
{=============================}
Procedure save_Fic_forme_win;
var ch:Char;
Entree,PrnOk:boolean;
SR,Name : string;
begin
Readbuf(6,11,55,13,Sub_Buf^);
TextAttr:=Menu_Color;
BoxFill(6,11,55,13,' ');
Rectangle (6,11,55,13,Simple);
Putxy(17,11,' To Save Standard ANSI ');
Name:='*.*';Sr:=Repertoire;
Entree:=ReadBox(8,12,name,46,65);
Writebuf(6,11,55,13,Sub_Buf^);
Csoff;
if Entree Then Entree:=Verify_Rep_Fic(SR,name);
if (Entree) And (Name<>'') then
begin
{=============================================}
{ converti le code Ascii en code ANSI windows }
{=============================================}
Save_Fichier_win(SR,Name);
end;
end; {*ends save_Fic_forme_win*}
Function Menu_File(y:byte):byte;
LaBel PASE_NEW;
Var Key:byte;
Nom_Pick:string;
Nom_Reper:string;
New,Termine:boolean;
Director,Load:boolean;
begin
Director:=False;
Load:=False;
New:=False;
Termine:=False;
HighBox(4,1,9,1,Bx);
if Y in[61,106] Then
begin
Key_Code:=True;
Case Y Of
61: begin Y:=3;Key:=61; end;
106: begin Y:=4;Key:=106;Alt:=True; end;
end;
end
else
begin
if Y=0 Then Y:=3;
Key:=0;
end;
ReadBuf(3,2,22,13,Menu_Buf^);
BoxColor(6,3,22,13,FondBox);
BoxFill(4,2,20,12,' ');
Rectangle (4,2,20,12,Double);
Putxy(6,3,'Load F3');
Putxy(6,4,'Pick Alt-F3');
Putxy(6,5,'New');
Putxy(6,6,'Save F2');
Putxy(6,7,'Write to');
Putxy(6,8,'Directoy F4');
Putxy(6,9,'Change dir');
Putxy(6,10,'Save the ANSI');
Putxy(6,11,'Quit Alt-X');
WriteCar(6,3,'L');
WriteCar(6,4,'P');
WriteCar(6,5,'N');
WriteCar(6,6,'S');
WriteCar(6,7,'W');
WriteCar(6,8,'D');
WriteCar(6,9,'C');
WriteCar(15,10,'A');
WriteCar(6,11,'Q');
HighBox(5,Y,19,Y,Bx);
Mousexy(3,1);
DisplayMouse;
Repeat
if (Not Key_Code) And(Key in[108,76,112,80,110,78,115,83,119,87,
100,68,99,57,80,112,113,81,65,97]) Then
begin
HighBox(5,Y,19,Y,Bx);
Case Key of
{L} 108,76: Y:=3;
{P} 112,80: Y:=4;
{N} 110,78: Y:=5;
{S} 115,83: Y:=6;
{W} 119,87: Y:=7;
{D} 100,68: Y:=8;
{C} 99,57 : Y:=9;
{A} 65,97 : Y:=10;
{Q} 113,81: Y:=11;
end; {case}
Key:=13;
HighBox(5,Y,19,Y,Bx);
end
else
if ((Key_Code) And (Key in[60,61])) OR ((Alt) And (Key in[106,45])) Then
begin
HighBox(5,Y,19,Y,Bx);
Case Key of
{F2} 60: Y:=6;
{F3} 61: Y:=3;
{Alt-F3} 106: Y:=4;
{Alt-X} 45: Y:=11;
end;
Key_Code:=False;
Key:=13;
HighBox(5,Y,19,Y,Bx);
end
else
if (Key_Code) And (Key=72) And (Y>3) Then
begin
HighBox(5,Y,19,Y,Bx);
Dec(y);
HighBox(5,Y,19,Y,Bx);
end
else
if (Key_Code) And (Key=80) And (Y<11) Then
begin
HighBox(5,Y,19,Y,Bx);
Inc(y);
HighBox(5,Y,19,Y,Bx);
end
else
if (Key_Code) And (Key=62) Then
begin
HighBox(5,Y,19,Y,Bx);
Y:=8;
HighBox(5,Y,19,Y,Bx);
if P_Directory(62)<>'' Then
begin
Key:=69;
Key_Code:=False;
New:=True;
Director:=True;
end;
end
else
{F1} if (Key_Code) and (Key=59) Then Help_Keys;
if (Not Key_Code) And (y in[3..11]) And (Key=13) Then
begin
Case y Of
3: if P_Load(4)<>'' Then
begin
Key:=69;
Key_Code:=False;
New:=True;
Load:=True;
end;
4: begin {*Debut Pick*}
Nom_Pick:='';Nom_Reper:='';
Selec_Pick(Nom_Reper,Nom_Pick);
if Nom_Pick='61..'Then
begin
HighBox(5,Y,19,Y,Bx);
Y:=3;
HighBox(5,Y,19,Y,Bx);
if P_Load(4)<>'' Then
begin
Key:=69;
Key_Code:=False;
New:=True;
Load:=True;
end;
end
else
begin
if Nom_Pick='<Load file>' Then Nom_Pick:=P_Pick_Load;
if Nom_Pick='NONAME.???' Then
begin
HighBox(5,Y,19,Y,Bx);
Y:=5;
HighBox(5,Y,19,Y,Bx);
Goto PASE_NEW;
end
else
if (Nom_Pick<>'') And (_Save_Fichier) Then
begin
if P_New<>69 Then {*sauvegarde du fichier actuel*}
Nom_Pick:=''; {*opperation anulle*}
end;
if Nom_Pick<>'' Then
begin
NomFic:=Nom_Pick;
if Nom_Reper<>'' Then Disque_Nom:=Nom_Reper;
Key:=69;
Key_Code:=False;
New:=True;
Load:=True;
end;
end;
end;{*ends Pick*}
5: begin
PASE_NEW:
Key:=P_New;
if Key=69 Then
begin
Key_Code:=False;
New:=True;
end;
end;
6: begin
P_Save(7,'WIN');
if (Not _Save_Fichier) and (NomFic<>'NONAME.???') Then
begin
Tab[1].Rtime:=FileDate(Tab[1].NomR+Tab[1].NomF);
Tab[1].PosX:=X_Curseur;
Tab[1].PosY:=Y_Curseur;
Tab[1].PageDebut:=Debut_Page;
Tab[1].Ligne:=Line_Curseur;
Tab[1].Marque:=Pose_Marque;
end;
Key:=27;
Key_Code:=False;
Termine:=True;
end;
7: begin
Key:=P_Write_TO;
if Key=69 Then
begin
Reinit_Pick(Disque_Nom,NomFic);
Key:=27;
Termine:=True;
Key_Code:=False;
end;
end;
8: if P_Directory(0)<>'' Then
begin
Key:=69;
Key_Code:=False;
New:=True;
Director:=True;
end;
9: P_Change_Dir;
10: begin
save_Fic_forme_win;
end;
11: begin
if _Save_Fichier Then
begin
if P_New = 69 Then Fin_programme:=True;
end
else Fin_programme:=True;
end
end;{*case*}
end;{*begin*}
CsOff;
if Not Termine Then
if (Not New) And (Not Fin_programme) Then
begin
DisplayMouse;
Key:=KeyMouse;
MaskMouse;
if (Key=1) And (not Key_Code) And (Mbox(5,3,19,11)) Then
begin
if MouseY<>Y Then
begin
HighBox(5,Y,19,Y,Bx);
Y:=MouseY;
HighBox(5,Y,19,Y,Bx);
end;
end
else
if (Key=2) And (not Key_Code) And (MouseY = Y) And (Mbox(5,3,19,11)) Then
begin
Key_Code:=False;
Key:=13;
end
else {*Menus*}
if (Key=2) And (not Key_Code) And (Mbox(13,1,44,1)) Then
begin
Key:=0;
Case MouseX Of
13..16: Key:=18; {Edit}
21..27: Key:=24; {Options}
32..35: Key:=38; {Lang}
40..44: Key:=50; {Maths}
else Key:=0;
end;
if (Key<>0) Then
begin
Alt:=True;
Key_Code:=True;
end;
end;
end;
Until ((Not Key_Code) And (Key In [27,101,69])) OR
((Key_Code) And (Alt) And (Key in[18,24,38,50])) OR
((Key_Code) And (Key in[77,75])) OR (Fin_programme);
HighBox(4,1,9,1,Bx);
WriteBuf(3,2,22,13,Menu_Buf^);
Retur1:=Y;
if New Then
begin
TextAttr:=Edit_Color;
Initialiser;
if (Load) OR (Director) Then
begin
if Director Then Disque_Nom:=Disque_Dire;
{=========================================}
{load file format ANSI compatible windows }
{=========================================}
Load_Fichier_Disque_win(Disque_Nom,NomFic);
if NomFic<>'NONAME.???' Then
begin
Reinit_Pick(Disque_Nom,NomFic);
if X_curseur<Max_curseurX Then E_curseurX:=X_curseur
else E_curseurX:=Max_curseurX-1;
Window(1,1,80,CrtGetMaxY);
Window(2,4,79,CrtGetMaxY-1);
Premiere_Page_Debut(Debut_Page);
end;
Window(1,1,80,CrtGetMaxY);
end
else
begin
NomFic:='NONAME.???';
Disque_Nom:=Repertoire;
end;
end;
if ((Key_Code) And (Alt) And (Key in[18,24,38,50])) Then
begin
Case Key Of
18: Menu_File:=2;
24: Menu_File:=3;
38: Menu_File:=4;
50: Menu_File:=5;
end;
end
else
if (Key_Code) And (Key in[77,75]) Then
begin
Case Key of
77: Menu_File:=2; {*Edit; *}
75: Menu_File:=5; {*Menu_Maths*}
end;
end
else
begin
Menu_File:=27;
Retur0:=1;
end;
end; {*ends menu File*}
Procedure Mode_25_50_Lines(Mode:byte);
begin
Max_CurseurX:=78;
Max_CurseurY:=CrtGetMaxY-4; {*position max de verticale*}
TextAttr:=Menu_Color;
Window(1,1,80,CrtGetMaxY);
Writechar(1,1,80,' ');
Putxy(5,1,'File Edit Options Lang Maths');
WriteCar(5,1,'F');
WriteCar(13,1,'E');
WriteCar(21,1,'O');
WriteCar(32,1,'L');
WriteCar(40,1,'M');
TextAttr:=Edit_Color;
Rectangle (1,2,80,CrtGetMaxY,Simple);
Putxy(36,2,' Edit ');
ClearScreen(2, 3, 79, CrtGetMaxY-1,Edit_Color);
TextAttr:=Etat_Color;
Putxy(6,3,'Line');
Putxy(18,3,'Col');
Putxy(28,3,'Insert');
Putxy(35,3,'Indent');
Putxy(49,3,'Unindent');
Putxy(58,3,NomFic);
TextAttr:=Edit_Color;
if X_curseur<Max_curseurX Then E_curseurX:=X_curseur
else E_curseurX:=Max_curseurX-1;
Window(1,1,80,CrtGetMaxY);
Window(2,4,79,CrtGetMaxY-1);
Premiere_Page_Debut(Debut_Page);
Window(1,1,80,CrtGetMaxY);
if Y_curseur>=Max_curseurY Then
begin
Dec(Line_curseur,Y_curseur-(Max_curseurY-1));
Y_curseur:=Max_curseurY-1;
end;
Change_de_ligne:=True;
end;
Function Menu_Options(y:byte):byte;
var Key : byte;
Ok_Ecran : byte;
begin
Ok_Ecran:=0;
HighBox(20,1,28,1,Bx);
Readbuf(20,2,37,10,Menu_Buf^);
BoxColor(22,3,37,10,FondBox);
BoxFill(20,2,35,9,' ');
Rectangle(20,2,35,9,Double);
Putxy(22,3,'Changer Attr');
Putxy(22,4,'Aide general');
Putxy(22,5,'Screen Size ');
Putxy(22,6,'Exten Defaul');
Putxy(22,7,'Table ASCII');
Putxy(22,8,'Information ');
WriteCar(22,3,'C');
WriteCar(22,4,'A');
WriteCar(22,5,'S');
WriteCar(22,6,'E');
WriteCar(22,7,'T');
WriteCar(22,8,'I');
HighBox(21,Y,34,Y,Bx);
Find_Valeur:=0;
Mousexy(19,1);
Repeat
CSOFF;
DisplayMouse;
Key:=KeyMouse;
MaskMouse;
if (Key=1) And (not Key_Code) And (Mbox(21,3,34,8)) Then
begin
if MouseY <> Y Then
begin
HighBox(21,Y,34,Y,Bx);
Y:=MouseY;
HighBox(21,Y,34,Y,Bx);
end;
end
else
if (Key=2) And (not Key_Code) And (MouseY = Y) And (Mbox(21,3,34,8)) Then
begin
Key_Code:=False;
Key:=13;
end
else {*Menus*}
if (Key=2) And (not Key_Code) And (Mbox(5,1,44,1)) Then
begin
Key:=0;
Case MouseX Of
5..8: Key:=33; {File}
13..16: Key:=18; {Edit}
32..35: Key:=38; {Lang}
40..44: Key:=50; {Maths}
else Key:=0;
end;
if (Key<>0) Then
begin
Alt:=True;
Key_Code:=True;
end;
end;
if (Not Key_Code) And (Key in[99,67,97,65,115,83,101,69,84,116,105,73]) Then
begin
HighBox(21,Y,34,Y,Bx);
Case Key of
{C} 99,67: Y:=3;
{A} 97,65: Y:=4;
{S} 115,83: Y:=5;
{E} 101,69: Y:=6;
{T} 84,116: Y:=7;
{I} 105,73: Y:=8;
end; {*case*}
Key:=13;
HighBox(21,Y,34,Y,Bx);
end
else
if (Key_Code) And (Key=72) And (Y>3) Then
begin
HighBox(21,Y,34,Y,Bx);
Dec(y);
HighBox(21,Y,34,Y,Bx);
end
else
if (Key_Code) And (Key=80) And (Y<8) Then
begin
HighBox(21,Y,34,Y,Bx);
Inc(y);
HighBox(21,Y,34,Y,Bx);
end;
if ((y in[3,4,5,6,7,8]) And (Key=13)) Then {*Load*}
begin
Case y Of
3: Change_Attribut;
4: Help_Dans_Index(Repertoire+'FILES\','EDIT13.HLP');
5: begin
Ok_Ecran:=Choix_Ecran;
Key:=0;
end;
6: begin
Extension_Defaut;
Key:=0;
end;
7: begin {*Table ASCII 850 Latin 1*}
ReadBuf(37,4,37+40,4+18,BuffDir^);
TableAscii(37,4);
WriteBuf(37,4,37+40,4+18,BuffDir^);
TextAttr:=Menu_Color;
Key:=0;
end;
8: begin
info_debut_program(10,9);
TextAttr:=Menu_Color;
Key:=0;
end;
end;{*ends case*}
end
else
if (Key_Code) and (Alt) And (Key=45) Then
begin
if _Save_Fichier Then
begin
if P_New = 69 Then Fin_programme:=True;
end
else Fin_programme:=True;
end
else
if (Key_Code) and (Key=59) Then Help_Keys;
Until ((not Key_code) And (Key in [255,27])) OR
((Key_Code) And (Key in[60,61,75,77])) OR
((Key_Code) And (Alt) And (Key in[33,18,38,50])) OR
((Alt) And (Key=106)) OR (Ok_Ecran>0) OR (Find_Valeur=84) Or
(Fin_programme);
HighBox(20,1,28,1,Bx);
Writebuf(20,2,37,10,Menu_Buf^);
Retur3:=Y;
if ((Key_Code) And (Alt) And (Key in[33,18,38,50])) Then
begin
Case Key Of
33: Menu_Options:=1;
18: Menu_Options:=2;
38: Menu_Options:=4;
50: Menu_Options:=5;
end;
end
else
Case Key Of
75: Menu_Options:=2;
77: Menu_Options:=4;
106: begin
Menu_Options:=1;
Retur1:=106;
end;
60: begin
P_Save(7,'WIN');
Menu_Options:=27;
Retur0:=3;
end;
61: begin
Menu_Options:=1;
Retur1:=61;
end;
27: begin
Menu_Options:=27;
Retur0:=3;
end;
end;
if Key=255 THen
begin
X_curseur:=1;
E_curseurX:=1;
Y_curseur:=1;
Line_Curseur:=1;
Debut_Page:=1;
TextAttr:=Edit_Color;
Premiere_Page_Debut(Debut_Page);
Menu_Options:=27;
end
else
if Fin_programme Then Menu_Options:=27;
if Ok_Ecran In[25,50] Then
begin
if (CrtGetMaxY=50) And (Ok_Ecran=25) Then ScreenLine25
else
if (CrtGetMaxY=25) And (Ok_Ecran=50) Then ScreenLine50;
StyleMouse(2,14);
WindowMouse(1,2,CrtGetMaxX,CrtGetMaxY);
Max_CurseurX:=78;
Max_CurseurY:=CrtGetMaxY-4; {*position max de verticale*}
TextAttr:=Menu_Color;
Window(1,1,80,CrtGetMaxY);
Writechar(1,1,80,' ');
Putxy(5,1,'File Edit Options Lang Maths');
WriteCar(5,1,'F');
WriteCar(13,1,'E');
WriteCar(21,1,'O');
WriteCar(32,1,'L');
WriteCar(40,1,'M');
TextAttr:=Edit_Color;
Rectangle(1,2,80,CrtGetMaxY,Simple);
Putxy(36,2,' Edit ');
ClearScreen(2, 3, 79, CrtGetMaxY-1,Edit_Color);
textAttr:=Etat_Color;
Putxy(6,3,'Line');
Putxy(18,3,'Col');
Putxy(28,3,'Insert');
Putxy(35,3,'Indent');
Putxy(49,3,'Unindent');
Putxy(58,3,NomFic);
textAttr:=Edit_Color;
finY:=1;
premiere_Page_Debut(Debut_Page);
if Y_curseur>=Max_curseurY Then
begin
Dec(Line_curseur,Y_curseur-(Max_curseurY-1));
Y_curseur:=Max_curseurY-1;
end;
Change_de_ligne:=True;
Menu_Options:=27;
end;
end;{*Menu Options*}
Function Menu_Language(y:byte):byte;
var Key : byte;
Entree : boolean;
begin
HighBox(31,1,36,1,Bx);
Readbuf(31,2,52,12,Menu_Buf^);
BoxColor(33,3,52,12,FondBox);
BoxFill(31,2,50,11,' ');
Rectangle (31,2,50,11,Double);
Putxy(33,3,'Block '+#26+' Notes ');
Putxy(33,4,'Phrases '+#26+' Notes');
Putxy(33,5,'Fran‡ais Anglais');
Putxy(33,6,'Anglais Fran‡ais');
Putxy(33,7,'Tables de verbes');
Putxy(33,8,'Examples Find ');
Putxy(33,9,'Repertoire Find');
Putxy(33,10,'Change of notes');
WriteCar(33,3,'B');
WriteCar(33,4,'P');
WriteCar(33,5,'F');
WriteCar(33,6,'A');
WriteCar(33,7,'T');
WriteCar(33,8,'E');
WriteCar(33,9,'R');
WriteCar(33,10,'C');
HighBox(32,Y,49,Y,Bx);
Mousexy(30,1);
Repeat
CSOFF;
DisplayMouse;
Key:=KeyMouse;
MaskMouse;
if (Key=1) And (not Key_Code) And (Mbox(32,3,49,10)) Then
begin
if MouseY <> Y Then
begin
HighBox(32,Y,49,Y,Bx);
Y:=MouseY;
HighBox(32,Y,49,Y,Bx);
end;
end
else
if (Key=2) And (not Key_Code) And (MouseY = Y) And (Mbox(32,3,49,10))
Then
begin
Key_Code:=False;
Key:=13;
end
else {*Menus*}
if (Key=2) And (not Key_Code) And (Mbox(5,1,44,1)) Then
begin
Key:=0;
Case MouseX Of
5..8: Key:=33; {File}
13..16: Key:=18; {Edit}
21..27: Key:=24; {Options}
40..44: Key:=50; {Maths}
else Key:=0;
end;
if (Key<>0) Then
begin
Alt:=True;
Key_Code:=True;
end;
end;
if (Not Key_Code) And
(Key in[66,98,80,112,70,102,65,97,84,116,69,101,82,114,67,99]) Then
begin
HighBox(32,Y,49,Y,Bx);
Case Key of
{B} 66,98: Y:=3;
{P} 80,112: Y:=4;
{F} 70,102: Y:=5;
{A} 65,97: Y:=6;
{T} 84,116: Y:=7;
{E} 69,101: Y:=8;
{R} 82,114: Y:=9;
{C} 67,99: Y:=10;
end; {*case*}
Key:=13;
HighBox(32,Y,49,Y,Bx);
end
else
if (Key_Code) And (Key=72) And (Y>3) Then
begin
HighBox(32,Y,49,Y,Bx);
Dec(y);
HighBox(32,Y,49,Y,Bx);
end
else
if (Key_Code) And (Key=80) And (Y<10) Then
begin
HighBox(32,y,49,Y,Bx);
Inc(y);
HighBox(32,Y,49,Y,Bx);
end;
if ((y in[3,4,5,6,7,8,9,10]) And (Key=13)) Then
begin
Case y Of
3: Lire_Phrases(25,4,Dic_Nom8);
4: Lire_Phrases(25,5,Dic_Nom7);
5: begin
Entree:=Texte_traduction(6,'F');
if Copy_Exemples Then
begin
Key_code:=False;
Key:= 27;
end;
end;
6: begin
Entree:=Texte_traduction(7,'A');
if Copy_Exemples Then
begin
Key_code:=False;
Key:= 27;
end;
end;
7: begin
Nom_Help:=Table_De_Verbes(FondBox);
if Nom_Help<>'' Then LireTexte(Disque_Help,Nom_Help);
Nom_Help:='*.Hlp';
if Copy_Exemples Then
begin
Key_code:=False;
Key:= 27;
end;
end;
8: begin
Dir_Nom_Help;
if Nom_Help<>'*.Hlp' Then LireTexte(Disque_Help,Nom_Help);
if Copy_Exemples Then
begin
Key_code:=False;
Key:= 27;
end;
end;
9: Change_Repertoire_Langage(FondBox);
10: Change_Nom_Fic_Notes(10)
end;
end
else
if (Key_Code) and (Alt) And (Key=45) Then
begin
if _Save_Fichier Then
begin
if P_New = 69 Then Fin_programme:=True;
end
else Fin_programme:=True;
end
else
if (Key_Code) and (Key=59) Then Help_Keys;
Until ((not Key_code) And (Key = 27)) OR
((Key_Code) And (Key in[60,61,75,77])) OR
((Key_Code) And (Alt) And (Key in[33,18,24,50])) OR
((Alt) And (Key=106)) OR (Fin_programme);
HighBox(31,1,36,1,Bx);
Writebuf(31,2,52,12,Menu_Buf^);
Retur4:=Y;
if ((Key_Code) And (Alt) And (Key in[33,18,24,50])) Then
begin
Case Key Of
33: Menu_Language:=1;
18: Menu_Language:=2;
24: Menu_Language:=3;
50: Menu_Language:=5;
end;
end
else
Case Key Of
75: Menu_Language:=3;
77: Menu_Language:=5;
106: begin
Menu_Language:=1;
Retur1:=106;
end;
60: begin
P_Save(7,'WIN');
Menu_Language:=27;
Retur0:=3;
end;
61: begin
Menu_Language:=1;
Retur1:=61;
end;
27: begin
Menu_Language:=27;
Retur0:=4;
end;
end;
if Fin_programme Then Menu_Language:=27;
end;{*langage*}
Function Menu_Mathes(y:byte):byte;
Var Key:byte;
Sn:string[10];
Lignes:byte;
Entree,Colory:boolean;
type_Ecran: boolean;
Erreur,nn:integer;
Snn:string;
begin
Colory:=False;
type_Ecran:=false;
HighBox(39,1,45,1,Bx);
Readbuf(39,2,57,13,Menu_Buf^);
BoxColor(41,3,56,12,FondBox);
BoxFill(39,2,54,10,' ');
Rectangle(39,2,55,10,Simple);
Putxy(41,3,'Calculatrice');
Putxy(41,4,'Calculator');
Putxy(41,5,'Rotation G3');
Putxy(41,6,'Distan Angle');
Putxy(41,7,'G3 Centre-Arc');
Putxy(41,8,'Light Colours');
Putxy(41,9,'Delay Mouse');
WriteCar(41,3,'C');
WriteCar(42,4,'a');
WriteCar(41,5,'R');
WriteCar(41,6,'D');
WriteCar(41,7,'G');
HighBox(40,Y,54,Y,Bx);
Mousexy(38,1);
Repeat
Csoff;
DisplayMouse;
Key:=KeyMouse;
MaskMouse;
if (Key=1) And (not Key_Code) And (Mbox(40,3,54,8)) Then
begin
if MouseY <> Y Then
begin
HighBox(40,Y,54,Y,Bx);
Y:=MouseY;
HighBox(40,Y,54,Y,Bx);
end;
end
else
if (Key=2) And (not Key_Code) And (MouseY = Y) And (Mbox(40,3,54,8))
Then
begin
Key_Code:=False;
Key:=13;
end
else {*Menus*}
if (Key=2) And (not Key_Code) And (Mbox(5,1,35,1)) Then
begin
Key:=0;
Case MouseX Of
5..8: Key:=33; {File}
13..16: Key:=18; {Edit}
21..27: Key:=24; {Options}
32..35: Key:=38; {Lang}
else Key:=0;
end;
if (Key<>0) Then
begin
Alt:=True;
Key_Code:=True;
end;
end;
if (Not Key_Code) And
(Key in[67,99,65,97,82,114,68,100,71,103]) Then
begin
HighBox(40,Y,54,Y,Bx);
Case Key of
{C} 67,99: Y:=3;
{a} 65,97: Y:=4;
{R} 82,114: Y:=5;
{D} 68,100: Y:=6;
{G} 71,103: Y:=7;
end; {*case*}
Key:=13;
HighBox(40,Y,54,Y,Bx);
end;
if (Key_Code) And (Key=80) And (Y<9) Then
begin
HighBox(40,Y,54,Y,Bx);
Inc(Y);
HighBox(40,Y,54,Y,Bx);
end
else
if (Key_Code) And (Key=72) And (Y>3) Then
begin
HighBox(40,Y,54,Y,Bx);
Dec(Y);
HighBox(40,Y,54,Y,Bx);
end
else
if (Not Key_Code) and (Key=13) Then
begin
if Y=3 Then
begin
ReadBuf(49,4,51+26,5+11,BuffDir^);
BoxColor(51,5,51+26,5+11,FondBox);
Calculatrice(49,4,Calculatrice_S2,Calculatrice_S3,Calculatrice_Total,Calculatrice_TotalM);
WriteBuf(49,4,51+26,5+11,BuffDir^);
CSOff;
end
else
if Y=4 Then
begin
if (_Save_Fichier) OR (NomFic='NONAME.???') then
begin
TextAttr:=Menu_Color;
if P_New<>69 then
begin
Entree1:=True;
end;
if (_Save_Fichier) And (NomFic<>'') And
(NomFic<>'NONAME.???') then
begin
Save_Fichier_Disque(Disque_Nom,NomFic);
end;
end;
Window(1,1,80,CrtGetMaxY);
if CrtGetMaxY=50 then ScreenLine25;
Calculator;
Colory:=true;
end
else
if Y=5 Then
begin
ReadBuf(48,6,50+30,7+8,BuffDir^);
BoxColor(50,7,50+30,7+8,FondBox);
DONNE_ROTATION_G3(48,6);
WriteBuf(48,6,50+30,7+8,BuffDir^);
end
else
if Y=6 Then
begin
ReadBuf(48,7,50+30,8+7,BuffDir^);
BoxColor(50,8,50+30,8+7,FondBox);
Cherche_Rayon(48,7);
WriteBuf(48,7,50+30,8+7,BuffDir^);
end
else
if Y=7 Then
begin
ReadBuf(48,8,50+30,9+11,BuffDir^);
BoxColor(50,9,50+30,9+11,FondBox);
Calcul_Centre_Arc(48,8);
WriteBuf(48,8,50+30,9+11,BuffDir^);
end
else
if Y=8 Then
begin
Key:=0;
ReadBuf(35,9,35+38,12,BuffDir^);
BoxColor(36,10,35+38,12,FondBox);
BoxFill(35,9,35+38,11,' ');
Rectangle (35,9,35+38,11,Simple);
Putxy(37,10,'Modification des Couleurs [Y/N]');
CsOff;
Repeat
Key:=Keyboard;
Until Key in[89,121,78,110,27];
writeBuf(35,9,35+38,12,BuffDir^);
if Key in[89,121] Then
begin
Mode_Color(Repertoire+'FILES\EDIT13.INI');
Colory:=True;
FondBox:=Edit_Color-(((Edit_Color And $70) shr 4) * 16);
Fond__Box:=FondBox;
end;
Key:=27;
end;
if Y=9 Then
begin
Key:=0;
nn:=DelayMouse;
ReadBuf(40,10,40+35,13,BuffDir^);
BoxColor(41,11,40+35,13,FondBox);
BoxFill(40,10,40+33,12,' ');
Rectangle(40,10,40+33,12,Simple);
Putxy(42,11,'Delay de la Soris: ');
Str(nn,Snn);
Entree:=ReadBox(61,11,Snn,4,5);
{$R-}
Val(Snn,nn,Erreur);
{$R+}
if (Erreur=0) then
begin
if (Entree) and (nn in[2..150]) Then
begin
BoxFill(40,10,40+33,12,' ');
Rectangle(40,10,40+33,12,Simple);
Putxy(42,11,'Modification de souris [Y/N]');
CsOff;
Repeat
Key:=KeyBoard;
Until Key in[89,121,78,110,27];
end;
end;
writeBuf(40,10,40+35,13,BuffDir^);
if Key in[89,121] Then
begin
DelayPose:=nn div 2; {*Editeur*}
DelayMouse:=nn; {*vitese de Mousse*}
Tempo__Mouse:=Round(DelayMouse)+1;
key:=27;
end;{*key=Y*}
Csoff;
end;
end
else
if (Key_Code) and (Alt) And (Key=45) Then
begin
if _Save_Fichier Then
begin
if P_New = 69 Then Fin_programme:=True;
end
else Fin_programme:=True;
end
else
if (Key_Code) and (Key=59) Then Help_Keys;
Until ((Not key_Code) And (Key in[27])) OR
((key_Code) And (Key in[75,77])) OR
((Key_Code) And (Alt) And (Key in[33,18,24,38])) OR
(Fin_Programme) OR (Colory);
if Not Colory Then
begin
writeBuf(39,2,57,13,Menu_Buf^);
HighBox(39,1,45,1,Bx);
end
else
begin
Window(1,1,80,CrtGetMaxY);
EDIt_ECRAN;
TextAttr:=Edit_Color;
if X_curseur<Max_curseurX then E_curseurX:=X_curseur
else E_curseurX:=Max_curseurX-1;
Window(1,1,80,CrtGetMaxY);
Window(2,4,79,CrtGetMaxY-1);
Premiere_Page_Debut(Debut_Page);
if Y_curseur>=Max_curseurY then
begin
Dec(Line_curseur,Y_curseur-(Max_curseurY-1));
Y_curseur:=Max_curseurY-1;
end;
Change_de_ligne:=True;
Key:=27;
end;
Retur5:=Y;
if ((Key_Code) And (Alt) And (Key in[33,18,24,38])) Then
begin
Case Key Of
33: Menu_Mathes:=1;{F}
18: Menu_Mathes:=2;{E}
24: Menu_Mathes:=3;{O}
38: Menu_Mathes:=4;{L}
end;
end
else
if Fin_Programme Then Menu_Mathes:=27
else
Case Key Of
75: Menu_Mathes:=4;
77: Menu_Mathes:=1;
27: begin
Menu_Mathes:=27;
Retur0:=5;
end;
end;
end; {*ends menu Mathes*}
{$i M_EDIT.pas} {*Menu Edit de Editeur*}
Function Menu_General(X:byte):byte;
Const XL:Array[1..5] OF byte=(9,17,28,36,44);
X1:Array[1..5] OF byte=(4,12,20,31,39);
var Key:byte;
begin
Key:=0;
TextAttr:=Menu_Color;
HighBox(X1[X],1,XL[x],1,Bx);
CSOFF;
Repeat
Key:=KeyBoard;
if (Key_Code) And (Key=75) Then
begin
HighBox(X1[X],1,XL[x],1,Bx);
if X=1 Then X:=5
else Dec(x);
HighBox(X1[X],1,XL[x],1,Bx);
end
else
if (Key_Code) And (key=77) Then
begin
HighBox(X1[x],1,XL[x],1,Bx);
if X=5 Then X:=1
else Inc(x);
HighBox(X1[x],1,XL[x],1,Bx);
end
else
if (Key_Code) and (Key=60) Then P_Save(7,'WIN')
else
if (Key_Code) and (Alt) And (Key=45) Then
begin
if _Save_Fichier Then
begin
if P_New = 69 Then Fin_Programme:=True;
end
else Fin_Programme:=True;
end
else
if (Key_Code) and (Key=59) Then Help_Keys;
Until ((not Key_code) And
(Key in [27,70,102,69,101,72,104,76,108,77,109])) OR
((x in[1,2,3,4,5]) and (Key=13)) OR
((Key_Code) And (Key in[60])) OR
((Key_Code) And (Alt) And (Key in[33,18,35,38,50])) OR
((Alt) And (Key=106)) OR (Fin_Programme);
HighBox(X1[x],1,XL[x],1,Bx);
Retur0:=x;
if Fin_Programme Then Menu_General:=27
else
if (Key=13) And (Not Fin_programme) Then Menu_General:=X
else
if (Not Key_Code) And
(Key In[27,70,102,69,101,72,104,76,108,77,109]) Then
begin
Case Key OF
{F} 70,102: Menu_General:=1;
{E} 69,101: Menu_General:=2;
{H} 72,104: Menu_General:=3;
{L} 76,108: Menu_General:=4;
{M} 77,109: Menu_General:=5;
{Edit} 27: Menu_General:=27;
end;
end
else
if ((Key_Code) And (Alt) And (Key in[33,18,35,38])) Then
begin
Case Key Of
33: Menu_General:=1;
18: Menu_General:=2;
35: Menu_General:=3;
38: Menu_General:=4;
50: Menu_General:=5;
end;
end
else
if Key in[60,106] Then
begin
Menu_General:=1;
Case Key OF
60: Retur1:=60;
106: Retur1:=106;
end;
end
else
Menu_General:=27;
end;{*menu general*}
Procedure Appel_Menu(N:byte);
begin
Repeat
Case n Of
0: N:=Menu_General(Retur0);
1: N:=Menu_File(Retur1);
2: N:=Edit(Retur2);
3: N:=Menu_Options(Retur3);
4: N:=Menu_Language(Retur4);
5: N:=Menu_Mathes(Retur5);
end;
Until (N=27);
end;{*appel menu*}
Unit NUMMOUSE▲
Sélectionnez
{========================= EDIT13 ========================}
{*EDit13 version 4.002e units buffers d'éditeur de texte *}
{*Copyright (S) 1997-2012 programmeur du logiciel A.Ara *}
{*Licence d'utilisation accord dans un but demonstratif *}
{*mummouse.pas; la vente du logiciel et interdite. *}
{*Numero de serie 00-441-7441-B21111946bb *}
{==========================================================}
{* fonctionnement souri du programme lancer MOUSE.COM *}
{* Version: 000003.crt *}
{* Gestion de la Souris mode texte ver turbo pascal 5,6,7 *}
{* Date: 23/03/1996 Author A.ARA *}
{==========================================================}
{$O+,F+}
Unit NUMMOUSE;
Interface
Const
MouseOk : Boolean = False;
Tempo__Mouse: Word = 1;
TYPE
PTRView = Longint;
Point = Record
x,y:Integer;
end;
Var
BoutMouse : Integer;
MouseX,MouseY : Integer;
PtMouse : Point;
Veille : Integer;
Function GetKeyMouseWord:Word;
Function InitMouse:Boolean;
Procedure StyleMouse(Caractere,Colory:Byte);
Procedure MouseXY(PosX,Posy:Byte);
Procedure WindowMouse(x1,y1,x2,y2:Byte);
Procedure ControlMouse;
Procedure DisplayMouse;
Procedure MaskMouse;
Function KeyMouse:Byte;
{---Assembleur---}
Function Mput(x,y:Byte):Boolean;
Function Mbox(x1,y1,x2,y2:Byte):Boolean;
Implementation
Uses Crt,Dos,bos13,Get_Key;
Type PTRRec = Record
Ofs:Word;
Seg:Word;
end;
PTRvRec = Record
ScreenMask:Word;
CursorMask:Word;
end;
Var MouseOn : Boolean;
IntSaveMouse: Pointer;
KeyCapsOn : Boolean;
KeyNumOn : Boolean;
time : Longint absolute $40:$6C;
BiosKbFlag : Byte absolute $40:$17;
ActStatus : Byte;
ExitOld : Pointer;
h1,minutes1,s01,hund22 : Word;
Function PtrDifChar(Car:Byte):Word;
begin
PtrDifChar:=Car Shl 8;
end;
Function PtrDifCol(Color:Byte):Word;
begin
PtrDifCol:=Color Shl 8;
end;
Function MouPtrMask(Car,Color:Word):PtrView;
Var Mask:PtrView;
begin
PTRVRec(Mask).ScreenMask:=((Color and $ff) shl 8) + (Car And $FF);
PTRVRec(Mask).CursorMask:=(Color And $ff00)+(Car shr 8);
MouPtrMask:=Mask;
end;
Procedure ChangeMouse(Mask:PtrView);
Var Reg:Registers;
begin
Reg.AX:=$000a;
Reg.BX:=0;
Reg.CX:=PtrVRec(Mask).ScreenMask; {*Ecran Couleur Fise *}
Reg.DX:=PtrVRec(Mask).CursorMask; {*curseur Caractere ASCII*}
Intr($33,Reg);
end;
Procedure ControlMouse;
Var Reg:Registers;
begin
Reg.AX:=$0003;
Intr($33,Reg);
BoutMouse:=Reg.BX;
PtMouse.X:=(Reg.CX shr 3) +1;
PTMouse.Y:=(Reg.DX Shr 3) +1;
MouseX:=PtMouse.X;
MouseY:=PtMouse.Y;
end;
Procedure MaskMouse;
Var Reg:Registers;
begin
if MouseOn Then
begin
Reg.AX:=$0002;
Intr($33,Reg);
MouseOn:=False;
end;
end;
Procedure DisplayMouse;
Var Reg:Registers;
begin
if Not MouseOn Then
begin
Reg.AX:=$0001;
Intr($33,Reg);
MouseOn:=True;
end;
end;
Procedure MouseXY(PosX,PosY:Byte);
Var Reg:Registers;
begin
Reg.Ax:=$0004;
MouseX:=PosX;
MouseY:=PosY;
Reg.CX:=Integer(PosX-1) shl 3;
Reg.DX:=Integer(PosY-1) shl 3;
Intr($33,Reg);
end;
{--------------------------------------------}
{* Fixe la zone de deplacement de la souris *}
{--------------------------------------------}
Procedure WindowMouse(x1,y1,x2,Y2:Byte);
Var Reg:Registers;
begin
Reg.AX:=$0008;
Reg.CX:=Integer(y1-1) shl 3;
Reg.DX:=Integer(y2-1) shl 3;
Intr($33,Reg);
Reg.AX:=$0007;
Reg.CX:=Integer(x1-1) shl 3;
Reg.DX:=Integer(x2-1) shl 3;
Intr($33,Reg);
end;
Function Time_Temps_Veille(A:Integer):Integer;
Var hh,mm,ss,hund:Word;
begin
GetTime(hh,mm,ss,hund);
A:=A+mm;
if (A 59) Then A:=(A-59);
if A<0 Then A:=A*(-1)
else
if A>59 Then A:=59;
Time_Temps_Veille:=A;
end;
Function GetKeyMouseWord:Word;
Var Reg:Registers;
Touche:Boolean;
tt:Integer;
begin
tt:=0;
Touche:=False;
Reg.AX:=$0C00;
MsDos(Reg);
tt:=Time_Temps_Veille(Veille);
Repeat
GetTime(h1,minutes1,s01,hund22);
if (tt=minutes1) Then
begin
GetKeyMouseWord:=24832; {CtrlF4}
Touche:=True;
end;
Reg.ax:=$200;
Intr($16,Reg);
Reg.AX:=$100;
Intr($16,Reg);
if (Reg.flags And 64 =0) Then
begin
Touche:=True;
Reg.ax:=0;
Intr($16,Reg);
if (Reg.ax and 255 =0) Then
begin
BoutMouse:=0;
GetkeyMouseWord:=Reg.ax;
end
else
begin
BoutMouse:=0;
GetKeyMouseWord:=Reg.ax And 255;
end;
if Mem[0:$417] And 128 = 128 Then Inser_Mode:=True
else Inser_mode:=False;
if Mem[0:$417] And 8 = 8 Then Alt :=True
else Alt:=False;
if Mem[0:$417] And 4 = 4 Then Ctrl:=True
else Ctrl:=False;
if Mem[0:$417] And 2 = 2 Then Shift_G:=True
else Shift_G:=False;
if Mem[0:$417] And 1 = 1 Then Shift_D:=True
else Shift_D:=False;
end
else
begin
Reg.AX:=3;
Intr($33,Reg);
if Reg.BX in[1,2] Then
begin
BoutMouse:=Reg.BX;
PtMouse.X:=(Reg.CX shr 3) +1;
PTMouse.Y:=(Reg.DX Shr 3) +1;
MouseX:=PtMouse.X;
MouseY:=PtMouse.Y;
Touche:=True;
GetKeyMouseWord:=BoutMouse+255;
if Mem[0:$417] And 128 = 128 Then Inser_Mode:=True
else Inser_mode:=False;
if Mem[0:$417] And 8 = 8 Then Alt :=True
else Alt:=False;
if Mem[0:$417] And 4 = 4 Then Ctrl:=True
else Ctrl:=False;
if Mem[0:$417] And 2 = 2 Then Shift_G:=True
else Shift_G:=False;
if Mem[0:$417] And 1 = 1 Then Shift_D:=True
else Shift_D:=False;
end;
end;
Until (Touche);
end; {*end GetkeyMouseWord*}
{---Assembleur MOUSEBOX.ASM---}
{$L MOUSEBOX}
Function Mput(x,y:Byte):Boolean;
External {MOUSEBOX};
Function Mbox(x1,y1,x2,y2:Byte):Boolean;
External {MOUSEBOX};
Function KeyMouse:Byte;
Var Reg : Registers;
Touche: Boolean;
begin
BoutMouse:=0;
Touche:=False;
Reg.AX:=$0C00;
MsDos(Reg);
Repeat
Reg.ax:=$200;
Intr($16,Reg);
Reg.AX:=$100;
Intr($16,Reg);
if (Reg.flags And 64 =0) Then
begin
Touche:=True;
Reg.ax:=0;
Intr($16,Reg);
if (Reg.ax and 255 =0) Then
begin
Key_Code:=True;
keyMouse:=Reg.ax shr 8 Or $100;
end
else
begin
Key_Code:=False;
KeyMouse:=Reg.ax And 255;
end;
end
else
begin
Reg.AX:=3;
Intr($33,Reg);
if Reg.BX <>0 Then
begin
BoutMouse:=Reg.BX;
PtMouse.X:=(Reg.CX shr 3) +1;
PTMouse.Y:=(Reg.DX Shr 3) +1;
MouseX:=PtMouse.X;
MouseY:=PtMouse.Y;
Touche:=True;
if BoutMouse = 1 Then
begin
Delay(Tempo__Mouse);
end
else
if BoutMouse = 2 Then
begin
Delay(Tempo__Mouse);
end;
Key_Code:=False;
if BoutMouse=3 Then
begin
KeyMouse:=27;
end
else
begin
KeyMouse:=BoutMouse;
Delay(Tempo__Mouse);
end;
end;
end;
Until (Touche);
if Mem[0:$417] And 128 = 128 Then Inser_Mode:=True
else Inser_mode:=False;
if Mem[0:$417] And 8 = 8 Then Alt :=True
else Alt:=False;
if Mem[0:$417] And 4 = 4 Then Ctrl:=True
else Ctrl:=False;
if Mem[0:$417] And 2 = 2 Then Shift_G:=True
else Shift_G:=False;
if Mem[0:$417] And 1 = 1 Then Shift_D:=True
else Shift_D:=False;
end; {*end keyMouse*}
{---------------------------------------------------------}
{* Procedure de exit n'a donc pas besoin de etre appele *}
{---------------------------------------------------------}
Procedure CloseCrtMouse;
Var Reg:Registers;
begin
MaskMouse;
Reg.AX:=0;
Intr($33,Reg);
ExitProc:=ExitOld;
end;
Procedure StyleMouse(Caractere,Colory:Byte);
begin
ChangeMouse(MouPtrMask(PtrDifChar(Caractere),PtrDifCol(Colory)));
end;
Function InitMouse : Boolean;
Var Reg:Registers;
begin
Reg.AX:=0;
Intr($33,Reg);
InitMouse:=(reg.ax=$FFFF);
if (Reg.AX=$FFFF) Then
begin
MouseY:=Hi(WindMax)+1;
MouseX:=Lo(WindMax)+1;
MouseY:=Hi(WindMax)+1;
MouseX:=Lo(WindMax)+1;
MouseOn:=False;
BoutMouse:=0;
PtMouse.X:=1;
PtMouse.Y:=1;
ExitOld:=ExitProc;
ExitProc:=@CloseCrtMouse;
StyleMouse(2,14);
MouseOk:=True;
InitMouse:=True;
end
else
begin
MouseOk:=False;
MouseOn:=False;
InitMouse:=False;
end;
end;
begin
Veille:=10;
end. {**Fin Unit CrtMouse**}
MOUSEBOX.ASM▲
Sélectionnez
{=====================EDIT13 MOUSEBOX====================}{*EDit13 version 4.002e units buffers d'éditeurdetexte*}{*Copyright (S)1997-2012programmeur du logiciel A.Ara*}{*Licence d'utilisationaccorddansunbutdemonstratif*}{*MOUSEBOX.ASM : la vente du logiciel et interdite.*}{*Numero de serie00-441-7441-B21111946bb*}{*Date:23/03/1996Author A.ARA*}{==========================================================}TITLEMOUSEBOXLOCALS @@
DATA
SEGMENTWORDPUBLICASSUMEDS:DATAEXTRNMouseX:BYTE,MouseY:BYTEDATA
ENDSCODE
SEGMENTBYTEPUBLICASSUMECS:CODEPUBLICMput,MboxMput:;FunctionMput(x,y:Byte):Boolean;x=[BP+8]y=[BP+6]PUSHBP;InitialiselapileMOVBP,SP;metlavaleurdeSPdansBPCALLCrtMputMOVSP,BP;Reprendl'ancienSPPOPBP;DepileBPRETF4;RetourFaraUnitappelant;retirelesargumentsdelapileMbox:;FunctionMbox(x1,y1,x2,y2:Byte):Boolean;[BP+12],[BP+10],[BP+8],[BP+6]PUSHBP;InitialiselapileMOVBP,SP;metlavaleurdeSPdansBPCALLCrtMBoxMOVSP,BP;Reprendl'ancienSPPOPBP;DepileBPRETF8;RetourFar…Unitappelant;retirelesargumentsdelapileCrtMput:MOVDL,[BP+8];chargeXMOVDH,[BP+6];chargeYCMPDL,MouseX;SautsinoegalJNECrtExit1CMPDH,MouseYJNECrtExit1;sautsinoegalMOVAL,01h;ResutategaltrueRETCrtMbox:MOVDL,[BP+12];chargeX1MOVDH,[BP+8];chargeX2CMPDL,MouseX;SautsiX1superieurMouseXJGCrtExit2CMPDH,MouseXJLCrtExit2;sautsiX2inferieur…MouseXMOVDL,[BP+10];chargeY1MOVDH,[BP+6];chargeY2CMPDL,MouseY;SautsiY1Suprieur…MouseYJGCrtExit2CMPDH,MouseYJLCrtExit2;sautsiY2inferieur…MouseYMOVAL,01h;ResutategaltrueRETCrtExit1:MOVAX,0000h;AXPrendlavaleurde0RET;ResutategalFalseCrtExit2:MOVAX,0000h;AXPrendlavaleurde0RET;ResutategalFalseCODE
ENDSEND
Unit U_Pick▲
Sélectionnez
{========================== EDIT13 ========================}
{* EDit13 version 4.002e units buffers d'éditeur de texte *}
{* Copyright (S) 1997-2012 programmeur du logiciel A.Ara *}
{* Licence d'utilisation accord dans un but demonstratif *}
{* u_pick.pas - la vente du logiciel et interdite. *}
{* Numéro de série 00-441-7441-B21111946bb *}
{===========================================================}
{$O+,F+}
Unit U_Pick;
Interface
Type
Pose_Marque_Fic = Array[1..4] Of Word;
Reg_Pick = Record
NomF : String[12];
NomR : String[60];
posX,posY: Byte;
pageDebut: Word;
Ligne : Word;
Marque : Pose_Marque_Fic;
RTime : Longint;
end;
Fichier5 = File of Reg_Pick;
Var
Tab : Array[1..10] OF Reg_Pick;
Pose_Marque : Pose_Marque_Fic;
Marque_Pick : Pose_Marque_Fic;
Libre10 : Fichier5;
Procedure Init_Pick;
Procedure Selec_Pick(var Reper,NeimeF:String);
Procedure Reinit_Pick(SR,SN:String);
Implementation
Uses Box13,Var_1,Buffs,Get_Key,NUMMOUSE;
Procedure Init_Pick;
var i:Byte;
begin
For i:=1 To 4 DO
Pose_Marque[i]:=0;
For i:=1 TO 10 DO
begin
Tab[i].NomF:='';
Tab[i].NomR:='';
Tab[i].posX:=1;
Tab[i].posY:=1;
Tab[i].PageDebut:=1;
Tab[i].ligne:=1;
Tab[i].Marque:=Pose_Marque;
Tab[i].Rtime:=0;
end;
Tab[1].NomF:='NONAME.???';
Tab[1].NomR:='';
Tab[2].NomF:='<Load file>';
Tab[2].NomR:='';
Max_Pick:=2;
end;
Procedure Selec_Pick(Var Reper,NeimeF:String);
var i,y,Long,Key : Byte;
begin
i:=1;Long:=13;
While (i<=10) And (Tab[i].NomF<>'') DO
begin
if (Tab[i].NomR<>Repertoire) And (tab[i].NomR<>'') Then
if (Long < Length(Tab[i].NomF+Tab[i].NomR)) Then
Long:=Length(Tab[i].NomF+Tab[i].NomR);
inc(i);
end;
ReadBuf(6,5,9+Long,16,BuffDir^);
BoxFill(6,5,9+Long,6+Max_Pick,' ');
Rectangle(6,5,9+Long,6+Max_Pick,Simple);
Putxy(6+((Long-9) div 2),5,' Recent files ');
{*** Affichage ***}
i:=1;
While (i<=10) And (Tab[i].NomF<>'') DO
begin
if Tab[i].NomR=Repertoire Then
Putxy(8,5+i,Tab[i].NomF)
else
Putxy(8,5+i,Tab[i].nomR+Tab[i].NomF);
inc(i);
end;
{*** Selection ***}
Y:=7;
Highbox(7,Y,Long+8,Y,Bx);
Mousexy(6,5);
CsOff;
Repeat
DisplayMouse;
Key:=KeyMouse;
MaskMouse;
if (Key=1) And (not Key_Code) And (Mbox(7,6,8+Long,5+Max_Pick)) Then
begin
if MouseY<>Y Then
begin
Highbox(7,Y,8+long,Y,Bx);
Y:=MouseY;
Highbox(7,Y,8+long,Y,Bx);
end;
end
else
if (Key=2) And (not Key_Code) And (MouseY = Y) And
(Mbox(7,6,8+Long,5+Max_Pick)) Then
begin
Key_Code:=False;
Key:=13;
end;
if (Key =80) And (Y<Max_Pick+5) Then
begin
Highbox(7,Y,8+long,Y,Bx);
Inc(y);
Highbox(7,Y,8+long,Y,Bx);
end
else
if (Key =72) And (Y>6) Then
begin
Highbox(7,Y,8+long,Y,Bx);
Dec(y);
Highbox(7,Y,8+long,Y,Bx);
end;
Until (Key in[27,13]) OR ((Key_Code) And (Key =61));
Highbox(7,Y,8+long,Y,Bx);
if (Key_Code) And (Key =61) Then NeimeF:='61..'
else
if Key = 13 Then
begin
Reper:=Tab[y-5].NomR;
NeimeF:=Tab[y-5].NomF;
end
else
begin
Reper:='';
NeimeF:='';
end;
WriteBuf(6,5,9+Long,16,BuffDir^);
end;
Procedure Reinit_Pick(SR,SN:String);
var i : Byte;
Trouve: Boolean;
begin
Trouve:=False;
i:=1;
SR:=Uppers(SR);
SN:=Uppers(SN);
if (SN=Tab[1].NomF) And (SR=Tab[1].NomR) Then
begin
Tab[1].marque:=Marque_Pick;
Tab[1].PosX:=X_Pick;
Tab[1].PosY:=Y_Pick;
Tab[1].PageDebut:=Page_Pick;
Tab[1].Ligne:=Line_Pick;
Tab[1].Rtime:=FileDate(Tab[1].NomR+Tab[1].NomF);
X_Curseur:=X_Pick;
Y_Curseur:=Y_Pick;
Debut_page:=Page_Pick;
Line_Curseur:=Line_Pick;
end
else
begin
if SN='NONAME.???' Then SR:='';
While (i<10) And (Tab[i].NomF<>'') DO
begin
if (SN=Tab[i].NomF) And (SR=Tab[i].NomR) Then
begin
if Tab[i].Rtime=FileDate(Tab[i].NomR+Tab[i].NomF) Then
begin
Debut_page:=Tab[i].PageDebut;
X_Curseur:=Tab[i].posX;
if X_curseur<Max_curseurX Then E_curseurX:=X_curseur;
Y_Curseur:=Tab[i].posY;
Line_Curseur:=Tab[i].Ligne;
Pose_Marque:=Tab[i].marque;
end;
Trouve:=True;
While (i<Max_Pick) And (Tab[i].NomF<>'') DO
begin
Tab[i]:=tab[i+1];
Inc(i);
end;
Tab[i].NomF:='';
Tab[i].NomR:='';
Dec(Max_Pick);
end;
Inc(i);
end;
i:=Max_Pick+1;
While (i>1) DO
begin
Tab[i]:=tab[i-1];
Dec(i);
end;
Tab[1].NomF:=SN;
Tab[1].NomR:=SR;
if Tab[2].NomF<>'NONAME.???' Then
begin
Tab[2].PosX:=X_Pick;
Tab[2].PosY:=Y_Pick;
Tab[2].PageDebut:=Page_Pick;
Tab[2].Ligne:=Line_Pick;
Tab[2].Marque:=Marque_Pick;
Tab[2].Rtime:=FileDate(Tab[2].NomR+Tab[2].NomF)
end
else
begin
Tab[2].PosX:=1;
Tab[2].PosY:=1;
Tab[2].PageDebut:=1;
Tab[2].Ligne:=1;
For i:=1 TO 4 DO
Tab[2].Marque[i]:=0;
end;
if Max_Pick<10 Then Inc(Max_Pick);
Tab[Max_Pick].NomF:='<Load file>';
Tab[Max_Pick].NomR:='';
For i:=1 TO 4 DO
Tab[Max_Pick].Marque[i]:=0;
{*** sauvegarde des dones du fichier a l'ouvertue *}
{*** si le fichier et modifie et non sauvergarde pick reprend les *}
{*** donnes de ouverture *}
X_Pick:=X_curseur;
Y_Pick:=Y_curseur;
Page_Pick:=Debut_Page;
Line_Pick:=Line_Curseur;
Marque_Pick:=Pose_Marque;
end;
end;
end.
Unit C_Read▲
Sélectionnez
{========================= EDIT13 =========================}
{* EDit13 version 4.002e units buffers d'éditeur de texte *}
{* Copyright (S) 1997-2012 programmeur du logiciel A.Ara *}
{* Licence d'utilisation accord dans un but demonstratif *}
{* c_read.pas - la vente du logiciel et interdite. *}
{* Numero de serie 00-441-7441-B21111946bb *}
{===========================================================}
{$O+,F+}
Unit C_Read;
Interface
Procedure Marque_Box (Var XX1,YY1,XX2,YY2:Byte;Color:Byte);
Procedure ReadBufCopy (Poss:Word;X1,Y1,X2,Y2:Byte);
Function Erreur_Critique (N:Integer;Diske:String):Boolean;
Implementation
Uses crt,Box13,Var_1,Type_buf,Buffs,Get_Key;
Procedure Marque_Box(Var XX1,YY1,XX2,YY2:Byte;Color:Byte);
var Ymax,Key,x,y : Byte;
CadreX1,CadreY1: Byte;
CadreX2,CadreY2: Byte;
Fin : Boolean;
Sy,Sx : String[2];
Cursor : Word;
begin
Ymax:=YY2;
Cursor:=GetCursor;
X:=WhereX+1;
Y:=WhereY+3;
if (X In[XX1..XX2]) And (Y In[YY1..YY2]) Then
begin
end
else
begin
X:=XX1;Y:=YY1;
end;
Fin:=False;
ReadBuf(1,1,80,1,LinePtr^);
TextAttr:=Block_Color;
Putxy(1,1,' '+
' ');
Putxy(2,1,'To mark the box mini:');
CadreX1:=0;CadreY1:=0;
Setcursor(InsCursorSmall);
Posxy(x,Y);
Repeat
Key:=KeyBoard;
if Key_Code Then
begin
if (CadreX1>0) And (X>=CadreX1) And (Y>=CadreY1) Then
HighBox(CadreX1,CadreY1,X,Y,Bx);
if (Key=77) And (X<XX2) Then Inc(X)
else
if (Key=80) And (Y<Ymax) Then Inc(Y)
else
if (Key=75) And (X>XX1) Then Dec(X)
else
if (Key=72) And (Y>YY1) Then Dec(Y);
if (CadreX1>0) And (CadreX1<=X) And (CadreY1<=Y) Then
HighBox(CadreX1,CadreY1,X,Y,Bx);
end;
Posxy(x,y);
if Key=13 Then
begin
Str(X-XX1+1:2,Sx);
Str(Y-YY1+1:2,Sy);
if CadreX1=0 Then
begin
CadreX1:=X;
CadreY1:=Y;
Putxy(24,1,Sx+','+sy);
HighBox(CadreX1,CadreY1,X,Y,Bx);
Beep;
end
else
begin
CadreX2:=X;
CadreY2:=Y;
if (CadreX2<CadreX1) OR (CadreY2<CadreY1) Then
begin
CadreX1:=X;
CadreY1:=Y;
CadreX2:=0;
CadreY2:=0;
Putxy(24,1,Sx+','+sy);
Beep;
HighBox(CadreX1,CadreY1,X,Y,Bx);
Posxy(x,y);
end
else
begin
Putxy(31,1,'max: '+Sx+','+Sy);
Putxy(43,1,'= Please confirmed Enter - ESC null');
Repeat
Key:=KeyBoard;
Until Key in[13,27];
if Key =13 Then
begin
Fin:=True;
XX2:=CadreX2-XX1+1;YY2:=CadreY2-YY1+1;
XX1:=CadreX1-XX1+1;YY1:=cadreY1-YY1+1;
end;
end
end;
end; { key=13}
Until (Key = 27) OR (Fin);
WriteBuf(1,1,80,1,LinePtr^);
Setcursor(Cursor);
TextAttr:=Color;
if CadreX1>0 Then HighBox(CadreX1,CadreY1,X,Y,Bx);
if Key=27 Then
begin
XX1:=0;YY1:=0;XX2:=0;YY2:=0;
Copy_Exemples:=False;
end
else
begin
{* Calcule les cordonees avec le deplacement de l'ecran *}
XX1:=XX1+(X_curseur-E_curseurX);
XX2:=XX2+(X_curseur-E_curseurX);
end;
end; {* end Marque_Box *}
{=================================================}
{ copy le rectangle marque par les cordones }
{ de l'ecran dans le buffer de blocs }
{ sauf les blans de fin de ligne }
{ poss: position ou doit etre copie sur le buffer }
{=================================================}
Procedure ReadBufCopy(Poss:Word;X1,Y1,X2,Y2:Byte);
var Conter,i,X : Word;
begin
if (X2 < X1) or (Y2 < Y1) then
begin
Copy_Exemples:=False;
DebutDAF :=0;
FinDAF :=0;
BlockDAF :=0;
Exit;
end;
i:=Poss;
For Conter := 0 to Y2 - Y1 do
begin
For X:=Succ(X1) To Succ(X2) DO
begin
Inc(i);
Copy__Buffer^[i]:=ScreenPtr^[Y1+3+Conter,x].data;
end;
While Copy__Buffer^[i]=#32 DO Dec(i);
Inc(i);
Copy__Buffer^[i]:=#13;
inc(i);
Copy__Buffer^[i]:=#10;
end;
BlockDAF:=i;
FinDAF:=i;
Copy__Buffer^[Succ(i)]:=#32;
Copy_Exemples:=True;
DebutDAF:=1;
end;
Function Erreur_Critique(N:Integer;Diske:String):Boolean;
var Serr : String;
Car1 : Byte;
Color: Byte;
Code : Boolean;
shh : String[5];
begin
Code:=True;
Serr:='';
Car1:=0;
Color:=TextAttr;
Case N OF
18,2: Serr:='File not found.';
3: Serr:='Path not Found.';
4: Serr:='Too many open files.';
5: Serr:='File access denied.';
6: Serr:='Invalid file handle.';
12: Serr:='Invalid file access code.';
15: Serr:='Invalid drive number.';
16: Serr:='Cannot remove current directory';
17: Serr:='cannot rename across drives.';
100: Serr:='Disk read error.';
101: Serr:='Disk write error.';
102: Serr:='File not assigned.';
103: Serr:='File not open.';
104: Serr:='File not open for input.';
105: Serr:='File not open for output.';
106: Serr:='Invalid numeric format.';
150: Serr:='Disk is write-protected.';
151: Serr:='Unknown unit.';
152: Serr:='Disk is not ready';
153: Serr:='Unknown command.';
154: Serr:='Crt error in data.';
155: Serr:='Bad drive request structure length.';
156: Serr:='Disk seek error.';
157: Serr:='Unknown media type.';
158: Serr:='Sector not found.';
159: Serr:='Printer ouf of paper.';
160: Serr:='Device write fault.';
161: Serr:='Device read fault.';
162: Serr:='Hardware failure.';
254: Serr:='File too Large';
300: Serr:='Insuffisant de memoire operation nulle.';
255: Serr:='Bad file request structure.';
500: Serr:='Erreur Non Save code Ascii non autorise dans le buffet.';
end;
if Serr='' then
begin
Str(N,shh);
Serr:='Error unknown... '+shh;
end;
if (N in[2..6,12..17,100..106,151,155..158,254]) OR (Serr='') Then
begin
Serr:=Serr+' in drive '+Diske+' Press < ESC >';
code:=False;
end
else
if (N=300) OR (N=500) Then
begin
Serr:=Serr+' press (ESC)';
Code:=False;
end
else
begin
Serr:=Serr+' in drive '+Diske+' (R)etry or (A)bort?';
Code:=True;
end;
ReadBuf(2,16,Max_CurseurX,18,Sub_Buf^);
TextAttr:=Error_Color;
BoxFill(4,16,7+Length(Serr),18,' ');
Rectangle(4,16,7+Length(Serr),18,Double);
Putxy((Length(Serr) div 2)-2,16,' Critical Error ');
Putxy(6,17,Serr);
Csoff;
Repeat
Car1:=KeyBoard;
Until ((Not Key_Code) And (Car1 in[114,82,65,97,27]));
TextAttr:=Color;
WriteBuf(2,16,Max_CurseurX,18,Sub_Buf^);
if Car1 In[114,82] Then Erreur_Critique:=True
else Erreur_Critique:=False;
if N in[2..6,12..17,100..106,151,155..158] Then Erreur_Critique:=False;
end;
end.
Unit Box13▲
Sélectionnez
{========================= EDIT13 ======================}
{*EDit13 version 4.002e units buffers d'éditeur de texte*}
{*Copyright (S) 1997-2012 programmeur du logiciel A.Ara *}
{*Licence d'utilisation accord dans un but demonstratif *}
{*la vente du logiciel et interdite. *}
{*Numero de serie 00-441-7441-B21111946bb *}
{========================================================}
{$O+,F+}
Unit Box13;
Interface
Uses Crt,Dos;
{$L Win_Asm.Obj}
{$L Miniscul.Obj}
{$L Uppers.Obj}
{$L Screen.Obj}
{*== BOX13 constantes publiques ==*}
Const
Titres_Color:Byte=48;
Menu_Color:Byte = 112;
Dir_Color :Byte = 112;
Edit_Color:Byte = 31;
Error_Color:Byte= 78;
Etat_Color:Byte = 23;
Help_Color:Byte = 48;
BX :Byte = 3;
Block_Color :Byte = 75;
Marque_Color:Byte = 116;
Char_Color :Byte = 4;
GetMaxEcranX = 80;
GetMaxEcranY = 50;
MinGetMaxEcranY = 25;
EGAInstalled:Boolean=False;
NoCursor = $2000;
InsCursorSmall = $0007;
InsCursorLarge = $000D;
TYPE {**Types publiques**}
ScreenColoneRange = 1..GetMaxEcranX;
ScreenlineRange = 1..GetMaxEcranY;
VideoTypes = (MDA, CGA, MCGA, EGA, VGA);
Direction = (Up, Down, Left, Right);
ScreenChar = record
Data : Char;
Attrib : Byte;
end;
ScreenArray = array[ScreenLineRange, ScreenColoneRange] of ScreenChar;
ScreenPointer = ^ScreenArray;
EditColoneRange = 1..160;
EditlineRange = 1..GetMaxEcranY;
ScreenPageXX = array[EditLineRange, EditColoneRange] of ScreenChar;
ScreenPagePtr = ^ScreenPageXX;
CadreChars = Array[0..5] Of Char;
KeysType = (On,Off);
Const Double:CadreChars ='Éͻȼº';
Simple:CadreChars ='ÚÄ¿ÀÙ³';
Var
ScreenPtr : ScreenPointer;
ScreenPage : ScreenPagePtr;
Getpage : Byte;
CrtGetMaxY : ScreenLineRange;
CrtGetMaxX : ScreenColoneRange;
VideoType : VideoTypes;
RES_Cursor : Word;
InsCursor : Word;
OldMode : Word;
BaseEcran : Pointer;
TailleEcran: Word; {renvoie la taille de l'ecran}
Begin_heap : ^Word;
{**Procedures et fonctions Publiques**}
Function Filedate(F: String) : Longint;
Function FileMaxSize(F : String) :Longint;
Function GetTexte:byte;
Function GetFond:Byte;
Procedure SetColor(Texte,Fond:Byte);
Function GetCursor : Word; {*Renvoie l'aspect du curseur*}
Procedure SetCursor(NewCursor : Word); {*Definit l'aspect du curseur*}
Procedure ScreenLine25;
Procedure CsOn(x,y:byte);
Procedure CsOff;
Procedure PosXY(X,Y:Byte);
Procedure Putxy(x,y:Byte;S:String); {cordones sur 80x25 sans control}
Procedure Writexy(x,y:Byte;S:String);
Procedure WriteCn(y:Byte;S:String);
Procedure WriteChar(x,y,Count:Byte;Ch:Char);
Function ReadBox(X,Y:Byte;Var SS: String;Longeur,MaxCh:Byte):Boolean;
Function ReadStr(X,Y:Byte;Var S1:String;Longeur:Byte):Boolean;
Function ReadNum(x,y,N:Byte):Integer;
Function ReadReal(x,y,N:Byte;Var Ent:Byte):Real;
Function CrtSize(X1,Y1,X2,Y2:Byte):Word;
Procedure ReadBuf(X1,Y1,X2,Y2:Byte;Var Buf);
Procedure WriteBuf(X1,Y1,X2,Y2:Byte;Var Buf);
Procedure Rectangle(x1,y1,x2,y2:Byte;Var Cadre:CadreChars);
Procedure HighBox(x1,y1,x2,y2,Colori:Byte);
Procedure BoxColor(x1,y1,x2,y2,Colori:Byte);
Procedure BoxFill(x1,y1,X2,Y2:Byte;Ch:Char);
Procedure MoveToScreen(var Source, Dest; Len : Word);
Procedure MoveFromScreen(var Source, Dest; Len : Word);
Procedure ClrscrFinLineXY(Col : ScreenColoneRange; Row : ScreenLineRange);
{============================================================}
{* MoveText( X1, Y1, X2, Y2, NewX1, NewY1 ); *}
{* Deplace une zone de texte en une nouvelle position de *}
{*l'ecran *}
{============================================================}
Procedure MoveText(OldX1, OldY1, OldX2, OldY2, NewX1, NewY1 : Word);
{============================================================}
{* ScrollText( Direction, X1, Y1, X2, Y2, Nbr, Color ); *}
{* Translation du texte - le texte est translate *}
{* puis la zone non concernee est remise … blanc. *}
{============================================================}
Procedure ScrollText(Dir : Direction; X1, Y1, X2, Y2, Amt, Attrib : Word);
{============================================================}
{* ClearScreen(X1, Y1, X2, Y2, Attrib : Word); *}
{* Efface une zone de l'ecran *}
{============================================================}
Procedure ClearScreen(X1, Y1, X2, Y2, Attrib : Word);
Procedure WriteCar(x,Y:Byte;Caractere:Char);
Procedure WriteClip(x,Y:Byte;Car:String;Clip:Byte);
Function Uppers(Str:String):String;
Function Miniscul(Str:String):String;
Procedure KeyCaps(tipe:KeysType);
Procedure KeyNum (tipe:KeysType);
Function GetPrn:Boolean;
Function TestPrn:Byte;
Function GetKeyByte:Byte;
Function SegEcran:Word;
Function OfsEcran(x,y:Byte):Word;
Procedure ClearBufKey;
Function Babi_Ti(NomA:String;U:Byte):String;
Function Code_Babi_Ti(NomA:String;U:Byte):String;
Implementation
Uses Get_Key;
Type Buf255 = Array[1..255] of Char;
Var Regg:Registers;
ch:Char;
{**Verifie la date enregitrement**}
Function Filedate(F: String) : Longint;
var
SR : SearchRec;
begin
FindFirst(F, AnyFile, SR);
If DosError = 0 Then Filedate:=SR.Time
Else Filedate:=0;
end; {*FileDate*}
{**Verifie l'existence du fichier et la Taille**}
Function FileMaxSize(F : String) :Longint;
var SR : SearchRec;
begin
FindFirst(F, AnyFile, SR);
If (DosError=0) Then FileMaxSize:=Sr.Size
Else FileMaxSize:=-1;
end; {*FileMaxSize*}
Function Miniscul(Str:String):String;
External {Miniscul};
Function GetTexte:byte; {**Renvoie la couleur du texte**}
External {Win_Box};
Function GetFond:Byte; {**Remvoie la couleur du fond**}
External {Win_Box};
Function GetKeyByte:Byte;
External {Win_Box};
Procedure SetColor(Texte,Fond:Byte); {**Initialise la couleur texte et fond**}
begin
textAttr:=(Fond Shl 4)+Texte;
end;
Procedure KeyCaps(tipe:KeysType);
Begin
Case Tipe Of
On: If Mem[0:$417]<>(Mem[0:$417] OR $40) Then Mem[0:$417]:=Mem[0:$417] OR $40;
OFf: If Mem[0:$417]=(Mem[0:$417] OR $40) Then Mem[0:$417]:=Mem[0:$417] And $BF;
End;
End;
Procedure KeyNum(tipe:KeysType);
Begin
Case Tipe Of
On: If Mem[0:$417]<>(Mem[0:$417] OR $20) Then Mem[0:$417]:=Mem[0:$417] OR $20;
OFf: If Mem[0:$417]=(Mem[0:$417] OR $20) Then Mem[0:$417]:=Mem[0:$417] And $DF;
End;
End;
{**Positione le curseur sur les cordonnes X et Y dans la page 0**}
Procedure PosXy(X,Y:Byte);
Const Page=0;
Var Reg:Registers; {*Registres unite Dos*}
Begin
Begin
Reg.Ax:=2 shl 8; {Numero de fonction}
Reg.bx:=Page Shl 8; {Page}
Reg.dx:=(Y-1) Shl 8 + (X-1); {Cordones}
Intr($10,Dos.registers(Reg)); {Appel}
End;
End;
Function SegEcran:Word;
External {Win_Box};
Function OfsEcran(x,y:Byte):Word;
External {Win_Box};
Procedure ClearBufKey;
External {Win_Box};
{**converti un majuscules une chaine**}
Function Uppers(Str:String):String;
External {Uppers};
{*********************************************************}
{*Entre: x,y codonees, Chaine de caracteres MaxWindow *}
{* Longeur: = place dans la boite *}
{* MaxCh : nombre de caracteres dans la chaine Max *}
{*cadre: X1= x-2, X2 = x+longeur+1 *}
{*Sortie: renvoit False si operation anule par ESC *}
{* sino renvoit True *}
{* ReadBox(x,y,Chaine,longeurBox,nombre de caracteres) *}
{*********************************************************}
Function ReadBox(X,Y:Byte;Var SS: String;Longeur,MaxCh:Byte):Boolean;
Var S:Buf255;
Bg,Key:Byte;
i,X1,X2:Byte;
debut,Pos:Byte;
FinBuf:Byte;
Function Copi(Deb,Nb:Byte):String;
Var p:String;
ii:Byte;
Begin
p:='';ii:=0;
While (ii<Nb) and (S[Deb+ii]<>^Z) DO
Begin
P:=P+S[Deb+ii];
Inc(ii);
End;
Copi:=p;
End;
Begin
X1:=X;
X2:=X1+Longeur;
For i:= 1 TO 255 DO S[i]:=' ';
Key:=0;
If SS<>'' Then
Begin
For i:=1 To Length(SS) DO
S[i]:=SS[i];
S[i+1]:=^Z;
Finbuf:=i;
If FinBuf>Longeur Then
Begin
Debut:=(FinBuf-Longeur)+1;
If FinBuf>=MaxCh Then
Begin
Pos:=FinBuf;
X:=(X1+longeur)-1;
End
Else
Begin
Pos:=FinBuf+1;
X:=X1+Longeur;
End;
Putxy(X1,y,Copi(Debut,longeur));
If Debut>1 Then Putxy(X1-1,Y,#17);
End
Else
Begin
Debut:=1;
Putxy(X1,y,Copi(1,FinBuf));
X:=Finbuf+X1;
pos:=Finbuf+1;
End;
If GetFond =0 Then Bg:=7
Else Bg:=GetFond;
HighBox(X1,Y,X,Y,Bg);
PosXy(X,Y);
Key:=KeyBoard;
If (Not Key_Code) And (Key<>13) And (Key in[32..255]) Then
Begin
For i:=0 TO Longeur DO Putxy(X1+i,Y,' ');
For i:=1 To 255 DO S[i]:=' ';
X:=X1;
S[1]:=^Z;
FinBuf:=0;
Debut:=1;
Pos:=1;
End
Else
HighBox(X1,Y,X,Y,Bg);
End {* SS<>'' *}
Else
Begin
X:=X1;
S[1]:=^Z;
FinBuf:=0;
Debut:=1;
Pos:=1;
End;
PosXy(X,Y);
Repeat
If (Key<>27) And (Key<>13) Then
Begin
{** Del possition curseur droite **}
If (Key_Code) And (Key=83) and (Pos<=FinBuf) Then
Begin
For i:=Pos To FinBuf+1 DO
S[i]:=S[i+1];
S[i]:=' ';
Dec(FinBuf);
If Debut>1 Then {* ramene le debut de un *}
Begin
Dec(Debut);
Putxy(X1,Y,Copi(Debut,Longeur));
Inc(X);
PosXy(x,Y);
End
Else {* eface vers la droite *}
Putxy(X1,Y,Copi(Debut,Longeur)+' ');
End {* end del droite *}
Else
{** del gauche **}
If ((Not Key_Code) And (Key=8) and (Pos>1)) Then
Begin
If (Debut>1) then
Begin
Dec(pos);
Dec(Debut);
If Debut=1 Then Putxy(X1-1,Y,' ');
For i:=Pos To FinBuf+1 DO
S[i]:=S[i+1];
S[i]:=' ';
Dec(FinBuf);
Putxy(X1,Y,Copi(Debut,Longeur));
End
Else
If (Debut=1) And (Pos<=Finbuf) Then
Begin
For i:=pos-1 To FinBuf DO
S[i]:=S[i+1];
S[i]:=' ';
Dec(FinBuf);
Dec(Pos);
Dec(X);
If FinBuf+X1-1<X2 Then Putxy(FinBuf+X1-1,Y,' ');
Putxy(X1,Y,Copi(Debut,Longeur));
PosXy(X,Y);
End
Else
If Pos>FinBuf Then
Begin
Dec(Pos);
S[pos]:=^Z;
Dec(FinBuf);
Dec(X);
Putxy(X,Y,' ');
PosXy(X,Y);
End;
End {* end del gauche *}
Else
{** fleche vers la quauche **}
{<-} If (Key_Code) And (Key=75) And (pos>1) then
Begin
Dec(Pos);
If X>X1 Then
Begin
Dec(X);
PosXy(X,Y);
End
Else
Begin
Debut:=Pos;
Putxy(X1,Y,Copi(Pos,Longeur));
End;
If pos=1 Then Putxy(X1-1,Y,' ');
End {*end fleche gauche*}
Else
{** ramene le curseur debut gauche **}
{<<} If (Key_Code) And (Key=71) Then
Begin
Putxy(X1,Y,Copi(1,Longeur));
X:=X1;
Pos:=1;
Debut:=1;
PosXy(X,Y);
Putxy(X1-1,Y,' ');
End {*end debut gauche*}
Else
{** deplace fin droite >> **}
{>>} If (Key_Code) And (Key=79) Then
Begin
If FinBuf>Longeur Then
Begin
For i:=0 To Longeur Do Putxy(X1+i,Y,' ');
Debut:=(FinBuf-Longeur)+1;
Pos:=FinBuf+1;
Putxy(X1,y,Copi(Debut,longeur)+' ');
X:=X1+Longeur;
End
Else
Begin
Debut:=1;
X:=Finbuf+X1;
pos:=Finbuf+1;
End;
PosXy(X,y);
End {*end Fin Droite*}
Else
{** deplace fleche droite une position **}
{->} If (Key_Code) And (Key=77) And (Pos<=FinBuf) And (pos<MaxCh) then
Begin
Inc(Pos);
If (X+1=X2) Then
Begin
If Pos<=FinBuf Then
Begin
Inc(Debut);
Putxy(X1,Y,Copi(Debut,Longeur)+' ');
End
Else
If Pos<=MaxCh Then
Begin
Inc(Debut,1);
{Dec(X);}
Putxy(X1,Y,Copi(Debut,Longeur)+' ');
Putxy(X2-1,Y,' ');
End;
End
Else
Begin
Inc(X);
PosXy(X,y);
End;
End {* end fleche droite ****}
Else
{** insere caractere **}
{inser} If (Not Key_Code) And (Key in[32..255]) And (FinBuf<MaxCh) Then
Begin
If (X=X2-1) Then
Begin
For i:=FinBuf+1 Downto Pos DO
S[i+1]:=S[i];
S[pos]:=Chr(Key);
Inc(Debut);
Inc(Pos);
Inc(FinBuf);
Putxy(X1,Y,Copi(Debut,Longeur));
End
Else
If (S[Pos]<>^Z) Then
Begin
For i:=FinBuf+1 Downto Pos DO
S[i+1]:=S[i];
S[pos]:=Chr(Key);
Inc(FinBuf);
Inc(pos);
Inc(X);
Putxy(X1,Y,Copi(Debut,Longeur));
PosXy(X,Y);
End
Else
If (S[Pos]=^Z) And (X<=X2) Then
Begin
S[pos]:=Chr(Key);
Inc(FinBuf);
Inc(Pos);
S[pos]:=^Z;
If X=X2 Then
Begin
Inc(Debut);
Putxy(X1,Y,Copi(Debut,Longeur));
End
Else
Begin
Putxy(x,Y,Chr(Key));
Inc(X);
PosXy(X,Y);
End;
End;
End; {*end inser*}
{mark} If MaxCh>Longeur Then
Begin
If Debut>1 Then Putxy(X1-1,Y,#17) Else Putxy(X1-1,y,' ');
If FinBuf-Debut>=Longeur Then Putxy(X2,Y,#16)
Else Putxy(X2,y,' ');
End;
{key} Key:=KeyBoard;
End; {*end key<>27 and Key<>13*}
Until (Key=27) OR (Key=13);
If S[1]=^Z Then SS:=''
Else
Begin
i:=1;
While S[i]=#32 DO Inc(i);
SS:=Copi(i,FinBuf);
End;
If Key=13 Then ReadBox:=True
Else ReadBox:=False;
End;{*end ReadBox*}
{*********************************************************}
{*Entrees: X,Y codones de affichage Rapor a l'ecran 80x25*}
{* S1 Chaine de caracteres *}
{* Longueur nombre de caracteres maximum de entree *}
{* *}
{*operations: EXC,Entree Revoit la chaine telle qui et *}
{* affichage sur l'ecran. *}
{* Del-Fleche-gauche: efface caracteres *}
{* Fleche-droite reinsere caracteres effaces *}
{*********************************************************}
Function ReadStr(X,Y:Byte;Var S1:String;Longeur:Byte):Boolean;
Var S:String;
Long,N:Byte;
i,X1,Key:Byte;
Begin
X1:=X;
S:=S1;
N:=LengTh(S1);
Long:=N;
Putxy(X,y,S1);
X:=X+N;
PosXy(X,Y);
Key:=KeyBoard;
If (Not Key_Code) And (Key<>13) And (Key in[32..255]) Then
Begin
If N>0 Then
For i:=0 TO Length(S1) DO
Putxy(X1+i,Y,' ');
X:=X1;
Long:=0;
End;
Repeat
If (Key<>27) And (Key<>13) Then
Begin
If ((Key=8) OR (Key_Code) And (Key=75)) and (Long>0) Then
Begin
Dec(X);
Putxy(X,Y,' ');
PosXy(X,Y);
Dec(Long);
End
Else
If (Key_Code) And (Key=77) And (Long<N) Then
Begin
Inc(Long);
Putxy(X,Y,S[Long]);
Inc(X);
PosXy(X,Y);
End
Else
If (Not Key_Code) And (Key in[32..255]) And (Long<Longeur) Then
Begin
If long+1>Length(S1) Then
Begin
S1:=S1+Chr(Key);
S:=S1;
End
Else
Begin
S1[long+1]:=Chr(Key);
S[long+1]:=Chr(Key);
End;
Putxy(X,Y,Chr(Key));
Inc(X);
Inc(Long);
PosXy(X,Y);
If Long>N Then N:=Long;
End;
Key:=KeyBoard;
End;
Until (Key=27) OR (Key=13);
S1:=Copy(S,1,Long);
If Key=13 Then ReadStr:=True
Else ReadStr:=False;
End;{*end ReadStr*}
Procedure CsOn(x,y:Byte);
var reg:Registers;
begin
Reg.AX:=$200;
Reg.BH:=GetPage;
Reg.DH:=Y-1;
Reg.Dl:=X-1;
Intr($10,reg);
End;
Procedure CsOff; {**etein le curseur**}
var reg:Registers;
begin
Posxy(1,CrtGetmaXY+1);
END;
{**Renvoie True si l'imprimante et un etat de imprimer**}
Function GetPrn:Boolean;
External {Win_Box};
Function TestPrn:Byte;
External {Win_Box};
{** Positione le curseur sur les cordonnes X et Y dans la page 0 **}
{** centre le texte dans le Ecran ou la fenetre active sur laligne Y **}
Procedure WriteCn(y:Byte;S:String);
External {Win_Box};
{** Ecrit un texte aux cordonnees X et Y **}
Procedure Putxy(x,y:Byte;S:String); {sans control cordones 80x25}
External {Win_Box};
Procedure Writexy(x,y:Byte;S:String);
External {Win_Box};
Procedure WriteChar(x,y,Count:Byte;Ch:Char);
External {Win_Box};
{========================================================================}
{*X,y : Enplacement a ecrire dans la fenetre active *}
{* N : Nombre de caracteres a ecrire maximun *}
{*note: la fonction retourne un entier limite entre -32768..32767 *}
{========================================================================}
Function ReadNum(x,y,N:Byte):Integer;
Const Ligne=' ';
Var Err,nn:Integer;
Nstr:String[6];
Lig:String[6];
Ch:Char;
fin:Boolean;
Nc:Byte;
Begin
Err:=1;
nn:=0;
Nc:=1;
Lig:=Copy(Ligne,1,N);
Gotoxy(X-1,Y);
Write(' ',Lig);
GotoXy(x,y);
Nstr:='';
KeyCaps(On);
KeyNum(On);
Repeat
Ch:=ReadKey;
If (Ord(Ch)=8) And (nc>1) Then
Begin
NStr:=Copy(NStr,1,LengTh(NStr)-1);
Gotoxy(WhereX-1,Y);
Write(' ');
Gotoxy(WhereX-1,Y);
Nc:=Nc-1;
End
Else
If (Ord(Ch)<>13) And (Nc<=N) and (Ch in['0'..'9','-']) then
Begin
NStr:=NStr+Ch;
Write(Ch);
Nc:=nc+1;
End;
If ((Ord(Ch)=13) And (Nstr<>'')) OR (Nc>N) Then
Begin
{$R-}
Val(Nstr,nn,Err);
{$R+}
If Err<>0 Then
Begin
Ch:=' ';
Gotoxy(x-1,y);
Write(' ',Lig);
GotoXy(x,y);
Nc:=1;NStr:='';
End;
End;
Until ((Nstr='') And (Ord(Ch)=13)) OR (Err=0);
KeyCaps(Off);
KeyNum(Off);
If Err=0 Then ReadNum:=nn
Else ReadNum:=0;
Beep;
End;
Function ReadReal(x,y,N:Byte;Var Ent:Byte):Real;
Const Ligne=' ';
Var Err:Integer;
nn:Real;
Nstr:String[11];
Lig:String[11];
Ch:Char;
nc:Byte;
fin:Boolean;
Begin
Err:=1;
nn:=0;
Nc:=1;
Lig:=Copy(Ligne,1,N);
Gotoxy(X-1,Y);
Write(' ',Lig);
GotoXy(x,y);
Nstr:='';
{KeyCaps(On);}
KeyNum(On);
If Ent In[45,48..57] Then Ch:=Chr(Ent)
Else Ch:='#';
Repeat
If (Ord(Ch)=8) And (nc>1) Then
Begin
NStr:=Copy(NStr,1,LengTh(NStr)-1);
Gotoxy(WhereX-1,Y);
Write(' ');
Gotoxy(WhereX-1,Y);
Nc:=Nc-1;
End
Else
If (Ord(Ch)<>13) And (Nc<=N) and (Ch in['0'..'9','-','.']) then
Begin
NStr:=NStr+Ch;
Write(Ch);
Nc:=nc+1;
End;
Ch:=ReadKey;
If ((Ord(Ch)=13) And (Nstr<>'')) OR (Nc>N) Then
Begin
{$R-}
Val(Nstr,nn,Err);
{$R+}
If Err<>0 Then
Begin
Ch:=' ';
Gotoxy(x-1,y);
Write(' ',Lig);
GotoXy(x,y);
Nc:=1;NStr:='';
End;
End;
Until ((Nstr='') And (Ord(Ch)=13)) OR (Err=0) OR (Ord(ch)=27);
{KeyCaps(Off);}
If Err=0 Then ReadReal:=nn
Else ReadReal:=0;
Ent:=Ord(Ch);
Beep;
End;
{**Renvoie le nombre d'octets necesaires … la sauvegarde de la region**}
{**Rectangulaire de Ecran specifiee, le nombre et arrondi au kilo octects**}
Function CrtSize(X1,Y1,X2,Y2:Byte):Word;
External {Win_Box};
{**Effectue une sauvegarde par octets de la region delimite**}
Procedure ReadBuf(X1,Y1,X2,Y2:Byte;Var Buf);
External {Win_Box};
{**Dessine une image par octets sauvegardee par GetImage**}
Procedure WriteBuf(X1,Y1,X2,Y2:Byte;Var Buf);
External {Win_Box};
{**dessine un Rectangle sur les cordonees**}
{**avec une forme qui peut etre simple traze ou Double**}
Procedure Rectangle(x1,y1,x2,y2:Byte;Var Cadre:CadreChars);
External {Win_Box};
{**inverse la region de le ecran delimite par les cordonees**}
Procedure HighBox(x1,y1,X2,Y2,Colori:Byte);
External {Win_Box};
Procedure BoxColor(X1,Y1,X2,Y2,Colori:Byte);
External {Win_Box};
{**Rempli un rectangle avec un caractere determine**}
{**le caractere peut etre un code ASCII … eviter un code de control**}
Procedure BoxFill(x1,y1,X2,Y2:Byte;Ch:Char);
External {Win_Box};
Function GetCursor : Word; {*Renvoie l'aspect du curseur*}
var
Reg : Registers;
begin
with Reg do
begin
AH := 3;
BH := 0;
Intr($10, Reg);
GetCursor := CX;
end; {*Reg*}
end; {*GetCursor*}
procedure SetCursor(NewCursor : Word); {*Definit l'aspect du curseur*}
var
Reg : Registers;
begin
with Reg do
begin
AH := 1;
BH := 0;
CX := NewCursor;
Intr($10, Reg);
end; {*with*}
end; {*SetCursor*}
function PS2 : Boolean;
{*Renvoit True si vous travaillez avec un adaptateur video PS/2*}
var
Regs : Registers;
begin
Regs.AX := $1A00;
Intr($10, Regs);
PS2 := ((Regs.AL and $FF) = $1A) and
((Regs.BL and $FF) in [$07, $08, $0B, $0C]);
end; {*PS2*}
Procedure Screen_Init;
{*Detecte l'adaptateur video et
initialise differentes variables en consequence*}
var
Reg : Registers;
begin
OldMode := LastMode;
Reg.AH := $0F;
Intr($10, Reg); {* Cherche le mode video actuel *}
if Reg.AL <> 7 then
begin
if EGAInstalled then
begin
if PS2 then
VideoType := VGA
else
VideoType := EGA;
end
else begin
if PS2 then
VideoType := MCGA
else
VideoType := CGA;
end;
ScreenPtr := Ptr($B800, 0);
BaseEcran := Ptr($B800, 0);
if Reg.AL < 2 then
CrtGetMaxX := 40
else
CrtGetMaxX := 80;
end
else begin
VideoType := MDA;
ScreenPtr := Ptr($B000, 0);
BaseEcran := Ptr($B000, 0);
CrtGetMaxX := 80;
end;
CrtGetMaxY := Hi(WindMax)+1;
{*Res_Cursor := GetCursor;*}
if (CrtGetMaxY = MinGetMaxEcranY) and (VideoType <> CGA) then
InsCursor := InsCursorLarge
else
InsCursor := InsCursorSmall;
TailleEcran:=MemW[$40:$4C];
end; {* Screen.Init *}
Procedure Screen_VGA;
{* Bascule l'affichage en 43/50-ligne *}
begin
if CrtGetMaxY = MinGetMaxEcranY then
begin
TextMode(Lo(LastMode) + Font8x8);
InsCursor := InsCursorSmall;
end
else begin
TextMode(Lo(LastMode));
InsCursor := InsCursorLarge;
end;
CrtGetMaxY:=(Hi(WindMax)+1);
{*GetmaxY:=Mem[$40:$84]+1;*}
TailleEcran:=MemW[$40:$4C];
end; {* Screen_Vga *}
Procedure ScreenLine25;
Begin
{*Restaure le mode ecran et l'aspect curseur anterieurs au programme*}
TextMode(OldMode);
Screen_Init;
End;
procedure ClearScreen(X1, Y1, X2, Y2, Attrib : Word);
{* Efface une zone de l'ecran *}
var
Reg : Registers;
begin
if (X1 > X2) or (Y1 > Y2) then {*Valeurs illegales*}
Exit;
with Reg do
begin
AX := $0600; {*Efface l'ecran par routine BIOS*}
BH := Attrib;
CH := Pred(Y1);
CL := Pred(X1);
DH := Pred(Y2);
DL := Pred(X2);
Intr($10, Reg);
end; {*with*}
end; {*ClearScreen*}
{**SCREEN**}
procedure MoveToScreen(var Source, Dest; Len : Word);
external {SCREEN};
{**Deplacement de zones memoire entre memoire "normale" et memoire ecran**}
{**voir le source dans SCREEN.ASM**}
procedure MoveFromScreen(var Source, Dest; Len : Word);
external {SCREEN};
{**Deplacement de zones memoire entre memoire ecran et memoire "normale" **}
{**voir le source dans SCREEN.ASM**}
procedure MoveText(OldX1, OldY1, OldX2, OldY2, NewX1, NewY1 : Word);
{**Deplace une zone de texte en une nouvelle position de l'ecran**}
var
Counter, Len : Word;
begin
if (OldX2 < OldX1) or (OldY2 < OldY1) then
Exit;
Len := Succ(OldX2 - OldX1) shl 1;
if NewY1 < OldY1 then
begin {* Deplacement en avant, ligne par ligne *}
for Counter := 0 to OldY2 - OldY1 do
MoveFromScreen(ScreenPtr^[OldY1 + Counter, OldX1],
ScreenPtr^[NewY1 + Counter, NewX1], Len)
end
else begin {* Deplacement en arriŠre, ligne par ligne *}
for Counter := OldY2 - OldY1 downto 0 do
MoveFromScreen(ScreenPtr^[OldY1 + Counter, OldX1],
ScreenPtr^[NewY1 + Counter, NewX1], Len)
end;
end; {*MoveText*}
procedure ScrollText(Dir : Direction; X1, Y1, X2, Y2, Amt, Attrib : Word);
{**Translation du texte le texte est translate puis la zone non concernee est remise a blanc**}
begin
case Dir of
Up : begin
MoveText(X1, Y1 + Amt, X2, Y2, X1, Y1);
ClearScreen(X1, Succ(Y2 - Amt), X2, Y2, Attrib);
end;
Down : begin
MoveText(X1, Y1, X2, Y2 - Amt, X1, Succ(Y1));
ClearScreen(X1, Y1, X2, Pred(Y1 + Amt), Attrib);
end;
Left : begin
MoveText(X1 + Amt, Y1, X2, Y2, X1, Y1);
ClearScreen(Succ(X2 - Amt), Y1, X2, Y2, Attrib);
end;
Right : begin
MoveText(X1, Y1, X2 - Amt, Y2, X1 + Amt, Y1);
ClearScreen(X1, Y1, Pred(X1 + Amt), Y2, Attrib);
end;
end; {*case*}
end; {*ScrollText*}
procedure ClrscrFinLineXY(Col : ScreenColoneRange; Row : ScreenLineRange);
{*Efface la fin de la ligne*}
begin
GotoXY(Col, Row);
ClrEOL;
end; {*ClrscrinLineXY*}
Procedure WriteCar(x,Y:Byte;Caractere:Char);
Var Reg:Registers;
Begin
PosXy(x,y);
Reg.AX:=9 shl 8 + Ord(Caractere);
Reg.BL:=GetFond Shl 4 + Char_Color;
Reg.BH:=GetPage;
Reg.CX:=1;
Intr($10,Reg);
End;
Procedure WriteClip(x,Y:Byte;Car:String;Clip:Byte);
Var Reg:Registers;
I:Byte;
Begin
For i:=0 TO Length(Car)-1 DO
Begin
PosXy(x+i,y);
Reg.AX:=9 shl 8 + Ord(Car[i+1]);
Reg.BL:=GetFond Shl 4 + Char_Color + Clip ;
Reg.BH:=GetPage;
Reg.CX:=1;
Intr($10,Reg);
End;
End;
Function Babi_Ti(NomA:String;U:Byte):String;
Var Nom1:String;
i:Byte;
car:Char;
Begin
Nom1:='';
Case U Of
1: For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Car=#191 Then Nom1:=Nom1+#32
Else
Nom1:=Nom1+Chr(Ord(Car)-70);
End;
2: For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Car=#145 Then Nom1:=Nom1+#32
Else
Nom1:=Nom1+Chr(Ord(Car)-119);
End;
3: For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Car=#250 Then Nom1:=Nom1+#32
Else
Nom1:=Nom1+Chr(Ord(Car)-127);
End;
End;
Babi_ti:=nom1;
End;
Function Code_Babi_Ti(NomA:String;U:Byte):String;
Var Nom1:String[80];
i:Byte;
car:Char;
Begin
Nom1:='';
Case U Of
1: For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Ord(Car)=32 Then Nom1:=Nom1+#191
Else
Nom1:=Nom1+Chr(Ord(Car)+70);
End;
2: For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Car=#32 Then Nom1:=Nom1+#145
Else
Nom1:=Nom1+Chr(Ord(Car)+119);
End;
3: For i:=1 To Length(NomA) DO
Begin
Car:=NomA[i];
If Car=#32 Then Nom1:=Nom1+#250
Else
Nom1:=Nom1+Chr(Ord(Car)+127);
End;
End;
Code_Babi_ti:=nom1;
End;
Begin
GetPage:=0;
Res_Cursor:=GetCursor;
TextMode(LastMode);
Screen_Init;
{**Selectione la page ecran active Page 0**}
Regg.AH:=5;
Regg.AL:=Getpage;
Intr($10,Regg);
CheckSnow:=False;
TextBackGround(Black);
TextColor(White);
End.
Plan de compilation▲
Pour pouvoir compiler les unités qu'utilse le programme EDIT13, il y a un ordre de compilation. Voilà la liste des fichiers, unités utilisées et fiches à inclure (*.pas, *.blc, *.obj) :
Sélectionnez
PROGRAM EDIT13;
Uses Overlay,init13, {*Unité INIT13 initialise les overlays*}
Crt,Dos, {*unités de turbo Pascal*}
Buff_Tex, {*ok*}
Buffs, {*ok*}
Box13, {*win_asm.obj,miniscul.obj,uppers.obj,screen.obj,get_key.tpu*}
Get_Key, {*ok*}
H_HElp,