VPF::Проблема с полем для "Сапер", ПОМОГИТЕ !!!

ZMaximI

Дата 8.12.2005, 18:34 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 251
Регистрация: 18.5.2004
Где: Украина, г. Харьк ов

Репутация: нет
Всего: -1

Добрый день.

Помогите, ПОЖАЛУЙСТА решить проблему.
Ниже приведен код компонента, который создает поле с яцейками, НО
ЯЧЕЙКИ ПОСТОЯННО перересовываются.
Подскажите, пожалуйста, что я не так делаю.

БОЛЬШОЕ спасибо.

Код


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.

--------------------

<удалено администрацией форума>

fadeev

Дата 9.12.2005, 15:49 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 9.12.2005

Репутация: 1
Всего: 1

Попробуй такой вариант кода uField (убрал компонент чтобы не морочиться с IDE, но не в этом суть smile

Код


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;
    constructor myCreate(AOwner: TComponent;X,Y:integer);
    property Canvas;
  published
  end;

  TPole = class(TCustomControl)
  private
    FBtn: TBtn;
    FCountColumns: Integer;
    FCountLines: Integer;
    procedure SetCountColumns(Value: Integer);
    procedure SetCountLines(Value: Integer);
    procedure PaintFields;
  protected
  public
    constructor myCreate(AOwner: TComponent;ACol,ARow: integer);
    procedure Init;
  published
    property CountColumns: Integer read FCountColumns write SetCountColumns;
    property CountLines: Integer read FCountLines write SetCountLines;
  end;


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(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 20;
  Height := 20;
end;

procedure TPole.PaintFields;
var
  X, Y, Columns, Lines: Integer;
begin
  X := 0;
  Y := 0;
  for Lines := 1 to FCountLines do
  begin
    for Columns := 1 to FCountColumns do
    begin
      FBtn := TBtn.myCreate(Self,X,Y);
      X := X + 20;
    end;
    X := 0;
    Y := Y + 20;
  end;
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 TBtn.myCreate(AOwner: TComponent;  X, Y: integer);
begin
  inherited Create(AOwner);
  Parent:=(AOwner as TWinControl);
  Width := 20;
  Height := 20;
  Top:=X;
  Left:=Y;
  Paint;
end;

procedure TPole.Init;
begin
  PaintFields;
end;

constructor TPole.myCreate(AOwner: TComponent;ACol,ARow: integer);
begin
  inherited Create(AOwner);
  with Canvas do
  begin
    Width := 20*ACol;
    Height := 20*ARow;
  end;
  FCountColumns := ACol;
  FCountLines := ARow;
  Parent:=(AOwner as TWinControl);
  PaintFields;
end;

end.

ZMaximI

Дата 9.12.2005, 15:53 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 251
Регистрация: 18.5.2004
Где: Украина, г. Харьк ов

Репутация: нет
Всего: -1

Спасибо ОГРОМНОЕ, выручил. smile

--------------------

<удалено администрацией форума>

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »