TBitMap.ScanLineへ意図通り入力するには? (ID:26103)

名前

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

本文

ツール作成手順

1.ファイル>新規作成>アプリケーション
2.Form1にTButton(2つ)、TEdit(1つ)、TLabel(5つ)、TPanel(6つ)、TComboBox(2つ)、

TTimer(1つ)を載せる。この際、TPanel内に他のコンポーネントが入ってしまわないように気をつける
3.Unit1.pasを以下のコードですべて置き換える
4.Form1のOnCreateイベントをダブルクリック
5.コンパイルで完成

〜  Unit1.pas 置き換えコード  〜

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Timer1: TTimer;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  clIndex:TColor;
  x,y:Integer;
  BitMap:TBitMap;
  PB:PByteArray;
  PW:PWordArray;
  PI:PIntegerArray;
  TPF:TPixelFormat;
begin
    BitMap:=TBitMap.create;

if Edit1.Text='' then Exit;

if ComboBox1.ItemIndex=0 then begin
        ShowMessage('PixelFormatを選択してください');
        Exit;
    end;

if ComboBox2.ItemIndex=0 then begin
        ShowMessage('ポインタ配列を選択してください');
        Exit;
    end;

//カラー値入力
    try
        clIndex:=StrToInt(Edit1.Text);
        Panel5.Caption:='10進数 = '+Edit1.Text;
        Panel6.Caption:='16進数 = '+Edit1.Text;

if Edit1.Text[1]<>'$' then
            Panel6.Caption:='16進数 = $'+IntToHex(clIndex,8)
        else
            Panel5.Caption:='10進数 = '+IntToStr(clIndex);
    except
    end;

BitMap.Width:=200;
    BitMap.Height:=100;

TPF:=TPixelFormat(ComboBox1.ItemIndex);
    BitMap.PixelFormat:=TPF;

try
        try
            for y:=0 to BitMap.Height -1 do begin

case ComboBox2.ItemIndex of

1:begin
                        PB:=BitMap.ScanLine[y];
                        for x:=0 to BitMap.Width -1 do PB[x]:=clIndex;
                    end;

2:begin
                        PW:=BitMap.ScanLine[y];
                        for x:=0 to BitMap.Width -1 do PW[x]:=clIndex;
                    end;

3:begin
                        PI:=BitMap.ScanLine[y];
                        for x:=0 to BitMap.Width -1 do PI[x]:=clIndex;
                    end;
                end;
            end;
            Canvas.Draw(0,0,BitMap);

SetCursorPos(Left+BitMap.Width div 2,Top+(Height-ClientHeight)+BitMap.Height div 2);
        except
            ShowMessage('現在のPixcelFormat、ポインタ型配列、カラー値の組合せは有効ではありません');
        end;
    finally
        BitMap.Free;
    end;

Timer1Timer(Sender);
    
    //色の一致判定
    if Panel5.Caption=Panel2.Caption then Label5.Caption:='○' else Label5.Caption:='×';

Edit1.Text:='';
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  R,G,B:Integer;
  DeskDC:HWND;
  pMs:Tpoint;
  clPoint:TColor;
begin
    //カーソル位置取得
    GetCursorPos(pMs);
    Panel1.Caption:='x ='+IntToStr(pMs.x)+', y ='+IntToStr(pMs.y);

//デスクトップDC(デバイスコンテキスト)取得
    DeskDC:=GetDC(0);

//カーソル位置カラー(10進数)取得
    clPoint:=GetPixel(DeskDC,pMs.x,pMs.y);
    Panel2.Caption:='10進数 = '+IntToStr(clPoint);

//DC(デバイスコンテキスト)解放
    ReleaseDC(0,DeskDC);

//カーソル位置カラー(16進数)取得
    Panel3.Caption:='16進数 = $'+IntToHex(clPoint,8);

//カーソル位置カラー(RGB)取得
    R:=GetRValue(clPoint);
    G:=GetGValue(clPoint);
    B:=GetBValue(clPoint);
    Panel4.Caption:='(R,G,B) ='+'('+IntToStr(R)+', '+IntToStr(G)+' ,'+IntToStr(B)+')';
end;

procedure TForm1.Button2Click(Sender: TObject);
type
  PRGBColor=^TRGBColor;
  TRGBColor=array[0..32768-1] of TRGBTriple;
var
  clIndex,x,y:Integer;
  BitMap:TBitmap;
  P:PRGBColor;
  TPF:TPixelFormat;
begin
    BitMap:=TBitMap.create;

if Edit1.Text='' then Exit;

if ComboBox1.ItemIndex=0 then begin
        ShowMessage('PixelFormatを選択してください');
        Exit;
    end;

