こんにちは、陽一です。

Bitmap.ScanLine の練習用に書いてみました。
矩形範囲をディザパターンによるグラデーションで塗りつぶします。

  

Form 上に PaintBox と Button と ColorGrid (Samplesページ)を
置いてください。


unit Unit1;

interface

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

type
  TTForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    ColorGrid1: TColorGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    Bitmap:   TBitmap;
    bm:       array[0..16] of TBitmap;
    procedure SetGradation;
  public
    { Public 宣言 }
  end;

var
  TForm1: TTForm1;

const
  grad:   array[0..16, 0..7] of Byte = (
    ($00, $00, $00, $00, $00, $00, $00, $00),
    ($88, $00, $00, $00, $22, $00, $00, $00),
    ($88, $00, $22, $00, $88, $00, $22, $00),
    ($aa, $00, $44, $00, $aa, $00, $11, $00),
    ($88, $44, $11, $22, $88, $44, $11, $22),
    ($aa, $44, $aa, $00, $aa, $44, $aa, $00),
    ($aa, $44, $aa, $11, $aa, $44, $aa, $11),
    ($aa, $55, $aa, $11, $aa, $55, $aa, $44),
    ($aa, $55, $aa, $55, $aa, $55, $aa, $55),
    ($55, $aa, $55, $ee, $55, $aa, $55, $bb),
    ($55, $bb, $55, $ee, $55, $bb, $55, $ee),
    ($55, $bb, $55, $ff, $55, $bb, $55, $ff),
    ($77, $bb, $ee, $dd, $77, $bb, $ee, $dd),
    ($55, $ff, $bb, $ff, $55, $ff, $ee, $ff),
    ($77, $ff, $dd, $ff, $77, $ff, $dd, $ff),
    ($77, $ff, $ff, $ff, $dd, $ff, $ff, $ff),
    ($ff, $ff, $ff, $ff, $ff, $ff, $ff, $ff));

implementation

{$R *.DFM}

procedure TTForm1.FormCreate(Sender: TObject);
begin
  ColorGrid1.ForegroundIndex := 0;
  ColorGrid1.BackgroundIndex := 15;
  PaintBox1.Width :=400;
  PaintBox1.Height:=400;

  Bitmap := TBitmap.Create;
  Bitmap.Width :=640;
  Bitmap.Height:=640;
end;

procedure TTForm1.FormDestroy(Sender: TObject);
begin
  Bitmap.Free;
end;

procedure TTForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, Bitmap);
end;

procedure TTForm1.Button1Click(Sender: TObject);
var
  y:    Integer;
  i:    Integer;
begin
  for i:=0 to 16 do begin
    bm[i] := TBitmap.Create;
    bm[i].PixelFormat:=pf24Bit;
    bm[i].Width:=8;
    bm[i].Height:=8;
  end;
  try
    SetGradation;
    for y:=0 to 16 do begin
      Bitmap.Canvas.Brush.Bitmap := Bm[y];
      Bitmap.Canvas.Pen.Style:=psClear;
      Bitmap.Canvas.FillRect(Rect(0,y*20,100,y*20+20));
    end;
    PaintBox1.Invalidate;
  finally
    for i:=0 to 16 do begin
      bm[i].Free;
    end;
  end;
end;

procedure TTForm1.SetGradation;
var
  c:            Integer;
  x, y:         Integer;
  p:            PByteArray;
begin
  with ColorGrid1 do begin
    for c:=0 to 16 do begin
      for y:=0 to 7 do begin
        p := bm[c].ScanLine[y];
        for x:=0 to 7 do begin
          if (grad[c,y] and (1 shl (7-x)))<>0 then begin
            p[x*3+0] := GetBValue(BackgroundColor);
            p[x*3+1] := GetGValue(BackgroundColor);
            p[x*3+2] := GetRValue(BackgroundColor);
          end else begin
            p[x*3+0] := GetBValue(ForegroundColor);
            p[x*3+1] := GetGValue(ForegroundColor);
            p[x*3+2] := GetRValue(ForegroundColor);
          end;
        end;
      end;
    end;
  end;
end;

end.

                              99/11/27(Sat) 07:59pm  HQG02340 陽一

Original document by 陽一            氏 ID:(HQG02340)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。