ＢＭＰ画像から線を読み取るには？ (ID：2581)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

ＢＭＰ形式にして取り込んだグラフを座標を新たに設定して、
数値化したいのです。
座標を読み取る前に、色を白、黒にしたいため、以下のコード
には、スマートではありませんが、そのような記述部分があり
ます。もともとのグラフは黒色の背景に白ラインなので、白ラ
インを黒ラインにして、背景を白にすると同時に黒くしたライ
ンの数値を読むよう、工夫してみたのですが、スピードが遅い
ことや、配列として扱う際に、配列の上限を設定するアイデア
が浮かばず、固定値をいれてます。
また、読み込んだ数値から、グラフの極大点を知りたい等、が
目標です。
長くなりますが、以下に試作してみたコードをつけます。
よきアドバイスよろしくお願い致します。

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}

←解決時は質問者本人がここをチェックしてください。

戻る