Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit2.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6 - (show annotations) (download) (as text)
Mon Jul 20 13:11:27 2015 UTC (8 years, 7 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 2801 byte(s)


1 unit Unit2;
2
3 interface
4
5 uses
6 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
7 System.Classes, Vcl.Graphics,
8 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ExtDlgs,
9 Vcl.Imaging.pngImage, Vcl.ComCtrls;
10
11 type
12 TForm2 = class(TForm)
13 ScrollBox1: TScrollBox;
14 Image1: TImage;
15 Button1: TButton;
16 Button2: TButton;
17 OpenPictureDialog1: TOpenPictureDialog;
18 SavePictureDialog1: TSavePictureDialog;
19 Edit1: TEdit;
20 Edit2: TEdit;
21 UpDown1: TUpDown;
22 UpDown2: TUpDown;
23 procedure Button1Click(Sender: TObject);
24 procedure Button2Click(Sender: TObject);
25 procedure Edit1Change(Sender: TObject);
26 private
27 { Private éŒž }
28 public
29 { Public éŒž }
30 end;
31
32 var
33 Form2: TForm2;
34
35 implementation
36
37 {$R *.dfm}
38
39 uses Unit3;
40
41 procedure TForm2.Button1Click(Sender: TObject);
42 var
43 bmp: TBitmap;
44 procedure LoadToBitmap(const FileName: string);
45 var
46 s: TPngImage;
47 t: TPicture;
48 begin
49 if ExtractFileExt(FileName) = '.png' then
50 begin
51 s := TPngImage.Create;
52 try
53 s.LoadFromFile(FileName);
54 bmp.Width:=s.Width;
55 bmp.Height:=s.Height;
56 s.Draw(bmp.Canvas,Rect(0,0,s.Width,s.Height));
57 finally
58 s.Free;
59 end;
60 end
61 else
62 begin
63 t:=TPicture.Create;
64 try
65 t.LoadFromFile(FileName);
66 bmp.Width:=t.Width;
67 bmp.Height:=t.Height;
68 bmp.Assign(t);
69 finally
70 t.Free;
71 end;
72 end;
73 end;
74
75 begin
76 if OpenPictureDialog1.Execute = true then
77 begin
78 bmp:=TBitmap.Create;
79 try
80 LoadToBitmap(OpenPictureDialog1.FileName);
81 Image1.Picture.Bitmap.Assign(bmp);
82 Form3.ClientWidth:=UpDown1.Position;
83 Form3.ClientHeight:=UpDown2.Position;
84 Form3.Show;
85 Form3.Image1.Picture.Bitmap.Assign(bmp);
86 finally
87 bmp.Free;
88 end;
89 end;
90 end;
91
92 procedure TForm2.Button2Click(Sender: TObject);
93 var
94 s: TBitmap;
95 begin
96 if SavePictureDialog1.Execute = true then
97 begin
98 s := TBitmap.Create;
99 try
100 s.Width := Form3.ClientWidth;
101 s.Height := Form3.ClientHeight;
102 SetStretchBltMode(s.Canvas.Handle,HALFTONE);
103 StretchBlt(s.Canvas.Handle,0,0,s.Width,s.Height,Image1.Picture.Bitmap.Canvas.Handle,
104 0,0,Image1.Picture.Bitmap.Width,Image1.Picture.Bitmap.Height,SRCCOPY);
105 s.SaveToFile(SavePictureDialog1.FileName);
106 finally
107 s.Free;
108 end;
109 end;
110 end;
111
112 procedure TForm2.Edit1Change(Sender: TObject);
113 var
114 i: integer;
115 s: TEdit;
116 begin
117 s:=Sender as TEdit;
118 i:=StrToIntDef(s.Text,100);
119 s.Text:=IntToStr(i);
120 if Sender = Edit1 then
121 Form3.ClientWidth:=i
122 else
123 Form3.ClientHeight:=i;
124 end;
125
126 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26