Develop and Download Open Source Software

zencart-clone

Browse Subversion Repository

/[zencart-clone]/Unit11.pas

Diff of /Unit11.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 15 by yamat0jp, Fri Aug 5 10:33:26 2016 UTC revision 18 by yamat0jp, Sat Aug 27 11:00:30 2016 UTC
# Line 7  uses Line 7  uses
7    Vcl.Controls, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl,    Vcl.Controls, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl,
8    IWCompEdit, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout,    IWCompEdit, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout,
9    IWContainerLayout, IWTemplateProcessorHTML, IWCompExtCtrls, IWDBExtCtrls,    IWContainerLayout, IWTemplateProcessorHTML, IWCompExtCtrls, IWDBExtCtrls,
10    IWCompButton, Vcl.Dialogs, Data.DB,    IWCompButton, Vcl.Dialogs, Data.DB, Graphics,
11    IWCompText, FireDAC.UI.Intf, FireDAC.VCLUI.Login, FireDAC.Stan.Intf,    IWCompText, FireDAC.UI.Intf, FireDAC.VCLUI.Login, FireDAC.Stan.Intf,
12    FireDAC.Comp.UI, IWCompGrids, Vcl.Forms, IWVCLBaseContainer,    FireDAC.Comp.UI, IWCompGrids, Vcl.Forms, IWVCLBaseContainer,
13    IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWCompLabel,    IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWCompLabel,
14    Vcl.Imaging.pngimage;    Vcl.Imaging.pngimage, IWCompFileUploader, IWCompCheckbox, FireDAC.Stan.Option,
15      FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
16      FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, FireDAC.Comp.DataSet,
17      FireDAC.Comp.Client, IWDBGrids;
18    
19  type  type
20    TAdminFile = class(TIWAppForm)    TAdminFile = class(TIWAppForm)
21      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
22      IWGrid1: TIWGrid;      IWGrid1: TIWGrid;
     IWImage1: TIWImage;  
23      IWDBText1: TIWDBText;      IWDBText1: TIWDBText;
24      IWDBEdit6: TIWDBEdit;      IWDBEdit6: TIWDBEdit;
25      IWDBEdit5: TIWDBEdit;      IWDBEdit5: TIWDBEdit;
# Line 27  type Line 29  type
29      IWDBEdit3: TIWDBEdit;      IWDBEdit3: TIWDBEdit;
30      IWDBEdit2: TIWDBEdit;      IWDBEdit2: TIWDBEdit;
31      IWDBEdit1: TIWDBEdit;      IWDBEdit1: TIWDBEdit;
     FDGUIxLoginDialog1: TFDGUIxLoginDialog;  
     FileOpenDialog1: TFileOpenDialog;  
