1 unit frmMainUnit;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 jpeg, // 这里是一些手工的引用
8 Dialogs, DB, ADODB, StdCtrls, DBCtrls, Mask, Grids, DBGrids, Buttons, Menus,
9 ExtCtrls, ExtDlgs;
10
11 type
12 TfrmMain = class(TForm)
13 ADOConnection1: TADOConnection;
14 ADOQuery1: TADOQuery;
15 DataSource1: TDataSource;
16 DBGrid1: TDBGrid;
17 DBEdit1: TDBEdit;
18 DBComboBox1: TDBComboBox;
19 Label1: TLabel;
20 Label2: TLabel;
21 DBEdit2: TDBEdit;
22 Label3: TLabel;
23 DBEdit3: TDBEdit;
24 Label4: TLabel;
25 DBEdit4: TDBEdit;
26 Label5: TLabel;
27 BitBtn1: TBitBtn;
28 BitBtn2: TBitBtn;
29 BitBtn3: TBitBtn;
30 Label8: TLabel;
31 Panel1: TPanel;
32 Image1: TImage;
33 PopupMenu1: TPopupMenu;
34 A1: TMenuItem;
35 N1: TMenuItem;
36 B1: TMenuItem;
37 N2: TMenuItem;
38 C1: TMenuItem;
39 p1: TOpenPictureDialog;
40 p2: TSavePictureDialog;
41 procedure FormCreate(Sender: TObject);
42 procedure ADOQuery1AfterPost(DataSet: TDataSet);
43 procedure ADOQuery1BeforeEdit(DataSet: TDataSet);
44 procedure ADOQuery1NewRecord(DataSet: TDataSet);
45 procedure BitBtn2Click(Sender: TObject);
46 procedure BitBtn1Click(Sender: TObject);
47 procedure BitBtn3Click(Sender: TObject);
48 procedure A1Click(Sender: TObject);
49 procedure ADOQuery1AfterScroll(DataSet: TDataSet);
50 procedure B1Click(Sender: TObject);
51 procedure C1Click(Sender: TObject);
52 procedure Image1DblClick(Sender: TObject);
53 private
54 { Private declarations }
55 function ShowImage(DataSet: TDataSet; FieldName: string; Image: TImage;
56 Panel: TPanel): Boolean;
57 public
58 { Public declarations }
59 end;
60
61 var
62 frmMain: TfrmMain;
63
64 implementation
65
66 {$R *.dfm}
67
68
69 function TfrmMain.ShowImage(DataSet: TDataSet; FieldName: string; Image:
70 TImage; Panel: TPanel): Boolean;
71 var
72 ms: TMemoryStream;
73 JI: TJpegImage;
74 begin
75 ms := TMemoryStream.Create;
76 JI := TJpegImage.Create;
77 try
78 try // 图片均以jpg格式保存，不支持使用dbimage，都在AfterScroll事件中读取。
79 TBlobField(DataSet.FieldByName(FieldName)).SaveToStream(ms);
80 if ms.Size > 0 then
81 begin
82 ms.Position := 0;
83 JI.LoadFromStream(ms);
84 Image.Picture.Bitmap.Assign(JI);
85 if (Image.Picture.Bitmap.Width > 119) or (Image.Picture.Bitmap.Width >
86 137) then
87 Image.Stretch := True
88 else
89 Image.Stretch := false;
90 Panel.Caption := '';
91 end
92 else
93 begin
94 Image.Picture := nil;
95 Panel.Caption := '无照片';
96 end;
97 finally
98 FreeAndNil(ms);
99 FreeAndNil(JI);
100 end;
101 result := True;
102 except
103 result := false;
104 end;
105 end;
106
107 procedure TfrmMain.A1Click(Sender: TObject);
108 var
109 ms: TMemoryStream;
110 JI: TJpegImage;
111 begin
112 if not ADOQuery1.Active then
113 exit;
114 if p1.Execute then
115 begin
116 ms := TMemoryStream.Create;
117 JI := TJpegImage.Create;
118 try // 图片读取后都转换成jpg格式并压缩后保存到数据库中。
119 if lowercase(ExtractFileExt(p1.FileName)) = '.bmp' then
120 begin
121 Image1.Picture.LoadFromFile(p1.FileName);
122 JI.Assign(Image1.Picture.Bitmap);
123 end
124 else
125 begin
126 JI.LoadFromFile(p1.FileName);
127 Image1.Picture.Bitmap.Assign(JI);
128 end;
129 JI.CompressionQuality := 75; // 图片压缩比，越低越不清楚。
130 JI.Compress;
131 JI.SaveToStream(ms);
132 if not(ADOQuery1.State in dsEditModes) then
133 ADOQuery1.Edit;
134 TBlobField(ADOQuery1.FieldByName('fphoto')).LoadFromStream(ms);
135 if (Image1.Picture.Bitmap.Width > 119) or (Image1.Picture.Bitmap.Height >
136 137) then
137 Image1.Stretch := True
138 else
139 Image1.Stretch := false;
140 Panel1.Caption := '';
141 finally
142 FreeAndNil(ms);
143 FreeAndNil(JI);
144 JI.Free;
145 end;
146 end;
147 end;
148
149 procedure TfrmMain.ADOQuery1AfterPost(DataSet: TDataSet);
150 begin // 保存或退出编辑状态时，显示为删除
151 BitBtn2.Caption := '删除 &D';
152 end;
153
154 procedure TfrmMain.ADOQuery1AfterScroll(DataSet: TDataSet);
155 begin
156 ShowImage(ADOQuery1, 'fphoto', Image1, Panel1);
157 end;
158
159 procedure TfrmMain.ADOQuery1BeforeEdit(DataSet: TDataSet);
160 begin // 进入编辑状态时，显示为取消
161 BitBtn2.Caption := '取消 &D';
162 end;
163
164 procedure TfrmMain.ADOQuery1NewRecord(DataSet: TDataSet);
165 begin // 这里处理新增
166 ADOQuery1.FieldByName('fsex').AsString := '男';
167 end;
168
169 procedure TfrmMain.B1Click(Sender: TObject);
170 begin
171 if not ADOQuery1.Active then
172 exit;
173 if ADOQuery1.State in dsEditModes then
174 exit;
175 if TBlobField(ADOQuery1.FieldByName('FPhoto')).IsNull then
176 exit; // 如果图片为空，就没必要继续了
177 if p2.Execute then
178 if ExtractFileExt(p2.FileName) = '' then
179 TBlobField(ADOQuery1.FieldByName('FPhoto'))
180 .SaveToFile(p2.FileName + '.jpg')
181 else
182 TBlobField(ADOQuery1.FieldByName('FPhoto')).SaveToFile(p2.FileName);
183 end;
184
185 procedure TfrmMain.BitBtn1Click(Sender: TObject);
186 begin
187 ADOQuery1.Append;
188 end;
189
190 procedure TfrmMain.BitBtn2Click(Sender: TObject);
191 begin
192 if ADOQuery1.State in dsEditModes then
193 ADOQuery1.Cancel
194 else
195 if Application.MessageBox('是否删除当前记录？', '提示信息', MB_OKCANCEL +
196 MB_ICONQUESTION + MB_DEFBUTTON2) = IDOK then
197 ADOQuery1.Delete;
198 ShowImage(ADOQuery1, 'fphoto', Image1, Panel1);
199 end;
200
201 procedure TfrmMain.BitBtn3Click(Sender: TObject);
202 begin
203 ADOQuery1.Post;
204 end;
205
206 procedure TfrmMain.C1Click(Sender: TObject);
207 begin
208 if not ADOQuery1.Active then
209 exit;
210 if TBlobField(ADOQuery1.FieldByName('fphoto')).IsNull then
211 exit;
212 if MessageBox(Application.Handle, '是否清除照片？', '提示信息',
213 MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2) = IDNO then
214 exit;
215 Image1.Picture := nil;
216 if not(ADOQuery1.State in dsEditModes) then
217 ADOQuery1.Edit;
218 TBlobField(ADOQuery1.FieldByName('fphoto')).Clear;
219 ShowImage(ADOQuery1, 'fphoto', Image1, Panel1);
220 end;
221
222 procedure TfrmMain.FormCreate(Sender: TObject);
223 begin
224 with ADOQuery1 do
225 begin
226 close;
227 sql.Text := 'select * from temployee';
228 Open;
229 end;
230 end;
231
232 procedure TfrmMain.Image1DblClick(Sender: TObject);
233 var
234 mPoint: TPoint;
235 begin
236 GetCursorPos(mPoint);
237 PopupMenu1.Popup(mPoint.X, mPoint.Y);
238 end;
239
240 end.
posted on