//カラー値入力
    try
        clIndex:=StrToInt(Edit1.Text);
        Panel5.Caption:='10進数 = '+Edit1.Text;
        Panel6.Caption:='16進数 = '+Edit1.Text;

if Edit1.Text[1]<>'$' then
            Panel6.Caption:='16進数 = $'+IntToHex(clIndex,8)
        else
            Panel5.Caption:='10進数 = '+IntToStr(clIndex);
    except
    end;

BitMap.Width:=200;
    BitMap.Height:=100;

TPF:=TPixelFormat(ComboBox1.ItemIndex);
    BitMap.PixelFormat:=TPF;

try
        for y:=0 to BitMap.Height -1 do begin

P:=BitMap.ScanLine[y];

for x:=0 to BitMap.Width -1 do begin
                P[x].rgbtRed:=GetRValue(clIndex);
                P[x].rgbtGreen:=GetGValue(clIndex);
                P[x].rgbtBlue:=GetBValue(clIndex);
            end;

Canvas.Draw(0,0,BitMap);

SetCursorPos(Left+BitMap.Width div 2,Top+(Height-ClientHeight)+BitMap.Height div 2);
        end;
    finally
        BitMap.Free;
    end;

Timer1Timer(Sender);

//色の一致判定
    if Panel5.Caption=Panel2.Caption then Label5.Caption:='○' else Label5.Caption:='×';

Edit1.Text:='';
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i:Integer;
  com:TComponent;
  slList:TStringList;
begin
    //フォームサイズ変更
    Width:=480;
    Height:=330;

//ラベル設定
    for i:=1 to 5 do begin
        com:=FindComponent('Label'+IntToStr(i));
        with (com as TLabel) do begin
            Left:=220;

case i of
                1:begin
                    Caption:='現在のカーソル位置は...';
                    Top:=155;
                end;

2:begin
                    Caption:='現在のマウスカーソル位置カラーは...';
                    Top:=205;
                end;

3:begin
                    Caption:='描画指定のカラーは...';
                    Top:=75;
                end;

4:begin
                    Caption:='描画させたいカラー入力';
                    Top:=35;
                end;

5:begin
                    Caption:='';
                    Top:=170;
                    Left:=65;
                    Font.Size:=60;
                end;
            end;
        end;
    end;
    
    //パネル設定
    for i:=1 to 6 do begin
        com:=FindComponent('Panel'+IntToStr(i));
        with (com as TPanel) do begin
            Caption:='';
            Left:=220;
            BevelOuter:=bvLowered;
            BevelWidth:=2;
            Alignment:=taLeftJustify;
            Width:=160;
            Height:=20;

case i of
                1:Top:=170;
                2:Top:=220;
                3:Top:=245;
                4:Top:=270;
                5:Top:=90;
                6:Top:=115;
            end;
        end;
    end;

//ボタン設定
    for i:=1 to 2 do begin
        com:=FindComponent('Button'+IntToStr(i));
        with (com as TButton) do begin
            Caption:='';
            Left:=350;
            Width:=100;
            Height:=25;

case i of
                1:begin
                    Caption:='TColor直接方式';
                    Top:=32;
                    OnClick:=Button1Click;
                end;

2:begin
                    Caption:='RGB変換方式';
                    Top:=60;
                    OnClick:=Button2Click;
                end;
            end;
        end;
    end;

//Edit1設定
    with Edit1 do begin
        Edit1.Text:='';
        Left:=220;
        Top:=50;
    end;

//コンボボックス設定
    for i:=1 to 2 do begin
        com:=FindComponent('ComboBox'+IntToStr(i));
        with (com as TComboBox) do begin
            Top:=5;
            Width:=100;
            Height:=20;

slList:=TStringList.Create;

case i of
                1:begin
                    Left:=220;

slList.Add('PixcelFormat');
                    slList.Add('pf1bit');
                    slList.Add('pf4bit');
                    slList.Add('pf8bit');
                    slList.Add('pf15bit');
                    slList.Add('pf16bit');
                    slList.Add('pf24bit');
                    slList.Add('pf32bit');

end;

2:begin
                    Left:=350;

slList.Add('ポインタ型配列');
                    slList.Add('PByteArray');
                    slList.Add('PWordArray');
                    slList.Add('PIntegerArray');

end;
            end;

Items:=slList;
            ItemIndex:=0;

slList.Free;
        end;
    end;

//Timer設定
    with Timer1 do begin
        Enabled:=True;
        Interval:=100;
        OnTimer:=Timer1Timer;
    end;
end;

end.

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

戻る