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 3 by yamat0jp, Sat Dec 26 07:30:17 2015 UTC revision 16 by yamat0jp, Sat Aug 6 08:27:34 2016 UTC
# Line 9  uses Line 9  uses
9    IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWDBStdCtrls,    IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWDBStdCtrls,
10    IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,    IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,
11    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
12    IWHTMLControls, IWCompExtCtrls, UserSessionUnit, PngImage, Data.DB,    IWHTMLControls, IWCompExtCtrls, PngImage, Data.DB,
13    IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,    IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14    IWCompMenu, Vcl.Menus, System.Variants;    IWCompMenu, Vcl.Menus, System.Variants, Vcl.Dialogs, System.UITypes, Unit8;
15    
16  type  type
17    TIWForm1 = class(TIWAppForm)    TIWForm1 = class(TIWAppForm)
     IWFrame1: TIWFrame1;  
18      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
19      IWLabel1: TIWLabel;      IWLabel1: TIWLabel;
20      IWDBLabel1: TIWDBLabel;      IWDBLabel1: TIWDBLabel;
# Line 40  type Line 39  type
39      IWLabel8: TIWLabel;      IWLabel8: TIWLabel;
40      IWList2: TIWList;      IWList2: TIWList;
41      IWLabel4: TIWLabel;      IWLabel4: TIWLabel;
     IWImageFile1: TIWImageFile;  
