uincoord.pas

clusterfilesrev 最新的分类聚类代码

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

interface

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

type
  TFCoord = class(TForm)
    StringGrid1: TStringGrid;
    AddButton: TButton;
    DelButton: TButton;
    EucButton: TButton;
    SaveButton: TButton;
    LoadButton: TButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    PButton: TButton;
    WRCSVButton: TButton;
    RDCSVButton: TButton;
    EucStdButton: TButton;
    AddColButton: TButton;
    DelColButton: TButton;
    PrintDialog1: TPrintDialog;
    procedure ExitButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure DelButtonClick(Sender: TObject);
    procedure EucButtonClick(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);
    procedure AddColButtonClick(Sender: TObject);
    procedure DelColButtonClick(Sender: TObject);
    procedure EucStdButtonClick(Sender: TObject);
  private
    { Private 愰尵 }
  public
    { Public 愰尵 }
  end;

var
  FCoord: TFCoord;


const
  MaxDim = 200;
var
  NDim  : Longint;
  Coord : array[1..MaxN,1..MaxDim] of extended;


implementation

{$R *.DFM}

uses
  Printers;
   

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



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



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


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


procedure TFCoord.FormCreate(Sender: TObject);
var sel : TGridRect;      //  慖戰僙儖偺埵抲傪昞傢偡偨傔偺宆
begin
    with StringGrid1 do
      begin
          ColCount:=3;                //  楍悢偺弶婜抣
          RowCount:=4;                //  峴悢偺弶婜抣
          Font.Height:=16;
          Colwidths[0]:=Round(1.5*ColWidths[0]);
          Cells[0,1]:=' 懏惈儔儀儖';
          Cells[0,2]:=' 懳徾 1';
          Cells[0,3]:=' 懳徾 2';
          Cells[1,0]:=' 儔儀儖';
          Cells[2,0]:=' 懏惈 1';
          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 TFCoord.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-2);
                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;
              end;    
        end;
end;



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

        //   僙儖偺抣偺堏摦
        if (1 < 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];   //  峴扨埵偺堏摦
          end;

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

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




//   僨乕僞偺愝掕姰椆
procedure TFCoord.EucButtonClick(Sender: TObject);
var i, j, h : Longint;
    v : extended;
begin
    with StringGrid1 do
      begin
        N:=RowCount-2;
        NDim:=ColCount-2;
        try
        for i:=1 to N do
          begin
            LObj[i]:=Cells[1,i+1];
            for j:=1 to NDim do
              Coord[i,j]:=StrToFloat(Cells[j+1,i+1]);
          end;
        except                             //   晄惓側僨乕僞
          ShowMessage('Error ===>  Cells['+IntToStr(i+1)+
                      ','+IntToStr(j)+'] = '+Cells[j,i+1]);
          Exit;   //   偙偺庤懕偒偺廔椆
        end;
      end;

    for i:=2 to N do
      for j:=1 to i-1 do
        begin
            v:=0.0;
            for h:=1 to NDim do
              v:=v+sqr(Coord[i,h]-Coord[j,h]);
            Dist[i,j]:=sqrt(v);
        end;

    //   撉傒崬傒僨乕僞弌椡梡僼傽僀儖柤偺愝掕
    with OpenDialog1 do
      begin
          Title:='Output File';
          Filter:='';
          FileName:='';
          if not execute then exit;
          AssignFile(outf, FileName);
      end;
    Rewrite(outf);

    //  愝掕僨乕僞偺彂偒弌偟
    writeln(outf);
    writeln(outf,'擖椡僨乕僞...');
    for i:=1 to N do
      begin
        write(outf, i:3, ' : ', StrToL(LObj[i],10));
        for j:=1 to NDim do write(outf, Coord[i,j]:7:1);
        writeln(outf);
      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 TFCoord.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 StringGrid1 do
      begin
        writeln(outf, RowCount);
        writeln(outf, ColCount);
        for h:=1 to RowCount-1 do
          for i:=1 to ColCount-1 do
              writeln(outf, Trim(Cells[i,h])); //  僨乕僞偺彂偒弌偟
      end;

    CloseFile(outf);
end;


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