Develop and Download Open Source Software

zencart-clone

Browse Subversion Repository

/[zencart-clone]/Unit1.pas

Diff of /Unit1.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 2 by yamat0jp, Sat Dec 19 14:35:42 2015 UTC
# Line 3  unit Unit1; Line 3  unit Unit1;
3  interface  interface
4    
5  uses  uses
6    Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWHTMLControls,    Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWVCLComponent,
   IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,  
   Vcl.Controls, Vcl.Forms, IWVCLBaseContainer, IWContainer, IWHTMLContainer,  
   IWHTML40Container, IWRegion, FireDAC.Stan.Intf, FireDAC.Stan.Option,  
   FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,  
   FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.IB,  
   FireDAC.Phys.IBDef, Data.DB, FireDAC.Comp.Client, Datasnap.DBClient,  
   Datasnap.Provider, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf,  
   FireDAC.DApt, FireDAC.Comp.DataSet, IWCompGrids, IWDBGrids, IWCompEdit,  
   IWDBStdCtrls, IWCompExtCtrls, IWDBExtCtrls, Unit3, IWVCLComponent,  
7    IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,    IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,
8    IWTemplateProcessorHTML, Data.Bind.EngExt, Vcl.Bind.DBEngExt, System.Rtti,    IWTemplateProcessorHTML, Vcl.Controls, Vcl.Forms, Unit2, IWVCLBaseContainer,
9    System.Bindings.Outputs, Vcl.Bind.Editors, Data.Bind.Components,    IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWDBStdCtrls,
10    Data.Bind.DBScope, IWCompListbox, IWCompButton, Web.HTTPApp, Web.HTTPProd,    IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,
11    Vcl.ImgList, IWImageList, PngImage, IWCompTabControl, IWCompMemo, IWCompText,    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
12    UserSessionUnit;    IWHTMLControls, IWCompExtCtrls, UserSessionUnit, PngImage, Data.DB;
13    
14  type  type
15    TTopForm = class(TIWAppForm)    TIWForm1 = class(TIWAppForm)
16      IWRegion1: TIWRegion;      IWFrame1: TIWFrame1;
17        IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
18      IWLabel1: TIWLabel;      IWLabel1: TIWLabel;
     IWList1: TIWList;  
     IWLink1: TIWLink;  
     IWLabel2: TIWLabel;  
19      IWDBLabel1: TIWDBLabel;      IWDBLabel1: TIWDBLabel;
20      IWFrame1: TIWFrame1;      IWRegion1: TIWRegion;
21        IWRegion2: TIWRegion;
22        IWText1: TIWText;
23        IWGrid1: TIWGrid;
24      IWRegion3: TIWRegion;      IWRegion3: TIWRegion;
     IWLabel3: TIWLabel;  
     IWLabel4: TIWLabel;  
25      IWRegion4: TIWRegion;      IWRegion4: TIWRegion;
26      IWLabel5: TIWLabel;      IWLink1: TIWLink;
27      IWList2: TIWList;      IWLabel2: TIWLabel;
28      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;      IWList1: TIWList;
29      IWRegion2: TIWRegion;      IWLabel3: TIWLabel;
     IWLabel6: TIWLabel;  
     IWRegion6: TIWRegion;  
30      IWEdit1: TIWEdit;      IWEdit1: TIWEdit;
31      IWButton1: TIWButton;      IWButton1: TIWButton;
     IWImageFile1: TIWImageFile;  
     IWRegion7: TIWRegion;  
     IWLabel8: TIWLabel;  
     IWGrid1: TIWGrid;  
     IWTabControl1: TIWTabControl;  
     IWTabControl1Page0: TIWTabPage;  
     IWTabControl1Page1: TIWTabPage;  
     IWText1: TIWText;  
     IWRegion8: TIWRegion;  
32      IWEdit2: TIWEdit;      IWEdit2: TIWEdit;
33      IWEdit3: TIWEdit;      IWEdit3: TIWEdit;
     IWLabel9: TIWLabel;  
     IWList3: TIWList;  
34      IWLink2: TIWLink;      IWLink2: TIWLink;
35        IWRegion5: TIWRegion;
36        IWLabel7: TIWLabel;
37        IWRegion6: TIWRegion;
38        IWLabel8: TIWLabel;
39        IWList2: TIWList;
40        IWLabel4: TIWLabel;
41        IWImageFile1: TIWImageFile;
42        IWRegion7: TIWRegion;
43        IWLabel5: TIWLabel;
44        IWLabel6: TIWLabel;
45        IWList3: TIWList;
46      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
47      procedure IWLink1Click(Sender: TObject);      procedure IWLink2Click(Sender: TObject);
48      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
49      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
50      procedure IWAppFormDestroy(Sender: TObject);      procedure IWLink1Click(Sender: TObject);
     procedure IWLink2Click(Sender: TObject);  
