Вниз
Скачать: CL | DM;

Режим картинки   Найти похожие ветки 

 
kail   (2007-02-24 16:25) [0]

Вот код:

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 кусков и выводится на экран. Ошибка в том, что только первый кусок вырезается, остальные пустые... Помогите


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

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


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

Точно....



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

Скачать: CL | DM;



Память: 0.45 MB
Время: 0.027 c
1-1169459125
Kolan
2007-01-22 12:45
2007.03.18
Как сделать Hint для каждой ячейки StringGrid?


2-1172335456
Gamer
2007-02-24 19:44
2007.03.18
взаимодействие DLL(!) с программой


15-1172031692
TUser
2007-02-21 07:21
2007.03.18
Открытое письмо к Фурсенко. Подпишитесь, кто за.


15-1172239795
isasa
2007-02-23 17:09
2007.03.18
"Легкий"(для малого офиса) Mail Server


3-1166758240
NovaC
2006-12-22 06:30
2007.03.18
INSERT INTO через ADOConnection.Execute




   Наверх