Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit11.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 15 - (show annotations) (download) (as text)
Fri Aug 5 10:33:26 2016 UTC (7 years, 8 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 6746 byte(s)
TDataSetNotifyEventの切り替え方法がはっきりわかりませんでしたが適当に実装しました。
1 unit Unit11;
2
3 interface
4
5 uses
6 Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWDBStdCtrls,
7 Vcl.Controls, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl,
8 IWCompEdit, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout,
9 IWContainerLayout, IWTemplateProcessorHTML, IWCompExtCtrls, IWDBExtCtrls,
10 IWCompButton, Vcl.Dialogs, Data.DB,
11 IWCompText, FireDAC.UI.Intf, FireDAC.VCLUI.Login, FireDAC.Stan.Intf,
12 FireDAC.Comp.UI, IWCompGrids, Vcl.Forms, IWVCLBaseContainer,
13 IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWCompLabel,
14 Vcl.Imaging.pngimage;
15
16 type
17 TAdminFile = class(TIWAppForm)
18 IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
19 IWGrid1: TIWGrid;
20 IWImage1: TIWImage;
21 IWDBText1: TIWDBText;
22 IWDBEdit6: TIWDBEdit;
23 IWDBEdit5: TIWDBEdit;
24 IWButton1: TIWButton;
25 IWDBNavigator1: TIWDBNavigator;
26 IWDBEdit4: TIWDBEdit;
27 IWDBEdit3: TIWDBEdit;
28 IWDBEdit2: TIWDBEdit;
29 IWDBEdit1: TIWDBEdit;
30 FDGUIxLoginDialog1: TFDGUIxLoginDialog;
31 FileOpenDialog1: TFileOpenDialog;
32 IWRegion1: TIWRegion;
33 IWLabel1: TIWLabel;
34 IWLabel2: TIWLabel;
35 IWLabel3: TIWLabel;
36 IWLabel4: TIWLabel;
37 IWLabel5: TIWLabel;
38 IWLabel6: TIWLabel;
39 IWButton2: TIWButton;
40 procedure IWAppFormCreate(Sender: TObject);
41 procedure IWButton1Click(Sender: TObject);
42 procedure IWDBNavigator1BeforeAction(Sender: TObject;
43 NavButton: TNavigateBtn; var Handled: Boolean);
44 procedure IWButton2Click(Sender: TObject);
45 procedure IWAppFormDestroy(Sender: TObject);
46 procedure IWDBNavigator1Post(Sender: TObject);
47 procedure IWGrid1Render(Sender: TObject);
48 procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
49 procedure IWDBNavigator1Insert(Sender: TObject);
50 private
51 serial: Integer;
52 dummy: TComponent;
53 png: TPngImage;
54 procedure Local(DataSet: TDataSet);
55 procedure ReadPng(DataSet: TDataSet);
56 public
57 end;
58
59 implementation
60
61 {$R *.dfm}
62
63 uses Unit3;
64
65 procedure TAdminFile.IWAppFormCreate(Sender: TObject);
66 begin
67 if DM.FDTable7.Locate('NUMBER', 1) = true then
68 begin
69 png := TPngImage.Create;
70 with DM.FDTableView do
71 begin
72 AfterScroll := Local;
73 AfterEdit := ReadPng;
74 AfterInsert := ReadPng;
75 Filter := 'MASTER = ' + QuotedStr(DM.FDTable7.FieldByName('NUMBER')
76 .AsString);
77 end;
78 DM.FDQuery1.Open('select MAX(serial) as serial from item_data;');
79 serial := DM.FDQuery1.FieldByName('SERIAL').AsInteger;
80 DM.FDQuery1.SQL.Clear;
81 DM.FDQuery1.SQL.Add('select * from item_data where master = :num;');
82 DM.FDQuery1.ParamByName('NUM').AsInteger :=
83 DM.FDTable7.FieldByName('NUMBER').AsInteger;
84 DM.FDQuery1.Open;
85 Local(nil);
86 end
87 else
88 Release;
89 end;
90
91 procedure TAdminFile.IWAppFormDestroy(Sender: TObject);
92 begin
93 png.Free;
94 dummy.Free;
95 end;
96
97 procedure TAdminFile.IWButton1Click(Sender: TObject);
98 begin
99 if FileOpenDialog1.Execute = true then
100 begin
101 IWImage1.Picture.LoadFromFile(FileOpenDialog1.FileName);
102 DM.FDTableView.Edit;
103 end;
104 end;
105
106 procedure TAdminFile.IWButton2Click(Sender: TObject);
107 begin
108 Release;
109 end;
110
111 procedure TAdminFile.IWDBNavigator1BeforeAction(Sender: TObject;
112 NavButton: TNavigateBtn; var Handled: Boolean);
113 var
114 s: TStream;
115 begin
116 case NavButton of
117 nbPost:
118 begin
119 DM.FDTableView.FieldByName('MASTER').AsInteger :=
120 DM.FDTable7.FieldByName('NUMBER').AsInteger;
121 if Assigned(IWImage1.Picture.Graphic) = true then
122 begin
123 s := DM.FDTableView.CreateBlobStream
124 (DM.FDTableView.FieldByName('IMAGE'), bmWrite);
125 try
126 IWImage1.Picture.Graphic.SaveToStream(s);
127 finally
128 s.Free;
129 end;
130 s := DM.FDTableView.CreateBlobStream
131 (DM.FDTableView.FieldByName('THUMBNAIL'), bmWrite);
132 try
133 IWImage1.Picture.Graphic.SaveToStream(s);
134 finally
135 s.Free;
136 end;
137 end;
138 inc(serial);
139 end;
140 else
141 if DM.FDTableView.State = dsInsert then
142 DM.FDTableView.Delete;
143 end;
144 end;
145
146 procedure TAdminFile.IWDBNavigator1Insert(Sender: TObject);
147 begin
148 DM.FDTableView.FieldByName('SERIAL').AsInteger := serial + 1;
149 end;
150
151 procedure TAdminFile.IWDBNavigator1Post(Sender: TObject);
152 begin
153 DM.FDTable2.Refresh;
154 DM.FDQuery1.Refresh;
155 IWGrid1Render(nil);
156 end;
157
158 procedure TAdminFile.IWGrid1CellClick(ASender: TObject;
159 const ARow, AColumn: Integer);
160 begin
161 DM.FDTableView.Locate('SERIAL', Integer(IWGrid1.Cell[ARow, AColumn].Tag));
162 end;
163
164 procedure TAdminFile.IWGrid1Render(Sender: TObject);
165 var
166 i, j, k: Integer;
167 s: TIWImage;
168 t: TStream;
169 ACell: TIWGridCell;
170 begin
171 k := DM.FDTableView.FieldByName('SERIAL').AsInteger;
172 IWGrid1.ColumnCount := 5;
173 i := DM.FDQuery1.RecordCount div IWGrid1.ColumnCount;
174 if i = 0 then
175 IWGrid1.ColumnCount := DM.FDQuery1.RecordCount;
176 if DM.FDQuery1.RecordCount mod IWGrid1.ColumnCount >= 0 then
177 inc(i);
178 IWGrid1.RowCount := i;
179 dummy := TComponent.Create(IWGrid1);
180 DM.FDQuery1.First;
181 for i := 0 to IWGrid1.RowCount - 1 do
182 for j := 0 to IWGrid1.ColumnCount - 1 do
183 begin
184 if DM.FDQuery1.Eof = true then
185 Exit;
186 s := TIWImage.Create(dummy);
187 ACell := IWGrid1.Cell[i, j];
188 ACell.Control := s;
189 t := DM.FDQuery1.CreateBlobStream
190 (DM.FDQuery1.FieldByName('THUMBNAIL'), bmRead);
191 try
192 png.LoadFromStream(t);
193 finally
194 t.Free;
195 end;
196 s.Picture.Assign(png);
197 ACell.Text := DM.FDQuery1.FieldByName('NAME').AsString;
198 ACell.Tag := Pointer(DM.FDQuery1.FieldByName('SERIAL').AsInteger);
199 ACell.Clickable := k <> DM.FDQuery1.FieldByName('SERIAL').AsInteger;
200 DM.FDQuery1.Next;
201 end;
202 end;
203
204 procedure TAdminFile.Local(DataSet: TDataSet);
205 var
206 s: TStream;
207 begin
208 s := DM.FDTableView.CreateBlobStream
209 (DM.FDTableView.FieldByName('THUMBNAIL'), bmRead);
210 try
211 png.LoadFromStream(s);
212 finally
213 s.Free;
214 end;
215 IWImage1.Picture.Assign(png);
216 end;
217
218 procedure TAdminFile.ReadPng(DataSet: TDataSet);
219 var
220 s: TStream;
221 begin
222 if (DM.FDTableView.FieldByName('THUMBNAIL').IsNull = true) and
223 (FileOpenDialog1.Execute = true) then
224 begin
225 png.LoadFromFile(FileOpenDialog1.FileName);
226 s := DM.FDTableView.CreateBlobStream
227 (DM.FDTableView.FieldByName('THUMBNAIL'), bmWrite);
228 try
229 png.SaveToStream(s);
230 finally
231 s.Free;
232 end;
233 IWImage1.Picture.Assign(png);
234 end;
235 end;
236
237 end.

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