Головна сторінка
Top.Mail.Ru Яндекс.Метрика
Форум: "Media";
Поточний архів: 2002.12.23;
Завантажити: [xml.tar.bz2];

Вниз

поворот зображення Знайти схожі гілки


Вован2   (2002-09-08 19:25) [0]

Допоможіть виправити процедуру.
Процедура повороту картинки. Нерівно виводить првёрнутую картинку.

PROCEDURE SetAngle (Value: integer);
VAR Src, Dst: TBitmap; // Початкова і повернена картинки
Angle: extended; // Кут
X, Y: integer;
Xo, Yo: integer; // Центр повороту
R, S, C: extended; // Радіус, синус і косинус
ПОЧАТИ
Angle: = Value * Pi / 180;
Dst: = TBitmap.Create;
Src: = TBitmap.Create;
Src: = Image1.Bitmap;
Xo: = Src.Width div 2;
Yo: = Src.Height div 2;
SinCos (Angle, S, C);
If S * C <0
then begin
Image1.Width: = Round (Abs (Src.Width * C-Src.Height * S));
Image1.Height: = Round (Abs (Src.Width * S-Src.Height * C));
кінець
else begin
Image1.Width: = Round (Abs (Src.Width * C + Src.Height * S));
Image1.Height: = Round (Abs (Src.Width * S + Src.Height * C));
end;
Dst.Width: = Image1.Width;
Dst.Height: = Image1.Height;
Dst.TransparentColor: = clWhite;
Dst.TransparentMode: = tmAuto;
Dst.Transparent: = True;
For Y: = 0 to Dst.Height do
For X: = 0 to Dst.Width do
починати
R: = Sqrt (Sqr (X-Xo) + Sqr (Y-Yo));
SinCos (Angle + ArcTan2 ((Y-Yo), (X-Xo)), S, C);
If (Round (Xo + R * C) in [0..Src.Width-1]) and (Round (Yo + R * S) in [0..Src.Height-1])
then Dst.Canvas.Pixels [X, Y]: = Src.Canvas.Pixels [Round (Xo + R * C), Round (Yo + R * S)]
else Dst.Canvas.Pixels [X, Y]: = clWhite;
end;
Image1.Canvas.Brush.Color: = clWhite;
Image1.Canvas.Brush.Style:=bsSolid;
Image1.Canvas.FillRect (Canvas.ClipRect);
Image1.Picture.Bitmap: = Dst;
Dst.Free;
Src.Free;
END;



MBo   (2002-09-09 09:38) [1]

при повороті на n * Pi / 2 можливі похибки на точку через округлення, тому в цих випадках краще застосовувати інші методи (вони прості)
function BmpRot (const B: TBitmap; fi: integer): TBitmap;
тип
TRGBTripleArray = array [word] of TRGBTriple;
pRGBTripleArray = ^ TRGBTripleArray;
було
x0,y0,i,j,x1,y1,x11,y11,x2,y2:integer;
ht, wd, newht, newwd: integer;
cfi, sfi: double;
sline1, sline2: pRGBTRipleArray;
ПОЧАТИ
sfi: = sin (degtorad (fi));
cfi: = cos (degtorad (fi));
ht: = b.height;
wd: = b.width;
newwd: = abs (round (ht * sfi)) + abs (round (wd * cfi));
newht: = abs (round (wd * sfi)) + abs (round (ht * cfi));
Result: = TBitmap.create;
Result.Width: = newwd;
Result.Height: = newht;
Result.PixelFormat: = pf24bit;
x0: = wd div 2;
y0: = ht div 2;
for j: = newht-1 downto 0 do begin
sline2: = Result.scanline [j];
y1: = 2 * (j- (newht-ht) div 2 -y0);
for i: = newwd-1 downto 0 do begin
x1: = 2 * (i- (newwd-wd) div 2 -x0);
x2: = round (x1 * cfi - y1 * sfi);
y2: = round (x1 * sfi + y1 * cfi);
x11: = x2 div 2 + x0;
y11: = y2 div 2 + y0;
if (x11> = 0) and (x11 <wd) and (y11> = 0) and (y11 <ht) then begin
sline1: = b.scanline [y11];
sline2 [i]: = sline1 [x11];
end;
end;
end;
end;



сторінки: 1 вся гілка

Форум: "Media";
Поточний архів: 2002.12.23;
Завантажити: [xml.tar.bz2];

Вгору





Пам'ять: 0.55 MB
Час: 0.024 c
3-74613
bedniy_student
2002-12-05 10:57
2002.12.23
Поясніть дурню, люди добрі .....


1-74630
bkv
2002-12-10 16:42
2002.12.23
скільки пікселів займе терміну в 10 символів?


6-74877
Romych
2002-10-24 12:26
2002.12.23
Вибачте що питання трохи не в тему UDP


1-74669
Джонс
2002-12-13 10:46
2002.12.23
Зникає напис.


4-75047
небезпека
2002-11-10 23:00
2002.12.23
Не можу поставити компоненту





африкаанс албанський арабська вірменин азербайджанець баскський білоруський болгарська каталонський Китайська (спрощене письмо) Китайський традиційний) хорватський чеська данську мову нідерландський Ukranian естонець Філіппінська фінську мову французький
галісійська грузинський німецький грецький гаїтянський креольський давньоєврейську хінді угорський ісландський індонезієць ірландський італійський японський корейський латиська литовець македонець малайський мальтійський норвежець
перс полірування португальська румунський російська сербський словацький словенський іспанська суахілі шведську мову тайський турецька український урду в'єтнамський валлійський ідиш бенгальський боснійський
кебуано есперанто гуджараті хауса хмонг ігбо яванський каннада кхмерская Лао латинь маорі маратхі монгольський непальська панджабі сомалійський тамільська телугу йоруба
зулуський
Англійська Французький Німецький Італійський Португальська Русский Іспанська