Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit2.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6 - (hide 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 yamat0jp 6 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