uindist.pas

clusterfilesrev 最新的分类聚类代码

unit UInDist;     (*  嫍棧乮旕椶帡搙乯僨乕僞偺愝掕   *)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls;

type
  TFDist = class(TForm)
    StringGrid1: TStringGrid;
    AddButton: TButton;
    DelButton: TButton;
    CalcButton: TButton;
    SaveButton: TButton;
    LoadButton: TButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    PButton: TButton;
    StringGrid2: TStringGrid;
    WRCSVButton: TButton;
    RDCSVButton: TButton;
    procedure ExitButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure DelButtonClick(Sender: TObject);
    procedure CalcButtonClick(Sender: TObject);
    procedure SaveButtonClick(Sender: TObject);
    procedure LoadButtonClick(Sender: TObject);
    procedure PButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure WRCSVButtonClick(Sender: TObject);
    procedure RDCSVButtonClick(Sender: TObject);
  private
    { Private 愰尵 }
  public
    { Public 愰尵 }
  end;

var
  FDist: TFDist;

implementation

{$R *.DFM}

uses
  UClusterRev,  Printers;

//   惍悢抣傪塃媗俀寘偺暥帤楍偲偟偰昞偡
function IntToStr2( i : Longint ) : string;
  var s : string;
  begin
      s:=IntToStr(i);
      if Length(s) < 2 then s:=' '+s;
      IntToStr2:=s;
  end;


procedure TFDist.ExitButtonClick(Sender: TObject);
begin
             Close;
end;


procedure TFDist.FormCreate(Sender: TObject);
var sel : TGridRect;      //  慖戰僙儖偺埵抲傪昞傢偡偨傔偺宆
begin
    with StringGrid1 do
      begin
          ColCount:=3;                //  懳徾偺悢偺弶婜抣
          RowCount:=3;
          Font.Height:=16;
          Cells[0,1]:=' 懳徾 1';
          Cells[0,2]:=' 懳徾 2';
          Cells[1,0]:=' 懳徾 1';
          Cells[2,0]:=' 懳徾 2';
          Cells[1,1]:='*';
          Cells[2,1]:='*';
          Cells[2,2]:='*';
          Options:=Options-[goRangeSelect];  //  扨堦僙儖偺慖戰
          with sel do                        //  僙儖偺埵抲
            begin  Left:=1; Top:=1; Right:=1; Bottom:=1;  end;
          Selection:=sel;                    //  慖戰僙儖偺愝掕
          Options:=[goEditing]+Options;      //  僙儖撪曇廤壜
          EditorMode:=true;                  //  僙儖撪曇廤壜
      end;

    with StringGrid2 do
      begin
          ColCount:=2;
          RowCount:=3;                       //  懳徾偺悢偺弶婜抣
          Font.Height:=16;
          Cells[0,0]:=' 懳丂徾';
          Cells[1,0]:=' 儔儀儖';
          Cells[0,1]:=' 懳徾 1';
          Cells[0,2]:=' 懳徾 2';
          Options:=Options-[goRangeSelect];  //  扨堦僙儖偺慖戰
          with sel do                        //  僙儖偺埵抲
            begin  Left:=1; Top:=1; Right:=1; Bottom:=1;  end;
          Selection:=sel;                    //  慖戰僙儖偺愝掕
          Options:=[goEditing]+Options;      //  僙儖撪曇廤壜
          EditorMode:=true;                  //  僙儖撪曇廤壜
      end;
end;