51    private    private
     procedure SetPage(const Value: TPage);  
52      function GetPage: TPage;      function GetPage: TPage;
53        procedure SetPage(const Value: TPage);
54      procedure LoadImage;      procedure LoadImage;
55      procedure ClearImage;      procedure ClearImage;
56    public    public
# Line 74  implementation Line 61  implementation
61    
62  {$R *.dfm}  {$R *.dfm}
63    
64  uses Unit2, ServerController, Unit4, Unit6;  uses Unit3, ServerController, Unit6;
65    
66  procedure TTopForm.ClearImage;  procedure TIWForm1.ClearImage;
67  var  var
68    i, j: integer;    i: Integer;
69      j: Integer;
70  begin  begin
71    for i := 0 to IWGrid1.ColumnCount - 1 do    for i := 0 to IWGrid1.RowCount - 1 do
72      for j := 0 to IWGrid1.RowCount - 1 do      for j := 0 to IWGrid1.ColumnCount - 1 do
73      begin        IWGrid1.Cell[i, j].Control.Free;
       IWGrid1.Cell[j, i].Control.Free;  
       IWGrid1.Cell[j, i].Control := nil;  
     end;  
74  end;  end;
75    
76  function TTopForm.GetPage: TPage;  function TIWForm1.GetPage: TPage;
77  begin  begin
78    result := UserSession.FPage;    result := UserSession.FPage;
79  end;  end;
80    
81  procedure TTopForm.IWAppFormCreate(Sender: TObject);  procedure TIWForm1.IWAppFormCreate(Sender: TObject);
 const  
   i = 150;  
 var  
   s: integer;  
82  begin  begin
   s:=DM.FDTable3.FieldByName('BGCOLOR').AsInteger;  
   IWLabel1.BGColor := s;  
   IWLabel3.BGColor := s;  
   IWLabel5.BGColor := s;  
   IWLabel6.BGColor := s;  
   IWLabel8.BGColor := s;  
   IWRegion1.Width := i;  
   IWRegion2.Width := i;  
   IWRegion3.Width := i;  
   IWRegion4.Width := i;  
   IWRegion7.Width := i;  
   IWRegion8.Width := i;  
83    Page := UserSession.FPage;    Page := UserSession.FPage;
84  end;  end;
85    
86  procedure TTopForm.IWAppFormDestroy(Sender: TObject);  procedure TIWForm1.IWAppFormRender(Sender: TObject);
 begin  
   ClearImage;  
 end;  
   
 procedure TTopForm.IWAppFormRender(Sender: TObject);  
87  var  var
88    s: string;    s: string;
89    i, j: integer;    i, j: Integer;
   x: Boolean;  
90  begin  begin
91    IWList1.Items.Clear;    IWList1.Items.Clear;
92    with DM.FDTable2 do    with DM.FDTable2 do
93      if RecordCount > 0 then    begin
94        First;
95        while Eof = false do
96      begin      begin
97        First;        s := FieldByName('CATEGORY').AsString;
98        while Eof = false do        if s = '' then
99        begin        begin
100          s := FieldByName('CATEGORY').AsString;          Next;
101          if s = '' then          continue;
102          begin        end;
103            Next;        if Filtered = true then
104            continue;        begin
105          end;          i := IWList1.Items.IndexOfName(s);
106          if Filtered = true then          if i = -1 then
107          begin            IWList1.Items.Add(s + '=1')
           i := IWList1.Items.IndexOfName(s);  
           if i = -1 then  
             IWList1.Items.Add(s + '=1')  
           else  
           begin  
             j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;  
             IWList1.Items[i] := s + '=' + j.ToString;  
           end;  
         end  
108          else          else
109          begin          begin
110            i := IWList1.Items.IndexOf(s);            j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
111            if i = -1 then            IWList1.Items[i] := s + '=' + j.ToString;
             IWList1.Items.Add(s);  
