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

Вниз

Помогите разобраться   Найти похожие ветки 

← →
Gydvin ©   (2006-04-27 22:04) [0]

Пишу компонент и где-то напортачил, гляньте пожалуста кто нибуть.
Компонент собирается нормально, проект с ним компилируется тоже.
В рунтайме тоже все нормально, но если в инспекторе объектов в поле WidthCount поставить цифру больше 10 при компиляции возникает AV после которого все продолжает работать, блин часа 4 бьюсь не могу понять где косяк. Ошибка возникает (выделено жирным).

unit krocc;

interface

uses
 SysUtils, Classes, Controls, ExtCtrls,windows,Graphics,dialogs;

 type
 TFdr=record
 x,y:integer;
 end;
type
 Tkrocc = class(TPaintBox)
 private
   { Private declarations }
   Pole:array of array of array [0..5]of char;
   timer:ttimer;
    active:boolean;
   ColorOpr1, ColorOpr2,
   ColorRab1,ColorRab2,
   ColorSelOpr1,ColorSelOpr2,
   ColorSelRab1,ColorSelRab2,ColorPen2,
   ColorPen1:tColor;
   
   SizePen1,SizePen2,
   WidthRestangle1,WidthRestangle2,
   HeightRestangle1,HeightRestangle2,

   WidthCount1, WidthCount2,HeightCount2,
   HeightCount1,Align1:Integer;
     bitmap:tbitmap;
     movecross:TFdr;
     resetcross:TFdr;
 protected
   { Protected declarations }
   procedure New;
   procedure timerclick(Sender: TObject);
   function PosRestangle(x,y:integer):tfdr;
   procedure createrestangle(a:tfdr);
 public
   { Public declarations }
   constructor Create(AOwner: TComponent); override;

   procedure paint; override;
   procedure painter(qw:tfdr);
   procedure MouseMove(Shift: TShiftState; X,  Y: Integer); override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
   destructor Destroy; override;
 published

  property Align: integer read Align1 write Align1;

  property ColorOpr: TColor read ColorOpr1 write ColorOpr1;
  property ColorRab: TColor read ColorRab1 write ColorRab1;
  property ColorSelOpr: TColor read ColorSelOpr1 write ColorSelOpr1;
  property ColorSelRab: TColor read ColorSelRab1 write ColorSelRab1;
  property ColorPen: TColor read ColorPen1 write ColorPen1;

  property SizePen: Integer read SizePen1 write SizePen1;
  property WidthRestangle: Integer read WidthRestangle1 write WidthRestangle1;
  property HeightRestangle: Integer read HeightRestangle1 write HeightRestangle1;
  property WidthCount: Integer read WidthCount1 write WidthCount1;
  property HeightCount: Integer read HeightCount1 write HeightCount1;
   { Published declarations }
 end;

procedure Register;

implementation

procedure Tkrocc.createrestangle(a:tfdr);
begin
if (a.x=-1)or(a.y=-1)then exit;
if Pole[a.x,a.y,0]="1" then Pole[a.x,a.y,0]:="2" else Pole[a.x,a.y,0]:="1";
end;

 procedure Tkrocc.MouseMove(Shift: TShiftState; X,  Y: Integer);
 var
 qw: tfdr;
 begin
   inherited;
   qw:= PosRestangle(x,y);
   if (qw.x<>movecross.x)or(qw.y<>movecross.y) then
   begin
       movecross:=qw;
      painter(qw);
   end;
  end;

procedure  Tkrocc.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 qw: tfdr;
begin
inherited;
    qw:= PosRestangle(x,y);
    createrestangle(qw);
    painter(movecross);
end;

 function Tkrocc.PosRestangle(x,y:integer):tfdr;
 var
 x1,y1:integer;
 begin
   result:=resetcross;

   for y1:=0 to HeightCount-1 do
   for x1:=0 to WidthCount-1 do
   if (x>x1*WidthRestangle)and(x<x1*WidthRestangle+WidthRestangle)
   and (y>y1*HeightRestangle)and(y<y1*HeightRestangle+HeightRestangle) then begin
     result.x:=x1;
     result.y:=y1;
   end;

 end;

procedure Tkrocc.New;
var
x,y:integer;
begin

 setlength(pole,0);
 setlength(pole,WidthCount,HeightCount);
   for y:=0 to HeightCount-1 do  begin
     for x:=0 to WidthCount-1 do begin
     pole[x,y,0]:="1";
     end;
   end;

     HeightCount2:=HeightCount;
     WidthCount2:=WidthCount;
     active:=true;
 //   painter;
end;

procedure Tkrocc.paint;
begin
 inherited paint;
 painter(resetcross);

end;

procedure Tkrocc.painter(qw:tfdr);
 var
 x,y:integer;
 color:tcolor;
 asd:boolean;
