この発言は
#01230　かとちん        さんのRE:グリッド点の描画コンポーネント
に対するコメントです



かとちんさんどもです。KENCH です。＼(^0^)／

　よくよくかんがえたら、プロパティのところは私もSet***とGet***としてました。
つい勢いでほかの関数と同じくF***としていましたが、
プロパティはReadとWriteがあるのでSetにするのが筋ですね。
ちょっとボケてました。で修正版をアップします。
(本当はClipRectのところだけ処理するとか考える事は他にもありそうなのだが...)




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;
    procedure SetGridVisible(Value:Boolean);
    procedure SetGridColor(Value:TColor);
    procedure SetGridSize(Value:integer);
    procedure SetGridInterval(Value:integer);
    procedure FMakeGridBmp;
    procedure FPaintGrid;
    procedure WMPaint(var Message: TWMPaint); message WM_Paint;
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    destructor Destroy;override;
    constructor Create(AOwner: TComponent); override;
  published
    { Published 宣言 }
    property GridVisible:Boolean Read PGridVisible Write SetGridVisible;
    property GridColor:TColor Read PGridColor Write SetGridColor;
    property GridSize:integer Read PGridSize Write SetGridSize;
    property GridInterval:integer Read PGridInterval Write SetGridInterval;
  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
                    FillRect(
                        Rect( x * PGridInterval,
                            y * PGridInterval,
                            x * PGridInterval + PGridSize,
                            y * PGridInterval + PGridSize
                        )
                    );
        end;
    end;
end;

procedure TPaintBoxGrid.FPaintGrid;
var
    x, y: Integer;
    WStep: Integer;
    WLoopX, WLoopY: Integer;
    WSvCopyMode: Integer;
    rc: TRect;
begin
    if Parent = nil then exit;

    with Self.Canvas do
    begin
        if PGridVisible then
        begin
            WStep := (128 div PGridInterval) * PGridInterval;
            WLoopX := (Width div WStep);
            WLoopY := (Height div WStep);
            WSvCopyMode := CopyMode;
            try
                CopyMode := cmSrcAnd;
                for y := 0 to WLoopY do
                begin
                    for x := 0 to WLoopX do
                    begin
                        rc.Left := x * WStep;
                        rc.Top := y * WStep;
                        rc.Right := ( x + 1 ) * WStep;
                        rc.Bottom := ( y + 1 ) * WStep;
                        CopyRect(rc,
                             PGridBmp.Canvas,
                             Rect(0,0,WStep,WStep)
                        );
                    end;
                end;
            finally
                CopyMode := WSvCopyMode;
            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.SetGridVisible(Value:Boolean);
begin
    PGridVisible := Value;
    if PGridVisible Then begin
        FMakeGridBmp;
        FPaintGrid;
    end;
end;

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

procedure TPaintBoxGrid.SetGridSize(Value:Integer);
begin
    PGridSize := Value;
    if PGridVisible Then begin
        FMakeGridBmp;
        FPaintGrid;
    end;
end;
procedure TPaintBoxGrid.SetGridInterval(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蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。