この発言に対し以下のコメントが寄せられています

#01230　かとちん        さん　RE:グリッド点の描画コンポーネント




TPaintBoxを継承した一定間隔の点を描画するコンポーネントです。
グラフィカルなエディタを作るときの背景に使えるかもしれません。
まだ無駄がありそうですが、とりあえず公開します。

ほとんど会議室で教えいていただいたコードをまとめただけです(^_^;



unit PaintBoxG;

interface

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

type
  TPaintBoxGrid = class(TPaintBox)
  private
    { Private 宣言 }
    PGridVisible:Boolean;
    PGridColor:TColor;
    PGridSize:integer;
    PGridInterval:integer;
    PGridBMP:TBitMap;
    destructor Destroy;override;
    procedure FGridVisible(Value:Boolean);
    procedure FGridColor(Value:TColor);
    procedure FGridSize(Value:integer);
    procedure FGridInterval(Value:integer);
    procedure FMakeGridBmp;
    procedure FPaintGrid;
    procedure WMPaint(var Message: TWMPaint); message WM_Paint;
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    constructor Create(AOwner: TComponent);override;
  published
    { Published 宣言 }
    property GridVisible:Boolean Read PGridVisible Write FGridVisible;
    property GridColor:TColor Read PGridColor Write FGridColor;
    property GridSize:integer Read PGridSize Write FGridSize;
    property GridInterval:integer Read PGridInterval Write FGridInterval;
  end;

procedure Register;

implementation


procedure TPaintBoxGrid.WMPaint(var Message: TWMPaint);
begin
    inherited;
    FPaintGrid;
end;

procedure TPaintBoxGrid.FMakeGridBmp;
var
  x, y: Integer;
begin
  if (PGridInterval < 2) or (PGridInterval > 128) then exit;

  PGridBmp.Width := 128;
  PGridBmp.Height := 128;

  with PGridBmp.Canvas do
  begin
    Brush.Color := clWhite;
    Brush.Style := bsSolid;
    FillRect( Rect( 0, 0, 128, 128 ) );
    Brush.Color := PGridColor;
    if PGridVisible then
    begin
      for y := 0 to (128 div PGridInterval) do
        for x := 0 to (128 div PGridInterval) do
//          Pixels[x * PGridWidth, y * PGridHeight] := PGridColor;
            FillRect(Rect(x * PGridInterval, y * PGridInterval,
                x * PGridInterval+PGridSize, y * PGridInterval+PGridSize));
    end;
  end;
end;

procedure TPaintBoxGrid.FPaintGrid;
var
  x, y: Integer;
  Step: Integer;
  LoopX, LoopY: Integer;
  SvCopyMode: Integer;
  rc: TRect;
begin
  if Parent = nil then exit;

  with Self.Canvas do
  begin
    if PGridVisible then
    begin
        Step := (128 div PGridInterval) * PGridInterval;
        LoopX := (Width{ClientWidth} div Step) +
         Integer((Width{ClientWidth} mod Step) <> 0);
        LoopY := (Height{ClientHeight} div Step) +
         Integer((Height{ClientHeight} mod Step) <> 0);
        SvCopyMode := CopyMode;
        try
          CopyMode := cmSrcAnd;

          for y := 0 to LoopY do
          begin
            for x := 0 to LoopX do
            begin
              rc.Left   := x   *Step;
              rc.Top    := y   *Step;
              rc.Right  := (x+1)*Step;
              rc.Bottom := (y+1)*Step;
              CopyRect(rc, PGridBmp.Canvas, Rect(0,0,Step,Step));
            end;
          end;
        finally
          CopyMode := SvCopyMode;
        end;
    end;
  end;
end;


destructor TPaintBoxGrid.Destroy;
begin
    PGridBmp.Free;

    inherited;
end;

constructor TPaintBoxGrid.Create(AOwner: TComponent); // override;
begin
    inherited;

    PGridVisible := True;
    PGridColor := clBlack;
    PGridSize := 1;
    PGridInterval := 6;
    PGridBmp := TBitMap.Create;
end;

procedure TPaintBoxGrid.FGridVisible(Value:Boolean);
begin
    PGridVisible := Value;
    if PGridVisible Then begin
        FMakeGridBmp;
        FPaintGrid;
    end;
end;

procedure TPaintBoxGrid.FGridColor(Value:TColor);
begin
    PGridColor := Value;
    if PGridVisible Then begin
        FMakeGridBmp;
        FPaintGrid;
    end;
end;

procedure TPaintBoxGrid.FGridSize(Value:Integer);
begin
    PGridSize := Value;
    if PGridVisible Then begin
        FMakeGridBmp;
        FPaintGrid;
    end;
end;
procedure TPaintBoxGrid.FGridInterval(Value:Integer);
begin
    PGridInterval := Value;
    if PGridVisible Then begin
        FMakeGridBmp;
        FPaintGrid;
    end;
end;


procedure Register;
begin
  RegisterComponents('MyComp', [TPaintBoxGrid]);
end;

end.
ー以上ー　　　　　　　　　　　　　　kench@nifty.ne.jp KENCH/平内健一
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・ミ☆キラッ!
 


Original document by KENCH           氏 ID:(GDH01352)

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