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