42      IWRegion7: TIWRegion;      IWRegion7: TIWRegion;
43      IWLabel5: TIWLabel;      IWLabel5: TIWLabel;
44      IWLabel6: TIWLabel;      IWLabel6: TIWLabel;
45      IWList3: TIWList;      IWList3: TIWList;
46        IWImage1: TIWImage;
47        IWFrame8: TIWFrame8;
48        IWLink4: TIWLink;
49        IWLink3: TIWLink;
50        IWLink5: TIWLink;
51        IWFrame1: TIWFrame1;
52        IWLink6: TIWLink;
53        IWLink7: TIWLink;
54      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
55      procedure IWLink2Click(Sender: TObject);      procedure IWLink2Click(Sender: TObject);
56      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
57      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
58      procedure IWLink1Click(Sender: TObject);      procedure IWLink1Click(Sender: TObject);
59        procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
60        procedure IWFrame8IWButton1Click(Sender: TObject);
61        procedure IWFrame8IWLink1Click(Sender: TObject);
62        procedure IWLink4Click(Sender: TObject);
63        procedure IWLink3Click(Sender: TObject);
64        procedure IWLink5Click(Sender: TObject);
65        procedure IWLink6Click(Sender: TObject);
66    private    private
67      function GetPage: TPage;      Filter: Boolean;
68      procedure SetPage(const Value: TPage);      function GetPage: Boolean;
69        procedure SetPage(const Value: Boolean);
70      procedure LoadImage;      procedure LoadImage;
71      procedure ClearImage;      procedure ClearImage;
72        function GetThumbnail: Boolean;
73        procedure CallBack(EventParams: TStringList);
74        procedure SetThumbnail(const Value: Boolean);
75    public    public
76      property Page: TPage read GetPage write SetPage;      property Page: Boolean read GetPage write SetPage;
77        property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
78    end;    end;
79    
80    var
81      IWForm1: TIWForm1;
82    
83  implementation  implementation
84    
85  {$R *.dfm}  {$R *.dfm}
86    
87  uses Unit3, ServerController, Unit6;  uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5, Unit11;
88    
89    procedure TIWForm1.CallBack(EventParams: TStringList);
90    begin
91      if SameText(EventParams.Values['RetValue'], 'true') = true then
92        TCartForm.Create(WebApplication).Show;
93      IWFrame8.IWEdit1.Text := '0';
94    end;
95    
96  procedure TIWForm1.ClearImage;  procedure TIWForm1.ClearImage;
97  var  var
# Line 73  begin Line 101  begin
101    for i := 0 to IWGrid1.RowCount - 1 do    for i := 0 to IWGrid1.RowCount - 1 do
102      for j := 0 to IWGrid1.ColumnCount - 1 do      for j := 0 to IWGrid1.ColumnCount - 1 do
103        IWGrid1.Cell[i, j].Control.Free;        IWGrid1.Cell[i, j].Control.Free;
104      IWGrid1.RowCount := 0;
105  end;  end;
106    
107  function TIWForm1.GetPage: TPage;  function TIWForm1.GetPage: Boolean;
108  begin  begin
109    result := UserSession.FPage;    result := UserSession.FPage;
110  end;  end;
111    
112    function TIWForm1.GetThumbnail: Boolean;
113    begin
114      result := UserSession.FThumbnail;
115    end;
116    
117  procedure TIWForm1.IWAppFormCreate(Sender: TObject);  procedure TIWForm1.IWAppFormCreate(Sender: TObject);
118  const  const
119    i = 120;    i = 120;
120  var  var
121    s: Integer;    s: Integer;
122  begin  begin
123      IWForm1 := Self;
124    Page := UserSession.FPage;    Page := UserSession.FPage;
125      Thumbnail := UserSession.FThumbnail;
126    s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;    s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
127    IWLabel2.BGColor := s;    IWLabel2.BGColor := s;
128    IWLabel3.BGColor := s;    IWLabel3.BGColor := s;
129    IWLabel5.BGColor := s;    IWLabel5.BGColor := s;
130      IWLabel7.BGColor := s;
131      IWLabel8.BGColor := s;
132    IWRegion1.Width := i;    IWRegion1.Width := i;
133    IWRegion2.Width := i;    IWRegion2.Width := i;
134    IWRegion4.Width := i;    IWRegion4.Width := i;
135    IWRegion5.Width := i;    IWRegion5.Width := i;
136    IWRegion6.Width := i;    IWRegion6.Width := i;
137    IWRegion7.Width := i;    IWRegion7.Width := i;
138      WebApplication.RegisterCallBack('callback', CallBack);
139  end;  end;
140    
141  procedure TIWForm1.IWAppFormRender(Sender: TObject);  procedure TIWForm1.IWAppFormRender(Sender: TObject);
# Line 157  begin Line 196  begin
196          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
197      end;      end;
198    IWList2.Items.Clear;    IWList2.Items.Clear;
199    if Page = TPage.Info then    with DM.FDQuery1 do
200    begin    begin
201      with DM.FDQuery1 do      SQL.Clear;
202        SQL.Add('select volume,name,price from cart_data,item_data');
203        SQL.Add(' where cart_data.serial = item_data.serial');
204        SQL.Add(' and number = :num;');
205        ParamByName('num').AsInteger := UserSession.user_number;
206        Open;
207        First;
208        i := 0;
209        while Eof = false do
210      begin      begin
211        SQL.Clear;        s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
212        SQL.Add('select volume,name,price from cart_data join item_data');        i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
213        SQL.Add(' on (cart_data.serial = item_data.serial)');        IWList2.Items.Add(s);
214        SQL.Add(' where number = :num;');        Next;
215        Params.ParamByName('num').AsInteger := UserSession.user_number;      end;
216        Open;      IWList2.Items.Add(i.ToString + '円');
217        First;      Close;
218        i := 0;      IWList3.Items.Clear;
219        while Eof = false do      SQL.Clear;
220        begin      SQL.Add('select name from recent_data,item_data');
221          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;      SQL.Add(' where recent_data.serial = item_data.serial');
222          i := i + Fields.Fields[2].AsInteger;      SQL.Add(' and number = :num;');
223          IWList2.Items.Add(s);      ParamByName('num').AsInteger := UserSession.user_number;
224          Next;      Open;
225        end;      First;
226        IWList2.Items.Add(i.ToString + '円');      while Eof = false do
227        Close;      begin
228        IWList3.Items.Clear;        IWList3.Items.Add(Fields.Fields[0].AsString);
229        SQL.Clear;        Next;
       SQL.Add('select name from recent_data join item_data');  
       SQL.Add(' on (recent_data.serial = item_data.serial)');  
       SQL.Add(' where number = :num;');  
       Params.ParamByName('num').AsInteger := UserSession.user_number;  
       Open;  
       First;  
       while Eof = false do  
       begin  
         IWList3.Items.Add(Fields.Fields[0].AsString);  
         Next;  
       end;  
       Close;  
