Как сделать калькулятор в Delphi?

Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.

Как Delphi реализует многоплатформенную разработку?

Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...

Растягивание изображения

Советы » Изображения » Растягивание изображения

unit

DeleteScans; //Renate Schaaf //renates@xmission.com interface

uses

Windows, Graphics; procedure

DeleteScansRect(Src, Dest: TBitmap; rs, rd: TRect); //scanline implementation of Stretchblt/Delete_Scans //about twice as fast //Stretches Src to Dest, rs is source rect, rd is dest. rect //The stretch is centered, i.e the center of rs is mapped to the center of rd. //Src, Dest are assumed to be bottom up implementation

uses

Classes, math; type

TRGBArray = array

[0..64000] of

TRGBTriple; PRGBArray = ^TRGBArray; TQuadArray = array

[0..64000] of

TRGBQuad; PQuadArray = ^TQuadArray; procedure

DeleteScansRect(Src, Dest: TBitmap; rs, rd: TRect); var

xsteps, ysteps: array

of

Integer; intscale: Integer; i, x, y, x1, x2, bitspp, bytespp: Integer; ts, td: PByte; bs, bd, WS, hs, w, h: Integer; Rows, rowd: PByte; j, c: Integer; pf: TPixelFormat; xshift, yshift: Integer; begin

WS := rs.Right - rs.Left; hs := rs.Bottom - rs.Top; w := rd.Right - rd.Left; h := rd.Bottom - rd.Top; pf := Src.PixelFormat; if

(pf <> pf32Bit) and

(pf <> pf24bit) then

begin

pf := pf24bit; Src.PixelFormat := pf; end

; Dest.PixelFormat := pf; if

not

(((w <= WS) and

(h <= hs)) or

((w >= WS) and

(h >= hs))) then

//we do not handle a mix of up-and downscaling, //using threadsafe StretchBlt instead. begin

Src.Canvas.Lock; Dest.Canvas.Lock; try

SetStretchBltMode(Dest.Canvas.Handle, STRETCH_DELETESCANS); StretchBlt(Dest.Canvas.Handle, rd.Left, rd.Top, w, h, Src.Canvas.Handle, rs.Left, rs.Top, WS, hs, SRCCopy); finally

Dest.Canvas.Unlock; Src.Canvas.Unlock; end

; Exit; end

; if

pf = pf24bit then

begin

bitspp := 24; bytespp := 3; end

else

begin

bitspp := 32; bytespp := 4; end

; bs := (Src.Width * bitspp + 31) and

not

31; bs := bs div

8; //BytesPerScanline Source bd := (Dest.Width * bitspp + 31) and

not

31; bd := bd div

8; //BytesPerScanline Dest if

w < WS then

//downsample begin

//first make arrays of the skipsteps SetLength(xsteps, w); SetLength(ysteps, h); intscale := round(WS / w * $10000); x1 := 0; x2 := (intscale + $7FFF) shr

16; c := 0; for

i := 0 to

w - 1 do

begin

xsteps[i] := (x2 - x1) * bytespp; x1 := x2; x2 := ((i + 2) * intscale + $7FFF) shr

16; if

i = w - 2 then

c := x1; end

; xshift := min(max((WS - c) div

2, - rs.Left), Src.Width - rs.Right); intscale := round(hs / h * $10000); x1 := 0; x2 := (intscale + $7FFF) shr

16; c := 0; for

i := 0 to

h - 1 do

begin

ysteps[i] := (x2 - x1) * bs; x1 := x2; x2 := ((i + 2) * intscale + $7FFF) shr

16; if

i = h - 2 then

c := x1; end

; yshift := min(max((hs - c) div

2, - rs.Top), Src.Height - rs.Bottom); if

pf = pf24bit then

begin

Rows := @PRGBArray(Src.Scanline[rs.Top + yshift])^[rs.Left + xshift]; rowd := @PRGBArray(Dest.Scanline[rd.Top])^[rd.Left]; for

y := 0 to

h - 1 do

begin

ts := Rows; td := rowd; for

x := 0 to

w - 1 do

begin

pRGBTriple(td)^ := pRGBTriple(ts)^; Inc(td, bytespp); Inc(ts, xsteps[x]); end

; Dec(rowd, bd); Dec(Rows, ysteps[y]); end

; end

else

begin

Rows := @PQuadArray(Src.Scanline[rs.Top + yshift])^[rs.Left + xshift]; rowd := @PQuadArray(Dest.Scanline[rd.Top])^[rd.Left]; for

y := 0 to

h - 1 do

begin

ts := Rows; td := rowd; for

x := 0 to

w - 1 do

begin

pRGBQuad(td)^ := pRGBQuad(ts)^; Inc(td, bytespp); Inc(ts, xsteps[x]); end

; Dec(rowd, bd); Dec(Rows, ysteps[y]); end

; end

; end

else

begin

//first make arrays of the steps of uniform pixels SetLength(xsteps, WS); SetLength(ysteps, hs); intscale := round(w / WS * $10000); x1 := 0; x2 := (intscale + $7FFF) shr

16; c := 0; for

i := 0 to

WS - 1 do

begin

xsteps[i] := x2 - x1; x1 := x2; x2 := ((i + 2) * intscale + $7FFF) shr

16; if

x2 > w then

x2 := w; if

i = WS - 1 then

c := x1; end

; if

c < w then

//>is now not possible begin

xshift := (w - c) div

2; yshift := w - c - xshift; xsteps[WS - 1] := xsteps[WS - 1] + xshift; xsteps[0] := xsteps[0] + yshift; end

; intscale := round(h / hs * $10000); x1 := 0; x2 := (intscale + $7FFF) shr

16; c := 0; for

i := 0 to

hs - 1 do

begin

ysteps[i] := (x2 - x1); x1 := x2; x2 := ((i + 2) * intscale + $7FFF) shr

16; if

x2 > h then

x2 := h; if

i = hs - 1 then

c := x1; end

; if

c < h then

begin

yshift := (h - c) div

2; ysteps[hs - 1] := ysteps[hs - 1] + yshift; yshift := h - c - yshift; ysteps[0] := ysteps[0] + yshift; end

; if

pf = pf24bit then

begin

Rows := @PRGBArray(Src.Scanline[rs.Top])^[rs.Left]; rowd := @PRGBArray(Dest.Scanline[rd.Top])^[rd.Left]; for

y := 0 to

hs - 1 do

begin

for

j := 1 to

ysteps[y] do

begin

ts := Rows; td := rowd; for

x := 0 to

WS - 1 do

begin

for

i := 1 to

xsteps[x] do

begin

pRGBTriple(td)^ := pRGBTriple(ts)^; Inc(td, bytespp); end

; Inc(ts, bytespp); end

; Dec(rowd, bd); end

; Dec(Rows, bs); end

; end

else

begin

Rows := @PQuadArray(Src.Scanline[rs.Top])^[rs.Left]; rowd := @PQuadArray(Dest.Scanline[rd.Top])^[rd.Left]; for

y := 0 to

hs - 1 do

begin

for

j := 1 to

ysteps[y] do

begin

ts := Rows; td := rowd; for

x := 0 to

WS - 1 do

begin

for

i := 1 to

xsteps[x] do

begin

pRGBQuad(td)^ := pRGBQuad(ts)^; Inc(td, bytespp); end

; Inc(ts, bytespp); end

; Dec(rowd, bd); end

; Dec(Rows, bs); end

; end

; end

; end

; end

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2024 - All Rights Reserved - www.delphirus.com