Додатки

Додаток а код програми

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtDlgs, Menus, ExtCtrls, Buttons, ComCtrls, StdCtrls, Gauges;

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

OpenPictureDialog1: TOpenPictureDialog;

SavePictureDialog1: TSavePictureDialog;

N7: TMenuItem;

N8: TMenuItem;

ScrollBox1: TScrollBox;

Image1: TImage;

GroupBox1: TGroupBox;

Gauge1: TGauge;

ComboBox1: TComboBox;

ComboBox2: TComboBox;

StaticText1: TStaticText;

StaticText2: TStaticText;

StaticText3: TStaticText;

StaticText4: TStaticText;

procedure N2Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N5Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

i,j,k,n: Longint;

ColCount, t: integer;

Filename,s: string;

BM: TBitmap;

dx,dy: real;

implementation

{$R *.dfm}

procedure Interpolate(var bm: TBitMap; dx, dy: single);

var

bm1: TBitMap;

z1, z2: single;

k, k1, k2: single;

x1, y1: integer;

c: array [0..1, 0..1, 0..2] of byte;

res: array [0..2] of byte;

x, y: integer;

xp, yp: integer;

xo, yo: integer;

col: integer;

pix: TColor;

begin

Form1.Image1.AutoSize:=False;

bm1 := TBitMap.Create;

bm1.Width := round(bm.Width * dx);

bm1.Height := round(bm.Height * dy);

for y := 0 to bm1.Height - 1 do begin

for x := 0 to bm1.Width - 1 do begin

xo := trunc(x / dx)-t;

yo := trunc(y / dy)-t;

x1 := round(xo * dx)+t;

y1 := round(yo * dy)+t;

for yp := 0 to 1 do

for xp := 0 to 1 do begin

pix := BM.Canvas.Pixels[xo + xp, yo + yp];

c[xp, yp, 0] := GetRValue(pix);

c[xp, yp, 1] := GetGValue(pix);

c[xp, yp, 2] := GetBValue(pix);

end;

for col := 0 to 2 do begin

k1 := (c[1,0,col] - c[0,0,col]) / dx;

z1 := x * k1 + c[0,0,col] - x1 * k1;

k2 := (c[1,1,col] - c[0,1,col]) / dx;

z2 := x * k2 + c[0,1,col] - x1 * k2;

k := (z2 - z1) / dy;

res[col] := round(y * k + z1 - y1 * k);

end;

bm1.Canvas.Pixels[x,y] := RGB(res[0], res[1], res[2]);

end;

Form1.Gauge1.Progress := round(100 * y / bm1.Height);

Application.ProcessMessages;

if Application.Terminated then Exit;

end;

Form1.Gauge1.Progress :=0;

Form1.Image1.Width:=BM1.Width;

Form1.Image1.Height:=Bm1.Height;

Form1.Image1.Picture.Graphic:=BM1;

end;

procedure TForm1.N2Click(Sender: TObject);

begin

Bm:=Tbitmap.Create;

Image1.AutoSize:=True;

If OpenPictureDialog1.Execute then begin

Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);

BM.LoadFromFile(OpenPictureDialog1.FileName);

end;

end;

procedure TForm1.N4Click(Sender: TObject);

begin

SavePictureDialog1.FileName := FileName;

If not SavePictureDialog1.Execute then exit;

FileName := SavePictureDialog1.FileName;

ColCount := Pos ('.', FileName);

if ColCount <= 0 then s := '.bmp';

FileName := FileName + s;

Image1.Picture.SaveToFile(FileName);

end;

procedure TForm1.N5Click(Sender: TObject);

begin

Close;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

BM.free;

end;

procedure TForm1.N7Click(Sender: TObject);

begin

try

dx:=strtofloat(Combobox1.Text) / 100;

dy:=strtofloat(Combobox2.Text) / 100;

t:=0;

if (dx>0.5) and (dx<0.76) and (dy>0.5) and (dy<0.76) then t:=1

else if (dx>0.6) and (dx<0.84) and (dy>0.76) and (dy<0.84) then t:=2

else if (dx>0.84) and (dx<0.88) and (dy>0.84) and (dy<0.88) then t:=3;

Interpolate(bm, dx, dy);

except

Showmessage('Ошибка: Загрузите изображение, или введите корректное значение масштаба');

exit;

end;

end;

procedure TForm1.N8Click(Sender: TObject);

begin

Form1.Image1.Width:=BM.Width;

Form1.Image1.Height:=Bm.Height;

Form1.Image1.Picture.Graphic:=BM;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

dx:= 1.0;

dy:= 1.0;

end;

end.