Develop and Download Open Source Software

zencart-clone

Browse Subversion Repository

/[zencart-clone]/Unit13.pas

Diff of /Unit13.pas

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

revision 17 by yamat0jp, Wed Aug 24 12:31:07 2016 UTC revision 18 by yamat0jp, Sat Aug 27 11:00:30 2016 UTC
# Line 5  interface Line 5  interface
5  uses  uses
6    Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, Vcl.Controls,    Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, Vcl.Controls,
7    IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompButton,    IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompButton,
8    IWCompExtCtrls;    IWCompExtCtrls, IWCompGrids, IWDBGrids, FireDAC.Stan.Intf,
9      FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS,
10      FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt,
11      Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, IWVCLComponent,
12      IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,
13      IWTemplateProcessorHTML;
14    
15  type  type
16    TIWForm13 = class(TIWAppForm)    TMasterForm = class(TIWAppForm)
17      IWButton1: TIWButton;      IWButton1: TIWButton;
18      IWRadioGroup1: TIWRadioGroup;      IWRadioGroup1: TIWRadioGroup;
19        IWDBGrid1: TIWDBGrid;
20        DataSource1: TDataSource;
21        FDQuery1: TFDQuery;
22        IWRadioGroup2: TIWRadioGroup;
23        IWButton2: TIWButton;
24        IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
25      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
26      procedure IWRadioGroup1Click(Sender: TObject);      procedure IWRadioGroup1Click(Sender: TObject);
27      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
28        procedure IWDBGrid1RenderCell(ACell: TIWGridCell;
29          const ARow, AColumn: Integer);
30        procedure IWDBGrid1Render(Sender: TObject);
31        procedure IWAppFormDestroy(Sender: TObject);
32        procedure IWRadioGroup2Click(Sender: TObject);
33        procedure IWButton2Click(Sender: TObject);
34      private
35        dummy: TComponent;
36        procedure Agree(Sender: TObject);
37    public    public
38    end;    end;
39    
# Line 21  implementation Line 41  implementation
41    
42  {$R *.dfm}  {$R *.dfm}
43    
44  uses Unit3;  uses Unit3, ServerController;
45    
46  procedure TIWForm13.IWAppFormCreate(Sender: TObject);  procedure TMasterForm.Agree(Sender: TObject);
47  begin  begin
48      if FDQuery1.Locate('SERIAL', (Sender as TIWButton).Tag) = true then
49      begin
50        if FDQuery1.FieldByName('SERIAL').AsInteger = -1 then
51          FDQuery1.Delete
52        else
53        begin
54          FDQuery1.Edit;
55          FDQuery1.FieldByName('AGREE').AsBoolean := true;
56          FDQuery1.Post;
57        end;
58        DM.FDTableView.Refresh;
59      end;
60    end;
61    
62    procedure TMasterForm.IWAppFormCreate(Sender: TObject);
63    begin
64      FDQuery1.Open;
65    IWRadioGroup1Click(Sender);    IWRadioGroup1Click(Sender);
66  end;  end;
67    
68  procedure TIWForm13.IWButton1Click(Sender: TObject);  procedure TMasterForm.IWAppFormDestroy(Sender: TObject);
69    begin
70      FDQuery1.Close;
71    end;
72    
73    procedure TMasterForm.IWButton1Click(Sender: TObject);
74  var  var
75    s: TList;    s: TList;
76    p: PInteger;    p: PInteger;
77    i, j: Integer;    i, j: Integer;
78  begin  begin
79      i := 1;
80    s := TList.Create;    s := TList.Create;
81    try    try
82        DM.FDTable2.IndexFieldNames := 'SERIAL';
83        DM.FDTable2.Refresh;
84      DM.FDTable2.First;      DM.FDTable2.First;
85      while (DM.FDTable2.Eof = false) and (i < 100) do      while (DM.FDTable2.Eof = false) and (i < 100) do
86      begin      begin
# Line 49  begin Line 94  begin
94        DM.FDTable2.Next;        DM.FDTable2.Next;
95      end;      end;
96      DM.FDTable2.Last;      DM.FDTable2.Last;
     DM.FDQuery1.SQL.Clear;  
     DM.FDQuery1.SQL.Add('select serial from cart_data where serial = :num');  
