Добрый день.
Помогите, ПОЖАЛУЙСТА решить проблему.
Ниже приведен код компонента, который создает поле с яцейками, НО
ЯЧЕЙКИ ПОСТОЯННО перересовываются.
Подскажите, пожалуйста, что я не так делаю.
БОЛЬШОЕ спасибо.
| Код |
unit uField;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Graphics, ExtCtrls, Dialogs,
StdCtrls;
type
TBtn = class(TGraphicControl)
private
FColor1: TColor;
FColor2: TColor;
FColor3: TColor;
FPicture: TPicture;
procedure SetEmptyCell;
procedure WmMouseMove(var Msg: TMessage);
message WM_LBUTTONDOWN;
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
property Canvas;
published
//
end;
TPole = class(TCustomControl)
private
FBtn: TBtn;
FCountColumns: Integer;
FCountLines: Integer;
procedure SetCountColumns(Value: Integer);
procedure SetCountLines(Value: Integer);
procedure PaintField(CountColumns, CountLines: Integer);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property CountColumns: Integer read FCountColumns write SetCountColumns;
property CountLines: Integer read FCountLines write SetCountLines;
end;
procedure Register;
implementation
{$R *.RES}
procedure TBtn.Paint;
begin
FColor1 := clWhite;
FColor2 := clGray;
FColor3 := clBlack;
with Canvas do
begin
Pen.Color := FColor1;
MoveTo(Width, 0);
LineTo(0, 0);
LineTo(0, Height-1);
Pen.Color := FColor3;
LineTo(Width-1, Height-1);
LineTo(Width-1, -1);
Pen.Color := FColor2;
MoveTo(0, Height-2);
LineTo(Width-2, Height-2);
LineTo(Width-2, -2);
end;
end;
procedure TBtn.WmMouseMove(var Msg: TMessage);
begin
inherited;
SetEmptyCell;
end;
procedure TBtn.SetEmptyCell;
begin
FPicture := TPicture.Create;
FPicture.Bitmap.LoadFromResourceName(HInstance, 'EMPTY_CELL');
with Canvas do
begin
Draw(0, 0, FPicture.Graphic);
end;
end;
constructor TBtn.Create;
begin
inherited;
Width := 20;
Height := 20;
end;
procedure TPole.PaintField(CountColumns, CountLines: Integer);
var
X, Y, Columns, Lines: Integer;
begin
X := 0;
Y := 0;
for Lines := 1 to CountLines do
begin
for Columns := 1 to CountColumns do
begin
FBtn := TBtn.Create(FBtn);
with FBtn do
begin
Left := X;
Top := Y;
Parent := Self;
end;
X := X + 20;
end;
X := 0;
Y := Y + 20;
end;
end;
procedure TPole.Paint;
begin
PaintField(FCountColumns, FCountLines);
end;
procedure TPole.SetCountColumns(Value: Integer);
begin
if FCountColumns <> Value then
begin
FCountColumns := Value;
Invalidate;
end;
end;
procedure TPole.SetCountLines(Value: Integer);
begin
if FCountLines <> Value then
begin
FCountLines := Value;
Invalidate;
end;
end;
constructor TPole.Create;
begin
Inherited Create(AOwner);
with Canvas do
begin
Width := 80;
Height := 80;
end;
FCountColumns := 3;
FCountLines := 3;
end;
procedure Register;
begin
RegisterComponents('Standard', [TPole]);
end;
end.
|
|
):