Unité de gestion matricielle

unit matrix;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, Menus, Db, DBTables, DBGrids, ComCtrls, ToolWin, ExtCtrls,
  StdCtrls, Math, DbiProcs, DbiTypes, DbiErrs;

type

Tmatrice = class(TForm)
    StringGrid1: TStringGrid;
    MainMenu1: TMainMenu;
    Fichiers1: TMenuItem;
    Ouvrir1: TMenuItem;
    N1: TMenuItem;
    Quitter1: TMenuItem;
    OpenDialog1: TOpenDialog;
    Table1: TTable;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    Enregistersous1: TMenuItem;
    Enregister1: TMenuItem;
    N2: TMenuItem;
    db: TDatabase;
    ComboBox1: TComboBox;
    SaveDialog1: TSaveDialog;
    ToolButton4: TToolButton;

    //procedure du menu
    procedure Ouvrir1Click(Sender: TObject);
    procedure Quitter1Click(Sender: TObject);
    procedure Enregistersous1Click(Sender: TObject);
    //transposer une matrice
    procedure Transpose(Sender: TObject);
    //crée un matrice avec les marges
    procedure VectoriseMarges(Sender: TObject);
    //renvoie la valeur réelle en position (i,j)
    function val(i,j : integer) : real;
    //détermine les marges de la matrice
    procedure CalculeMarges;
    //multiplie la diagonale par un nombre
    procedure ToolButton4Click(Sender: TObject);
    //ouvre un table si une base est ouverte
    procedure ComboBox1Change(Sender: TObject);
    //recalcule les marges sur modification
    procedure StringGrid1KeyUp(Sender: TObject; var Key: Word;
              Shift: TShiftState);
    //adapte la taille de la grille et du formulaire
    procedure FormResize(Sender: TObject);
    procedure Enregister1Click(Sender: TObject);
  private

  public
    nc : integer;//taille de la matrice-nombre de colonnes
    nl : integer;//nombre de lignes
  end;
//fonction qui renvoie 1 si deux matrices sont de meme dimension
  function compare(mat1,mat2 : Tmatrice) : boolean;

implementation

uses mod_grav;

//---------------------------------------------------------------

function compare(mat1,mat2 : Tmatrice) : boolean;
begin
  if ((mat1.nc<>mat2.nc) OR (mat1.nl<>mat2.nl))
  then compare := FALSE
  else compare := TRUE;
end;

{$R *.DFM}

//---------------------------------------------------------------
//---------------------------------------------------------------
//                    gestionnaire matriciel
//---------------------------------------------------------------
//---------------------------------------------------------------
//enrees-sorties
//---------------------------------------------------------------
//inscrit dans TableListe les tables de la base ACCESS ouverte
procedure fDbiOpenTableList(hTmpDb: hDBidb; TableList: TStrings);

var
  hCursor : hDBICur;
  ListDesc : TBLBaseDesc;
begin
  Check(DbiOpenTableList(hTmpDb, False, False, '*.mdb', hCursor));
  TableList.Clear;
  while (DbiGetNextRecord(hCursor, dbiNOLOCK, @ListDesc, nil) = dbiErr_None) do
    TableList.Add(ListDesc.szName);
end;
//---------------------------------------------------------------
procedure Tmatrice.Ouvrir1Click(Sender: TObject);

begin
  if OpenDialog1.Execute then
  begin
    //definition de l'Alias pour la base access
    db.DatabaseName:=caption;
    db.drivername:='MSACCESS';
    db.params.clear;
    db.params.add('LANGDRIVER=Access General');
    db.params.add('DATABASE NAME='+OpenDialog1.FileName);
    db.params.add('OPEN MODE=READ/WRITE');
    db.params.add('SYSTEM DATABASE=');
    db.params.add('PASSWORD=');
    db.Connected:=True;
    Table1.databasename:=caption;
    ComboBox1.Text:='Choisir une table';
    fDbiOpenTableList(db.handle, ComboBox1.Items);
  end;
end;
//-------------------------------------------------------------------
procedure Tmatrice.Quitter1Click(Sender: TObject);
begin
  close;
end;
//---------------------------------------------------------------------
procedure Tmatrice.Enregistersous1Click(Sender: TObject);
begin
  SaveDialog1.Execute;
  
end;
//-------------------------------------------------------------------
procedure Tmatrice.ComboBox1Change(Sender: TObject);
var
  i,j : integer;
  temp : real;
begin
  Table1.TableName:=ComboBox1.Text;
  Table1.Active:=True;
  //la table ouverte est stokee ds une grille
  nc:=Table1.FieldList.count;
  StringGrid1.ColCount:=nc+2;
  nl:=Table1.RecordCount;
  StringGrid1.RowCount:=nl+2;
  for i := 1 to nl do
  begin
    for j := 1 to nc do
    begin
    //on remplit les trous eventuellement
      if (Table1.Fields[j-1].Value = NULL)
        then temp:=0
        else temp:=Table1.Fields[j-1].Value;
      StringGrid1.Cells[j+1,i+1]:=floattostr(temp);
    end;
  Table1.Next;
  end;
  Table1.Active:=False;
  db.connected:=False;
  CalculeMarges;
