uincwdist.pas

clusterfilesrev 最新的分类聚类代码

unit UInCWDist;     (*  嫍棧乮儐乕僋儕僢僪嫍棧乯僨乕僞偺愝掕   *)

interface

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

type
  TFDist = class(TForm)
    StringGrid1: TStringGrid;
    AddButton: TButton;
    DelButton: TButton;
    WardButton: TButton;
    SaveButton: TButton;
    LoadButton: TButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    PButton: TButton;
    StringGrid2: TStringGrid;
    WRCSVButton: TButton;
    RDCSVButton: TButton;
    CentroidButton: TButton;
    CloseButton: TButton;
    procedure ExitButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure DelButtonClick(Sender: TObject);
    procedure WardButtonClick(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 CloseButtonClick(Sender: TObject);
    procedure CentroidButtonClick(Sender: TObject);
  private
    { Private 愰尵 }
  public
    { Public 愰尵 }
  end;

var
  FDist: TFDist;

implementation

{$R *.DFM}

uses
  UClusterCWDist,  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.WardButtonClick(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;

    DistType:=DWard;
    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;