Soyez le premier à donner votre avis sur cette source.
Vue 9 265 fois - Téléchargée 1 341 fois
procedure TForm1.resolClick(Sender: TObject); var i,j : integer; a,coef : extended; b,pivot_af : string; begin // à l'initialisation toutes les étapes sont true sauf etape1 à false. // étape 5 if etape5=false then etape1:=false; etape5:=true; // étape 4,élimination des coef. de la colonne pivot : Li=Li-aij*Lipiv. if etape4=false then begin edit1.text:='élimination des coef. de la colonne pivot(rang='+inttostr(rang)+')'; sleep(2000); for i:=1 to dim.ligne do begin if i<>ipiv then begin coef:= mat[i,jpiv]; for j:=1 to dim.colonne do begin mat[i,j]:= mat[i,j]-coef*mat[ipiv,j]; end; vect[i]:=vect[i]-vect[ipiv]*coef; end; end; form1.paint; if rang=dim.ligne then begin etape4:=true; end else begin etape4:=true;etape5:=false; pivot:=false; end; end; // étape 3, division de la ligne par le pivot. if etape3=false then begin a:=mat[ipiv,jpiv]; str( a:3:3,pivot_af); edit1.text:='division de la ligne '+inttostr(ipiv)+' par le pivot.('+pivot_af+')'; sleep(1000); for j:=1 to dim.colonne do begin mat[ipiv,j]:=mat[ipiv,j]/a; end; vect[ipiv]:=vect[ipiv]/a; form1.paint; etape3:=true;etape4:=false; end; // étape 2, permutation des lignes ou colonnes. if etape2=false then begin edit1.text:='ipiv ='+inttostr(ipiv); if ipiv<>rang then begin edit1.text:='permutation des lignes '+inttostr(rang)+' et '+inttostr(ipiv); sleep(1000); for j:=1 to dim.colonne do begin a:= mat[rang,j]; mat[rang,j]:= mat[ipiv,j]; mat[ipiv,j]:= a; end; a:=vect[rang]; vect[rang]:=vect[ipiv]; vect[ipiv]:=a; end; if jpiv<>rang then begin edit1.text:='permutation des colonnes'+inttostr(rang)+'et'+inttostr(jpiv); sleep(2000); for i:=1 to dim.ligne do begin a:= mat[i,rang]; mat[i,rang]:= mat[i,jpiv]; mat[i,jpiv]:= a; end; b:=inc[rang]; inc[rang]:=inc[jpiv]; inc[jpiv]:=b; end; form1.Paint; ipiv:=rang; jpiv:=rang; etape2:=true;etape3:=false; end; // étape 1, recherche du pivot dans une sous-matrice complète. if etape1=false then begin for j:=rang+1 to dim.colonne do begin for i:= rang+1 to dim.ligne do begin if pivot = false then begin if mat[i,j] <> 0 then begin pivot:= true; rang:=rang+1; ipiv:=i; jpiv:=j; end; end; end; end; if pivot=true then begin str(mat[ipiv,jpiv]:3:3,pivot_af); edit1.text:=' pivot trouvé '+inttostr(ipiv)+','+inttostr(jpiv)+' = '+pivot_af; sleep(1000); end; if (pivot = false) and (rang = 0) then edit1.text:='rang nul'; if (pivot = false) and (rang <> 0) then edit1.text:='rang de ce syst. linéaire = '+inttostr(rang); if pivot = true then begin if (ipiv<> rang) or (jpiv<> rang) then begin edit1.text:='permutation '+inttostr(ipiv)+inttostr(jpiv); etape1:=true;etape2:=false; end else begin // edit1.text:='division de la ligne '+inttostr(ipiv)+'par le pivot'; etape1:=true;etape3:=false; end; end; end; end;
D'ailleurs, je note que tu affectes plusieurs fois la variable chemin dans la partie initialization. Est-ce bien utile ?
unit princ;
interface
uses
Windows, Messages, SysUtils,declarations,fichier, Classes, Graphics, Controls,
Forms,apropos, Dialogs,filectrl,StdCtrls, ExtCtrls, Menus, ComCtrls, ToolWin, ImgList, ActnList,
Gauges;
type
TForm1 = class(TForm)
Timer1: TTimer;
MainMenu1: TMainMenu;
Edition1: TMenuItem;
Creerunematrice1: TMenuItem;
Ouvrir1: TMenuItem;
editer: TMenuItem;
enregistrer: TMenuItem;
apropos: TMenuItem;
Memo1: TMemo;
StatusBar1: TStatusBar;
N1: TMenuItem;
quitter2: TMenuItem;
ouvrirdialog: TOpenDialog;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ImageList1: TImageList;
editerdialog: TOpenDialog;
editionfin: TButton;
resol: TButton;
Edit1: TEdit;
procedure Timer1Timer(Sender: TObject);
procedure Creerunematrice1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure editerClick(Sender: TObject);
procedure quitter1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure StatusBar1Click(Sender: TObject);
procedure Ouvrir1Click(Sender: TObject);
procedure enregistrerClick(Sender: TObject);
procedure ouvrirdialogCanClose(Sender: TObject; var CanClose: Boolean);
procedure editerdialogCanClose(Sender: TObject; var CanClose: Boolean);
procedure editionfinClick(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure editerdialogClose(Sender: TObject);
procedure resolClick(Sender: TObject);
procedure aproposClick(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Timer1Timer(Sender: TObject);
var
h,m,s,z : word;
begin
decodetime(now, h,m,s,z);
statusbar1.Panels[3].text := format('horloge : %.2d:%.2d:%.2d',[h, m, s]);
{ calcul du temps passé.
}
Inc(SecUtil);
if SecUtil >= 60 then
begin
SecUtil := 0;
Inc(MinUtil);
end;
if MinUtil >= 60 then
begin
MinUtil := 0;
Inc(HeureUtil);
end;
statusbar1.Panels[1].text:= format('temps passé : %.2d:%.2d:%.2d',[HeureUtil, MinUtil, SecUtil]);
end;
procedure TForm1.Creerunematrice1Click(Sender: TObject);
var
v: string;
begin
// creer un système.Gestion des exceptions.
v := InputBox('nombre de lignes',
'entrer le nombre de lignes :',
'5');
dim.ligne := StrToIntDef(v, 3);
v := InputBox('nombre de colonnes',
'entrer le nombre de colonnes :',
'3');
dim.colonne:=StrToIntDef(v, 6);
if dim.ligne < 1 then
dim.ligne := 3
else
if dim.ligne > 24 then
dim.ligne := 24;
if dim.colonne < 1 then
dim.colonne := 3
else
if dim.colonne > 24 then
dim.colonne := 24;
v := inputbox('nom de la matrice',
'entrer le nom (sans .txt):',
'GMP04');
// supprimer l'extension
v := ChangeFileExt(V, '.txt');
CreerMat(v);
NomCour := v;
v := ExtractFilePath(Application.ExeName);
v := v+'matrices\'+NomCour;
memo1.visible := true;
memo1.lines.loadfromfile(v);
statusbar1.panels[0].text := NomCour;
editionfin.visible := true;
end;
procedure TForm1.editerdialogCanClose(Sender: TObject; var CanClose : Boolean);
var v,nom : string;
begin
memo1.Visible := true;
editionfin.visible := true;
v := ExtractFilePath(Application.ExeName);
v := v+'matrices\';
nom := editerdialog.filename;
delete(nom, 1, length(v));
statusbar1.panels[0].text := Nom;
NomCour := Nom;
Ouvrir(NomCour);
memo1.visible := true;
memo1.lines.loadfromfile(editerdialog.filename);
end;
procedure TForm1.editionfinClick(Sender: TObject);
var
v : string;
begin
toolbar1.visible:=true;
// extension complète ...
v := extractfilepath(application.exename);
v := v+'matrices\'+nomcour;
memo1.lines.SaveToFile(v);
editionfin.Visible := false;
memo1.visible := false;
ouvrir(nomcour);
statusbar1.panels[0].text:=nomcour;
Paint;
//initialisation des variables globales.
rang := 0;
etape1 := false;
etape2 := true;
etape3 := true;
etape4 := true;
etape5 := true;
pivot := false;
end;
/////////////////////////////////////////////////
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.Visible := false;
editionfin.visible := false;
if nomcour = 'matricecour.txt' then
ouvrir('matricecour.txt')
else
if nomcour = 'acreer' then
begin
sauver('matricecour.txt');
sauver('matrice3x3.txt');
end;
nomcour := 'matricecour.txt';
statusbar1.Panels[0].text:=nomcour;
end;
procedure TForm1.editerClick(Sender: TObject);
begin
toolbar1.visible:=false;
editerdialog.initialdir:=application.ExeName+'matrices\';
editerdialog.filename:='matricecour.txt';
editerdialog.execute;
end;
procedure TForm1.quitter1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
tps : textfile;
chemin : string;
begin
chemin := extractfilepath(application.exename)+'tempspasse\tpspasse.txt';
assignfile(tps,chemin);
rewrite(tps);
writeln(tps,inttostr(heureutil));
writeln(tps,inttostr(minutil));
writeln(tps,inttostr(secutil));
closefile(tps);
nomcour := 'matricecour.txt';
sauver(nomcour);
end;
procedure TForm1.StatusBar1Click(Sender: TObject);
begin
// changer le nom de matricecour.text
nomcour:=entrernom('autre nom sans .txt','entrer un nouveau nom pour le syst. courant');
statusbar1.panels[0].text:=nomcour;
sauver(nomcour);
end;
procedure TForm1.Ouvrir1Click(Sender: TObject);
begin
// Ouvrir
//sauver(nomcour);
pivot:=false;
ouvrirdialog.initialdir:=application.ExeName+'matrices\';
ouvrirdialog.filename:='matricecour.txt';
ouvrirdialog.execute;
end;
procedure TForm1.enregistrerClick(Sender: TObject);
var
nom : string;
begin
// Enregistrer
nom:='matcour.txt';
nom:=entrernom('nom du système','donner un nom de fichier sans extension :');
sauver(nom);
end;
procedure TForm1.ouvrirdialogCanClose(Sender: TObject; var CanClose: Boolean);
var
v,nom: string;
begin
//sauver(nomcour);
v:=extractfilepath(application.exename);
v:=v+'matrices\';
nom:=ouvrirdialog.filename;
delete(nom,1,length(v));
ouvrir(nom);
statusbar1.panels[0].text:=nom;
nomcour:=nom;
Paint;
rang:=0;
etape1:=false;
etape2:=true;
etape3:=true;
etape4:=true;
etape5:=true;
pivot:= false;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
coul : tcolor;
begin
efface(canvas,posa);
if (dim.colonne>0) and (dim.colonne<13) then
begin
larg:=80;
haut:=30;
end
else
if (dim.colonne>12) and (dim.colonne<20) then
begin
larg:=50;
haut:=30;
end
else
if (dim.colonne>19) and (dim.colonne<25) then
begin
larg:=40;
haut:=20;
end;
posa.dx := 10;
posa.dy := 50;
posb.dx := posa.dx;
posb.dy := posa.dy+haut;
posc.dy := posb.dy;
posc.dx := posb.dx+ dim.colonne*larg;
efface(canvas,posa);
coul := clred;
affichemat(canvas,posb,coul);
coul := clgreen;
affichevect(canvas,posc,coul);
coul := clblue;
affichinc(canvas,posa,coul);
end;
procedure TForm1.editerdialogClose(Sender: TObject);
begin
toolbar1.visible:=true;
end;
procedure TForm1.resolClick(Sender: TObject);
var
i,j : integer;
a,coef : extended;
b,pivot_af : string;
begin
// à l'initialisation toutes les étapes sont true sauf etape1 à false.
// étape 5
if not Etape5 then
Etape1 := false;
// étape 4,élimination des coef. de la colonne pivot : Li=Li-aij*Lipiv.
if not Etape4 then
begin
edit1.text := 'élimination des coef. de la colonne pivot(rang='+inttostr(rang)+')';
sleep(2000);
for i:= 1 to dim.ligne do
begin
if i <> ipiv then
begin
coef:= mat[i,jpiv];
for j := 1 to dim.colonne do
mat[i,j]:= mat[i,j]-coef*mat[ipiv,j];
vect[i]:=vect[i]-vect[ipiv]*coef;
end;
end;
paint;
if rang = dim.ligne then
etape4 := true
else
begin
etape4 := true;
etape5 := false;
pivot := false;
end;
end;
// étape 3, division de la ligne par le pivot.
if not Etape3 then
begin
edit1.text:= format('division de la ligne %d par le pivot. (%.3f)',[ipiv, mat[ipiv,jpiv]]);
sleep(1000);
for j := 1 to dim.colonne do
mat[ipiv,j]:=mat[ipiv,j]/a;
vect[ipiv]:=vect[ipiv]/a;
paint;
etape3 := true;
etape4 := false;
end;
// étape 2, permutation des lignes ou colonnes.
if not Etape2 then
begin
edit1.text:='ipiv ='+inttostr(ipiv);
if ipiv<>rang then
begin
edit1.text:='permutation des lignes '+inttostr(rang)+' et '+inttostr(ipiv);
sleep(1000);
for j:=1 to dim.colonne do
begin
a:= mat[rang,j];
mat[rang,j]:= mat[ipiv,j];
mat[ipiv,j]:= a;
end;
a:=vect[rang];
vect[rang]:=vect[ipiv];
vect[ipiv]:=a;
end;
if jpiv<>rang then
begin
edit1.text:='permutation des colonnes'+inttostr(rang)+'et'+inttostr(jpiv);
sleep(2000);
for i:=1 to dim.ligne do
begin
a:= mat[i,rang];
mat[i,rang]:= mat[i,jpiv];
mat[i,jpiv]:= a;
end;
b:=StrInc[rang];
StrInc[rang]:=StrInc[jpiv];
StrInc[jpiv]:=b;
end;
Paint;
ipiv:=rang;
jpiv:=rang;
etape2:=true;
etape3:=false;
end;
// étape 1, recherche du pivot dans une sous-matrice complète.
if not Etape1 then
begin
for j := rang+1 to dim.colonne do
for i:= rang+1 to dim.ligne do
if not pivot then
if mat[i,j] <> 0 then
begin
pivot:= true;
inc(rang);
ipiv:=i;
jpiv:=j;
end;
if pivot=true then
begin edit1.text:format(' pivot trouvé %d, %d %.3f',[ipiv, jpiv, mat[ipiv,jpiv]]);
sleep(1000);
end;
if (not pivot) and (rang = 0) then
edit1.text:='rang nul';
if (not pivot) and (rang <> 0) then
edit1.text:='rang de ce syst. linéaire = '+inttostr(rang);
if pivot then
if (ipiv<> rang) or (jpiv<> rang) then
begin
edit1.text := format('permutation %d%d',[ipiv,jpiv]);
etape1:=true;
etape2:=false;
end
else
begin
// edit1.text:='division de la ligne '+inttostr(ipiv)+'par le pivot';
etape1 := true;
etape3 := false;
end;
end;
end;
procedure TForm1.aproposClick(Sender: TObject);
begin
form3.show;
end;
end.
_____________________________________________________________
declarations.pas ::
unit declarations;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,filectrl, Menus, ComCtrls, ToolWin, ImgList, ActnList;
type
TStrInc = array[1..100] of string;
TMat = array[1..100,1..100] of extended;
TVect = array[1..100] of extended;
TDim = record
ligne, colonne : integer;
end;
TPos = record
dx,dy : integer;
end;
var
SecUtil,MinUtil,HeureUtil : integer;
tps : textfile;
chemin,nomcour : string;
dim : TDim;
mat : TMat;
vect : TVect;
StrInc : TStrInc;
larg,haut : integer;
ipiv,jpiv,m,p : integer;
rang : integer = 0;
posa : TPos = (dx:50; dy:50);
posb : TPos = (dx:50; dy:80);
posc : TPos = (dx:260; dy:80);
//Etapes de progression de la résolution
etape1: boolean = false;
etape2: boolean = true;
etape3: boolean = true;
etape4: boolean = true;
etape5: boolean = true;
pivot : boolean = false;
implementation
initialization
// Essai d'ouverture du fichier tpspasse.txt
// Si le rep. contenant tpspasse.txt n'existe pas il faut le créer : forcedirectories...
chemin := extractfilepath(application.exename);
chemin := chemin+'tempspasse\tpspasse.txt';
if FileExists(chemin) then
begin
assignfile(tps,chemin);
reset(tps);
readln(tps,HeureUtil);
readln(tps,MinUtil);
readln(tps,SecUtil);
closefile(tps);
end
else
begin
//création du répertoire tempspassé
HeureUtil:=0;
MinUtil:=0;
SecUtil:=0;
chemin:= extractfilepath(application.exename);
chemin:=chemin+'tempspasse\';
forcedirectories(chemin);
end;
// essai d'ouverture de matricecour.txt
chemin:=extractfilepath(application.exename);
chemin:=chemin+'matrices\matricecour.txt';
if FileExists(chemin) then
begin
assignfile(tps,chemin);
reset(tps);
// traitement chargement des coefficients depuis matricecour.txt.
nomcour:='matricecour.txt';
closefile(tps);
end
else
begin
// création du répertoire matrices.
nomcour:='acreer';
chemin:= extractfilepath(application.exename);
chemin:=chemin+'matrices\';
forcedirectories(chemin);
dim.ligne:=3;
dim.colonne:=3;
//initialisation des coefficients.
mat[1,1]:=1;
mat[1,2]:=2;
mat[1,3]:=3;
mat[2,1]:=4;
mat[2,2]:=5;
mat[2,3]:=6;
mat[3,1]:=7;
mat[3,2]:=8;
mat[3,3]:=9;
vect[1]:=5;
vect[2]:=6;
vect[3]:=7;
StrInc[1]:='x1';
StrInc[2]:='x2';
StrInc[3]:='x3';
ipiv:=1;
jpiv:=1;
end;
end.
D'ailleurs ce prof lui aussi écrivait ses propres programmes pour résoudre ce type de système.
Je me demande si par hasard ...
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.