DPTOOLS.ZIP - MOUSEDTV.PAS

Current area: HOME ->
Zip File view

Dptool

This page allows you to view the contents of a file contained inside a ZIP archive available at Programmer's Heaven. This means you can view the code and find what you need from it without having to download the ZIP file first. If the file contains source code for a language we recognize, we have syntax highlighted it.

Filename displayed: MOUSEDTV.PAS
Found in file: DPTOOLS.ZIP

{
programme de changement de curseur sous turbo vision
programme realise par
charles vidal
pour toutes suggestions
email : [[Email Removed]]

}
program Edit_curseur_TV;
uses Dos, Crt,MsgBox, Objects, Drivers,Views,Menus, Dialogs,
App,InpLong,stddlg,tvgraph;

const
cmAbout = 1000;
cmLoad = 1001;
cmsave = 1002;
cmModifier = 1003;
cmInverse = 1004;
cmFill =1005;
cmClear=1006;
cmessai = 1010;
cmmodif_masque=1011;
cmfillmasque=1012;
cmrotation=1014;
cmpascal=1015;
cmsourceC=1016;
cmmodif_xy=1017;
type
TListboxRec = record
PS : PStringCollection;
Focused : Integer;
end;
type
TMyApp = object(TApplication)
procedure InitMenuBar; virtual;
procedure LoadCurseur;
procedure saveascurseur;
procedure Modif_curseur;
procedure Inverse_curseur;
procedure Fill_curseur;
procedure Fill_masque;
procedure clear_curseur;
procedure essai_curseur;
procedure modif_ecran;
procedure rotation90;
procedure pascal;
procedure sourcec;
procedure modif_xy;
procedure HandleEvent(var Event: TEvent); virtual;
end;
Type
dessin_curseur = record
contx,conty : integer;
mask_ecran : array[0..15] of word;
mask_curseur : array[0..15] of word;
end;

Const
fleche: dessin_curseur = (contx:0; conty:0;
mask_ecran: ($3FFF,$1FFF,$0FFF,$07FF,
$03FF,$01FF,$00FF,$007F,
$003F,$001F,$01FF,$10FF,
$30FF,$F87F,$F87F,$FC3F);
mask_curseur: ($0000,$4000,$6000,$7000,
$7800,$7C00,$7E00,$7F00,
$7F80,$7FC0,$7C00,$4600,
$0600,$0300,$0300,$0000));

var modif_c: dessin_curseur;
var
fichier:file of dessin_curseur;
fichiert:Text;
char:array[1..16] of byte;
var
DataRecChar : record
Field1 : Word;
Field2 : Word;
Field3 : Word;
Field4 : Word;
Field5 : Word;
Field6 : Word;
Field7 : Word;
Field8 : Word;
Field9 : Word;
Field10 : Word;
Field11 : Word;
Field12 : Word;
Field13 : Word;
Field14 : Word;
Field15 : Word;
Field16 : Word;
end;

var
MyApp: TMyApp;
i:byte;
chaine:string;

{-----------------function misc .----------------------}
Procedure change_souris(var p:dessin_curseur);
Var reg : registers;
begin
with reg,p do
begin
ax:=9;
bx:=contx;
cx:=conty;
dx:=ofs(mask_ecran[00]);
es:=seg(mask_ecran[00]);
end;
intr($33,reg);
end;

function bit_a_un(a,pos:word):Boolean;
BEGIN
if ((a shr pos) and 1)=1 then bit_a_un:=true
else bit_a_un:=false;
END;
procedure put_bit_a_un(var a:word;pos:word);
BEGIN
a:=a or (1 shl pos);
END;
procedure rotation(var source,dest:dessin_curseur);
var i,j:byte;
BEGIN
fillchar(dest,sizeof(dessin_curseur),0);
for i:=0 to 15 do
BEGIN
for j:=0 to 15 do
BEGIN
if bit_a_un(source.mask_curseur[i],j) then put_bit_a_un(dest.mask_curseur[j],15-i);
if bit_a_un(source.mask_ecran[i],j) then put_bit_a_un(dest.mask_ecran[j],15-i);
END;
END;
END;
{ ------------------ les boites dialogues --------------------- }
function nom : PDialog;
var
Dlg : PDialog;
R : TRect;
Control : PView;

