Текущий архив: 2013.09.08;
Скачать: CL | DM;
Вниз
Не получается копировать часть изображения Найти похожие ветки
← →
oam333 © (2012-12-24 14:13) [0]Есть TBitmap. В нем сидит скриншот экрана. Нужно в цикле сохранить этот скриншот, разрезанный на прямоугольники (блоки), в несколько файлов (сколько блоков, столько и файлов). Первый блок сохраняется нормально. Все остальные содержат белый цвет. И ничего больше. Размер картинок создается нормальный, но содержат только белый цвет, будто холст банально залили белым цветом. Что за хрень?
procedure TForm1.Button1Click(Sender: TObject);
var gr: TBitmap;
ScreenCopy: TCanvas;
gr, gr_part: TBitmap;
i: smallint;
rcDest, rcSource, aRect: TRect;
block_width, block_height: smallint;
begin
rcSource := Rect(0, 0, Screen.Width, Screen.Height); //исходный размер изображения
rcDest := Rect(0, 0, Screen.Width, Screen.Height); //конечный размер изображения
block_width:=64; //ширина блока
block_height:=64; //высота блока
//создаем канву и присоединяем ее к контексту Рабочего стола
ScreenCopy := TCanvas.Create;
ScreenCopy.Handle := GetDC(0);
gr:= TBitmap.Create;
gr.Height := screen_height;
gr.Width := screen_width;
gr.Canvas.CopyRect(rcDest, ScreenCopy, rcSource);
for i:=1 to 6 do
begin
SetRect(aRect, block_width*(i-1), block_height*(i-1), block_width*i, block_height*i);
gr_part:= TBitmap.Create;
gr_part.Width := block_width;
gr_part.Height := block_height;
gr_part.Canvas.CopyRect(aRect, gr.Canvas, aRect);
gr_part.SaveToFile("img_"+inttostr(i)+".bmp");
gr_part.Free;
end;
end;
← →
Капитан Очевидность (2012-12-24 14:16) [1]
> gr_part.Canvas.CopyRect(aRect, gr.Canvas, aRect);
Первый параметр должен всегда быть квадратом (0, 0, 63, 63)
← →
oam333 © (2012-12-24 14:49) [2]Капитан Очевидность
А разве (0, 0, 64, 64) не квадрат?
← →
Капитан Очевидность (2012-12-24 15:04) [3](0, 0, 64, 64) — квадрат!
← →
oam333 © (2012-12-24 15:20) [4]Эмм.. не там единицу вычитал (в программе правильно, это здесь описАлся)
SetRect(aRect, block_width*(i-1), block_height*i, block_width*(i-1), block_height*i);
А по-хорошему лучше так:SetRect(aRect, block_width*(i-1), 0, block_width*(i-1)-1, block_height-1);
Т.е. конечный вариант:procedure TForm1.Button1Click(Sender: TObject);
var gr: TBitmap;
ScreenCopy: TCanvas;
gr, gr_part: TBitmap;
i: smallint;
rcDest, rcSource, aRect: TRect;
block_width, block_height: smallint;
begin
rcSource := Rect(0, 0, Screen.Width, Screen.Height); //исходный размер изображения
rcDest := Rect(0, 0, Screen.Width, Screen.Height); //конечный размер изображения
block_width:=64; //ширина блока
block_height:=64; //высота блока
//создаем канву и присоединяем ее к контексту Рабочего стола
ScreenCopy := TCanvas.Create;
ScreenCopy.Handle := GetDC(0);
gr:= TBitmap.Create;
gr.Height := screen_height;
gr.Width := screen_width;
gr.Canvas.CopyRect(rcDest, ScreenCopy, rcSource);
for i:=1 to 6 do
begin
SetRect(aRect, block_width*(i-1), 0, block_width*(i-1)-1, block_height-1);
gr_part:= TBitmap.Create;
gr_part.Width := block_width;
gr_part.Height := block_height;
gr_part.Canvas.CopyRect(aRect, gr.Canvas, aRect);
gr_part.SaveToFile("img_"+inttostr(i)+".bmp");
gr_part.Free;
end;
end;
1 проход: (0, 0, 63, 63)
2 проход: (64, 0, 127, 63)
3 проход: (128, 0, 191, 63)
4 проход: (192, 0, 255, 63)
и т.д.
Но все равно не хочет. Кстати, в этом примере вообще все блоки сохраняет белым цветом. В программе (откуда выдрал этот кусок) первый блок сохраняется нормально (сюда не выложу, т.к. текста много и много запутанного).
← →
oam333 © (2012-12-24 15:23) [5]нет, все же строка должна быть
SetRect(aRect, block_width*(i-1), 0, block_width*i-1, block_height-1);
Но и так не работает. Все блоки сохраняются белыми.
← →
MBo © (2012-12-24 15:39) [6]надо разобраться, что означают параметры TCanvas.CopyRect
← →
Капитан Очевидность (2012-12-24 16:22) [7]
> Но все равно не хочет
Не та это субстанция, чтоб хотеть. Перечитывай [1] до просветления.
← →
KilkennyCat © (2012-12-24 19:07) [8]var gr: TBitmap;
ScreenCopy: TCanvas;
gr, gr_part: TBitmap;
че-то лишнее тут
← →
KilkennyCat © (2012-12-24 19:21) [9]
procedure TForm1.btn1Click(Sender: TObject);
var
gr, gr_part: TBitmap;
i, block_width, block_height: smallint;
begin
block_width := 64; //ширина блока
block_height := 64; //высота блока
gr := TBitmap.Create;
try
gr.Height := screen.height;
gr.Width := screen.width;
gr.Canvas.Handle := GetDC(0);
gr_part := TBitmap.Create;
gr_part.Width := block_width;
gr_part.Height := block_height;
try
for i := 0 to 5 do
begin
gr_part.Canvas.CopyRect(Rect(0, 0, block_width, block_height), gr.Canvas, Rect(block_width * i, block_height * i, block_width * (i + 1), block_height * (i + 1)));
gr_part.SaveToFile("img_"+inttostr(i)+".bmp");
end;
finally
gr_part.Free;
end;
finally
gr.Free;
end;
end;
← →
KilkennyCat © (2012-12-24 19:28) [10]так лучше:
procedure TForm1.btn1Click(Sender: TObject);
var
gr_part: TBitmap;
i, block_width, block_height: smallint;
begin
block_width := 64; //ширина блока
block_height := 64; //высота блока
gr_part := TBitmap.Create;
try
gr_part.Width := block_width;
gr_part.Height := block_height;
for i := 0 to 5 do
begin
BitBlt(gr_part.Canvas.Handle, 0, 0, block_width, block_height, GetDC(0), block_width * i, block_height * i, SRCCOPY);
gr_part.SaveToFile("img_" + inttostr(i + 1) + ".bmp");
end;
finally
gr_part.Free;
end;
end;
← →
KilkennyCat © (2012-12-24 19:30) [11]
> BitBlt(gr_part.Canvas.Handle, 0, 0, block_width, block_height,
> GetDC(0), block_width * i, block_height * i, SRCCOPY);
диагональю будет, однако :)
← →
KilkennyCat © (2012-12-24 19:37) [12]ну и чтоб еще красивше:
procedure TForm1.btn1Click(Sender: TObject);
begin
Raspilovka("Img_" ,64, 64);
end;
procedure Raspilovka(preFile : String; bWidth : integer; bHeight : Integer);
var
gr_part: TBitmap;
i : smallint;
begin
gr_part := TBitmap.Create;
try
gr_part.Width := bWidth;
gr_part.Height := bHeight;
for i := 0 to 5 do
begin
BitBlt(gr_part.Canvas.Handle, 0, 0, bWidth, bHeight, GetDC(0), bWidth * i, bHeight * i, SRCCOPY);
gr_part.SaveToFile(preFile + inttostr(i + 1) + ".bmp");
end;
finally
gr_part.Free;
end;
end;
← →
Anatoly Podgoretsky © (2012-12-24 19:52) [13]
> диагональю будет, однако :)
Штрихом, очень маленьким при том.
← →
oam333 © (2012-12-24 22:24) [14]KilkennyCat
Большое сенкс! Хорошее исполнение!
← →
Дмитрий С © (2012-12-25 02:30) [15]
> KilkennyCat © (24.12.12 19:37) [12]
С твоими именами параметров, можно и без переменной gr_part обойтись.
← →
KilkennyCat © (2012-12-25 02:32) [16]
> Дмитрий С © (25.12.12 02:30) [15]
и как тогда выполнить SaveToFile определенного куска рабочего стола?
← →
Дмитрий С © (2012-12-25 02:36) [17]
procedure Raspilovka(preFile : String; bWidth : integer; bHeight : Integer);
var
i : smallint;
begin
with TBitmap.Create do
try
Width := bWidth;
Height := bHeight;
for i := 0 to 5 do
begin
BitBlt(Canvas.Handle, 0, 0, bWidth, bHeight, GetDC(0), bWidth * i, bHeight * i, SRCCOPY);
SaveToFile(preFile + inttostr(i + 1) + ".bmp");
end;
finally
Free;
end;
end;
Кстати, а GetDC(0) релизить разве не нужно?
← →
KilkennyCat © (2012-12-25 02:48) [18]
> with TBitmap.Create do
а, ну да.
> а GetDC(0) релизить
мне кажется, в данном случае не нужно. а вот проверять имело бы смысл.
← →
KilkennyCat © (2012-12-25 03:15) [19]не, все-таки нужно.
Страницы: 1 вся ветка
Текущий архив: 2013.09.08;
Скачать: CL | DM;
Память: 0.52 MB
Время: 0.008 c
