home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC Interdit
/
pc-interdit.iso
/
graph
/
grabber.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-10-06
|
9KB
|
272 lines
Program grabber;
{$m 1024,0,0} {pile réduite, pas de tas }
Uses ModeXLib,Crt,Dos;
Var OldInt9:Pointer; {pointe sur l'ancien gestionnaire de clavier }
actif:Boolean; {vrai s'il y a déjà une copie d'écran en cours }
nr:Word;{numéro de l'image, pour le nom du fichier }
installe:Boolean; {déjà installé ?}
mode, {mode VGA actuel : 13h, ffh (mode X)}
{ou 0 (aucun des deux)}
Split_at, {ligne de fractionnement (ligne graphique)}
LSA, {Linear Starting Address}
Skip:Word; {Nombre d'octets à sauter }
Procedure GetMode;
{détermine le mode graphique courant 13h ou mode X (N° 255)}
{ainsi que ses paramètres ligne de fractionnement, adresse de départ)}
Begin
mode:=$13;{mode 13h standard}
asm {détermine le mode BIOS}
mov ax,0f00h {fonction : infos vidéo}
int 10h
cmp al,13h {est-ce le mode BIOS 13h ?}
je @Bios_ok
mov mode,0 {non -> ni mode 13h ni X actif}
@bios_ok:
End;
If mode=0 Then Exit;{mode erroné -> abandonner}
Port[$3c4]:=4; {lit le registre 4 du TS Memory Mode}
If Port[$3c5] and 8 = 0 Then {Chain 4 (Bit 3) inactif ?}
mode:=$ff; {alors mode X}
Port[$3d4]:=$0d; {Linear Starting Address Low (CRTC 0dh)}
LSA:=Port[$3d5]; {à lire}
Port[$3d4]:=$0c; {Linear Starting Address High (CRTC 0ch)}
LSA:=LSA or Port[$3d5] shl 8; {à lire et à inclure }
Port[$3d4]:=$18; {Line Compare CRTC 18h}
Split_at:=Port[$3d5]; {à lire}
Port[$3d4]:=7; {Overflow Low}
Split_at:=Split_at or {extrait par masque le bit 4 et le décale en bit 8 }
(Port[$3d5] and 16) shl 4;
Port[$3d4]:=9; {Maximum Row Address}
Split_at:=Split_at or {extrait par masque le bit 6 et le décale en bit 9}
(Port[$3d5] and 64) shl 3;
Split_at:=Split_at shr 1;{calcule en lignes d'écran }
Port[$3d4]:=$13; {Row Offset (CRTC Register 13h)}
Skip:=Port[$3d5]; {à lire}
Skip:=Skip*2-80{différence avec l'interligne "normal" }
End;
Procedure PCXShift;assembler;
{convertit la palette courante au format PCX (décalage de 2 bits vers la gauche )}
asm
mov si,offset palette {ds:si pointe sur la palette}
mov cx,768{ 768 octets à traiter }
@lp:
lodsb{prend une valeur}
shl al,2 {la décale}
mov ds:[si-1],al {la remet dans l'ancienne position }
loop @lp {teste la fin de boucle }
End;
Var pcx:File; {Fichier PCX sur disque }
Procedure Hardcopy(Startadr,splt:Word;s : string);
{copie un graphique 320x200 (mode 13 ou X) dans un fichier PCX appelé s}
{début de l'écran courant (Linear Starting Address) en Startadr}
{ligne de fractionnement en splt}
Var Buf:Array[0..57] of Byte; {mémorise des données avant enregistrement }
Aux_Ofs:Word;
const
Header1:Array[0..15] of Byte {en-tête PCX, première partie }
=($0a,5,1,8, 0,0, 0,0, $3f,1, 199,0,$40,1,200,0);
Header2:Array[0..5] of Byte {en-tête PCX, deuxième partie }
=(0,1,$40,1,0,0);
plan:Byte=0; {plan courant}
var count:Byte; {facteur de répétition }
valeur , {octet en cours de traitement }
lastbyt:Byte;{octet précédent}
i:word; {compteur }
begin
asm {lecture de la palette}
xor al,al {commence par la couleur 0 }
mov dx,3c7h {vers le DAC par Pixel Read Address}
out dx,al
push ds {es:di pointe sur la palette}
pop es
mov di,offset palette
mov cx,768{768 octets à lire }
mov dx,3c9h {Pixel Color Value}
rep insb {on lit }
cmp mode,13h {mode X ?}
je @Linear{alors:}
mov dx,03ceh {fixe le mode d'écriture et de lecture 0 }
mov ax,4005h {par le registre 5 du GDC (GDC Mode)}
out dx,ax
@Linear:
End;
Assign(pcx,s); {ouvre le fichier en écriture }
Rewrite(pcx,1);
BlockWrite(pcx,Header1,16); {enregistre la 1ère partie de l'en-tête }
PCXShift; {prépare la palette}
BlockWrite(pcx,palette,48); {enregistre les 16 premières couleurs }
BlockWrite(pcx,Header2,6); {enregistre la 2ème partie de l'en-tête }
FillChar(buf,58,0); {58 zéros de remplissage }
BlockWrite(pcx,buf,58);
plan:=0; {commence par le plan 0 }
count:=1; {initialise le facteur de répétition }
If splt<200 Then
If mode = $ff Then
splt:=splt*80 Else {calcule l'offset de fractionnement }
splt:=splt*320 Else {dépend du mode }
splt:=$ffff;
If mode=$13 Then {LSA se refère au modèle des plans !}
Startadr:=Startadr*4;
for i:=0 to 64000 do Begin {traite chaque pixel }
If i shr 2 < splt Then
aux_ofs:=(i div 320) * skip {fixe l'offset auxiliaire en tenant compte }
{de la longueur des lignes }
Else
aux_ofs:=((i shr 2 - splt) div 320) * skip;
{en cas de fractionnement }
asm {lit un pixel}
mov ax,0a000h {d'abord le segment}
mov es,ax
mov si,i {puis l'offset}
cmp mode,13h {mode 13h ?}
je @Linear1
shr si,2 {non, calcul l'offset }
@Linear1:
cmp si,splt {ligne de fractionnement atteinte ?}
jb @suite{non on continue}
sub si,splt {sinon référence au début }
sub si,startadr{de l'écran }
@suite:
add si,startadr{adresse de début }
add si,aux_ofs { + offset auxiliaire }
cmp mode,13h {mode 13h ?}
je @Linear2 {non, lecture en mode X }
mov dx,03ceh {active le registre 4 du GDC (Read Plane Select)}
mov ah,plan {sélectionne le plan courant }
inc plan {et passe au suivant }
mov al,4
and ah,03h
out dx,ax
@Linear2:
mov al,es:[si] {lit un octet}
mov valeur,al {le met dans la variable valeur }
End;
If i<>0 Then Begin {pas de compression pour le premier octet }
If (Valeur = lastbyt) Then Begin{octets identiques?}
Inc(Count); {incrémente le facteur de répétition }
If (Count=64) or {facteur trop grand ? }
(i mod 320 =0) Then Begin {ou début de ligne?}
buf[0]:=$c0 or (count-1); {alors on stocke }
buf[1]:=lastbyt;{le facteur et la valeur de l'octet }
count:=1; {réinitialise le facteur de répétition }
BlockWrite(pcx,buf,2); {enregistre le tout sur disque }
End;
End Else {octets divers :}
If (Count > 1) or {plusieurs octets identiques ?}
(lastbyt and $c0 <> 0) Then {octet trop grand ? }
Begin
buf[0]:=$c0 or count;{stocke le facteur et l'octet dans le fichier}
buf[1]:=lastbyt;
lastbyt:=Valeur; {sauve l'octet courant pour la suite de la compression }
Count:=1; {et réinitialise }
BlockWrite(pcx,buf,2);
End Else Begin {octet isolé à ... }
buf[0]:=lastbyt;{... enregistrer directement }
lastbyt:=Valeur; {sauve l'octet courant pour la suite de la compression }
BlockWrite(pcx,buf,1);
End;
End Else lastbyt:=valeur; {premier octet juste à sauver }
End;
buf[0]:=$0c; {enregistre la signature de la palette }
blockwrite(pcx,buf[0],1);
blockwrite(pcx,palette,256*3);{puis la palette }
Close(pcx); {ferme le fichier }
End;
Procedure Action;
{appelé lorsqu'on appuie sur la touche de déclenchement (Hot-Key) }
Var nrs:String; {chaîne pour le nom }
Begin
if not actif Then Begin {pas encore chargé }
actif:=true;{maintenant actif }
str(nr,nrs); {convertit le numéro en chaîne et l'incrémente }
Inc(nr);
GetMode;{consulte le mode graphique, etc}
If mode <> 0 Then
HardCopy(LSA,Split_at,'hard'+nrs+'.pcx');
{exécute la copie d'écran }
actif:=false; {activité terminée }
End;
End;
Procedure Handler9;interrupt;assembler;
{nouveau gestionnaire d'interruption de l'IRQ clavier }
asm
pushf
call [oldint9]{appelle l'ancien gestionnaire de l'IRQ 1 }
cli {inhibe toute nouvelle interruption }
in al,60h {lit le scan code }
cmp al,34d{G ?}
jne @fini {non -> c'est terminé }
xor ax,ax {charge le segment 0}
mov es,ax
mov al,es:[417h] {lit l'état du clavier }
test al,8 {Bit 8 à 1 (touche Alt) ?}
je @fini{non -> c'est terminé}
call action {exécute la copie d'écran }
@fini:
sti {autorise à nouveau les interruptions}
End;
Procedure signature;assembler;
{procédure fantôme, contient un avis de copyright pour le test d'installation }
{ CODE NON EXECUTABLE !}
asm
db 'Screen-Grabber, (c) Micro Application 1994';
End;
Procedure Check_Inst;assembler;
{teste si le grabber est déjà installé }
asm
mov installe,1 {a priori: oui }
push ds {ds va resservir!}
les di,oldint9 {charge un pointeur sur l'ancien gestionnaire }
mov di,offset signature {la procedure signature est dans le même segment }
mov ax,cs {ds:si va pointer sur la signature du programme }
mov ds,ax
mov si,offset signature
mov cx,20 {compare 20 caractères }
repe cmpsb
pop ds {restaure ds }
jcxz @installe {égalité -> déjà installé}
mov installe,0 {pas encore installé }
@installe:
End;
Begin
nr:=0; {premier nom de fichier : hard0.pcx}
GetIntVec(9,OldInt9); {lit l'ancien vecteur d'interruption }
Check_Inst; {teste si déjà installé }
If not installe Then Begin {si ce n'est pas le cas :}
SetIntVec(9,@Handler9);{installe le nouveau gestionnaire }
WriteLn('Grabber installé');
WriteLn('(c) Micro Application 1994');
WriteLn('Déclenchement par <Alt> g');
Keep(0);{affichage et mise en résidence }
End;
WriteLn('Grabber déjà installé ');
{on s'en va }
End.