begin
R.Assign(24, 2, 58, 9);
New(Dlg, Init(R,'Nom du curseur'));
Dlg^.Flags := Dlg^.Flags and not wfClose;

R.Assign(4, 2, 21, 3);
Control := New(PInputLine, Init(R, 13));
Dlg^.Insert(Control);

R.Assign(1, 4, 13, 6);
Control := New(PButton, Init(R, '~O~K', cmOK, bfDefault));
Dlg^.Insert(Control);

R.Assign(13, 4, 25, 6);
Control := New(PButton, Init(R, '~A~nnuler', cmCancel, bfgrabfocus));
Dlg^.Insert(Control);

Dlg^.SelectNext(False);
nom := Dlg;
end;

function xydialog : PDialog;
var
Dlg : PDialog;
R : TRect;
Control : PView;

begin
R.Assign(10, 2, 45, 9);
New(Dlg, Init(R, 'x y dialogue'));
Dlg^.Palette := dpBlueDialog;

R.Assign(8, 2, 16, 3);
Control := New(PInputLong, Init(R, 6, 0, 15, 0));
Dlg^.Insert(Control);

R.Assign(2, 2, 5, 3);
Dlg^.Insert(New(PLabel, Init(R, 'X', Control)));

R.Assign(8, 4, 16, 5);
Control := New(PInputLong, Init(R, 6, 0, 15, 0));
Dlg^.Insert(Control);

R.Assign(2, 4, 5, 5);
Dlg^.Insert(New(PLabel, Init(R, 'Y', Control)));

R.Assign(22, 2, 32, 4);
Control := New(PButton, Init(R, 'O~k~', cmOK, bfDefault));
Dlg^.Insert(Control);

R.Assign(22, 4, 32, 6);
Control := New(PButton, Init(R, 'C~a~ncel', cmCancel, bfGrabFocus));
Dlg^.Insert(Control);

Dlg^.SelectNext(False);
xydialog := Dlg;
end;

function MakeDialogC(titre:string) : PDialog;
var
Dlg : PDialog;
R : TRect;
Control : PView;

begin
R.Assign(3, 2, 71, 24);
New(Dlg, Init(R, titre));