112          end;          end;
113          Next;        end
114          else
115          begin
116            i := IWList1.Items.IndexOf(s);
117            if i = -1 then
118              IWList1.Items.Add(s);
119        end;        end;
120          Next;
121      end;      end;
122      end;
123    if DM.FDTable2.Filtered = true then    if DM.FDTable2.Filtered = true then
124      for i := 0 to IWList1.Items.Count - 1 do      for i := 0 to IWList1.Items.Count - 1 do
125      begin      begin
# Line 167  begin Line 129  begin
129        else        else
130          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
131      end;      end;
132    IWList3.Items.Clear;    IWList2.Items.Clear;
133    if Page = Info then    if Page = TPage.Info then
134    begin    begin
135      with DM.FDQuery1 do      with DM.FDQuery1 do
136      begin      begin
# Line 178  begin Line 140  begin
140        SQL.Add(' where number = :num;');        SQL.Add(' where number = :num;');
141        Params.ParamByName('num').AsInteger := UserSession.user_number;        Params.ParamByName('num').AsInteger := UserSession.user_number;
142        Open;        Open;
143        if RecordCount > 0 then        First;
144          i := 0;
145          while Eof = false do
146        begin        begin
147          First;          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
148          i := 0;          i := i + Fields.Fields[2].AsInteger;
149          while Eof = false do          IWList2.Items.Add(s);
150          begin          Next;
           s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;  
           inc(i, Fields.Fields[2].AsInteger);  
           IWList3.Items.Add(s);  
           Next;  
         end;  
         IWList3.Items.Add(i.ToString + '円');  
151        end;        end;
152          IWList2.Items.Add(i.ToString + '円');
153        Close;        Close;
154      end;        IWList3.Items.Clear;
     IWList2.Items.Clear;  
     with DM.FDQuery1 do  
     begin  
155        SQL.Clear;        SQL.Clear;
156        SQL.Add('select name from recent_data join item_data');        SQL.Add('select name from recent_data join item_data');
157        SQL.Add(' on (recent_data.serial = item_data.serial)');        SQL.Add(' on (recent_data.serial = item_data.serial)');
158        SQL.Add(' where number = :num;');        SQL.Add(' where number = :num;');
159        //Params.ParamByName('num').AsInteger:=UserSession.user_number;        Params.ParamByName('num').AsInteger := UserSession.user_number;
160        Open;        Open;
161        if RecordCount > 0 then        First;
162          while Eof = false do
163        begin        begin
164          First;          IWList3.Items.Add(Fields.Fields[0].AsString);
165          while Eof = false do          Next;
         begin  
           IWList2.Items.Add(Fields.Fields[0].AsString);  
           Next;  
         end;  
166        end;        end;
167        Close;        Close;
168      end;      end;
169    end;    end;
   x := Page = Info;  
   IWRegion4.Visible := x;  
   IWLabel2.Visible := x;  
   IWDBLabel1.Visible := x;  
   IWLink2.Visible := not x;  
170    LoadImage;    LoadImage;
171  end;  end;
172    
173  procedure TTopForm.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
174  const  const
175    filter = 'NAME LIKE ''%s''';    Filter = 'NAME like ''%s''';
176  begin  begin
177    if IWEdit1.Text = '' then    if IWEdit1.Text = '' then
178      DM.FDTable2.Filtered := false      DM.FDTable2.Filtered := false
179    else    else
180    begin    begin
181      DM.FDTable2.filter := Format(filter, ['%' + IWEdit1.Text + '%']);      DM.FDTable2.Filter.Format(Filter, ['%' + IWEdit1.Text + '%']);
182      DM.FDTable2.Filtered := true;      DM.FDTable2.Filtered := true;
183      IWLabel9.Text := IWEdit1.Text + 'を検索しています';      IWLabel6.Caption := IWEdit1.Text + 'を検索しています';
184    end;    end;
185    IWLabel9.Visible := DM.FDTable2.Filtered;    IWLabel6.Visible := DM.FDTable2.Filtered;
186  end;  end;
187    
188  procedure TTopForm.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWLink1Click(Sender: TObject);
189    begin
190      TUserForm.Create(WebApplication).Show;
191      Release;
192    end;
193    
194    procedure TIWForm1.IWLink2Click(Sender: TObject);
195  const  const
196    filter = 'EMAIL = ''%s'' and PASSWORD = ''%s''';    Filter = 'EMAIL = ''%s'' and PASSWORD = ''%s''';
197  begin  begin
198    case Page of    case Page of
199      Main:      Main:
200        begin        begin
201          DM.FDTable1.filter := Format(filter, [IWEdit2.Text, IWEdit3.Text]);          DM.FDTable1.Filter.Format(Filter, [IWEdit2.Text, IWEdit3.Text]);
202          DM.FDTable1.Filtered := true;          DM.FDTable1.Filtered := true;
203          if DM.FDTable1.RecordCount = 1 then          if DM.FDTable1.RecordCount = 1 then
204          begin          begin
           IWLink1.Caption := 'ログアウト';  