begin
if not active then exit;
bitmap.Width:=self.ClientWidth;
bitmap.Height:=self.ClientHeight;
   bitmap.Canvas.Brush.Color:=self.Color;
   bitmap.Canvas.Pen.Width:=1;
   bitmap.Canvas.Rectangle(self.ClientRect);

   bitmap.Canvas.Pen.Color:=ColorPen;
   bitmap.Canvas.Pen.Width:=SizePen;
  for y:=0 to HeightCount-1 do
   for x:=0 to WidthCount-1 do begin
   asd:=false;
   if (x=qw.x)and(y=qw.y) then asd:=true;
    if pole[x,y,0]="1" then  if asd then color:=ColorSelRab else color:=ColorRab;//здесь выкидывает
     if pole[x,y,0]="2" then  if asd then color:=ColorSelOpr else color:=ColorOpr;
      with bitmap.Canvas do begin
         Brush.Color:=color;
         Rectangle(x*WidthRestangle,y*HeightRestangle,x*WidthRestangle+WidthRestangle,y*HeightRestangle+HeightRestangle);
      end;
    end;
   bitblt(self.Canvas.Handle,0,0,self.ClientWidth,self.ClientHeight,bitmap.Canvas.H andle,0,0,SRCCOPY );

end;

 procedure Tkrocc.timerclick(Sender: TObject);
  var
  x,y:integer;
  begin
       x:=WidthRestangle*WidthCount;
       y:=HeightRestangle*HeightCount;
    if (self.Width<>x)or(self.Height<>y) then begin
       self.Width:=x;
       self.Height:=y;
    end;

  if (WidthCount2<>WidthCount)or (HeightCount2<>HeightCount) then  new;

  if   (WidthRestangle2<>WidthRestangle)or(HeightRestangle2<>HeightRestangle)or
  (ColorOpr2<>ColorOpr)or(ColorRab2<>ColorRab)or(ColorSelOpr2<>ColorSelOpr)
  or(ColorSelRab2<>ColorSelRab)or(ColorPen2<>ColorPen)or(SizePen2<>SizePen)
  or(WidthRestangle2<>WidthRestangle)or(HeightRestangle2<>HeightRestangle) then begin

   WidthRestangle2:=WidthRestangle;
   HeightRestangle2:=HeightRestangle;
   ColorOpr2:=ColorOpr;
   ColorRab2:=ColorRab;
   ColorSelOpr2:=ColorSelOpr;
   ColorSelRab2:=ColorSelRab;
   ColorPen2:=ColorPen;

   SizePen2:=SizePen;
   WidthRestangle2:=WidthRestangle;
   HeightRestangle2:=HeightRestangle;
   painter(resetcross);
   end;
  end;

constructor Tkrocc.Create(AOwner: TComponent);
var
x,y:integer;
begin

 inherited Create(AOwner);
Parent:=AOwner as TWinControl;
setlength(pole,0);

WidthRestangle:=10;
HeightRestangle:=10;

   ColorOpr:=clblue;
   ColorRab:=clwhite;
   ColorSelOpr:=cllime;
   ColorSelRab:=clyellow;
   ColorPen:=clblack;

   SizePen:=1;
   WidthRestangle:=20;
   HeightRestangle:=20;
   WidthCount:=10;
   HeightCount:=10;
   active:=false;
     bitmap:=tbitmap.Create;
     New;
     timer:=ttimer.Create(self);
     timer.Interval:=100;
     timer.OnTimer:=timerclick;
     resetcross.x:=-1;
     resetcross.y:=-1;
   end;

destructor Tkrocc.Destroy;
 begin
  timer.Free;
  bitmap.Free;
 inherited;
end;

procedure Register;
begin
 RegisterComponents("Samples", [Tkrocc]);
end;

end.

---

← →
ЮЮ ©   (2006-04-28 03:12) [1]

Установка размера массива pole производится только в методе New, которая, никоим образом не вызывается при изменении WidthCount

property HeightCount: Integer read HeightCount1 write SetHeightCount;

а в методе SetHeightCount установить нужные размеры массиву pole

P.S. Чтобы остальные тебя читали без "акцента", следует придерживаться общепринятых правил наименования полей и свойств:  

property HeightCount: Integer read FHeightCount write SetHeightCount;

---

← →
Gydvin ©   (2006-04-28 08:32) [2]

> ЮЮ ©   (28.04.06 03:12) [1]

Спасибо, я совсем забыл, что SetHeightCount может быть и процедурой, а потому обрабатывал это все в ontimer, за что и был наказан.

зы. название полей с китайского перевел )))))

---

← →
ЮЮ ©   (2006-04-28 09:20) [3]

> название полей с китайского перевел )))))


Суть не в переводе, а в том, что поле принято именовать так же, как свойство, но с префиксом "F", а не с окончанием "1", "2" как у тебя.

---

← →
Gydvin ©   (2006-04-28 09:34) [4]

Понятно, еще раз спасибо

---

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

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

Наверх

Память: 0.48 MB
Время: 0.011 c