ＢＭＰ画像から線を読み取るには？
ＢＭＰ形式にして取り込んだグラフを座標を新たに設定して、
数値化したいのです。
座標を読み取る前に、色を白、黒にしたいため、以下のコード
には、スマートではありませんが、そのような記述部分があり
ます。もともとのグラフは黒色の背景に白ラインなので、白ラ
インを黒ラインにして、背景を白にすると同時に黒くしたライ
ンの数値を読むよう、工夫してみたのですが、スピードが遅い
ことや、配列として扱う際に、配列の上限を設定するアイデア
が浮かばず、固定値をいれてます。
また、読み込んだ数値から、グラフの極大点を知りたい等、が
目標です。
長くなりますが、以下に試作してみたコードをつけます。
よきアドバイスよろしくお願い致します。
unit Unit1;
interface
uses
Windows, Messages,SysUtils,Variants, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls,
unit2 ,ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button3: TButton;
Button4: TButton;
GroupBox1: TGroupBox;
Button6: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private 宣言 }
BitMap : TBitMap;
CanselFlag : Boolean;
public
{ Public 宣言 }
Procedure DeskTopSs;
Function RoundByte(Data:Double):Byte;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
Function TForm1.RoundByte(data:Double):Byte;
begin
if Data >= 255 then
Data := 255;
if Data <= 0 then
Data := 0;
RoundByte := Round(Data);
end;
procedure TForm1.DeskTopSs;
var
x,y : SmallInt; //ビットマップのＸ軸、Ｙ軸
CpBMP : TBitMap; //取り込まれた画面
pxlRGB : LongInt; //ピクセル値（ＲＧＢ型）
R,G,B : Byte; //Ｒ値、Ｇ値、Ｂ値
DC : Hdc; //デバイスコンテキストへのハンドルを定義
rect :Trect; //Trect構造体を定義
hdc :hwnd; //ウインドーへのハンドルを定義
aryDay : array of array of String;
begin
CanselFlag := False;
ShowWindow(form2.Handle,sw_hide);
sleep(300);
CpBMP:=Tbitmap.Create;
hdc:=GetForegroundWindow;
getwindowrect(hdc,rect);
CpBMP.width:=rect.Right-rect.Left;
CpBMP.height:=rect.Bottom-rect.Top;
dc:=getdc(0);
bitblt(CpBMP.canvas.handle,0,0,rect.Right-rect.Left,rect.Bottom-rect.Top,dc,rect.Left,rect.top,srccopy);
Form2.Image1.Picture.BitMap.Assign(CpBMP);
releasedc(0,dc);
ShowWindow(Form2.Handle,sw_show);
SetLength(aryDay,10000 );
for x := 0 to CpBMP.Width div 2 do
begin
SetLength(aryDay[x],10000);
for y := 0 to CpBMP.Height do
begin
pxlRGB := ColorToRGB( Form2.Image1.Canvas.Pixels[x,y] );
R := GetRValue(pxlRGB);
G := GetGValue(pxlRGB);
B := GetBValue(pxlRGB);
//色判定（判定色のみ描画）
if R+G+B=765 then
begin
CpBMP.Canvas.Pixels[x,y] := RGB(0,0,0);
aryDay[x][y] := IntToStr(x)+','+IntToStr(y);
Memo1.Lines.Add(aryDay[x][y]);
end
else begin
CpBMP.Canvas.Pixels[x,y] := RGB(255,255,255);
aryDay[x][y] := '0';
Memo1.Lines.Add(aryDay[x][y]);
end;
end;
Application.ProcessMessages;
if CanselFlag then
Break;
end;
if CanselFlag = False then
Form2.ImageView(CpBMP);
CpBMP.Free;
end;
{--TForm1 Event----------------------------------------------------------------}
procedure TForm1.Button1Click(Sender: TObject);
begin
DeskTopSs;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
CanselFlag := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
BitMap := TBitMap.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
BitMap.Free;
end;
end.{Unit1 End}
遅いのなら、ScanLineプロパティを使ってはどうでしょうか？
このサイトのDelphiのページに、いくつか画像フィルタサンプルがありますけど、
それが参考になると思います。
あと、XY位置を取るのは、TPointのほうが楽だと思います。
それから、TListを継承して、TPointのリストを作って、
それで各座標を管理するとか。
早くなるかどうかはわかりませんけど。
あと、GetRValueなどは、ビット演算で一気に抜き出したほうが、
若干早くなるそうです。
うちの"おんぷむらのうら">おんぷ村倉庫>Delphiユニット>stdGraphicsユニット内に、そういう関数があります。
ScanLineの使い方の参考になる関数(LightScreen関数)も中に入っているので、見てみてください。
グラフ処理はやったことないので、これが役に立つかどうかわかりませんけど、
一応参考までに。
気がついたんですけど、
> Memo1.Lines.Add(aryDay[x][y]);
関数の最初と最後に、Memo1.beginupdateなどを呼び出すと早くなりますよ。
あと、ループ内のIntToStrが、遅くなる原因になっているかもしれません。
できるだけループ外でやるようにしたり、どうしてもだめなら、事前に定数配列にしておくとかしておいたほうがいいと思います。
ありがとうございます。
一つ一つ検討していきます。
時間がかかりそうですが＾＾；
今Ｓｃａｎｌｉｎｅについて調べています。
お付き合いください。
こんにちは。はじめまして。
ＶＢでいう、PSET関数、PGET関数を作ってみました。
ScanLineをじかに使うよりはかなり遅いですが、Pixelsをつかうよりは
かなり早いです。
procedure pset(bmp:TBitmap;point:TPoint;R,G,B:byte);
Type TRGB=record B,G,R:byte; end;
TRGBArray=array[0..65535] of TRGB;
PRGBArray=^TRGBArray;
var Color:TRGB;
Line:PRGBArray;
begin
if (bmp.Width<=0) or (bmp.Height<=0) then exit;
if (point.x<0) or (point.x>(bmp.Width -1)) or
(point.y<0) or (point.y>(bmp.height-1)) then exit;
if Bmp.PixelFormat<>pf24bit then Bmp.PixelFormat:=pf24bit;
Line:=Bmp.ScanLine[point.y];
Color:=Line^[point.x];
Color.R:=Byte(r);
Color.G:=Byte(g);
Color.B:=Byte(b);
Line^[point.x]:=Color;
end;
procedure pget(bmp:TBitmap;point:TPoint;var R,G,B:byte);
Type TRGB=record B,G,R:byte; end;
TRGBArray=array[0..65535] of TRGB;
PRGBArray=^TRGBArray;
var Color:TRGB;
Line:PRGBArray;
begin
if (bmp.Width<=0) or (bmp.Height<=0) then exit;
if (point.x<0) or (point.x>(bmp.Width -1)) or
(point.y<0) or (point.y>(bmp.height-1)) then exit;
if Bmp.PixelFormat<>pf24bit then Bmp.PixelFormat:=pf24bit;
Line:=Bmp.ScanLine[point.y];
Color:=Line^[point.x];
r:=Color.R;
g:=Color.G;
b:=Color.B;
end;
使い方の例：
procedure TForm1.Button1Click(Sender: TObject);
var x,y:integer;
point:TPoint;
begin
Image1.Canvas.FillRect(rect(0,0,Image1.Width-1,Image1.Height-1));
for x:=0 to Image1.Width-1 do
for y:=0 to Image1.Height-1 do
begin
point.X:=x;
point.Y:=y;
Pset(Image1.Picture.Bitmap,point,255,0,0);
end;
Image1.Refresh;
end;
procedure TForm1.Button2Click(Sender: TObject);
var point:TPoint;
r,g,b:byte;
begin
point.X:=0;
point.Y:=0;
pget(Image1.picture.Bitmap,point,r,g,b);
showmessage('R='+inttostr(r)+' G='+inttostr(g)+' B='+inttostr(b));
end;
| ツイート |  |