Develop and Download Open Source Software

Browse Subversion Repository

Diff of /Unit4.pas

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

revision 1 by yamat0jp, Sun Nov 22 11:18:44 2015 UTC revision 12 by yamat0jp, Sun Jul 24 06:09:44 2016 UTC
# Line 3  unit Unit4; Line 3  unit Unit4;
3  interface  interface
4    
5  uses  uses
6    System.SysUtils, System.Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option,    Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWVCLComponent,
7    FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,    IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,
8    FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, FireDAC.UI.Intf,    IWTemplateProcessorHTML, Vcl.Controls, IWVCLBaseControl, IWBaseControl,
9    FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Phys, FireDAC.Phys.IB,    IWBaseHTMLControl, IWControl, IWCompGrids, IWCompButton, Variants,
10    FireDAC.Phys.IBDef, Data.DB, FireDAC.Comp.Client, FireDAC.Comp.DataSet;    IWCompLabel,
11      IWDBStdCtrls, PngImage, IWCompExtCtrls, Data.DB;
12    
13  type  type
14    TDataModule1 = class(TDataModule)    TCartForm = class(TIWAppForm)
15      FDTable1: TFDTable;      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
16      FDTable1NAME: TWideStringField;      IWGrid1: TIWGrid;
17      FDTable2: TFDTable;      IWButton1: TIWButton;
18      FDTable2NAME: TWideStringField;      IWButton2: TIWButton;
19      FDTable2MAKER: TWideStringField;      IWLabel1: TIWLabel;
20      FDTable2STOCK: TIntegerField;      procedure IWAppFormRender(Sender: TObject);
21      FDTable2WEIGHT: TIntegerField;      procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
22      FDTable2DATE: TDateField;      procedure IWAppFormCreate(Sender: TObject);
23      FDTable2COMMENT: TMemoField;      procedure IWButton2Click(Sender: TObject);
24      FDTable2CATEGORY: TWideStringField;      procedure IWButton1Click(Sender: TObject);
     FDTable2IMAGE: TBlobField;  
     FDTable2PRICE: TIntegerField;  
     item: TDataSource;  
     user: TDataSource;  
     FDConnection1: TFDConnection;  
     FDTable3: TFDTable;  
     form: TDataSource;  
     FDQuery1: TFDQuery;  
     cart: TDataSource;  
     FDTable2THUMBNAIL: TBlobField;  
     FDTable1EMAIL: TWideStringField;  
     FDTable1ADDRESS: TWideStringField;  
     FDTable1NUMBER: TIntegerField;  
     FDTable1PASSWORD: TWideStringField;  
     FDTable2SERIAL: TIntegerField;  
     FDTable1BIRTH: TDateField;  
     FDTable3NAME: TWideStringField;  
     FDTable3BGCOLOR: TIntegerField;  
   private  
     { Private 宣言 }  
25    public    public
     { Public 宣言 }  
26    end;    end;
27    
 function DM: TDataModule1;  
   
28  implementation  implementation
29    
30  {%CLASSGROUP 'Vcl.Controls.TControl'}  {$R *.dfm}
31    
32  uses ServerController;  uses Unit3, Unit7, Unit6, ServerController;
33    
34  {$R *.dfm}  procedure TCartForm.IWAppFormCreate(Sender: TObject);
35    begin
36      with DM.FDQuery1 do
37      begin
38        SQL.Clear;
39        SQL.Add('select thumbnail,name,volume,price,number,serial from cart_data join item_data');
40        SQL.Add(' on (cart_data.serial = item_data.serial)');
41        SQL.Add(' where number = :num');
42        Params.ParamByName('num').AsInteger := UserSession.user_number;
43      end;
44    end;
45    
46  function DM: TDataModule1;  procedure TCartForm.IWAppFormRender(Sender: TObject);
47    var
48      i, j, k: Integer;
49      s: TStream;
50      pic: TIWImage;
51      png: TPngImage;
52  begin  begin
53    result:=UserSession.DM;    for i := 0 to IWGrid1.RowCount - 1 do
54        IWGrid1.Cell[i, 0].Control.Free;
55      IWGrid1.RowCount := 0;
56      with DM.FDQuery1 do
57      begin
58        Open;
59        IWGrid1.RowCount := RecordCount;
60        if IWGrid1.RowCount = 0 then
61          IWGrid1.Caption := 'カートの中身がありません';
62        First;
63        i := 0;
64        k := 0;
65        png := TPngImage.Create;
66        try
67          while Eof = false do
68          begin
69            if Fields.Fields[0].AsBytes <> nil then
70            begin
71              s := CreateBlobStream(Fields.Fields[0], bmRead);
72              try
73                png.LoadFromStream(s);
74              finally
75                s.Free;
76              end;
77              pic := TIWImage.Create(IWGrid1);
78              pic.Picture.Assign(png);
79              IWGrid1.Cell[i, 0].Control := pic;
80            end;
81            IWGrid1.Cell[i, 1].Text := Fields.Fields[1].AsString;
82            IWGrid1.Cell[i, 2].Text := Fields.Fields[2].AsString;
83            j := Fields.Fields[2].AsInteger * Fields.Fields[3].AsInteger;
84            inc(k, j);
85            IWGrid1.Cell[i, 3].Text := IntToStr(j);
86            IWGrid1.Cell[i, 4].Text := '削除';
87            IWGrid1.Cell[i, 4].Clickable := true;
88            Next;
89            inc(i);
90          end;
91        finally
92          png.Free;
93        end;
94      end;
95      IWLabel1.Text := Format('(合計) %d + (消費税) %d = %d円',
96        [k, Trunc(k * 0.08), Trunc(k * 1.08)]);
97    end;
98    
99    procedure TCartForm.IWButton1Click(Sender: TObject);
100    begin
101      if IWGrid1.RowCount > 0 then
102        TPayForm.Create(WebApplication).Show;
103      if (UserSession.user_number <> 0) and
104        (DM.FDTable1.FieldByName('EMAIL').AsString = '') then
105        TUserForm.Create(WebApplication).Show;
106      Release;
107    end;
108    
109    procedure TCartForm.IWButton2Click(Sender: TObject);
110    begin
111      Release;
112    end;
113    
114    procedure TCartForm.IWGrid1CellClick(ASender: TObject;
115      const ARow, AColumn: Integer);
116    var
117      i, j: Integer;
118    begin
119      with DM.FDQuery1 do
120      begin
121        RecNo := ARow + 1;
122        i := FieldByName('NUMBER').AsInteger;
123        j := FieldByName('SERIAL').AsInteger;
124        Open('select * from cart_data');
125        if Locate('NUMBER;SERIAL', VarArrayOf([i, j]), []) = true then
126          Delete;
127      end;
128      IWAppFormCreate(ASender);
129  end;  end;
130    
131  end.  end.

Legend:
Removed from v.1  
changed lines
  Added in v.12

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