205            Page := Info;            Page := Info;
206            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')
207              .AsInteger;              .AsInteger;
# Line 259  begin Line 212  begin
212      Info:      Info:
213        begin        begin
214          DM.FDTable1.Filtered := false;          DM.FDTable1.Filtered := false;
         IWLink1.Caption := 'ログイン';  
215          Page := Main;          Page := Main;
         DM.FDQuery1.Params.ParamByName('num').AsInteger := 0;  
216        end;        end;
217    end;    end;
218    IWLabel9.Visible := UserSession.user_number <> 0;    IWLink1.Visible := UserSession.user_number = 0;
 end;  
   
 procedure TTopForm.IWLink2Click(Sender: TObject);  
 begin  
   UserSession.FPage := Info;  
   TUserForm.Create(WebApplication).Show;  
219  end;  end;
220    
221  procedure TTopForm.LoadImage;  procedure TIWForm1.LoadImage;
222  var  var
223    i, j, k: integer;    s: TStream;
224    png: TPngImage;    png: TPngImage;
225    pic: TIWImageFile;    pic: TIWImageFile;
226    st: TStream;    i: Integer;
227  label label1;    j: Integer;
228      k: Integer;
229  begin  begin
230    ClearImage;    ClearImage;
231    if DM.FDTable2.RecordCount > 0 then    png := TPngImage.Create;
232    begin    try
233      IWGrid1.RowCount := (DM.FDTable2.RecordCount div IWGrid1.ColumnCount) + 1;      IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
234      k := 1;      k := 1;
235      DM.FDTable2.Last;      for i := 0 to IWGrid1.RowCount - 1 do
236      png := TPngImage.Create;        for j := 0 to IWGrid1.ColumnCount - 1 do
     try  
       for i := 0 to IWGrid1.RowCount - 1 do  
237        begin        begin
238          for j := 0 to IWGrid1.ColumnCount - 1 do          s := DM.FDTable2.CreateBlobStream
239          begin            (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
240            st := DM.FDTable2.CreateBlobStream          try
241              (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);            png.LoadFromStream(s);
242            try            pic := TIWImageFile.Create(IWGrid1);
243              png.LoadFromStream(st);            pic.Picture.Assign(png);
244              pic := TIWImageFile.Create(Self);            IWGrid1.Cell[i, j].Control := pic;
245              pic.Picture.Assign(png);            IWGrid1.Cell[i, j].Text := k.ToString;
246              IWGrid1.Cell[i, j].Control := pic;            inc(k);
247              IWGrid1.Cell[i, j].Text := k.ToString;          finally
248              inc(k);            s.Free;
             DM.FDTable2.Prior;  
           finally  
             st.Free;  
           end;  
           if DM.FDTable2.Bof = true then  
             goto label1;  
249          end;          end;
250        end;        end;
     label1:  
     finally  
       png.Free;  
     end;  
   end  
   else  
     IWGrid1.RowCount := 0;  
   st := nil;  
   png := nil;  
   Randomize;  
   DM.FDTable2.Last;  
   DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));  
   st := DM.FDTable2.CreateBlobStream  
     (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);  
   png := TPngImage.Create;  
   try  
     png.LoadFromStream(st);  
     IWImageFile1.Picture.Assign(png);  
251    finally    finally
     st.Free;  
252      png.Free;      png.Free;
253    end;    end;
   IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;  
254  end;  end;
255    
256  procedure TTopForm.SetPage(const Value: TPage);  procedure TIWForm1.SetPage(const Value: TPage);
257  var  var
258    s: string;    x: Boolean;
259  begin  begin
260    UserSession.FPage := Value;    UserSession.FPage := Value;
261    case Value of    x := Value = Info;
262      Main:    IWRegion7.Visible := x;
263        s := 'toppage.htm';    IWLabel6.Visible := x;
264      Info:    IWDBLabel1.Visible := x;
265        s := 'mypage.htm';    IWLink1.Visible := not x;
266      IWText1.Visible := not x;
267      if x = true then
268      begin
269        IWLabel1.Caption := 'ようこそ';
270        IWLink2.Caption := 'ログアウト';
271      end
272      else
273      begin
274        IWLabel1.Caption := 'ようこそゲスト様';
275        IWLink2.Caption := 'ログイン';
276    end;    end;
   IWTemplateProcessorHTML1.Templates.Default := s;  
277  end;  end;
278    
279  initialization  initialization
280    
281  TTopForm.SetAsMainForm;  TIWForm1.SetAsMainForm;
282    
283  end.  end.
Legend:
Removed from v.1  
changed lines
  Added in v.2
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help