📄 unit12.~pas
字号:
unit Unit12;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtDlgs, ComCtrls, ExtCtrls;
type
tproceduce=procedure;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
SavePictureDialog1: TSavePictureDialog;
OpenPictureDialog1: TOpenPictureDialog;
ScrollBox1: TScrollBox;
N1: TMenuItem;
Image1: TImage;
ProgressBar1: TProgressBar;
StatusBar1: TStatusBar;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N3001: TMenuItem;
N4001: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
N25: TMenuItem;
N26: TMenuItem;
N27: TMenuItem;
N28: TMenuItem;
N29: TMenuItem;
N30: TMenuItem;
N31: TMenuItem;
N32: TMenuItem;
N33: TMenuItem;
N34: TMenuItem;
N35: TMenuItem;
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure N14Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N3001Click(Sender: TObject);
procedure N4001Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N18Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N19Click(Sender: TObject);
procedure N20Click(Sender: TObject);
procedure N23Click(Sender: TObject);
procedure N24Click(Sender: TObject);
procedure N26Click(Sender: TObject);
procedure N27Click(Sender: TObject);
procedure N28Click(Sender: TObject);
procedure N29Click(Sender: TObject);
procedure N30Click(Sender: TObject);
procedure N31Click(Sender: TObject);
procedure N32Click(Sender: TObject);
procedure N33Click(Sender: TObject);
procedure N34Click(Sender: TObject);
private
imageload:boolean;
pixels:array of byte;
procedure zoomshow(k:integer);
procedure updatearray();
procedure updateimage();
procedure backup();
{ Private declarations }
public
w,h:integer;
mbdragging:boolean;
backupw,backuph:integer;
backuparray:array of byte;
{ type
trect = packed record
case integer of
0:(left,top,right,bottom:integer);
1:(topleft,bottomright:tpoint);
end; }
{ Public declarations }
end;
var
Form1: TForm1;
frect:trect;
showscale:integer;
{ type
{ trect = packed record
case integer of
0:(left,top,right,bottom:integer);
1:(topleft,bottomright:tpoint);
end; }
implementation
uses unitsize,unitbrightness;
{$R *.dfm}
procedure TForm1.N2Click(Sender: TObject);
var
ext:string;
i:integer;
frect:trect;
showscale:integer;
begin
openpicturedialog1.Title:='请选择图象文件';
openpicturedialog1.DefaultExt:=graphicextension(tbitmap);
openpicturedialog1.Filter:=graphicfilter(tbitmap);
if openpicturedialog1.Execute then
begin
ext:=uppercase(extractfileext(openpicturedialog1.FileName));
image1.Picture.LoadFromFile(form1.OpenPictureDialog1.filename);
imageload:=true;
w:=image1.Picture.Width;
h:=image1.picture.Height;
image1.Width:=w;
image1.Height:=h;
image1.Picture.Bitmap.PixelFormat:=pf24bit;
setlength(pixels,w*h*3);
for i:=0 to h-1 do
move(image1.Picture.Bitmap.scanline[i]^,pixels[i*w*3],w*3);
imageload:=true;
// with mainmenue1 do
//begin
// items[0].
frect:=rect(0,0,0,0);
showscale:=1;
end;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
image1.Picture.SaveToFile(form1.OpenPictureDialog1.FileName);
end;
procedure TForm1.N4Click(Sender: TObject);
var
ext:string;
begin
savepicturedialog1.DefaultExt:=graphicextension(tbitmap);
if savepicturedialog1.Execute then
begin
ext:=uppercase(extractfileext(savepicturedialog1.FileName));
if ext='.bmp' then
image1.Picture.SaveToFile(savepicturedialog1.FileName);
end;
end;
procedure TForm1.N6Click(Sender: TObject);
begin
close();
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
imageload:=false;
//with mainmenu1 do
//begin
// items[0].Items[1].Enabled:=false;
// items[0].Items[2].Enabled:=false;
/// for i:=1 to items.count-1 do
// items[i].Enabled:=false;
// end;
image1.Width:=0;
image1.Height:=0;
mbdragging:=false;
scrollbox1.DoubleBuffered:=true;
end;
procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
scrollbox1.Width:=form1.Width-20;
scrollbox1.Height:=form1.Height-63;
progressbar1.Top:=form1.Height-63;
if(form1.Width>350)then
statusbar1.Panels.Items[1].Width:=form1.Width-350
else
statusbar1.Panels.Items[1].Width:=0;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if imageload then
begin
statusbar1.Panels[2].Text:='x:'+inttostr(x);
statusbar1.Panels[3].Text:='y:'+inttostr(y);
end;
end;
procedure tform1.zoomshow(k:integer);
var
y,x,i,j:integer;
temp:array of byte;
begin
//if not isrectclear(frect) then
// begin
image1.Canvas.DrawFocusRect(frect);
if (k=1)then
begin
image1.Picture.Bitmap.Width:=w;
image1.Picture.Bitmap.Height:=h;
for y:=0 TO h-1 do
move(pixels[y*w*3],image1.picture.bitmap.scanline[y]^,w*3);
image1.Repaint;
end
else begin
progressbar1.Position:=0;
setlength(temp,w*h*h*k*3);
for y:=h-1 downto 0 do
begin
for x:=w-1 downto 0 do
for i:= 0 to k-1 do
for j:=0 to k-1 do
move(pixels[(y*w+x)*3],temp[((y*k+i)*k*w+x*k+j)*3],3);
end;
progressbar1.Position:=0;
image1.Picture.Bitmap.Width:=w*k;
image1.Picture.Bitmap.Height:=h*k;
for y:=0 to h*k-1 do
move(temp[y*w*k*3],image1.picture.bitmap.scanline[y]^,w*k*3);
image1.Repaint;
end;
end;
procedure tform1.backup();
var i:integer;
begin
backupw:=w;
backuph:=h;
setlength(backuparray,length(pixels));
for i:=0 to length(pixels)-1 do
backuparray[i]:=pixels[i];
end;
procedure TForm1.N14Click(Sender: TObject);
var
x,y,pos:integer;
temp:array of byte;
begin
backup();
progressbar1.Position:=0;
setlength(temp,length(pixels));
for y:=1 to h-2 do
begin
for x:=3 to w*3-4 do
begin
pos:=y*w*3+x;
temp[pos]:=trunc((pixels[pos-w*3]+pixels[pos-3]+pixels[pos]+pixels[pos+3]+pixels[pos+w*3])/5);
end;
progressbar1.Position:=trunc(100*y/(h-1));
end;
for y:=1 to h-2 do
for x:=3 to w*3-4 do
pixels[y*w*3+x]:=temp[y*w*3+x];
progressbar1.Position:=0;
updateimage;
end;
procedure TForm1.N11Click(Sender: TObject);
begin
showscale:=1;
zoomshow(1);
end;
procedure TForm1.N12Click(Sender: TObject);
begin
showscale:=2;
zoomshow(2);
end;
procedure TForm1.N3001Click(Sender: TObject);
begin
showscale:=4;
zoomshow(4);
end;
procedure TForm1.N4001Click(Sender: TObject);
begin
showscale:=8;
zoomshow(8);
end;
procedure tform1.updatearray();
var
y,x,k:integer;
tw,th:integer;
temp:array of byte;
begin
w:=image1.Picture.Width;
h:=image1.Picture.Height;
setlength(pixels,w*h*3);
// for y:=0 to h-1 do
// move(image1.Picture.Bitmap.scanline[y]^,temp[y*w*3],w*3);
// image1.Refresh;
// end
//else begin
tw:=image1.Picture.Width;
th:=image1.Picture.Height;
setlength(temp,tw*h*3);
for y:=0 to th-1 do
move(image1.Picture.Bitmap.scanline[y]^,temp[y*tw*3],tw*3);
w:=tw div k;
h:=th div k;
setlength(pixels,w*h*3);
for y:=0 to h-1 do
for x:=0 to w-1 do
move(temp[((y*k)*w*k+x*k)*3],pixels[(y*w+x)*3],3);
end;
procedure tform1.updateimage();
begin
zoomshow(showscale);
end;
procedure TForm1.N15Click(Sender: TObject);
var
x,y,pos:integer;
temp:array of byte;
val:integer;
begin
backup();
progressbar1.Position:=0;
setlength(temp,length(pixels));
for y:=1 to h-2 do
begin
for x:=3 to w*3-4 do
begin
pos:=y*w*3+x;
val:=trunc((pixels[pos]*12-pixels[pos-w*3-3]-pixels[pos-w*3]-pixels[pos-w*3+3]-pixels[pos-3]-pixels[pos+3]-pixels[pos+w*3-3]-pixels[pos+w*3]-pixels[pos+w*3+3])/4);
if val>255 then
temp[pos]:=255
else if val<0 then
temp[pos]:=0
else
temp[pos]:=val;
end;
progressbar1.Position:=trunc(100*y/(h-1));
end;
for y:=1 to h-2 do
for x:=3 to w*3-4 do
pixels[y*w*3+x]:=temp[y*w*3+x];
progressbar1.Position:=0;
updateimage();
end;
procedure TForm1.N18Click(Sender: TObject);
var
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -