各列と各行の鮮やかさ係数の合計が １ になるように、計算します。
鮮やかさ係数は、 1 で変化なし、 1 より大きくすれば、鮮やかさが上がり、1 より小さくすれば下がります。
鮮やかさ係数を 0.333 (1/3) に設定すると、ＲＧＢ 三色平均のグレー画像となり、それより小さくすると、補色になります。
鮮やかさのアップダウン
鮮やかさのアップダウンを行うプログラムです。
ＲＧＢｔｏＨＳＶ、 あるいは、ＲＧＢｔｏＹＳＨ 変換、逆変換を利用して、彩度を変更する方法もありますが、此処では単に鮮やかさ度だけを変更するプログラムを取り上げました。
ＲＧＢｔｏＨＳＶ、ＲＧＢｔｏＹＳＨ 変換、逆変換を利用した場合、彩度を大きくしても、ＲＧＢの最大値が、明度で制限されるため、鮮やかさがあまり上がらない場合があります。
此処での方法の場合、制限がない為、鮮やかさをかなり変化させることが出来ます。
計算は、意外と単純で、
各列と各行の鮮やかさ係数の合計が １ になるように、計算します。
鮮やかさ係数は、 1 で変化なし、 1 より大きくすれば、鮮やかさが上がり、1
より小さくすれば下がります。
鮮やかさ係数を 0.333 (1/3) に設定すると、ＲＧＢ
三色平均のグレー画像となり、それより小さくすると、補色になります。
ＲＧＢｔｏＨＳＶ、ＲＧＢｔｏＹＳＨの 変換、逆変換を使用した場合は、彩度係数をゼロにするとグレーになり、マイナスの値にすると補色になります。
サンプルプログラム
// Saturation // 鮮やかさの変更 unit Saturation_Main; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ExtDlgs, system.Types, system.Math, system.UITypes; type TForm1 = class(TForm) FileOpen: TButton; OpenPictureDialog1: TOpenPictureDialog; ScrollBox1: TScrollBox; Image2: TImage; ScrollBox2: TScrollBox; Image1: TImage; SaturationBtn: TButton; LabeledEdit1: TLabeledEdit; SavePictureDialog1: TSavePictureDialog; FileeSaveBtn: TButton; procedure FormCreate(Sender: TObject); procedure FileOpenClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure SaturationBtnClick(Sender: TObject); procedure FileeSaveBtnClick(Sender: TObject); private { Private 宣言 } public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.dfm} type TPrgbarry = array[0..0] of Trgbtriple; // 24ビットカラーレコード 32ビット用はTRGBQuadArray Prgbarray = ^TPrgbarry; // ポインター // 配列のポインターが必要なだけなので、長さは1 [0..0]で問題ありません。 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'; // 必要変数の宣言 var InBitmap : TBitmap; // ビットマップ OutBitmap : TBitmap; GHeight, GWidth : integer; // ソース画像サイズ //*************************************************************************** // 鮮やかさの調整 // R = Rin * sat + Gin * (1 - sat) / 2 + Bin * (1 - sat) / 2 係数合計 1 // G = Rin * (1 - sat) / 2 + Gin * sat + Bin * (1 - sat) / 2 係数合計 1 // B = Rin * (1 - sat) / 2 + Gin * (1 - sat) / 2 + Bin * sat 係数合計 1 // 係数合計 1 係数合計 1 係数合計 1 // 行及び列の調整係数の合計が１になるように設定します //*************************************************************************** procedure TForm1.SaturationBtnClick(Sender: TObject); var X, Y : Integer; Pin, Pout : Prgbarray; Rin, Gin, Bin : Smallint; R, G, B : Smallint; sat, mst : Double; // 華やかさ調整係数 begin Val(LabeledEdit1.Text, sat, X); // 鮮やかさ係数 if X <> 0 then begin Application.MessageBox('入力値は数値ではありません','鮮やかさ係数',0); exit; end; mst := (1 - sat) / 2; // 補正係数計算 for Y := 0 to GHeight - 1 do begin Pin := InBitmap.ScanLine[Y]; Pout := OutBitmap.ScanLine[Y]; for X := 0 to GWidth - 1 do begin Bin := pin[X].rgbtBlue; Gin := pin[X].rgbtGreen; Rin := pin[X].rgbtRed; B := Round(Bin * sat + Gin * mst + Rin * mst); G := Round(Bin * mst + Gin * sat + Rin * mst); R := Round(Bin * mst + Gin * mst + Rin * sat); if R < 0 then R := 0; if G < 0 then G := 0; if B < 0 then B := 0; if R > 255 then R := 255; if G > 255 then G := 255; if B > 255 then B := 255; Pout[X].rgbtBlue := B; Pout[X].rgbtGreen := G; Pout[X].rgbtRed := R; end; end; image2.Picture.Bitmap := OutBitmap; // 画像表示 FileeSaveBtn.Enabled := True; end; //************************************************************ // ファイルのオープン WIC がファイルの種類が多いので使用 //************************************************************ procedure TForm1.FileOpenClick(Sender: TObject); var WIC : TWICImage; InFilename : String; begin OpenPictureDialog1.Filter := OpenFileFilter; // ファイルオープンフィルターの設定 if OpenPictureDialog1.Execute then // ファイルが指定されたら begin WIC := TWICImage.Create; // TWICImageの生成 try InFilename := OpenPictureDialog1.FileName; // ファイル名の取得 WIC.LoadFromFile(InFilename); // 画像の読み込み GHeight := WIC.Height; // 画像高さ取得 GWidth := WIC.Width; // 画像幅取得 InBitmap.Width := GWidth; InBitmap.Height := GHeight; InBitmap.Canvas.Draw(0, 0, WIC); // DrawでInBitmapに入力画像設定フォーマット24ビットに変換されます OutBitmap.Width := GWidth; // 出力画像幅 OutBitmap.Height := GHeight; // 出力画像高さ image1.Picture.Bitmap := InBitmap; // 画像表示 finally WIC.Free; // TWICImage 解放 end; end else Exit; SaturationBtn.Enabled := True; end; //************************************************************************* // TWICImage を使用してファイル保存 // XE3, XE4 では、メモリーリークが発生します //************************************************************************* procedure TForm1.FileeSaveBtnClick(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; // ファイルセーブフィルターの設定 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; try WIC.Assign(OutBitmap); WIC.ImageFormat := WICF; WIC.SaveTofile(Fname); // XE3,XE4 ではメモリーリークが発生します。 finally // アンシャープマスキングを参照して下さい。 WIC.Free; end; end; //********************* // 初期設定 //********************* procedure TForm1.FormCreate(Sender: TObject); begin Top := (Screen.Height - Height) div 2; // 表示位置設定 Left := (Screen.Width - Width) div 2; InBitmap := TBitmap.Create; // 入力画像用 OutBitmap := TBitmap.Create; // 出力画像用 InBitmap.PixelFormat := pf24bit; // 24ビットカラーに設定 OutBitmap.PixelFormat := pf24bit; // 24ビットカラーに設定 SaturationBtn.Enabled := False; FileeSaveBtn.Enabled := False; end; //********************** // ビットマップの解法 //********************** procedure TForm1.FormDestroy(Sender: TObject); begin InBitmap.Free; OutBitmap.Free; end; end.
Saturation.zip