Ｋ-平均法(K-means)
クラスタリング(clustering)の手法の一つである k-means 法のプログラムを組んでみました。
左図の赤と緑のデーター点が、クラスター(cluster)。
番号を振られた点が、各クラスターの平均値(重心位置)とします。
左図の例では三個のクラスター平均点(重心位置)が設定されています。
最初、データー点は、何処のクラスターにも割り振られていません。
次に、仮のクラスター平均位置を設定します左図では三個です。
各データー点から、各クラスター平均位置迄の距離を計算します。
一番近いクラスター平均位置を、その点のクラスターとします。
全てのデーター点に対して終了すると、新しいクラスター分けが形成されるので、クラスター平均値を再計算します。
座標点の平均値なので、そのクラスターの重心位置と一致します。
再度、各データーに対して、一番近いクラスター平均位置に対してクラスター分けを行い、新しい平均位置(重心位置)を計算します。
これを繰り返し、クラスター平均位置(重心位置)が変化しなくなるまで行います。
問題は、最初の仮のクラスター平均値(重心位置)の設定で、この仮の位置で、クラスタリングの結果が左右されるということです。
上図③の点は、どのデーター点に対しても、他のクラスター平均位置に対して遠いので、そのクラスター位置にたいして割り振られるデーター点は無いことになります。
どの様にクラス分けをするかを考えながら、最初の位置と数を決める必要があります。
此処でのプログラムは、画像点(ピクセル単位)を一個のデーターとして扱っています。
白い部分は、データーの無い点とし、白以外は、ピクセル単位で、データー点(値１)としている為、図形のデーター点の位置の平均値はその図形の重心位置と一致します。
上図は、五個のデーター群に対して、クラスターの数を五個と、同じ数に設定してクラスタリングを行っています。
この場合は、綺麗に分類されています。
左図は、全面にデーター点がある場合で、画像は、黒ベタ、赤ベタでも構いません。
クラスターの初期位置で、分割される形状が変化します。
左は元の画像点群が三個なのに対して、五個のクラスターをセットした場合です。
クラスターの初期位置によって次のようになります。
一つの花びらは、２つのクラスターに別れ、一つのクラスターには全くデーターが割り振られていません。
左図は、マウスでクラスターの初期位置を設定出来るようにしたものです。
初期位置を画像部の中に全て設定することにより、画像点の割り付けられないクラスターはなくなります。
インターネットで検索すると、画像として表示しているプログラム例があるので、同じようにプログラムしてみました。
実際のデーターで行う場合は、散布図の様なグラフ的表示になるかと思います。
プログラム
プログラムの、クラスターの数は６個迄です。
理由は、単に色分けの都合からです、色を作成するとき、色相を等分割して色分けする方法を利用すれば、クラスターの数を増やすことが出来ます。
unit K_MeansMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtDlgs, Vcl.StdCtrls, Vcl.ExtCtrls, system.Math,
system.UITypes, Vcl.Grids;
type
D2array = array of array of Double;
B2array = array of array of array of Byte;
TForm1 = class(TForm)
FileOpenBtn: TButton;
OpenPictureDialog1: TOpenPictureDialog;
KMeansBtn: TButton;
FileSaveBtn: TButton;
SavePictureDialog1: TSavePictureDialog;
Timer1: TTimer;
ScrollBox1: TScrollBox;
Image1: TImage;
ScrollBox2: TScrollBox;
Image2: TImage;
KNoEdit: TLabeledEdit;
ScaleEdit: TLabeledEdit;
ScaleDisBtn: TButton;
RepeatEdit: TLabeledEdit;
MReset: TButton;
procedure FileOpenBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure KMeansBtnClick(Sender: TObject);
procedure FileSaveBtnClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ScaleDisBtnClick(Sender: TObject);
procedure Image1DblClick(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure MResetClick(Sender: TObject);
procedure Image1MouseEnter(Sender: TObject);
procedure KNoEditChange(Sender: TObject);
private
{ Private 宣言 }
procedure Imageout(Image: TBitmap; ImageNo: integer; magnification: double);
procedure KMeans;
function dis(Ynow, Xnow: double; Y, X: integer): double;
procedure KMarks;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
Tcluster = record // クラスターレコード
now_x, now_y: double; // クラスター位置 x, y
no : integer; // データー点カウンター
new_x, new_y: double; // X,Y座標値合計
end;
TPrgbarry = array[0..0] of Trgbtriple; // 24ビットカラーレコード 32ビット用はTRGBQuadArray
Prgbarray = ^TPrgbarry; // ポインター
const
OpenFileFilter =
'画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.ico;*.wdp'+
'|*.png|*.png' +
'|*.jpg|*.jpg' +
'|*.gif|*.gif' +
'|*.bmp|*.bmp' +
'|*.tif|*.tif' +
'|*.ico|*.ico' +
'|*.wdp|*.wdp';
SaveFileFilter =
'画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.wdp' +
'|*.png|*.png' +
'|*.jpg|*.jpg' +
'|*.gif|*.gif' +
'|*.bmp|*.bmp' +
'|*.tif|*.tif' +
'|*.wdp|*.wdp';
ImageHWC = 440; // 表示枠サイズ
Laplacian = 0;
Gaussians = 1;
Deconvolution = 2;
Unsharp = 3;
var
InputDBitmap : TBitmap; // 入力データー表示用ビットマップ
OutputBitmap : TBitmap; // 出力画像表示用ビットマップ
GHeight : Integer; // 入力データー画像高さ
GWidth : Integer; // 入力データー画像幅
VRect : Trect; // 表示サイズ設定用
InFilename : string; // 入力ファイル名
ColorMat : array of array of byte; // 二値化データー画像用
OutMat : B2array; // 計算結果画像出力用配列
RepeatF : Boolean; // 繰り返し計算フラグ
K : integer;
cluster : array of Tcluster; // クラスター用配列
Scale : double;
DidScale : double;
MSetF : smallint;
YPos, Xpos : Integer;
Ino : Integer;
//-------------------------------------
// マウスによるクラスターの初期位置設定
// MSetF = -3 マウスによる位置未設定
// MSetF = -2 初期化済み
// MSetF = 0 マウスによる設定終了
//-------------------------------------
procedure TForm1.Image1DblClick(Sender: TObject);
var
X, Y, I: Integer;
begin
if MSetF = -3 then begin
// 初期化
if not RepeatF then begin
val(KnoEdit.Text, K, X);
if X <> 0 then begin
Application.MessageBox('クラスタ数の入力値に誤りがあります。','クラスタ数', 0);
exit;
end;
if (K < 2) or (K > 6) then begin
Application.MessageBox('クラスタ数の範囲は２≦数≦６です。','クラスタ数', 0);
exit;
end;
// データー数とクラスター数の確認
I := 0;
for Y := 0 to GHeight - 1 do
for X := 0 To GWidth - 1 do
if ColorMat[Y, X] <> 0 then inc(I);
if K > I then begin
Application.MessageBox('クラスタ数がデーター数より多いです。','クラスタ数', 0);
exit;
end;
setlength(cluster, K);
// クラスタの初期設定
for I := 0 to K -1 do begin
cluster[I].no := 0;
cluster[I].new_y := 0;
cluster[I].new_x := 0;
end;
end;
MSetF := -2;
Ino := 0;
end;
if (MSetF = -2) then begin
// 初期位置設定
cluster[Ino].now_y := round(YPos * DidScale);
cluster[Ino].now_x := round(XPos * DidScale);
inc(Ino);
// 初期位置設定終了判定
if Ino = K then begin
RepeatF := True;
MSetF := 0;
Image1.Hint := 'クラスター位置設定済みです。';
end;
// 初期位置表示
Image1.Canvas.Pen.Color := clBlack;
Image1.Canvas.Brush.Style := bsSolid;
Image1.Canvas.Brush.Color := clBlack;
Image1.Canvas.Ellipse(XPos - 5, YPos - 5, XPos + 5, YPos +5);
end;
end;
//-------------------
// ヒント表示設定
//-------------------
procedure TForm1.Image1MouseEnter(Sender: TObject);
begin
if MSetF < 0 then Image1.Hint := 'ダブルクリックでクラスター位置がセットされます。';
if MSetF = 0 then Image1.Hint := 'クラスター位置設定済みです。';
end;
//---------------------
// マウスの位置の取得
//---------------------
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Ypos := Y;
Xpos := X;
end;
//------------------------
// 画像データーの変倍出力
//------------------------
procedure TForm1.Imageout(Image: TBitmap; ImageNo: integer; magnification: double);
var
Rect0 : Trect;
MW, MH : Integer;
begin
MW := Round(GWidth * magnification);
MH := Round(GHeight * magnification);
Rect0 := Rect(0, 0, MW, MH);
if ImageNo = 1 then begin
Image1.Width := MW;
Image1.Height := MH;
Image1.Picture.Bitmap.SetSize(MW, MH);
Image1.Canvas.StretchDraw(Rect0, Image); // 出力枠に変倍出力
end;
if ImageNo = 2 then begin
Image2.Width := MW;
Image2.Height := MH;
Image2.Picture.Bitmap.SetSize(MW, MH);
Image2.Canvas.StretchDraw(Rect0, Image); // 出力枠に変倍出力
end;
end;
//--------------------------------------
// フィルター計算タイマー遅延
// ボタンの表示切り替えVCL実行の時間待ち
//--------------------------------------
procedure TForm1.KMeansBtnClick(Sender: TObject);
begin
FileOpenBtn.Enabled := False;
FileSaveBtn.Enabled := False;
Timer1.Enabled := True;
end;
//----------------------------------
// クラスター数を変更した時リセット
//----------------------------------
procedure TForm1.KNoEditChange(Sender: TObject);
begin
MResetClick(nil);
end;
//---------------------------------------------
// マウスによりセットしたクラスターの位置初期化
//---------------------------------------------
procedure TForm1.MResetClick(Sender: TObject);
begin
MSetF := -3;
RepeatF := False;
Imageout(InputDBitmap, 1, scale); // 出力枠に変倍出力
end;
//---------------------------------------------------
// 変倍率変更再表示
// マウスセットによる初期位置は再表示されません
//---------------------------------------------------
procedure TForm1.ScaleDisBtnClick(Sender: TObject);
var
C: integer;
begin
val(ScaleEdit.Text, scale, C);
if C <> 0 then begin
Application.MessageBox('表示倍率の値に間違いがあります。','表示倍率', 0);
exit;
end;
if scale <= 0 then begin
Application.MessageBox('表示倍率の値に間違いがあります。','表示倍率', 0);
exit;
end;
Imageout(OutputBitmap, 2, Scale); // 出力枠に変倍出力
Imageout(InputDBitmap, 1, scale); // 出力枠に変倍出力
if RepeatF then KMarks;
end;
//--------------------------------------------
// タイマーによる遅延スタート
//--------------------------------------------
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
KMeans;
FileSaveBtn.Enabled := True;
FileOpenBtn.Enabled := True;
end;
//--------------------------
// 距離を計算します
//--------------------------
function TForm1.dis(Ynow, Xnow: double; Y, X: integer): double;
begin
// 距離の比較なのでルートを開く必要なし
result := (Y - Ynow) * (Y - Ynow) + (X - Xnow) * (X - Xnow);
// result := sqrt((Y - Ynow) * (Y - Ynow) + (X - Xnow) * (X - Xnow));
end;
//-----------------------
// クラスター黒丸表示
//-----------------------
procedure TForm1.KMarks;
var
X, Y, I : integer;
begin
for I := 0 to K -1 do begin
Y := round(cluster[I].now_Y * scale);
X := round(cluster[I].now_X * scale);
Image2.Canvas.Pen.Color := clBlack;
Image2.Canvas.Brush.Style := bsSolid;
Image2.Canvas.Brush.Color := clBlack;
Image2.Canvas.Ellipse(X - 5, Y - 5, X + 5, Y +5);
end;
end;
//-------------------------------------
// クラスター分類
// クラスター毎の色分け
// SetCl[I] = -2 初期位置再設定未処理
// SetCl[I] = -1 初期位置設定開始
// SetCl[I] > -1 初期位置設定済み
//-------------------------------------
procedure TForm1.KMeans;
var
X, Y : integer;
I, IM : integer;
Loop : integer;
MinLeng : double;
MinPos : Byte;
nowLeng : double;
PB : Prgbarray;
ReNo : integer;
SetCl : array of Integer;
SetClF : Boolean;
begin
// 初期化
if not RepeatF then begin
val(KnoEdit.Text, K, X);
if X <> 0 then begin
Application.MessageBox('クラスタ数の入力値に誤りがあります。','クラスタ数', 0);
exit;
end;
if (K < 2) or (K > 6) then begin
Application.MessageBox('クラスタ数の範囲は２≦数≦６です。','クラスタ数', 0);
exit;
end;
// データー数とクラスター数の確認
I := 0;
for Y := 0 to GHeight - 1 do
for X := 0 To GWidth - 1 do
if ColorMat[Y, X] <> 0 then inc(I);
if K > I then begin
Application.MessageBox('クラスタ数がデーター数より多いです。','クラスタ数', 0);
exit;
end;
setlength(cluster, K);
setlength(SetCl, K);
X := GWidth div K;
Y := GHeight div K;
// クラスタの初期設定
// 画像に対して左上から右下に向かって斜めに等分の位置に割り付けられます
for I := 0 to K -1 do begin
cluster[I].now_y := I * Y + Y div 2;
cluster[I].now_x := I * X + X div 2;
cluster[I].no := 0;
cluster[I].new_y := 0;
cluster[I].new_x := 0;
SetCl[I] := -2;
end;
IM := 0;
MinLeng := 0;
// 設定されたクラスター位置に対して一番近いデーター位置にクラスター初期位置を再設定
for Loop := 0 to K - 1 do begin
I := 0; // 位置番号クリア
for Y := 0 to GHeight - 1 do begin
for X := 0 To GWidth - 1 do begin
if ColorMat[Y, X] <> 0 then begin
// 既にクラスターに使用されているデーター位置か確認
SetClF := False;
for ReNo := 0 to K - 1 do
if I = SetCl[ReNo] then SetClF := True;
// 使用されていないデーター位置だったら
if not SetClF then begin
// 最初の位置が設定されていたら
if SetCl[Loop] = -1 then begin
// データー位置との距離計算
nowLeng := dis(cluster[Loop].now_y, cluster[Loop].now_x, Y, X);
// 現在位置が前の位置より近かったら新しい位置を保存
if MinLeng > nowLeng then begin
cluster[Loop].new_y := Y; // Y 位置
cluster[Loop].new_x := X; // X 位置
MinLeng := nowLeng; // 距離
IM := I; // 位置番号
end;
end;
// クラスター初期位置開始していなかったら
if SetCl[Loop] = -2 then begin
// 最初のデーター位置との距離設定
MinLeng := dis(cluster[Loop].now_y, cluster[Loop].now_x, Y, X);
// 最初の距離設定フラグセット
SetCl[Loop] := -1;
end;
end;
end;
inc(I); // 位置番号インクリメント
end;
end;
SetCl[Loop] := IM; // 位置番号セット
cluster[Loop].now_y := cluster[Loop].new_y; // Y位置セット
cluster[Loop].now_x := cluster[Loop].new_x; // X位置セット
cluster[Loop].new_y := 0; // y座標合計用クリア
cluster[Loop].new_X := 0; // x座標合計用クリア
end;
end;
// リピート数
val(RepeatEdit.Text, ReNo, X);
if X <> 0 then begin
Application.MessageBox('リピート数の入力値に誤りがあります。','リピート数', 0);
exit;
end;
if (ReNo < 0) or (ReNo > 100) then begin
Application.MessageBox('リピート数はゼロ以上にしてください。','リピート数', 0);
exit;
end;
// カラー配列の初期化
for Y := 0 to GHeight - 1 do
for X := 0 to GWidth - 1 do
for I := 0 to 2 do
OutMat[Y, X, I] := $FF;
RepeatF := true;
// 指定回数クラスターリング計算
for Loop := 1 to ReNo do begin
// 全座標をチェック
for Y := 0 to GHeight - 1 do
for X := 0 to GWidth - 1 do begin
// 画像があったら一番近いクラスターを検索
if ColorMat[Y, X] <> 0 then begin
MinPos := 0;
MinLeng := dis(cluster[0].now_y, cluster[0].now_x, Y, X);
for I := 1 to K -1 do begin
nowLeng := dis(cluster[I].now_y, cluster[I].now_x, Y, X);
if MinLeng > nowLeng then begin
MinPos := I;
MinLeng := nowLeng;
end;
end;
// 一番近いクラスターのカウンターインクリメント
inc(cluster[MinPos].no);
// 座標の合計を求めます
cluster[MinPos].new_y := cluster[MinPos].new_y + Y;
cluster[MinPos].new_x := cluster[MinPos].new_x + X;
// 色を表示するためインクリメント
inc(MinPos);
// MinPosの値で色セット この方法では６色迄
// 色を増やす場合は、HSLtoRGB を使用
if MinPos and $01 = $01 then OutMat[Y, X, 0] := $FF // 赤
else OutMat[Y, X, 0] := $00;
if MinPos and $02 = $02 then OutMat[Y, X, 1] := $FF // 緑
else OutMat[Y, X, 1] := $00;
if MinPos and $04 = $04 then OutMat[Y, X, 2] := $FF // 青
else OutMat[Y, X, 2] := $00;
end;
end;
// クラスターのY,Y座標の合計値と、座標の数から平均値を求め、クラスターの新しい座標とします。
// 平均値計算後カウンターと合計値はクリア
for I := 0 to K -1 do begin
if cluster[I].no > 0 then begin
cluster[I].now_y := cluster[I].new_y / cluster[I].no;
cluster[I].now_x := cluster[I].new_x / cluster[I].no;
end;
cluster[I].no := 0;
cluster[I].new_y := 0;
cluster[I].new_x := 0;
end;
end;
// ビットマップに色配列の値をセット
for Y := 0 to GHeight - 1 do begin
PB := OutputBitmap.ScanLine[Y];
for X := 0 To GWidth - 1 do begin
PB[X].rgbtRed := OutMat[Y, X, 0];
PB[X].rgbtGreen := OutMat[Y, X, 1];
PB[X].rgbtBlue := OutMat[Y, X, 2];
end;
end;
Imageout(OutputBitmap, 2, Scale); // 出力枠に変倍出力
Image2.Canvas.Brush.Style := bsSolid;
Image2.Canvas.Brush.Color := clWhite;
KMarks; // クラスターの位置黒丸表示
end;
//---------------------------------------------------
// ファイルのオープンと色相データー変換
//---------------------------------------------------
procedure TForm1.FileOpenBtnClick(Sender: TObject);
var
WIC : TWICImage;
X, Y, D : Integer;
PBA : PBytearray;
PW : integer;
begin
VRect := Rect(0, 0, Image1.Width, Image1.Height);
Image1.Canvas.Brush.Style := bsSolid;
Image1.Canvas.Brush.Color := clBtnface;
Image1.Canvas.FillRect(VRect); // Canvas 画像消去
OpenPictureDialog1.Filter := OpenFileFilter; // ファイルオープンフィルターの設定
if OpenPictureDialog1.Execute = true then // ファイルが指定されたら
begin
WIC := TWICImage.Create; // TWICImageの生成
try
InFilename := OpenPictureDialog1.FileName; // ファイル名の取得
WIC.LoadFromFile(InFilename); // 画像の読み込み
GHeight := WIC.Height; // 画像高さ取得
GWidth := WIC.Width; // 画像幅
Image1.Width := GWidth;
Image1.Height:= GHeight;
Image1.Picture.Bitmap.SetSize(GWidth, GHeight);
InputDBitmap.Width := GWidth;
InputDBitmap.Height := GHeight;
InputDBitmap.Canvas.Draw(0, 0, WIC); // ビットマップに描画フォーマット変換
Image2.Picture.Bitmap.SetSize(GWidth, GHeight);
finally
WIC.Free; // TWICImage 解放
end;
end
else exit;
OutputBitmap.Width := GWidth;
OutputBitmap.Height := GHeight;
// 処理用配列確保
setLength(ColorMat, GHeight, GWidth);
setLength(OutMat, GHeight, GWidth, 3);
// 画像があるか全座標チェック
for Y := 0 to Gheight - 1 do begin
PBA := InputDBitmap.ScanLine[Y];
for X := 0 to GWidth - 1 do begin
PW := X * 3;
D := PBA[PW] + PBA[PW + 1] + PBA[PW + 2];
// クラスター座標計算用画像配列 画像部は１に無い場所は０にセットします
if D < $FF * 3 then ColorMat[Y, X] := 1
else ColorMat[Y, X] := 0;
end;
end;
// 画像表示スケール設定
scale := 485 / GWidth;
if scale > 435 / GHeight then scale := 435 / GHeight;
if scale <> 0 then DidScale := 1 / scale;
scaleEdit.Text := FloatTostrF(scale, ffFixed, 5, 3);
// 入力画像表示
Imageout(InputDBitmap, 1, scale); // 出力枠に変倍出力
// ボタン制御
KmeansBtn.Enabled := True;
// クラスター計算初期化フラグセット
RepeatF := False;
MSetF := -3;
end;
//------------------------------
// 画像のファイルへの保存
//------------------------------
procedure TForm1.FileSaveBtnClick(Sender: TObject);
var
WIC : TWicImage;
WICF : TWicImageFormat;
Fname : String;
ExeStr : String;
FnameTop: String;
Findex : integer;
function WFormatSet: Boolean; // 拡張子によるファイルフォーマット設定
begin
Result := false;
ExeStr := LowerCase(ExeStr);
if ExeStr = '.jpg' then begin WICF := Wifjpeg; Result := True; end;
if ExeStr = '.jpeg' then begin WICF := Wifjpeg; Result := True; end;
if ExeStr = '.tif' then begin WICF := Wiftiff; Result := True; end;
if ExeStr = '.tiff' then begin WICF := Wiftiff; Result := True; end;
if ExeStr = '.png' then begin WICF := Wifpng; Result := True; end;
if ExeStr = '.gif' then begin WICF := Wifgif; Result := True; end;
if ExeStr = '.bmp' then begin WICF := Wifbmp; Result := True; end;
if ExeStr = '.wdp' then begin WICF := WifWMPhoto; Result := True; end;
if ExeStr = '.hdp' then begin WICF := WifWMPhoto; Result := True; end;
end;
begin
SavePictureDialog1.Filter := SaveFileFilter;
// SavePictureDialog1.DefaultExt := GraphicExtension(TWicImage);
if not SavePictureDialog1.Execute then exit;
ExeStr := ExtractFileExt(SavePictureDialog1.FileName);
if ExeStr = '' then begin // 拡張子がなかったら
Findex := SavePictureDialog1.FilterIndex; // FilterIndexによる拡張子の設定
case Findex of
1, 3 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.jpg'); // 拡張子の設定
2 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.png'); // 拡張子の設定
4 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.gif'); // 拡張子の設定
5 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.bmp'); // 拡張子の設定
6 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.tif'); // 拡張子の設定
7 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.wdp'); // 拡張子の設定
end;
end
else
Fname := SavePictureDialog1.FileName;
ExeStr := ExtractFileExt(Fname); // 拡張子だけ取り出し
if not WFormatSet then begin // 拡張子によるファイルフォーマット設定と確認
application.MessageBox('ファイルの拡張子が間違っています。','注意', 0);
exit;
end;
FnameTop := ExtractFileName(Fname); // ファイル名だけ取り出し
if Length(FnameTop) = Length(ExeStr) then begin // ファイル名の長さ確認
application.MessageBox('ファイル名がありません。','注意', 0);
exit;
end;
if FileExists(Fname) then // ファイル名によるファイル検索
if MessageDlg('既に同じ名前のファイルがあります上書きしますか ' + ExtractFileName(Fname) + '?',
mtConfirmation, [mbYes, mbNo], 0, mbNo) = IDNo then exit;
WIC := TWicImage.Create; // TWicImage生成
try
WIC.Assign(OutputBitmap); // TWicImageにビットマップデーター割り付け
WIC.ImageFormat := WICF; // 保存フォーマットセット
WIC.SaveTofile(Fname); // ファイルの書き出し
finally
WIC.Free; // TWicImage解放
end;
end;
//----------------
// 初期設定
//----------------
procedure TForm1.FormCreate(Sender: TObject);
begin
Height := 496;
Width := 1136;
Timer1.Enabled := False;
Image1.Width := ImageHWC div 2;
Image1.Height := ImageHWC div 2;
ScrollBox1.Left := 8;
ScrollBox1.Height := ImageHWC;
ScrollBox1.Width := 490;
Image1.Top := 0;
Image1.Left := 0;
Image2.Width := ImageHWC div 2;
Image2.Height := ImageHWC div 2;
ScrollBox2.Left := 512;
ScrollBox2.Height := ImageHWC;
ScrollBox2.Width := 490;
Image2.Top := 0;
Image2.Left := 0;
InputDBitmap := TBitmap.Create;
OutputBitmap := TBitmap.Create;
InputDBitmap.PixelFormat := pf24bit;
OutputBitmap.PixelFormat := pf24bit;
KMeansBtn.Enabled := False;
FileSaveBtn.Enabled := False;
Scale := 1;
MSetF := -3;
end;
//----------------
// 終了処理
//----------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
InputDBitmap.Free;
OutputBitmap.Free;
end;
end.
KMeans.zip