97      while (DM.FDTable2.Bof = false) and (s.Count > 0) do      while (DM.FDTable2.Bof = false) and (s.Count > 0) do
98      begin      begin
99        p := s[0];        p := s[0];
100        j := DM.FDTable2.FieldByName('SERIAL').AsInteger;        j := DM.FDTable2.FieldByName('SERIAL').AsInteger;
101        with DM.FDQuery1 do        with DM.FDQuery1 do
102        begin        begin
103            SQL.Clear;
104            SQL.Add('select serial from cart_data where serial = :num');
105            ParamByName('num').AsInteger := j;
106            Open;
107            First;
108            while Eof = false do
109            begin
110              Edit;
111              Fields[0].AsInteger := p^;
112              Post;
113              Next;
114            end;
115            SQL.Clear;
116            SQL.Add('select serial from recent_data where serial = :num');
117          ParamByName('num').AsInteger := j;          ParamByName('num').AsInteger := j;
118          Open;          Open;
119          First;          First;
120          while Eof = false do          while Eof = false do
121          begin          begin
122              Edit;
123            Fields[0].AsInteger := p^;            Fields[0].AsInteger := p^;
124              Post;
125            Next;            Next;
126          end;          end;
         Close;  
127        end;        end;
128          DM.FDTable2.Edit;
129        DM.FDTable2.FieldByName('SERIAL').AsInteger := p^;        DM.FDTable2.FieldByName('SERIAL').AsInteger := p^;
130          DM.FDTable2.Post;
131        DM.FDTable1.Prior;        DM.FDTable1.Prior;
132        System.Dispose(p);        System.Dispose(p);
133        s.Delete(0);        s.Delete(0);
134      end;      end;
135    finally    finally
136      s.Free;      s.Free;
137        DM.FDTable2.IndexFieldNames := 'MASTER';
138      end;
139    end;
140    
141    procedure TMasterForm.IWButton2Click(Sender: TObject);
142    begin
143      Release;
144    end;
145    
146    procedure TMasterForm.IWDBGrid1Render(Sender: TObject);
147    begin
148      dummy.Free;
149      dummy := TComponent.Create(IWDBGrid1);
150    end;
151    
152    procedure TMasterForm.IWDBGrid1RenderCell(ACell: TIWGridCell;
153      const ARow, AColumn: Integer);
154    var
155      s: TIWImage;
156      t: TIWButton;
157    begin
158      if (ARow = 0) or (IWRadioGroup2.ItemIndex <> 0) then
159        Exit;
160      if AColumn = FDQuery1.FieldByName('THUMBNAIL').Index then
161      begin
162        s := TIWImage.Create(dummy);
163        UserSession.FieldToImg(s.Picture, FDQuery1.FieldByName('THUMBNAIL'));
164        ACell.Control := s;
165      end
166      else if AColumn = FDQuery1.FieldByName('AGREE').Index then
167      begin
168        t := TIWButton.Create(dummy);
169        t.Tag := FDQuery1.FieldByName('SERIAL').AsInteger;
170        t.OnClick := Agree;
171        ACell.Control := t;
172    end;    end;
173  end;  end;
174    
175  procedure TIWForm13.IWRadioGroup1Click(Sender: TObject);  procedure TMasterForm.IWRadioGroup1Click(Sender: TObject);
176  begin  begin
177    IWButton1.Enabled := IWRadioGroup1.ItemIndex = 1;    IWButton1.Enabled := IWRadioGroup1.ItemIndex = 1;
178  end;  end;
179    
180    procedure TMasterForm.IWRadioGroup2Click(Sender: TObject);
181    begin
182      case IWRadioGroup2.ItemIndex of
183        0:
184          FDQuery1.Open('select * from item_data where agree = false');
185        1:
186          FDQuery1.Open('select * from item_data where agree = true');
187        2:
188          FDQuery1.Open
189            ('select * from item_data where agree = true and activate = true');
190      end;
191    end;
192    
193  end.  end.
Legend:
Removed from v.17  
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