(*           捛壛          *)
procedure TFDist.AddButtonClick(Sender: TObject);
var   i, j, pos : Longint;
begin
      with StringGrid1 do
        begin
            pos:=Selection.top;
            if 0 < pos then
              begin
                RowCount:=RowCount+1;
                Cells[0,RowCount-1]:=' 懳徾'+IntToStr2(RowCount-1);
                for j:=1 to ColCount-1 do
                  Cells[j,RowCount-1]:=' ';
                if (pos < RowCount-2) then
                  begin
                    for i:=RowCount-1 downto pos+2 do
                      for j:=1 to ColCount-1 do
                        begin
                          Cells[j,i]:=Cells[j,i-1];
                        end;

                    for j:=1 to ColCount-1 do
                      Cells[j,pos+1]:=' ';
                  end;

                ColCount:=ColCount+1;
                Cells[ColCount-1,0]:=' 懳徾'+IntToStr2(ColCount-1);
                for j:=1 to RowCount-1 do
                  Cells[ColCount-1,j]:=' ';
                if (pos < ColCount-2) then
                  begin
                    for i:=ColCount-1 downto pos+2 do
                      for j:=1 to RowCount-1 do
                        begin
                          Cells[i,j]:=Cells[i-1,j];
                        end;

                    for j:=1 to RowCount-1 do
                      Cells[pos+1,j]:=' ';
                  end;
              end;

            for i:=1 to RowCount-1 do
              for j:=i to RowCount-1 do
                Cells[j,i]:='*';
        end;

      with StringGrid2 do
        begin
            if 0 < pos then
              begin
                RowCount:=RowCount+1;
                Cells[0,RowCount-1]:=' 懳徾'+IntToStr2(RowCount-1);
                Cells[1,RowCount-1]:=' ';
                if (pos < RowCount-2) then
                  begin
                    for i:=RowCount-1 downto pos+2 do
                          Cells[1,i]:=Cells[1,i-1];
                    Cells[1,pos+1]:=' ';
                  end;
              end;
        end;
end;



(*          嶍彍           *)
procedure TFDist.DelButtonClick(Sender: TObject);
var pos, i, j : Longint;
begin
    with StringGrid1 do
      begin
        pos:= Selection.top;     //  慖戰峴偺愝掕

        //   僙儖偺抣偺堏摦
        if (0 < pos) and (pos < RowCount-1) then
          begin
            for i:=pos to RowCount-2 do
              for j:=1 to ColCount-1 do
                Cells[j,i]:=Cells[j,i+1];   //  峴扨埵偺堏摦

            for i:=pos to ColCount-2 do
              for j:=1 to RowCount-1 do
                Cells[i,j]:=Cells[i+1,j];   //  楍扨埵偺堏摦
          end;

           //   嵟屻偺峴丒楍傪嶍彍
        if 0 < pos then
            if RowCount > 2 then
              begin
                RowCount:=RowCount-1;
                ColCount:=ColCount-1;
              end;

        for i:=1 to RowCount-1 do
          begin
            Cells[0,i]:=' 懳徾'+IntToStr2(i);
            Cells[i,0]:=' 懳徾'+IntToStr2(i);
          end;

        for i:=1 to RowCount-1 do
          for j:=i to RowCount-1 do
            Cells[j,i]:='*';  
      end;

    with StringGrid2 do
      begin
        //   僙儖偺抣偺堏摦
        if (0 < pos) and (pos < RowCount-1) then
            for i:=pos to RowCount-2 do
                Cells[1,i]:=Cells[1,i+1];

           //   嵟屻偺峴傪嶍彍
        if 0 < pos then
          if RowCount > 2 then RowCount:=RowCount-1;
          for i:=1 to RowCount-1 do
            Cells[0,i]:=' 懳徾'+IntToStr2(i);
      end;
end;


//   僨乕僞偺愝掕姰椆
procedure TFDist.CalcButtonClick(Sender: TObject);
var   i, j  : Longint;
begin
    with StringGrid2 do
      begin
        N:=RowCount-1;   //   懳徾偺愝掕
        for i:=1 to N do
          LObj[i]:=Cells[1,i];
      end;

    with StringGrid1 do
      begin
        try
        for i:=2 to N do
          for j:=1 to i-1 do
            Dist[i,j]:=StrToFloat(Cells[j,i]);

        except                             //   晄惓側僨乕僞
          ShowMessage('Error ===>  Cells['+IntToStr(i)+
                      ','+IntToStr(j)+'] = '+Cells[j,i]);
          Exit;   //   偙偺庤懕偒偺廔椆
        end;
      end;


    ckFSim:=1;    //   偙偺僼僅乕儉傪惗惉偟偨儐僯僢僩偵偍偗傞
    Close;        //   repeate...until暥傪敳偗弌偡