230      end;      end;
231        Close;
232    end;    end;
233    LoadImage;    LoadImage;
234      if IWGrid1.Visible = true then
235        IWLabel6.Visible := Filter
236      else
237        DM.FDTable2.Locate('SERIAL', UserSession.Serial);
238  end;  end;
239    
240  procedure TIWForm1.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
241    var
242      i: Integer;
243  begin  begin
244    DM.FDTable2.Filtered := false;    IWFrame8IWLink1Click(Sender);
245    if IWEdit1.Text <> '' then    if IWEdit1.Text <> '' then
246    begin    begin
247      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%'+IWEdit1.Text+'%');      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
248      DM.FDTable2.Filtered := true;      DM.FDTable2.Filtered := true;
249      IWLabel6.Caption := IWEdit1.Text + 'を検索しています';      i := DM.FDTable2.RecordCount;
250        IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
251        if i = 0 then
252          DM.FDTable2.Filtered := false;
253        Filter := true;
254      end
255      else
256      begin
257        DM.FDTable2.Filtered := false;
258        Filter := false;
259      end;
260    end;
261    
262    procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
263    var
264      i, j: Integer;
265      s: string;
266    begin
267      if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
268      begin
269        WebApplication.ShowMessage('個数が不正です');
270        Exit;
271      end;
272      if i = 0 then
273      begin
274        WebApplication.ShowMessage('１個以上のご注文が必要です');
275        Exit;
276      end;
277      s := WebApplication.Request.CookieFields.Values['user_cookie'];
278      if s = '' then
279      begin
280        DM.FDTable1.Last;
281        j := DM.FDTable1.FieldByName('NUMBER').AsInteger + 1;
282        while DM.FDTable1.Lookup('NUMBER', j, 'NUMBER') = j do
283          inc(j);
284        UserSession.user_number := j;
285        DM.FDTable1.AppendRecord([nil, nil, nil, nil, nil, nil,
286          UserSession.user_number, Date]);
287        WebApplication.Response.Cookies.AddCookie('user_cookie',
288          UserSession.user_number.ToString, '/', Date + 10);
289      end;
290      with DM.FDQuery1 do
291      begin
292        Open('select * from cart_data;');
293        if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
294          UserSession.Serial]), []) = true then
295        begin
296          Edit;
297          FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
298          Post;
299        end
300        else
301          AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
302    end;    end;
303    IWLabel6.Visible := DM.FDTable2.Filtered;    WebApplication.ShowConfirm('カートに移動しますか', 'callback', '移動', 'はい', 'いいえ');
304    end;
305    
306    procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
307    begin
308      Thumbnail := true;
309    end;
310    
311    procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
312      const ARow, AColumn: Integer);
313    begin
314      Thumbnail := false;
315      UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
316  end;  end;
317    
318  procedure TIWForm1.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWLink1Click(Sender: TObject);
# Line 215  begin Line 321  begin
321  end;  end;
322    
323  procedure TIWForm1.IWLink2Click(Sender: TObject);  procedure TIWForm1.IWLink2Click(Sender: TObject);
324    var
325      i: Integer;
326  begin  begin
327    case Page of    if Page = true then
328      Main:    begin
329        i := UserSession.user_number;
330        if (DM.FDTable1.Locate('EMAIL;PASSWORD',
331          VarArrayOf([IWEdit2.Text, UserSession.hash(IWEdit3.Text)]),
332          [loCaseInsensitive]) = true) and
333          (DM.FDTable1.FieldByName('EMAIL').AsString <> '') then
334        begin
335          IWEdit2.Text := '';
336          UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
337          if i <> 0 then
338        begin        begin
339          if DM.FDTable1.Locate('EMAIL;PASSWORD',          with DM.FDQuery1 do
           VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true  
         then  
340          begin          begin
341            Page := Info;            Open('select * from user_data where number = :num', [i]);
342            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')            Delete;
343              .AsInteger;            Open('select number from cart_data where number = :num;', [i]);
344            IWEdit2.Text := '';            First;
345              while Eof = false do
346              begin
347                Edit;
348                FieldByName('number').AsInteger := UserSession.user_number;
349                Next;
350              end;
351          end;          end;
         IWEdit3.Text := '';  
       end;  
     Info:  
       begin  
         DM.FDTable1.Filtered := false;  
         Page := Main;  
352        end;        end;
353          Page := false;
354        end;
355        IWEdit3.Text := '';
356      end
357      else
358        Page := true;
359    end;
360    
361    procedure TIWForm1.IWLink3Click(Sender: TObject);
362    begin
363      with TMyPage.Create(WebApplication) do
364      begin
365        Form := Self;
366        Show;
367    end;    end;
368  end;  end;
369    
370    procedure TIWForm1.IWLink4Click(Sender: TObject);
371    begin
372      TCartForm.Create(WebApplication).Show;
373    end;
374    
375    procedure TIWForm1.IWLink5Click(Sender: TObject);
376    begin
377      TIWForm10.Create(WebApplication).Show;
378    end;
379    
380    procedure TIWForm1.IWLink6Click(Sender: TObject);
381    begin
382      Page := true;
383      if Sender = IWLink6 then
384        TAdminPage.Create(WebApplication).Show
385      else
386        TAdminFile.Create(WebApplication).Show;
387    end;
388    
389  procedure TIWForm1.LoadImage;  procedure TIWForm1.LoadImage;
390  var  var
391    s: TStream;    pic: TIWImage;
   png: TPngImage;  
   pic: TIWImageFile;  
392    i: Integer;    i: Integer;
393    j: Integer;    j: Integer;
394    k: Integer;    t: string;
395  label label1;  label label1;
396  begin  begin
397    ClearImage;    ClearImage;
398    exit;    if Thumbnail = true then
399    png:=TPngImage.Create;    begin
400    try      i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
401      IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;      if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
402      k := 1;        inc(i);
403        IWGrid1.RowCount := i;
404        if DM.FDTable2.Filtered = false then
405          DM.FDTable2.Last
406        else
407          DM.FDTable2.FindLast;
408      for i := 0 to IWGrid1.RowCount - 1 do      for i := 0 to IWGrid1.RowCount - 1 do
409        for j := 0 to IWGrid1.ColumnCount - 1 do        for j := 0 to IWGrid1.ColumnCount - 1 do
410        begin        begin
411          s := DM.FDTable2.CreateBlobStream          if DM.FDTable2.Filtered = false then
412            (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);          begin
413          try            if DM.FDTable2.Bof = true then
414            png.LoadFromStream(s);              goto label1;
415            pic := TIWImageFile.Create(IWGrid1);          end
416            pic.Picture.Assign(png);          else if DM.FDTable2.Found = false then
           IWGrid1.Cell[i, j].Control := pic;  
           IWGrid1.Cell[i, j].Text := k.ToString;  
           inc(k);  
         finally  
           s.Free;  
         end;  
         if DM.FDTable2.Bof = true then  
417            goto label1;            goto label1;
418            pic := TIWImage.Create(IWGrid1);
419            UserSession.FieldToImg(pic.Picture,
420              DM.FDTable2.FieldByName('THUMBNAIL'));
421            IWGrid1.Cell[i, j].Control := pic;
422            t := DM.FDTable2.FieldByName('NAME').AsString;
423            if Length(t) > 10 then
424              t := Copy(t, 1, 8) + '..';
425            IWGrid1.Cell[i, j].Tag :=
426              Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
427            IWGrid1.Cell[i, j].Text := t;
428            IWGrid1.Cell[i, j].Alignment := taCenter;
429            IWGrid1.Cell[i, j].Clickable := true;
430            if DM.FDTable2.Filtered = false then
431              DM.FDTable2.Prior
432            else
433              DM.FDTable2.FindPrior;
434        end;        end;
435    label1:    label1:
436    finally    end
437      png.Free;    else if DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true then
438    end;      UserSession.FieldToImg(IWFrame8.IWImage1.Picture,
439    png := nil;        DM.FDTable2.FieldByName('IMAGE'));
   s := nil;  
440    Randomize;    Randomize;
441    DM.FDTable2.Last;    DM.FDTableView.Filter := 'DATE > ' + QuotedStr(DateTimeToStr(Date - 10));
442    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));    DM.FDTableView.First;
443    s := DM.FDTable2.CreateBlobStream    DM.FDTableView.MoveBy(Random(DM.FDTableView.RecordCount));
444      (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);    UserSession.FieldToImg(IWImage1.Picture,
445    png := TPngImage.Create;      DM.FDTableView.FieldByName('THUMBNAIL'));
446    try    IWLabel4.Caption := DM.FDTableView.FieldByName('NAME').AsString;
     png.LoadFromStream(s);  
     IWImageFile1.Picture.Assign(png);  
   finally  
     png.Free;  
     s.Free;  
   end;  
   IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;  