end;
//---------------------------------------------------------------------
//operations algebriques
//---------------------------------------------------------------------
procedure Tmatrice.Transpose(Sender: TObject);
var
  maxi : integer;
  i,j  : integer;
  temp : string;
begin
  maxi:=max(nl,nc);
  StringGrid1.RowCount:=maxi+2;
  StringGrid1.ColCount:=maxi+2;
  for i := 1 to maxi+2 do
  begin
    for j := 0 to (i-1) do
    begin
      temp:=StringGrid1.Cells[i,j];
      StringGrid1.Cells[i,j]:=StringGrid1.Cells[j,i];
      StringGrid1.Cells[j,i]:=temp;
    end;
  end;
  StringGrid1.RowCount:=nc+2;
  StringGrid1.ColCount:=nl+2;
  nc:=nl;nl:=StringGrid1.RowCount-2;
end;
//-------------------------------------------------------------------
procedure Tmatrice.CalculeMarges;
var
  i,j   : integer;
  sigma : real;
begin
  sigma:=0;
  for j := 1 to nc do
  begin
    for i := 1 to nl do
      sigma := sigma+strtofloat(StringGrid1.Cells[j+1,i+1]);
    StringGrid1.Cells[j+1,0]:=floattostr(sigma);
    sigma:=0;
  end;
  for i := 1 to nl do
  begin
    for j := 1 to nc do
      sigma := sigma+strtofloat(StringGrid1.Cells[j+1,i+1]);
    StringGrid1.Cells[0,i+1]:=floattostr(sigma);
    sigma:=0;
  end;
  for i := 1 to nl do
  begin
    sigma:=sigma+strtofloat(StringGrid1.Cells[0,i+1])
  end;
  StringGrid1.Cells[0,0]:=floattostr(sigma);
  for i := 1 to nc do StringGrid1.Cells[i+1,1]:=inttostr(i);
  for i := 1 to nl do StringGrid1.Cells[1,i+1]:=inttostr(i);
end;
//-------------------------------------------------------------------
procedure Tmatrice.VectoriseMarges(Sender: TObject);
var
  i     : integer;
  matos : Tmatrice;
begin
  if (nl<>nc) then ShowMessage('La matrice n''est pas carrée !!!')
  else
  begin
    Application.CreateForm(Tmatrice,matos);
    matos.caption:='Marges de : '+caption;
    Form1.newmat(matos);
    matos.nc:=2;
    matos.nl:=nl;
    matos.StringGrid1.RowCount:=nc+2;
    matos.StringGrid1.ColCount:=4;
    for i:= 1 to nl do
    begin
      matos.StringGrid1.Cells[1,i+1]:=inttostr(i);
      matos.StringGrid1.Cells[2,i+1]:=StringGrid1.Cells[0,i+1];
      matos.StringGrid1.Cells[3,i+1]:=StringGrid1.Cells[i+1,0];
    end;
    matos.CalculeMarges;
    matos.show;
  end;
end;
//---------------------------------------------------------------------
function Tmatrice.val(i,j : integer) : real;
begin
  val:=StrToFloat(StringGrid1.Cells[j+1,i+1]);
end;
//---------------------------------------------------------------------
procedure Tmatrice.ToolButton4Click(Sender: TObject);
var
  i    : integer;
  temp : real;
  rep  : String;
begin
  if (nl<>nc) then ShowMessage('La matrice n''est pas carrée !!!')
  else
  begin
    rep:=InputBox('Multiplier la diagonale par : ','','');
    if (rep <> '') then
    begin
      for i := 1 to nc do
      begin
        temp:=StrtoFloat(rep)*StrtoFloat(StringGrid1.Cells[i+1,i+1]);
        StringGrid1.Cells[i+1,i+1]:=floattostr(temp);
      end;
    calculemarges;
    end;
  end;
end;
//---------------------------------------------------------------------
procedure Tmatrice.StringGrid1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  calculemarges;
end;
//---------------------------------------------------------------------
procedure Tmatrice.FormResize(Sender: TObject);
begin
  StringGrid1.Height:=ClientHeight-33;
  StringGrid1.Width:=ClientWidth-2;
end;
//---------------------------------------------------------------------
procedure Tmatrice.Enregister1Click(Sender: TObject);
var i,j:integer;
begin
  db.connected:=true;
  table1.active:=true;
  table1.First;
  for i := 1 to nl do
  begin
    Table1.edit;
    for j := 1 to nc do
    begin
      Table1.Fields[j-1].value:=strtofloat(stringgrid1.Cells[j+1,i+1]);
    end;
    table1.post;
    table1.next;
  end;
  table1.active:=false;
  db.connected:=false;
end;
//---------------------------------------------------------------------
end.