end;


//   奼挘巕.csv偺僠僃僢僋
function CheckCSV( s : string) : string;
  begin
      if Length(s) < 4 then s:=s+'.csv'
      else if ((Copy(s, Length(s)-3,4) <> '.csv')
            and
               (Copy(s, Length(s)-3,4) <> '.CSV'))
                       then s:=s+'.csv';
      CheckCSV:=s;                 
  end;


(*    僌儕僢僪偵愝掕偝傟偰偄傞僨乕僞偺曐懚    *)
procedure TFDist.SaveButtonClick(Sender: TObject);
var outf : TextFile;
    FN   : string;
    h, i : Longint;
begin
    with SaveDialog1 do        //   曐懚梡僼傽僀儖偺柤慜偺愝掕
      begin
          Title:='僼傽僀儖柤';
          FileName:='';
          if not Execute then exit;
          FN:=FileName;
          AssignFile(outf,FN);
      end;

    Rewrite(outf);            //  僼傽僀儖傪彂偒弌偟梡偵愝掕

    with StringGrid2 do
      begin
        writeln(outf,RowCount-1);
        for i:=1 to RowCount-1 do writeln(outf,Cells[1,i]);
      end;
    with StringGrid1 do
      begin
        for h:=2 to RowCount-1 do
          begin
            for i:=1 to h-1 do
              writeln(outf, Trim(Cells[i,h])); //  僨乕僞偺彂偒弌偟
          end;
      end;

    CloseFile(outf);
    CalcButton.SetFocus;
end;

(*    僼傽僀儖偐傜僌儕僢僪傊僨乕僞傪撉傒崬傓    *)
procedure TFDist.LoadButtonClick(Sender: TObject);
var inf : TextFile;
    v, h, i   : Longint;
    s      : string;
begin
    with OpenDialog1 do           //  僼傽僀儖柤偺愝掕
      begin
          Title:='僼傽僀儖柤';
          FileName:='';
          if not Execute then exit;
          AssignFile(inf,FileName);
      end;

    Reset(inf);                  //   僼傽僀儖傪撉傒弌偟梡偵愝掕

    with StringGrid2 do
      begin
          readln(inf, v);
          RowCount:=v+1;
          for h:=1 to v do
            begin
              Cells[0,h]:=' 懳徾'+IntToStr2(h);
              readln(inf,s);
              Cells[1,h]:=s;
            end;
      end;
    with StringGrid1 do
      begin
        ColCount:=v+1;
        RowCount:=v+1;
        for h:=1 to v do
          for i:=h to v do Cells[i,h]:='*';
        for h:=2 to v do
          for i:=1 to h-1 do
            begin
              readln(inf,s);     //    僨乕僞偺撉傒崬傒
              Cells[i,h]:=s;
            end;

        for h:=1 to v do
          begin
              Cells[0,h]:=' 懳徾'+IntToStr2(h);
              Cells[h,0]:=' 懳徾'+IntToStr2(h);
          end;
      end;

    CloseFile(inf);
    CalcButton.SetFocus;
end;

procedure TFDist.PButtonClick(Sender: TObject);
var   pout : TextFile;
      h, i    : Longint;

  function AdjStrL( s : string; L : integer ) : string;
    var w, i : integer;
    begin
        w:=Length(s);
        if w < L then
          for i:=1 to L-w do s:=s+' ';
        AdjStrL:=s;
    end;

begin
      with printer do
        begin
          AssignPrn(pout);
          Rewrite(pout);

          with Canvas.Font do
            begin
                Name:='俵俽 柧挬';
                size:=12;
            end;

          writeln(pout);
          writeln(pout);
          writeln(pout,'Data =');
          writeln(pout);

          with StringGrid2 do
            for h:=0 to RowCount-1 do
              begin
                for i:=0 to ColCount-1 do
                  write(pout,AdjStrL(Cells[i,h],10));
                writeln(pout);
              end;
          writeln(pout);

          with StringGrid1 do
            for h:=0 to RowCount-1 do
              begin
                for i:=0 to ColCount-1 do
                  write(pout,AdjStrL(Cells[i,h],10));
                writeln(pout);
              end;
          CloseFile(pout);
        end;

      CalcButton.SetFocus;