447  end;  end;
448    
449  procedure TIWForm1.SetPage(const Value: TPage);  procedure TIWForm1.SetPage(const Value: Boolean);
 var  
   x: Boolean;  
450  begin  begin
451    UserSession.FPage := Value;    UserSession.FPage := Value;
452    x := Value = Info;    IWRegion7.Visible := not Value;
453    IWRegion7.Visible := x;    IWDBLabel1.Visible := not Value;
454    IWLabel6.Visible := x;    IWLink3.Visible := not Value;
455    IWDBLabel1.Visible := x;    IWLink1.Visible := Value;
456    IWLink1.Visible := not x;    IWText1.Visible := Value;
457    IWText1.Visible := not x;    if Value = false then
   if x = true then  
458    begin    begin
459      IWLabel1.Caption := 'ようこそ';      IWLabel1.Caption := 'ようこそ';
460      IWLink2.Caption := 'ログアウト';      IWLink2.Caption := 'ログアウト';
461        WebApplication.Response.Cookies.AddCookie('user_cookie',
462          UserSession.user_number.ToString, '/', Date + 10);
463    end    end
464    else    else
465    begin    begin
466      IWLabel1.Caption := 'ようこそゲスト様';      IWLabel1.Caption := 'ようこそゲスト様';
467      IWLink2.Caption := 'ログイン';      IWLink2.Caption := 'ログイン';
468        Thumbnail := true;
469        IWText1.Text := '';
470        DM.FDTable2.Filtered := false;
471        Filter := false;
472        if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
473        begin
474          WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/',
475            Date - 1);
476          UserSession.user_number := 0;
477        end;
478    end;    end;
479  end;  end;
480    
481    procedure TIWForm1.SetThumbnail(const Value: Boolean);
482    begin
483      UserSession.FThumbnail := Value;
484      IWGrid1.Visible := Value;
485      IWFrame8.Visible := not Value;
486    end;
487    
488  initialization  initialization
489    
490  TIWForm1.SetAsMainForm;  TIWForm1.SetAsMainForm;
Legend:
Removed from v.3  
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