Module du modèle gravitaire

unit mod_grav;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, Grids, StdCtrls ,Math ,matrix, param, matrix_stat, ExtCtrls,
  repartition;

const

  maxi = 20;

type

  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Fichiers1: TMenuItem;
    Quitter1: TMenuItem;
    matrice1: TMenuItem;
    creer1: TMenuItem;
    Modle1: TMenuItem;
    Distribution1: TMenuItem;
    Label1: TLabel;
    marges: TLabel;
    cbox: TListBox;
    mbox: TListBox;
    Parametres1: TMenuItem;
    Fonctiondimpdance1: TMenuItem;
    Statistiques1: TMenuItem;
    Synchroniser1: TMenuItem;
    Rpartionmodale1: TMenuItem;
    eclater1: TMenuItem;
    eclater2: TMenuItem;
    multiplier1: TMenuItem;
    procedure Quitter1Click(Sender: TObject);
    procedure creer1Click(Sender: TObject);
    procedure Distribution1Click(Sender: TObject);
    procedure Fonctiondimpdance1Click(Sender: TObject);
    procedure Statistiques1Click(Sender: TObject);
    //mboxKeyDown et cboxKeyDown gèrent la suppression des matrices
    procedure mboxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure cboxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure mboxDblClick(Sender: TObject);
    procedure cboxDblClick(Sender: TObject);
    procedure Rpartionmodale1Click(Sender: TObject);
    procedure eclater2Click(Sender: TObject);
    procedure multiplier1Click(Sender: TObject);
  private

  public
    procedure newmat(mat : Tmatrice);
  end;

var
    Form1     : Tform1;
    alpha     : real = 1.198037556;
    beta      : real = 0.237794387;
    p         : real = 7.693570373;
    liste_mat : array [0..30] of Tmatrice;

implementation

{$R *.DFM}

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//boutons et outils
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure TForm1.Quitter1Click(Sender: TObject);
begin
  Application.Terminate;
end;
 //-------------------------------------------------------------------
procedure TForm1.newmat(mat : Tmatrice);

begin
  liste_mat[mbox.items.count]:=mat;
  mbox.items.addobject(mat.caption,mat);
  cbox.items.addobject(mat.caption,mat);
end;
//-------------------------------------------------------------------
procedure TForm1.creer1Click(Sender: TObject);
var
  mat : Tmatrice;
  rep : string;
begin
  Application.CreateForm(Tmatrice,mat);
  rep:=InputBox('Nom de la matrice','','');
  mat.caption:=rep;
  newmat(mat);
  mat.show;
end;

//-------------------------------------------------------------------
procedure TForm1.Fonctiondimpdance1Click(Sender: TObject);
begin
  param_f.showmodal;
end;
//-------------------------------------------------------------------
procedure TForm1.Rpartionmodale1Click(Sender: TObject);
begin
  
  Form3.showmodal;
end;
//-------------------------------------------------------------------
procedure TForm1.Statistiques1Click(Sender: TObject);

begin
  Form2.calcule_stat(liste_mat[cbox.ItemIndex],liste_mat[mbox.ItemIndex]);
end;
//-------------------------------------------------------------------
procedure TForm1.mboxKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
var
  i : integer;
begin
  if ((Key=VK_DELETE) AND (mbox.ItemIndex<>-1)) then
  begin
    for i := mbox.ItemIndex to 29 do
      begin
        liste_mat[i]:=liste_mat[i+1];
      end;
    mbox.Items.Objects[mbox.ItemIndex].Free;
    cbox.Items.Delete(mbox.ItemIndex);
    mbox.Items.Delete(mbox.ItemIndex);
  end;
end;
//-------------------------------------------------------------------
procedure TForm1.cboxKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
var
  i : integer;
begin
  if ((Key=VK_DELETE) AND (cbox.ItemIndex<>-1)) then
  begin
    for i := cbox.ItemIndex to 29 do
      begin
        liste_mat[i]:=liste_mat[i+1];
      end;
    cbox.Items.Objects[cbox.ItemIndex].Free;
    mbox.Items.Delete(cbox.ItemIndex);
    cbox.Items.Delete(cbox.ItemIndex);
  end;
end;
//-------------------------------------------------------------------
procedure TForm1.mboxDblClick(Sender: TObject);
begin
  liste_mat[mbox.ItemIndex].WindowState:=wsNormal;
end;
//-------------------------------------------------------------------
procedure TForm1.cboxDblClick(Sender: TObject);
begin
  liste_mat[cbox.ItemIndex].WindowState:=wsNormal;
