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 16 by yamat0jp, Sat Aug 6 08:27:34 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;
15    
16  type  type
17    TAdminFile = class(TIWAppForm)    TAdminFile = class(TIWAppForm)
18      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
19      IWGrid1: TIWGrid;      IWGrid1: TIWGrid;
     IWImage1: TIWImage;  
20      IWDBText1: TIWDBText;      IWDBText1: TIWDBText;
21      IWDBEdit6: TIWDBEdit;      IWDBEdit6: TIWDBEdit;
22      IWDBEdit5: TIWDBEdit;      IWDBEdit5: TIWDBEdit;
# Line 27  type Line 26  type
26      IWDBEdit3: TIWDBEdit;      IWDBEdit3: TIWDBEdit;
27      IWDBEdit2: TIWDBEdit;      IWDBEdit2: TIWDBEdit;
28      IWDBEdit1: TIWDBEdit;      IWDBEdit1: TIWDBEdit;
     FDGUIxLoginDialog1: TFDGUIxLoginDialog;  
     FileOpenDialog1: TFileOpenDialog;  
29      IWRegion1: TIWRegion;      IWRegion1: TIWRegion;
30      IWLabel1: TIWLabel;      IWLabel1: TIWLabel;
31      IWLabel2: TIWLabel;      IWLabel2: TIWLabel;
# Line 37  type Line 34  type
34      IWLabel5: TIWLabel;      IWLabel5: TIWLabel;
35      IWLabel6: TIWLabel;      IWLabel6: TIWLabel;
36      IWButton2: TIWButton;      IWButton2: TIWButton;
37        IWFileUploader1: TIWFileUploader;
38        IWImage1: TIWImage;
39        FileOpenDialog1: TFileOpenDialog;
40        IWButton3: TIWButton;
41      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
42      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
43      procedure IWDBNavigator1BeforeAction(Sender: TObject;      procedure IWDBNavigator1BeforeAction(Sender: TObject;
# Line 47  type Line 48  type
48      procedure IWGrid1Render(Sender: TObject);      procedure IWGrid1Render(Sender: TObject);
49      procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);      procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
50      procedure IWDBNavigator1Insert(Sender: TObject);      procedure IWDBNavigator1Insert(Sender: TObject);
51        procedure IWButton3Click(Sender: TObject);
52    private    private
53      serial: Integer;      serial: Integer;
54      dummy: TComponent;      dummy: TComponent;
     png: TPngImage;  
55      procedure Local(DataSet: TDataSet);      procedure Local(DataSet: TDataSet);
     procedure ReadPng(DataSet: TDataSet);  
56    public    public
57    end;    end;
58    
# Line 60  implementation Line 60  implementation
60    
61  {$R *.dfm}  {$R *.dfm}
62    
63  uses Unit3;  uses Unit3, ServerController;
64    
65  procedure TAdminFile.IWAppFormCreate(Sender: TObject);  procedure TAdminFile.IWAppFormCreate(Sender: TObject);
66  begin  begin
67    if DM.FDTable7.Locate('NUMBER', 1) = true then    if DM.FDTable7.Locate('NUMBER', 1) = true then
68    begin    begin
     png := TPngImage.Create;  
69      with DM.FDTableView do      with DM.FDTableView do
70      begin      begin
71        AfterScroll := Local;        AfterScroll := Local;
       AfterEdit := ReadPng;  
       AfterInsert := ReadPng;  
72        Filter := 'MASTER = ' + QuotedStr(DM.FDTable7.FieldByName('NUMBER')        Filter := 'MASTER = ' + QuotedStr(DM.FDTable7.FieldByName('NUMBER')
73          .AsString);          .AsString);
74      end;      end;
# Line 90  end; Line 87  end;
87    
88  procedure TAdminFile.IWAppFormDestroy(Sender: TObject);  procedure TAdminFile.IWAppFormDestroy(Sender: TObject);
89  begin  begin
   png.Free;  
90    dummy.Free;    dummy.Free;
91  end;  end;
92    
93  procedure TAdminFile.IWButton1Click(Sender: TObject);  procedure TAdminFile.IWButton1Click(Sender: TObject);
94    var
95      s: TBitmap;
96      t: TPicture;
97  begin  begin
98    if FileOpenDialog1.Execute = true then    if FileOpenDialog1.Execute = true then
99    begin    begin
100      IWImage1.Picture.LoadFromFile(FileOpenDialog1.FileName);      IWImage1.Picture.LoadFromFile(FileOpenDialog1.FileName);
101      DM.FDTableView.Edit;      DM.FDTableView.Edit;
102        UserSession.ImgToField(IWImage1.Picture,
103          DM.FDTableView.FieldByName('IMAGE'));
104        s := TBitmap.Create;
105        t := TPicture.Create;
106        try
107          s.Width := 50;
108          s.Height := 50;
109          s.Canvas.StretchDraw(Rect(0, 0, 50, 50), IWImage1.Picture.Graphic);
110          t.Assign(s);
111          UserSession.ImgToField(t, DM.FDTableView.FieldByName('THUMBNAIL'));
112        finally
113          s.Free;
114          t.Free;
115        end;
116    end;    end;
117  end;  end;
118    
119  procedure TAdminFile.IWButton2Click(Sender: TObject);  procedure TAdminFile.IWButton2Click(Sender: TObject);
120  begin  begin
121      DM.FDTableView.AfterScroll := nil;
122    Release;    Release;
123  end;  end;
124    
125    procedure TAdminFile.IWButton3Click(Sender: TObject);
126    begin
127      IWImage1.Picture.Assign(nil);
128      DM.FDTableView.Edit;
129    end;
130    
131  procedure TAdminFile.IWDBNavigator1BeforeAction(Sender: TObject;  procedure TAdminFile.IWDBNavigator1BeforeAction(Sender: TObject;
132    NavButton: TNavigateBtn; var Handled: Boolean);    NavButton: TNavigateBtn; var Handled: Boolean);
 var  
   s: TStream;  
133  begin  begin
134    case NavButton of    case NavButton of
135      nbPost:      nbPost:
136        begin        begin
137          DM.FDTableView.FieldByName('MASTER').AsInteger :=          DM.FDTableView.FieldByName('MASTER').AsInteger :=
138            DM.FDTable7.FieldByName('NUMBER').AsInteger;            DM.FDTable7.FieldByName('NUMBER').AsInteger;
139          if Assigned(IWImage1.Picture.Graphic) = true then          Local(nil);
         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;  
140          inc(serial);          inc(serial);
141        end;        end;
142    else    else
# Line 145  end; Line 147  end;
147    
148  procedure TAdminFile.IWDBNavigator1Insert(Sender: TObject);  procedure TAdminFile.IWDBNavigator1Insert(Sender: TObject);
149  begin  begin
150      IWImage1.Picture.Assign(nil);
151    DM.FDTableView.FieldByName('SERIAL').AsInteger := serial + 1;    DM.FDTableView.FieldByName('SERIAL').AsInteger := serial + 1;
152  end;  end;
153    
# Line 165  procedure TAdminFile.IWGrid1Render(Sende Line 168  procedure TAdminFile.IWGrid1Render(Sende
168  var  var
169    i, j, k: Integer;    i, j, k: Integer;
170    s: TIWImage;    s: TIWImage;
   t: TStream;  
171    ACell: TIWGridCell;    ACell: TIWGridCell;
172  begin  begin
173    k := DM.FDTableView.FieldByName('SERIAL').AsInteger;    k := DM.FDTableView.FieldByName('SERIAL').AsInteger;
174    IWGrid1.ColumnCount := 5;    IWGrid1.ColumnCount := 5;
175    i := DM.FDQuery1.RecordCount div IWGrid1.ColumnCount;    i := DM.FDQuery1.RecordCount div IWGrid1.ColumnCount;
176    if i = 0 then    if i = 0 then
177      begin
178      IWGrid1.ColumnCount := DM.FDQuery1.RecordCount;      IWGrid1.ColumnCount := DM.FDQuery1.RecordCount;
179    if DM.FDQuery1.RecordCount mod IWGrid1.ColumnCount >= 0 then      i := 1;
180      end
181      else if DM.FDQuery1.RecordCount mod IWGrid1.ColumnCount > 0 then
182      inc(i);      inc(i);
183    IWGrid1.RowCount := i;    IWGrid1.RowCount := i;
184    dummy := TComponent.Create(IWGrid1);    dummy := TComponent.Create(IWGrid1);
# Line 186  begin Line 191  begin
191        s := TIWImage.Create(dummy);        s := TIWImage.Create(dummy);
192        ACell := IWGrid1.Cell[i, j];        ACell := IWGrid1.Cell[i, j];
193        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);  
194        ACell.Text := DM.FDQuery1.FieldByName('NAME').AsString;        ACell.Text := DM.FDQuery1.FieldByName('NAME').AsString;
195        ACell.Tag := Pointer(DM.FDQuery1.FieldByName('SERIAL').AsInteger);        ACell.Tag := Pointer(DM.FDQuery1.FieldByName('SERIAL').AsInteger);
196        ACell.Clickable := k <> DM.FDQuery1.FieldByName('SERIAL').AsInteger;        ACell.Clickable := k <> DM.FDQuery1.FieldByName('SERIAL').AsInteger;
197          UserSession.FieldToImg(s.Picture, DM.FDQuery1.FieldByName('THUMBNAIL'));
198        DM.FDQuery1.Next;        DM.FDQuery1.Next;
199      end;      end;
200  end;  end;
201    
202  procedure TAdminFile.Local(DataSet: TDataSet);  procedure TAdminFile.Local(DataSet: TDataSet);
 var  
   s: TStream;  
 begin  
   s := DM.FDTableView.CreateBlobStream  
     (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;  
203  begin  begin
204    if (DM.FDTableView.FieldByName('THUMBNAIL').IsNull = true) and    UserSession.FieldToImg(IWImage1.Picture, DM.FDTableView.FieldByName('IMAGE'));
     (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;  
205  end;  end;
206    
207  end.  end.
Legend:
Removed from v.15  
changed lines
  Added in v.16
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help