Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Режим картинки


kail ©   (2007-02-24 16:25:00) 

Вот код:

var
 Form1: TForm1;
 imagemain:timage;
 rows,cols:integer;
 puzzle:array [1..10000] of timage;

implementation

{$R *.dfm}
procedure Tform1.CutPicture(Im1, Im2: TCanvas; const ARect: TRect);
begin
im2.CopyRect(Rect(0,0,Arect.Right-ARect.Left, Arect.Bottom-Arect.Top), Im1, ARect);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 h,w,kusokh,kusokw:integer;
 i,j,k:longword;
begin
 imagemain:=timage.Create(self);
 imagemain.Picture.LoadFromFile('img.bmp');
 try
   rows:=strtoint(edit1.Text);
   cols:=strtoint(edit2.Text);
 except
   showmessage('Неверно введено количество строк и столбцов.');
   exit;
 end;
 h:=imagemain.Picture.Height;
 w:=imagemain.Picture.Width;
 if ((rows=1) or (rows=0) or (cols=0) or (cols=1)) then begin showmessage ('Слишком маленькое количество строк и/или столбцов!');exit;end;
 if ((rows>h) or (cols>w)) then begin showmessage('Недопустимое количество строк или столбцов'); exit;end;
 kusokh:=round(h/rows);
 kusokw:=round(w/cols);
 k:=1;
 for i:=1 to rows do
   for j:=1 to cols do begin
     puzzle[k]:=timage.Create(self);
     puzzle[k].Parent:=self;
     cutpicture(imagemain.Canvas, puzzle[k].Canvas, Rect( (j-1)*kusokw ,(i-1)*kusokh ,kusokh,kusokw));
     puzzle[k].Left:=(j-1)*kusokw;
     puzzle[k].Top:=(i-1)*kusokh;
     k:=k+1;
   end;
end;


Поясняю... По нажатию на кнопку загружается большая картинка, которая в последствии должна быть разрена на rows строк и cols столбцов итого на rows*cols кусков и выводится на экран. Ошибка в том, что только первый кусок вырезается, остальные пустые... Помогите


kail   (2007-02-24 16:37:00) [1]

Точно....


Германн   (2007-02-24 16:36:00) [2]

function Rect(ALeft, ATop, ARight, ABottom: Integer)


Наверх

Титульная страница Поиск, карта сайта Написать письмо