Форум: "Начинающим";
Текущий архив: 2008.01.06;
Скачать: [xml.tar.bz2];

Вниз

создание класса на основе TBitmap   Найти похожие ветки 

← →
San1   (2007-12-11 03:26) [0]

Подскажите пожалуйста.
Мне необходимо реализовать отрисовку сетки на объекте дочернего класса (TMyBitmap) порожденного от класса TBitmap.

Например:
-создаем объект класса TMyBitmap;
- задаем в его свойствах шаг и тощину отрисовываемой сетки;
- и при вызове процедуры отрисовки объекта он отрисовывается на форме.

Каким образом в моем создаваемом классе реализовать отрисовку объекта, который еще не создан?

---

← →
{RASkov} ©   (2007-12-11 04:20) [1]

> [0] San1   (11.12.07 03:26)

unit Unit1;

interface

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

type
 TMyBmp = class(TBitMap)
 private
   FCellSize: Byte;
   FLnWidth: Byte;
   FLnColor: TColor;
   procedure SetCellSize(const Value: Byte);
   procedure SetLnWidth(const Value: Byte);
   procedure SetLnColor(const Value: TColor);
 protected
   procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
 public
   procedure PaintTo(ACanvas: TCanvas); overload;
   procedure PaintTo(const X, Y: Integer; ACanvas: TCanvas); overload;
   property CellSize: Byte read FCellSize write SetCellSize;
   property LnWidth: Byte read FLnWidth write SetLnWidth;
   property LnColor: TColor read FLnColor write SetLnColor;
 end;

 TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

{ TMyBmp }

procedure TMyBmp.SetCellSize(const Value: Byte);
begin
 if FCellSize <> Value then begin
  if Value<3 then FCellSize := 3 else FCellSize := Value;
 end;
end;

procedure TMyBmp.SetLnWidth(const Value: Byte);
begin
 if FLnWidth <> Value then begin
  if Value<1 then FLnWidth := 1 else FLnWidth := Value;
 end;
end;

procedure TMyBmp.SetLnColor(const Value: TColor);
begin
 FLnColor := Value;
end;

procedure TMyBmp.Draw(ACanvas: TCanvas; const Rect: TRect);
var R, C, W, H: Integer;
begin
 W:=(Rect.Right-Rect.Left) div CellSize;
 H:=(Rect.Bottom-Rect.Top) div CellSize;
 with Canvas do begin
  Pen.Width:=LnWidth;
  Pen.Color:=LnColor;
  Pen.Style:=psInsideFrame;
  Brush.Style:=bsClear;
  for C:=0 to W do
   for R:=0 to H do
    Rectangle(C*CellSize, R*CellSize, C*CellSize+CellSize, R*CellSize+CellSize);
 end;
 inherited;
end;

procedure TMyBmp.PaintTo(ACanvas: TCanvas);
begin
 ACanvas.Draw(0, 0, Self);
end;

procedure TMyBmp.PaintTo(const X, Y: Integer; ACanvas: TCanvas);
begin
 ACanvas.Draw(X, Y, Self);
end;

procedure TForm1.Button1Click(Sender: TObject);
var B: TMyBmp;
begin
 B:=TMyBmp.Create;
 B.LoadFromFile(<имя бмпшки>);
 B.CellSize:=50;
 B.LnWidth:=3;
 B.LnColor:=clSilver;
 Canvas.Draw(10, 30, B);
 B.PaintTo(10, B.Height+40, Canvas);
 B.Free;
end;

end.

---

← →
Юрий Зотов ©   (2007-12-11 13:14) [2]

А если во всех трех сеттерах в конце еще и перерисовку вызвать - полный кайф наступит. Поменяли, например, толщину линии - и все тут же само собой перерисовалось, как надо.

И в процедуре Draw я бы inherited вызвал в самом начале - чтобы сетка рисовалась поверх картинки, а не затиралась ею.

А сетку рисовал бы через MoveTo и LineTo, сразу по всей области, а не ячейками, через Rectangle - чтобы не было повторной прорисовки линий.

:o)

---

← →
{RASkov} ©   (2007-12-11 14:11) [3]

> [2] Юрий Зотов ©   (11.12.07 13:14)

:)
Некое домашние задание автору)

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.01.06;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.04 c