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 7 by yamat0jp, Wed Dec 30 09:56:24 2015 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;
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 := DM.FDTable1.FieldByName('NUMBER')
43          .AsInteger;
44      end;
45    end;
46    
47  function DM: TDataModule1;  procedure TCartForm.IWAppFormRender(Sender: TObject);
48    var
49      i, j, k: Integer;
50      s: TStream;
51      pic: TIWImage;
52      png: TPngImage;
53  begin  begin
54    result:=UserSession.DM;    for i := 0 to IWGrid1.RowCount - 1 do
55        IWGrid1.Cell[i, 0].Control.Free;
56      IWGrid1.RowCount := 0;
57      with DM.FDQuery1 do
58      begin
59        Open;
60        IWGrid1.RowCount := RecordCount;
61        if IWGrid1.RowCount = 0 then
62          IWGrid1.Caption := 'カートの中身がありません';
63        First;
64        i := 0;
65        k := 0;
66        png := TPngImage.Create;
67        try
68          while Eof = false do
69          begin
70            if Fields.Fields[0].AsBytes <> nil then
71            begin
72              s := CreateBlobStream(Fields.Fields[0], bmRead);
73              try
74                png.LoadFromStream(s);
75              finally
76                s.Free;
77              end;
78              pic := TIWImage.Create(IWGrid1);
79              pic.Picture.Assign(png);
80              IWGrid1.Cell[i, 0].Control := pic;
81            end;
82            IWGrid1.Cell[i, 1].Text := Fields.Fields[1].AsString;
83            IWGrid1.Cell[i, 2].Text := Fields.Fields[2].AsString;
84            j := Fields.Fields[2].AsInteger * Fields.Fields[3].AsInteger;
85            inc(k, j);
86            IWGrid1.Cell[i, 3].Text := IntToStr(j);
87            IWGrid1.Cell[i, 4].Text := '削除';
88            IWGrid1.Cell[i, 4].Clickable := true;
89            Next;
90            inc(i);
91          end;
92        finally
93          png.Free;
94        end;
95      end;
96      IWLabel1.Text := Format('(合計) %d + (消費税) %d = %d円',
97        [k, Trunc(k * 0.08), Trunc(k * 1.08)]);
98    end;
99    
100    procedure TCartForm.IWButton1Click(Sender: TObject);
101    begin
102      if IWGrid1.RowCount > 0 then
103        TPayForm.Create(WebApplication).Show;
104      Release;
105    end;
106    
107    procedure TCartForm.IWButton2Click(Sender: TObject);
108    begin
109      Release;
110    end;
111    
112    procedure TCartForm.IWGrid1CellClick(ASender: TObject;
113      const ARow, AColumn: Integer);
114    var
115      i, j: Integer;
116    begin
117      with DM.FDQuery1 do
118      begin
119        RecNo := ARow + 1;
120        i := FieldByName('NUMBER').AsInteger;
121        j := FieldByName('SERIAL').AsInteger;
122        SQL.Clear;
123        SQL.Add('select * from cart_data');
124        Open;
125        Locate('NUMBER;SERIAL', VarArrayOf([i, j]), []);
126        Delete;
127      end;
128      IWAppFormCreate(ASender);
129  end;  end;
130    
131  end.  end.

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

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