R.Assign(1, 1, 5, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('A', NewSItem('b', NewSItem('c ', NewSItem('d',
NewSItem('e',
NewSItem('f',
NewSItem('i',
NewSItem('j',
NewSItem('k',
NewSItem('l',
NewSItem('o',
NewSItem('p',
NewSItem('k',
NewSItem('q',
NewSItem('x',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(5, 1, 10, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(9, 1, 14, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(13, 1, 18, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(17, 1, 22, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(21, 1, 26, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(25, 1, 30, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(29, 1, 34, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(33, 1, 38, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('A', NewSItem('b', NewSItem('c ', NewSItem('d',
NewSItem('e',
NewSItem('f',
NewSItem('i',
NewSItem('j',
NewSItem('k',
NewSItem('l',
NewSItem('o',
NewSItem('p',
NewSItem('k',
NewSItem('q',
NewSItem('x',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(37, 1, 42, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('a',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(41, 1, 46, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('b',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(45, 1, 50, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('c',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(49, 1, 54, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('d',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(53, 1, 58, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('e',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(57, 1, 62, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('f',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(61, 1, 66, 17);
Control := New(PCheckboxes, Init(R,
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('g',
NewSItem('x',
Nil))))))))))))))))));
Dlg^.Insert(Control);

R.Assign(3, 18, 13, 20);
Control := New(PButton, Init(R, 'O~k~', cmOK, bfDefault));
Dlg^.Insert(Control);

R.Assign(29, 18, 39, 20);
Control := New(PButton, Init(R, 'C~a~ncel', cmCancel, bfGrabfocus));
Dlg^.Insert(Control);

Dlg^.SelectNext(False);
MakeDialogc:= Dlg;
end;
{---------------------------------------}
procedure TMyApp.essai_curseur;
var curseur_tempo:dessin_curseur;
begin
rotation(modif_c,curseur_tempo);
change_souris(curseur_tempo);
messagebox(' Alors Qu''en dites vous ?',nil,mfokbutton);
change_souris(fleche);
end;
procedure TMyApp.Loadcurseur;
var
R: TRect;
FileDialog: PFileDialog;
TheFile: FNameStr;
b:byte;
const
FDOptions: Word = fdOKButton or fdOpenButton;
begin
TheFile := '*.CUR';
New(FileDialog, Init(TheFile, 'Open file', '~F~ile name',
FDOptions, 1));
if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
begin
assign(Fichier,TheFile);
reset(Fichier);
read(Fichier,modif_c);
close(fichier);
end;
end;
procedure TMyApp.saveascurseur;
var
R: TRect;
FileDialog: PFileDialog;
TheFile: FNameStr;
const
FDOptions: Word = fdOKButton or fdOpenButton;
begin
TheFile := '*.CUR';
New(FileDialog, Init(TheFile, 'Save file', '~F~ile name',
FDOptions, 1));
if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
begin
assign(Fichier,TheFile);
rewrite(Fichier);
write(Fichier,modif_c);
close(fichier);
end;
end;

procedure TMyApp.Modif_curseur;
var j:byte;
k:word;
b:byte;
tempo:string;
begin
with Datarecchar,modif_c do
begin
field1:=mask_curseur[0];field2:=mask_curseur[1];field3:=mask_curseur[2];
field4:=mask_curseur[3];field5:=mask_curseur[4];field6:=mask_curseur[5];
field7:=mask_curseur[6];field8:=mask_curseur[7];
field9:=mask_curseur[8];field10:=mask_curseur[9];field11:=mask_curseur[10];
field12:=mask_curseur[11];field13:=mask_curseur[12];field14:=mask_curseur[13];field15:=mask_curseur[14];
field16:=mask_curseur[15];
end;
if Application^.ExecuteDialog(MakeDialogC('Figure'),@Datarecchar) = cmOk then
begin
with Datarecchar,modif_c do
begin
mask_curseur[0]:=field1;mask_curseur[1]:=field2;mask_curseur[2]:=field3;
mask_curseur[3]:=field4;mask_curseur[4]:=field5;mask_curseur[5]:=field6;
mask_curseur[6]:=field7;mask_curseur[7]:=field8;
mask_curseur[8]:=field9;mask_curseur[9]:=field10;mask_curseur[10]:=field11;
mask_curseur[11]:=field12;mask_curseur[12]:=field13;mask_curseur[13]:=field14;
mask_curseur[14]:=field15;mask_curseur[15]:=field16;
end;
end;
end;
procedure TMyApp.Modif_ecran;
var j:byte;
k:word;
b:byte;
tempo:string;
begin
with Datarecchar,modif_c do
begin
field1:=mask_ecran[0];field2:=mask_ecran[1];field3:=mask_ecran[2];
field4:=mask_ecran[3];field5:=mask_ecran[4];field6:=mask_ecran[5];
field7:=mask_ecran[6];field8:=mask_ecran[7];
field9:=mask_ecran[8];field10:=mask_ecran[9];field11:=mask_ecran[10];
field12:=mask_ecran[11];field13:=mask_ecran[12];field14:=mask_ecran[13];field15:=mask_ecran[14];
field16:=mask_ecran[15];
end;
if Application^.ExecuteDialog(MakeDialogC('Masque'),@Datarecchar) = cmOk then
begin
with Datarecchar,modif_c do
begin
mask_ecran[0]:=field1;mask_ecran[1]:=field2;mask_ecran[2]:=field3;
mask_ecran[3]:=field4;mask_ecran[4]:=field5;mask_ecran[5]:=field6;
mask_ecran[6]:=field7;mask_ecran[7]:=field8;
mask_ecran[8]:=field9;mask_ecran[9]:=field10;mask_ecran[10]:=field11;
mask_ecran[11]:=field12;mask_ecran[12]:=field13;mask_ecran[13]:=field14;
mask_ecran[14]:=field15;mask_ecran[15]:=field16;
end;
end;
end;
procedure TMyApp.Rotation90;
var tempo_curseur:dessin_curseur;
BEGIN
rotation(modif_c,tempo_curseur);
modif_c:=tempo_curseur;
END;
procedure TMyApp.pascal;
var t_c:dessin_curseur;
R: TRect;
FileDialog: PFileDialog;
TheFile: FNameStr;
var nomcurseur :record
F1: string[30];
end;
const
FDOptions: Word = fdOKButton or fdOpenButton;
begin
rotation(modif_c,t_c);
fillchar(nomcurseur,sizeof(nomcurseur),0);
if ExecuteDialog(nom, @nomcurseur) <> cmCancel then
BEGIN
TheFile := '*.PAS';
New(FileDialog, Init(TheFile, 'Save file', '~F~ile name',
FDOptions, 1));
if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
begin
assign(fichiert,theFile);
{$I-}
append(fichiert);
{$I+}
if IOResult<>0 then rewrite(fichiert);
with t_c do
begin
writeln(fichiert,'const ',nomcurseur.f1,': dessin_curseur = (contx:',contx,'; conty:',conty,';');
writeln(fichiert,' mask_ecran: (',mask_ecran[0],',',mask_ecran[1],',',mask_ecran[2],',',mask_ecran[3],',');
writeln(fichiert,' ',mask_ecran[4],',',mask_ecran[5],',',mask_ecran[6],',',mask_ecran[7],',');
writeln(fichiert,' ',mask_ecran[8],',',mask_ecran[9],',',mask_ecran[10],',',mask_ecran[11],',');
writeln(fichiert,' ',mask_ecran[12],',',mask_ecran[13],',',mask_ecran[14],',',mask_ecran[15],');');
writeln(fichiert,' mask_curseur: (',mask_curseur[0],',',mask_curseur[1],',',mask_curseur[2],',',mask_curseur[3],',');
writeln(fichiert,' ',mask_curseur[4],',',mask_curseur[5],',',mask_curseur[6],',',mask_curseur[7],',');
writeln(fichiert,' ',mask_curseur[8],',',mask_curseur[9],',',mask_curseur[10],',',mask_curseur[11],',');
writeln(fichiert,' ',mask_curseur[12],',',mask_curseur[13],',',mask_curseur[14],',',mask_curseur[15],'));');
end;
close(fichiert);
end;
end;
END;
procedure TMyApp.sourceC;
var t_c:dessin_curseur;
R: TRect;
FileDialog: PFileDialog;
TheFile: FNameStr;
var nomcurseur :record
F1: string[13];
end;
const
FDOptions: Word = fdOKButton or fdOpenButton;
begin
rotation(modif_c,t_c);
if ExecuteDialog(nom, @nomcurseur) <> cmCancel then
BEGIN
TheFile := '*.C';
New(FileDialog, Init(TheFile, 'Save file', '~F~ile name',
FDOptions, 1));
if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
begin
assign(fichiert,theFile);
{$I-}
append(fichiert);
{$I+}
if IOResult<>0 then rewrite(fichiert);
with t_c do
begin
writeln(fichiert,'const dessin_curseur ',nomcurseur.f1,' = {{',contx,',',conty,'},');
writeln(fichiert,' {',mask_ecran[0],',',mask_ecran[1],',',mask_ecran[2],',',mask_ecran[3],',');
writeln(fichiert,' ',mask_ecran[4],',',mask_ecran[5],',',mask_ecran[6],',',mask_ecran[7],',');
writeln(fichiert,' ',mask_ecran[8],',',mask_ecran[9],',',mask_ecran[10],',',mask_ecran[11],',');
writeln(fichiert,' ',mask_ecran[12],',',mask_ecran[13],',',mask_ecran[14],',',mask_ecran[15],'},');
writeln(fichiert,' {',mask_curseur[0],',',mask_curseur[1],',',mask_curseur[2],',',mask_curseur[3],',');
writeln(fichiert,' ',mask_curseur[4],',',mask_curseur[5],',',mask_curseur[6],',',mask_curseur[7],',');
writeln(fichiert,' ',mask_curseur[8],',',mask_curseur[9],',',mask_curseur[10],',',mask_curseur[11],',');
writeln(fichiert,'&n