end;
//---------------------------------------------------------------------
//---------------------------------------------------------------------
//                  implementation du modele gravitaire
//---------------------------------------------------------------------
//---------------------------------------------------------------------
//              Fonction d'impédance
function f(x : real) : real;
begin
     f := power(x,alpha)*exp(-x*beta+p);
end;
//-------------------------------------------------------------------
procedure TForm1.Distribution1Click(Sender: TObject);
var
  i,j,k        : integer;
  taille       : integer;
  sigma        : real;
  model        : Tmatrice;
  couts,marges : Tmatrice;
  temp         : Tmatrice;
begin
  Application.CreateForm(Tmatrice,model);
  Application.CreateForm(Tmatrice,temp);
  model.caption:='Modèle gravitaire';
  Form1.newmat(model);
  couts:=liste_mat[cbox.ItemIndex];
  marges:=liste_mat[mbox.ItemIndex];
  temp.StringGrid1.RowCount:=marges.StringGrid1.RowCount;
  temp.StringGrid1.ColCount:=marges.StringGrid1.ColCount;
  taille:=couts.StringGrid1.RowCount-2;
  model.StringGrid1.RowCount:=taille+2;
  model.StringGrid1.ColCount:=taille+2;
  model.nc:=taille;
  model.nl:=taille;
//-------------------------initialisations--------------------------------------
  for i := 1 to taille do temp.StringGrid1.cells[3,i+1]:='1';
//-------------------------calcul des Ai et Bi----------------------------------
  for k := 1 to 20 do
  begin
    for i := 1 to taille do
    begin
      sigma:=0;
      for j := 1 to taille do
      begin
        sigma:=sigma+temp.val(j,2)*marges.val(j,2)*f(couts.val(i,j));
      end;
    temp.StringGrid1.Cells[2,i+1]:=FloatToStr(1/sigma);
    end;
    for j := 1 to taille do
    begin
      sigma:=0;
      for i := 1 to taille do
      begin
        sigma:=sigma+temp.val(i,1)*marges.val(i,1)*f(couts.val(i,j));
      end;
    temp.StringGrid1.Cells[3,j+1]:=FloatToStr(1/sigma);
    end;
  end;
//------------------------------calcul des Tij=Ai*Oi*Bj*Dj*f(Cij)
  for i := 1 to taille do
  begin
    for j := 1 to taille do
    begin                                          
      model.StringGrid1.Cells[j+1,i+1]:=
				   //Ai           Oi              Bi              Di
	floattostr(round(temp.val(i,1)*marges.val(i,1)*temp.val(j,2)*marges.val(j,2)*f(couts.val(i,j))));
    end;
  end;
  model.calculemarges;
  model.show;
  temp.destroy;
end;
//------------------------------------------------------------------------------
//proc pour jean-michel
//------------------------------------------------------------------------------
procedure TForm1.eclater2Click(Sender: TObject);
var
  source, relat, cible : Tmatrice;
  rep : string;
  idx : integer;
  i, j : integer;
  ir, jr : integer;
begin
  source:=liste_mat[cbox.ItemIndex];
  relat:=liste_mat[mbox.ItemIndex];
  rep:=inputbox('nom de la matrice cible','','');
  idx:=mbox.items.indexof(rep);
  cible:=liste_mat[idx];

  for i := 1 to cible.nc do
  begin
    ir:=strtoint( relat.stringgrid1.cells[3,i+1]);
    for j := 1 to cible.nl do
    begin
      jr:=strtoint( relat.stringgrid1.cells[3,j+1]);
      if ((ir>source.nc) or (jr>source.nl)) then
      cible.StringGrid1.cells[j+1,i+1]:='1'
      else
      cible.StringGrid1.cells[j+1,i+1]:=source.StringGrid1.cells[ir+1,jr+1];
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure TForm1.multiplier1Click(Sender: TObject);
var
  mat1, mat2, cible : Tmatrice;
  i, j : integer;
  rep : string;
  idx : integer;
  a, b : real;
begin
  mat1:=liste_mat[cbox.ItemIndex];
  mat2:=liste_mat[mbox.ItemIndex];
  rep:=inputbox('nom de la matrice cible','','');
  idx:=mbox.items.indexof(rep);
  cible:=liste_mat[idx];

  for i := 1 to cible.nc do
  begin
    for j := 1 to cible.nl do
    begin
      a:=strtofloat(mat1.StringGrid1.cells[i+1,j+1]);
      b:=strtofloat(mat2.StringGrid1.cells[i+1,j+1]);
      cible.StringGrid1.cells[i+1,j+1]:=floattostr(round(a*b));
    end;
  end;

end;
//------------------------------------------------------------------------------
end.