32      IWRegion1: TIWRegion;      IWRegion1: TIWRegion;
33      IWLabel1: TIWLabel;      IWLabel1: TIWLabel;
34      IWLabel2: TIWLabel;      IWLabel2: TIWLabel;
# Line 37  type Line 37  type
37      IWLabel5: TIWLabel;      IWLabel5: TIWLabel;
38      IWLabel6: TIWLabel;      IWLabel6: TIWLabel;
39      IWButton2: TIWButton;      IWButton2: TIWButton;
40        IWFileUploader1: TIWFileUploader;
41        IWImage1: TIWImage;
42        FileOpenDialog1: TFileOpenDialog;
43        IWButton3: TIWButton;
44        IWDBCheckBox1: TIWDBCheckBox;
45        IWDBGrid1: TIWDBGrid;
46        FDQuery1: TFDQuery;
47        DataSource1: TDataSource;
48      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
49      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
50      procedure IWDBNavigator1BeforeAction(Sender: TObject;      procedure IWDBNavigator1BeforeAction(Sender: TObject;
# Line 47  type Line 55  type
55      procedure IWGrid1Render(Sender: TObject);      procedure IWGrid1Render(Sender: TObject);
56      procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);      procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
57      procedure IWDBNavigator1Insert(Sender: TObject);      procedure IWDBNavigator1Insert(Sender: TObject);
58        procedure IWButton3Click(Sender: TObject);
59        procedure IWDBNavigator1Delete(Sender: TObject);
60        procedure IWDBNavigator1Edit(Sender: TObject);
61    private    private
62      serial: Integer;      serial: Integer;
63      dummy: TComponent;      dummy: TComponent;
     png: TPngImage;  
64      procedure Local(DataSet: TDataSet);      procedure Local(DataSet: TDataSet);
     procedure ReadPng(DataSet: TDataSet);  
65    public    public
66    end;    end;
67    
# Line 60  implementation Line 69  implementation
69    
70  {$R *.dfm}  {$R *.dfm}
71    
72  uses Unit3;  uses Unit3, ServerController;
73    
74  procedure TAdminFile.IWAppFormCreate(Sender: TObject);  procedure TAdminFile.IWAppFormCreate(Sender: TObject);
75  begin  begin
76      DM.FDTable2.Filtered := false;
77      FDQuery1.Open;
78    if DM.FDTable7.Locate('NUMBER', 1) = true then    if DM.FDTable7.Locate('NUMBER', 1) = true then
79    begin    begin
     png := TPngImage.Create;  
80      with DM.FDTableView do      with DM.FDTableView do
81      begin      begin
82        AfterScroll := Local;        AfterScroll := Local;
       AfterEdit := ReadPng;  
       AfterInsert := ReadPng;  
83        Filter := 'MASTER = ' + QuotedStr(DM.FDTable7.FieldByName('NUMBER')        Filter := 'MASTER = ' + QuotedStr(DM.FDTable7.FieldByName('NUMBER')
84          .AsString);          .AsString);
85      end;      end;
86      DM.FDQuery1.Open('select MAX(serial) as serial from item_data;');      DM.FDQuery1.Open('select MAX(serial) as serial from item_data;');
87      serial := DM.FDQuery1.FieldByName('SERIAL').AsInteger;      serial := DM.FDQuery1.Fields[0].AsInteger;
88      DM.FDQuery1.SQL.Clear;      DM.FDQuery1.SQL.Clear;
89      DM.FDQuery1.SQL.Add('select * from item_data where master = :num;');      DM.FDQuery1.SQL.Add
90          ('select * from item_data where master = :num and agree = true;');
91      DM.FDQuery1.ParamByName('NUM').AsInteger :=      DM.FDQuery1.ParamByName('NUM').AsInteger :=
92        DM.FDTable7.FieldByName('NUMBER').AsInteger;        DM.FDTable7.FieldByName('NUMBER').AsInteger;
93      DM.FDQuery1.Open;      DM.FDQuery1.Open;
# Line 90  end; Line 99  end;
99    
100  procedure TAdminFile.IWAppFormDestroy(Sender: TObject);  procedure TAdminFile.IWAppFormDestroy(Sender: TObject);
101  begin  begin
   png.Free;  
102    dummy.Free;    dummy.Free;
103      FDQuery1.Close;
104      DM.FDTable2.Filtered := true;
105  end;  end;
106    
107  procedure TAdminFile.IWButton1Click(Sender: TObject);  procedure TAdminFile.IWButton1Click(Sender: TObject);
108    var
109      s: TBitmap;
110      t: TPicture;
111  begin  begin
112    if FileOpenDialog1.Execute = true then    if FileOpenDialog1.Execute = true then
113    begin    begin
114      IWImage1.Picture.LoadFromFile(FileOpenDialog1.FileName);      IWImage1.Picture.LoadFromFile(FileOpenDialog1.FileName);
115      DM.FDTableView.Edit;      DM.FDTableView.Edit;
116        UserSession.ImgToField(IWImage1.Picture,
117          DM.FDTableView.FieldByName('IMAGE'));
118        s := TBitmap.Create;
119        t := TPicture.Create;
120        try
121          s.Width := 50;
122          s.Height := 50;
123          s.Canvas.StretchDraw(Rect(0, 0, 50, 50), IWImage1.Picture.Graphic);
124          t.Assign(s);
125          UserSession.ImgToField(t, DM.FDTableView.FieldByName('THUMBNAIL'));
126        finally
127          s.Free;
128          t.Free;
129        end;
130    end;    end;
131  end;  end;
132    
133  procedure TAdminFile.IWButton2Click(Sender: TObject);  procedure TAdminFile.IWButton2Click(Sender: TObject);
134  begin  begin
135      DM.FDTableView.AfterScroll := nil;
136    Release;    Release;
137  end;  end;
138    
139    procedure TAdminFile.IWButton3Click(Sender: TObject);
140    begin
141      IWImage1.Picture.Assign(nil);
142      DM.FDTableView.Edit;
143    end;
144    
145  procedure TAdminFile.IWDBNavigator1BeforeAction(Sender: TObject;  procedure TAdminFile.IWDBNavigator1BeforeAction(Sender: TObject;
146    NavButton: TNavigateBtn; var Handled: Boolean);    NavButton: TNavigateBtn; var Handled: Boolean);
 var  
   s: TStream;  
147  begin  begin
148    case NavButton of    case NavButton of
149      nbPost:      nbPost:
150        begin        begin
151          DM.FDTableView.FieldByName('MASTER').AsInteger :=          DM.FDTableView.FieldByName('MASTER').AsInteger :=
152            DM.FDTable7.FieldByName('NUMBER').AsInteger;            DM.FDTable7.FieldByName('NUMBER').AsInteger;
         if Assigned(IWImage1.Picture.Graphic) = true then  
         begin  
           s := DM.FDTableView.CreateBlobStream  
             (DM.FDTableView.FieldByName('IMAGE'), bmWrite);  
           try  
             IWImage1.Picture.Graphic.SaveToStream(s);  
           finally  
             s.Free;  
           end;  
           s := DM.FDTableView.CreateBlobStream  
             (DM.FDTableView.FieldByName('THUMBNAIL'), bmWrite);  
           try  
             IWImage1.Picture.Graphic.SaveToStream(s);  
           finally  
             s.Free;  
           end;  
         end;  
153          inc(serial);          inc(serial);
154        end;        end;
155    else      nbDelete:
156      if DM.FDTableView.State = dsInsert then        if DM.FDTable2.Locate('SERIAL', DM.FDQuery1.FieldByName('SERIAL').AsInteger) = true then
157        DM.FDTableView.Delete;        begin
158            DM.FDTable2.Edit;
159            DM.FDTable2.FieldByName('SERIAL').AsInteger := -1;
160            DM.FDTable2.FieldByName('AGREE').AsBoolean := false;
161            DM.FDTable2.Post;
162            Handled := true;
163            DM.FDTable2.Refresh;
164            IWDBNavigator1Delete(Sender);
165            IWDBGrid1.Refresh;
166          end;
167        else
168          if DM.FDTableView.State = dsInsert then
169            DM.FDTableView.Delete
170          else if DM.FDTableView.State = dsEdit then
171            DM.FDTableView.Cancel;
172    end;    end;
173  end;  end;
174    
175    procedure TAdminFile.IWDBNavigator1Delete(Sender: TObject);
176    begin
177      DM.FDTableView.Refresh;
178      DM.FDQuery1.Refresh;
179      FDQuery1.Refresh;
180      IWGrid1Render(nil);
181    end;
182    
183    procedure TAdminFile.IWDBNavigator1Edit(Sender: TObject);
184    begin
185      if DM.FDTableView.State = dsInsert then
186        IWDBNavigator1Insert(Sender);
187    end;
188    
189  procedure TAdminFile.IWDBNavigator1Insert(Sender: TObject);  procedure TAdminFile.IWDBNavigator1Insert(Sender: TObject);
190  begin  begin
191      IWImage1.Picture.Assign(nil);
192    DM.FDTableView.FieldByName('SERIAL').AsInteger := serial + 1;    DM.FDTableView.FieldByName('SERIAL').AsInteger := serial + 1;
193  end;  end;
194    
195  procedure TAdminFile.IWDBNavigator1Post(Sender: TObject);  procedure TAdminFile.IWDBNavigator1Post(Sender: TObject);
196    var
197      i: Integer;
198  begin  begin
199    DM.FDTable2.Refresh;    DM.FDTable2.Refresh;
200      if DM.FDTable2.Locate('SERIAL', serial) = true then
201      begin
202        DM.FDTable2.Edit;
203        DM.FDTable2.FieldByName('AGREE').AsBoolean := false;
204        DM.FDTable2.Post;
205      end;
206      DM.FDTableView.Refresh;
207    DM.FDQuery1.Refresh;    DM.FDQuery1.Refresh;
208      FDQuery1.Refresh;
209    IWGrid1Render(nil);    IWGrid1Render(nil);
210  end;  end;
211    
212  procedure TAdminFile.IWGrid1CellClick(ASender: TObject;  procedure TAdminFile.IWGrid1CellClick(ASender: TObject;
213    const ARow, AColumn: Integer);    const ARow, AColumn: Integer);
214  begin  begin
215      if DM.FDTableView.State = dsEdit then
216        DM.FDTableView.Cancel;
217    DM.FDTableView.Locate('SERIAL', Integer(IWGrid1.Cell[ARow, AColumn].Tag));    DM.FDTableView.Locate('SERIAL', Integer(IWGrid1.Cell[ARow, AColumn].Tag));
218  end;  end;
219    
# Line 165  procedure TAdminFile.IWGrid1Render(Sende Line 221  procedure TAdminFile.IWGrid1Render(Sende
221  var  var
222    i, j, k: Integer;    i, j, k: Integer;
223    s: TIWImage;    s: TIWImage;
   t: TStream;  
224    ACell: TIWGridCell;    ACell: TIWGridCell;
225  begin  begin
226    k := DM.FDTableView.FieldByName('SERIAL').AsInteger;    k := DM.FDTableView.FieldByName('SERIAL').AsInteger;
227    IWGrid1.ColumnCount := 5;    IWGrid1.ColumnCount := 5;
228    i := DM.FDQuery1.RecordCount div IWGrid1.ColumnCount;    if IWGrid1.ColumnCount > DM.FDQuery1.RecordCount then
229    if i = 0 then    begin
230        IWGrid1.RowCount := 1;
231      IWGrid1.ColumnCount := DM.FDQuery1.RecordCount;      IWGrid1.ColumnCount := DM.FDQuery1.RecordCount;
232    if DM.FDQuery1.RecordCount mod IWGrid1.ColumnCount >= 0 then    end
233      inc(i);    else
234    IWGrid1.RowCount := i;    begin
235        i := DM.FDQuery1.RecordCount div IWGrid1.ColumnCount;
236        if DM.FDQuery1.RecordCount mod IWGrid1.ColumnCount > 0 then
237          inc(i);
238        IWGrid1.RowCount := i;
239      end;
240      dummy.Free;
241    dummy := TComponent.Create(IWGrid1);    dummy := TComponent.Create(IWGrid1);
242    DM.FDQuery1.First;    DM.FDQuery1.First;
243    for i := 0 to IWGrid1.RowCount - 1 do    for i := 0 to IWGrid1.RowCount - 1 do
# Line 186  begin Line 248  begin
248        s := TIWImage.Create(dummy);        s := TIWImage.Create(dummy);
249        ACell := IWGrid1.Cell[i, j];        ACell := IWGrid1.Cell[i, j];
250        ACell.Control := s;        ACell.Control := s;
       t := DM.FDQuery1.CreateBlobStream  
         (DM.FDQuery1.FieldByName('THUMBNAIL'), bmRead);  
       try  
         png.LoadFromStream(t);  
       finally  
         t.Free;  
       end;  
       s.Picture.Assign(png);  
251        ACell.Text := DM.FDQuery1.FieldByName('NAME').AsString;        ACell.Text := DM.FDQuery1.FieldByName('NAME').AsString;
252        ACell.Tag := Pointer(DM.FDQuery1.FieldByName('SERIAL').AsInteger);        ACell.Tag := Pointer(DM.FDQuery1.FieldByName('SERIAL').AsInteger);
253        ACell.Clickable := k <> DM.FDQuery1.FieldByName('SERIAL').AsInteger;        ACell.Clickable := k <> DM.FDQuery1.FieldByName('SERIAL').AsInteger;
254          UserSession.FieldToImg(s.Picture, DM.FDQuery1.FieldByName('THUMBNAIL'));
255        DM.FDQuery1.Next;        DM.FDQuery1.Next;
256      end;      end;
257  end;  end;
258    
259  procedure TAdminFile.Local(DataSet: TDataSet);  procedure TAdminFile.Local(DataSet: TDataSet);
 var  
   s: TStream;  
260  begin  begin
261    s := DM.FDTableView.CreateBlobStream    UserSession.FieldToImg(IWImage1.Picture, DM.FDTableView.FieldByName('IMAGE'));
     (DM.FDTableView.FieldByName('THUMBNAIL'), bmRead);  
   try  
     png.LoadFromStream(s);  
   finally  
     s.Free;  
   end;  
   IWImage1.Picture.Assign(png);  
 end;  
   
 procedure TAdminFile.ReadPng(DataSet: TDataSet);  
 var  
   s: TStream;  
 begin  
   if (DM.FDTableView.FieldByName('THUMBNAIL').IsNull = true) and  
     (FileOpenDialog1.Execute = true) then  
   begin  
     png.LoadFromFile(FileOpenDialog1.FileName);  
     s := DM.FDTableView.CreateBlobStream  
       (DM.FDTableView.FieldByName('THUMBNAIL'), bmWrite);  
     try  
       png.SaveToStream(s);  
     finally  
       s.Free;  
     end;  
     IWImage1.Picture.Assign(png);  
   end;  
262  end;  end;
263    
264  end.  end.
Legend:
Removed from v.15  
changed lines
  Added in v.18
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help