Форум: "Основная";
Текущий архив: 2002.01.10;
Скачать: [xml.tar.bz2];
ВнизТут еще такой вопросец возник трансформирование Bitmap ov Найти похожие ветки
← →
vbazik (2001-12-23 16:29) [2]/// продолжение
begin
h := Im1.Height ; w := Im1.Width ;
h := h - 1 ;
w := w - 1 ;
find_offset( Im1 , xc , yc , angle , xoff , yoff ,xw ,yh );
Im2.Height := yh ; Im2.Width := xw ;
size_ := Pixel_Size( Im1 );
if not(size_ in [1..4])then
begin MessageBox(0,"Im1 : Unsupported type of bitmap","Error",0);exit; end;
Im2.PixelFormat := Im1.PixelFormat ;
Im2.Palette := Im1.Palette ;
line_size1 := (w+1) * size_ ;
if (line_size1 mod 4 <> 0)
then line_size1 := line_size1 + 4 - line_size1 mod 4 ;// т.к. размер
//строки изображения в памяти дополняется до кратного 4
line_size2 := xw * size_ ;
if (line_size2 mod 4 <> 0)
then line_size2 := line_size2 + 4 - line_size2 mod 4 ;
pntr2 := Im2.ScanLine[0] ;// получение указателя на начало 0 строки
pntr := Im1.ScanLine[0] ;
for j := 0 to yh-1 do
begin
index2 := -line_size2 * j ;// определение смещения j строки в памяти
//относительно 0 для Im2
i3 := - size_ ;
for i := 0 to xw-1 do
begin
x_int := i ; y_int := j ;
i3 := i3 + size_ ;
x_int := x_int + xoff ;
y_int := y_int + yoff ;
RotateXY(xc,yc,angle,x_int ,y_int );
if (x_int<0)or(y_int<0)or(y_int>h)or(x_int>w ) //Out of bounds !
then continue;
index1 := -line_size1 * y_int ;
ii:= (x_int) * size_ ;
// Копирование пиксела
R := pntr[ii + index1 ] ; G := 0 ; B := 0 ; Intens := 0 ;
if size_>1 then G := pntr[ii + index1 + 1] ;
if size_>2 then B := pntr[ii + index1 + 2] ;
if size_>3 then Intens := pntr[ii + index1 + 3] ;
try
pntr2 [i3 + index2 ] := R ;
if size_>1 then pntr2 [i3 + index2 + 1] := G ;
if size_>2 then pntr2 [i3 + index2 + 2] := B ;
if size_>3 then pntr2 [i3 + index2 + 3] := Intens ;
except
// Конец копирования пиксела
end;
end; // for i
end; // for j
Im2.ReleasePalette ;
end; // proc povorot
?????????????????????????????????????????
Встречный вопрос знатокам - в D3 под W-98 при попытке разворота больших изображений дает Out of resurs :-( Под NT4.0 все О.К. В чем причина
Кто разберется - киньте на мыло: vbazik@mail.ru
Заранее спасибо :-)
?????????????????????????????????????????
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.01.10;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.003 c