Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2007.03.18;
Скачать: 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 вся ветка

Текущий архив: 2007.03.18;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.067 c
2-1172410281
CaptainBlack
2007-02-25 16:31
2007.03.18
C++,DLL и Delphi


6-1159770522
Виктор 5
2006-10-02 10:28
2007.03.18
не работает InternetSetFilePointer


2-1172548934
Ivolg
2007-02-27 07:02
2007.03.18
ASCII в Unicode


15-1171890622
CCili
2007-02-19 16:10
2007.03.18
Кто-нить играл в World of Warcraft


3-1166968045
gekakos
2006-12-24 16:47
2007.03.18
не могу отсортироватьв DBGrid....