end;


procedure TFDist.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
           ckFSim:=1;      //   repeat...until暥傪敳偗弌偡
end;

//   Excel屳姺偺偨傔CSV宍幃偱僼傽僀儖弌椡
procedure TFDist.WRCSVButtonClick(Sender: TObject);
var outf : TextFile;
    FN   : string;
    h, i : Longint;

  function CheckCSV( s : string ) : string;
    begin
        if Length(s) < 5 then s:=s+'.csv'
        else if  (Copy(s, Length(s)-3,4) <> '.csv')
               and
                 (Copy(s, Length(s)-3,4) <> '.CSV') then s:=s+'.csv';
        CheckCSV:=s;
    end;

begin
    with SaveDialog1 do        //   曐懚梡僼傽僀儖偺柤慜偺愝掕
      begin
          Title:='僼傽僀儖柤';
          Filter:='CSV files (*.csv)|*.CSV';
          FileName:='';
          if not Execute then exit;
          FN:=CheckCSV(FileName);
          AssignFile(outf,FN);
          Filter:='';
      end;

    Rewrite(outf);            //  僼傽僀儖傪彂偒弌偟梡偵愝掕

    with StringGrid2 do
      begin
        for i:=1 to RowCount-1 do write(outf,',', Cells[1,i]);
        writeln(outf);
      end;
    with StringGrid1 do
      begin
        writeln(outf, StringGrid2.Cells[1,1]);
        for h:=2 to RowCount-1 do
          begin
            write(outf, StringGrid2.Cells[1,h]);
            for i:=1 to h-1 do
              write(outf, ',', Trim(Cells[i,h])); //  僨乕僞偺彂偒弌偟
            writeln(outf);
          end;
      end;

    CloseFile(outf);
    CalcButton.SetFocus;
end;


//   Excel偵傛傞CSV宍幃弌椡偺僨乕僞僼傽僀儖傪撉傒崬傓
procedure TFDist.RDCSVButtonClick(Sender: TObject);
var inf : TextFile;
    s   : string;
    i, j, n : Longint;
    SL   : TStringList;
begin
    with OpenDialog1 do        //   曐懚梡僼傽僀儖偺柤慜偺愝掕
      begin
          Title:='僼傽僀儖柤';
          Filter:='CSV files (*.csv)|*.CSV';
          FileName:='';
          if not Execute then exit;
          AssignFile(inf,FileName);
          Filter:='';
      end;

    Reset(inf);            //  僼傽僀儖傪彂偒弌偟梡偵愝掕
    SL:=TStringList.Create;
    readln(inf, s);
    SL.CommaText:=s;
    n:=SL.Count-1;         //  崁栚悢偺愝掕

    with StringGrid2 do
      begin
        RowCount:=n+1;

        for i:=1 to RowCount-1 do
          begin
            Cells[0,i]:=' 懳徾'+IntToStr2(i);
            Cells[1,i]:=SL.Strings[i];
          end;
      end;

    with StringGrid1 do
      begin
        RowCount:=n+1;
        ColCount:=n+1;
        for i:=1 to n do
          begin
            Cells[0,i]:=' 懳徾'+IntToStr2(i);
            Cells[i,0]:=' 懳徾'+IntToStr2(i);
          end;
        readln(inf);
        for i:=2 to n do
          begin
              readln(inf, s);
              SL.CommaText:=s;
              for j:=1 to i-1 do Cells[j,i]:=SL.Strings[j];
          end;
        for i:=1 to n do
          for j:=i to n do Cells[j,i]:='*';
      end;

    SL.Free;
    CloseFile(inf);
    CalcButton.SetFocus;
end;

end.