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 5 by yamat0jp, Tue Dec 29 08:41:54 2015 UTC revision 11 by yamat0jp, Fri Jul 22 23:40:03 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, Unit8, Vcl.Dialogs;    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 46  type Line 45  type
45      IWList3: TIWList;      IWList3: TIWList;
46      IWImage1: TIWImage;      IWImage1: TIWImage;
47      IWFrame8: TIWFrame8;      IWFrame8: TIWFrame8;
     IWLink3: TIWLink;  
48      IWLink4: TIWLink;      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);
# Line 56  type Line 58  type
58      procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);      procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
59      procedure IWFrame8IWButton1Click(Sender: TObject);      procedure IWFrame8IWButton1Click(Sender: TObject);
60      procedure IWFrame8IWLink1Click(Sender: TObject);      procedure IWFrame8IWLink1Click(Sender: TObject);
     procedure IWLink3Click(Sender: TObject);  
61      procedure IWLink4Click(Sender: TObject);      procedure IWLink4Click(Sender: TObject);
62        procedure IWLink3Click(Sender: TObject);
63        procedure IWLink5Click(Sender: TObject);
64        procedure IWLink6Click(Sender: TObject);
65    private    private
66      Filter: Boolean;      Filter: Boolean;
67      function GetPage: TPage;      function GetPage: Boolean;
68      procedure SetPage(const Value: TPage);      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, Unit4;  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 85  begin Line 103  begin
103    IWGrid1.RowCount := 0;    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;
# Line 109  begin Line 134  begin
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 169  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;
214        Params.ParamByName('num').AsInteger := UserSession.user_number;      end;
215        Open;      IWList2.Items.Add(i.ToString + '円');
216        First;      Close;
217        i := 0;      IWList3.Items.Clear;
218        while Eof = false do      SQL.Clear;
219        begin      SQL.Add('select name from recent_data join item_data');
220          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;      SQL.Add(' on (recent_data.serial = item_data.serial)');
221          i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;      SQL.Add(' where number = :num;');
222          IWList2.Items.Add(s);      Params.ParamByName('num').AsInteger := UserSession.user_number;
223          Next;      Open;
224        end;      First;
225        IWList2.Items.Add(i.ToString + '円');      while Eof = false do
226        Close;      begin
227        IWList3.Items.Clear;        IWList3.Items.Add(Fields.Fields[0].AsString);
228        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;  
229      end;      end;
230        Close;
231    end;    end;
232      LoadImage;
233    if IWGrid1.Visible = true then    if IWGrid1.Visible = true then
   begin  
234      IWLabel6.Visible := Filter;      IWLabel6.Visible := Filter;
     LoadImage;  
   end  
   else  
     DM.FDTable2.Locate('SERIAL', UserSession.Serial, []);  
235  end;  end;
236    
237  procedure TIWForm1.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
# Line 239  end; Line 258  end;
258    
259  procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);  procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
260  var  var
261    i: Integer;    i, j: Integer;
262      s: string;
263  begin  begin
264    if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then    if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
265    begin    begin
# Line 251  begin Line 271  begin
271      WebApplication.ShowMessage('１個以上のご注文が必要です');      WebApplication.ShowMessage('１個以上のご注文が必要です');
272      Exit;      Exit;
273    end;    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,
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    with DM.FDQuery1 do
288    begin    begin
289      SQL.Clear;      SQL.Clear;
# Line 266  begin Line 299  begin
299      else      else
300        AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);        AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
301    end;    end;
302    IWFrame8.IWEdit1.Text := '0';    WebApplication.ShowConfirm('カートに移動しますか', 'callback', '移動', 'はい', 'いいえ');
   if MessageDlg('カートに移動しますか', mtConfirmation, [mbYes, mbNo], 0) = mrYes then  
     TCartForm.Create(WebApplication).Show;  
303  end;  end;
304    
305  procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);  procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
306  begin  begin
307    UserSession.Thumbnail := true;    Thumbnail := true;
   IWFrame8.Visible := false;  
   IWGrid1.Visible := true;  
308  end;  end;
309    
310  procedure TIWForm1.IWGrid1CellClick(ASender: TObject;  procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
311    const ARow, AColumn: Integer);    const ARow, AColumn: Integer);
312  begin  begin
313    UserSession.Thumbnail := false;    Thumbnail := false;
   IWFrame8.Visible := true;  
314    IWFrame8.IWEdit1.Text := '1';    IWFrame8.IWEdit1.Text := '1';
   IWLabel6.Visible := false;  
   IWGrid1.Visible := false;  
315    UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);    UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
316  end;  end;
317    
318  procedure TIWForm1.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWLink1Click(Sender: TObject);
319  begin  begin
320    with TUserForm.Create(WebApplication) do    TUserForm.Create(WebApplication).Show;
   begin  
     Form := Self;  
     Show;  
   end;  
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;            SQL.Clear;
342            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')            SQL.Add('select * from user_data where number = :num');
343              .AsInteger;            Params.ParamByName('num').AsInteger := i;
344            IWEdit2.Text := '';            Open;
345              Delete;
346              SQL.Clear;
347              SQL.Add('select number from cart_data where number = :num;');
348              Params.ParamByName('num').AsInteger := i;
349              Open;
350              First;
351              while Eof = false do
352              begin
353                Edit;
354                FieldByName('number').AsInteger := UserSession.user_number;
355                Next;
356              end;
357          end;          end;
         IWEdit3.Text := '';  
358        end;        end;
359      Info:        Page := false;
360        begin      end;
361          DM.FDTable1.Filtered := false;      IWEdit3.Text := '';
362          Page := Main;    end
363          UserSession.user_number := 0;    else
364        end;      Page := true;
   end;  
365  end;  end;
366    
367  procedure TIWForm1.IWLink3Click(Sender: TObject);  procedure TIWForm1.IWLink3Click(Sender: TObject);
368  begin  begin
369    WebApplication.ShowMessage('ＯＫをクリックすると退会します');    with TMyPage.Create(WebApplication) do
370    Page := Main;    begin
371    DM.FDTable1.Delete;      Form := Self;
372        Show;
373      end;
374  end;  end;
375    
376  procedure TIWForm1.IWLink4Click(Sender: TObject);  procedure TIWForm1.IWLink4Click(Sender: TObject);
# Line 335  begin Line 378  begin
378    TCartForm.Create(WebApplication).Show;    TCartForm.Create(WebApplication).Show;
379  end;  end;
380    
381    procedure TIWForm1.IWLink5Click(Sender: TObject);
382    begin
383      TIWForm10.Create(WebApplication).Show;
384    end;
385    
386    procedure TIWForm1.IWLink6Click(Sender: TObject);
387    begin
388      Page := true;
389      TIWForm3.Create(WebApplication).Show;
390    end;
391    
392  procedure TIWForm1.LoadImage;  procedure TIWForm1.LoadImage;
393  var  var
394    s: TStream;    s: TStream;
# Line 349  begin Line 403  begin
403    ClearImage;    ClearImage;
404    png := TPngImage.Create;    png := TPngImage.Create;
405    try    try
406      i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;      if Thumbnail = true then
407      if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then      begin
408        inc(i);        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
409      IWGrid1.RowCount := i;        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
410      if DM.FDTable2.Filtered = false then          inc(i);
411        DM.FDTable2.Last        IWGrid1.RowCount := i;
412      else        if DM.FDTable2.Filtered = false then
413        DM.FDTable2.FindLast;          DM.FDTable2.Last
414      for i := 0 to IWGrid1.RowCount - 1 do        else
415        for j := 0 to IWGrid1.ColumnCount - 1 do          DM.FDTable2.FindLast;
416        begin        for i := 0 to IWGrid1.RowCount - 1 do
417          if DM.FDTable2.Filtered = false then          for j := 0 to IWGrid1.ColumnCount - 1 do
418          begin          begin
419            if DM.FDTable2.Bof = true then            if DM.FDTable2.Filtered = false then
420              begin
421                if DM.FDTable2.Bof = true then
422                  goto label1;
423              end
424              else if DM.FDTable2.Found = false then
425              goto label1;              goto label1;
426          end            if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
427          else if DM.FDTable2.Found = false then            begin
428            goto label1;              s := DM.FDTable2.CreateBlobStream
429          if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then                (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
430          begin              try
431            s := DM.FDTable2.CreateBlobStream                png.LoadFromStream(s);
432              (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);              finally
433            try                s.Free;
434              png.LoadFromStream(s);              end;
435            finally              pic := TIWImage.Create(IWGrid1);
436              s.Free;              pic.Picture.Assign(png);
437                IWGrid1.Cell[i, j].Control := pic;
438            end;            end;
439              t := DM.FDTable2.FieldByName('NAME').AsString;
440              if Length(t) > 10 then
441                t := Copy(t, 1, 8) + '..';
442              IWGrid1.Cell[i, j].Tag :=
443                Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
444              IWGrid1.Cell[i, j].Text := t;
445              IWGrid1.Cell[i, j].Alignment := taCenter;
446              IWGrid1.Cell[i, j].Clickable := true;
447              if DM.FDTable2.Filtered = false then
448                DM.FDTable2.Prior
449              else
450                DM.FDTable2.FindPrior;
451          end;          end;
452          t := DM.FDTable2.FieldByName('NAME').AsString;      label1:
453          if Length(t) > 10 then      end
454            t := Copy(t, 1, 8) + '..';      else if (DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true) and
455          pic := TIWImage.Create(IWGrid1);        (DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil) then
456          pic.Picture.Assign(png);      begin
457          IWGrid1.Cell[i, j].Control := pic;        s := DM.FDTable2.CreateBlobStream
458          IWGrid1.Cell[i, j].Tag :=          (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
459            Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);        try
460          IWGrid1.Cell[i, j].Text := t;          png.LoadFromStream(s);
461          IWGrid1.Cell[i, j].Alignment := taCenter;          IWFrame8.IWImage1.Picture.Assign(png);
462          IWGrid1.Cell[i, j].Clickable := true;        finally
463          if DM.FDTable2.Filtered = false then          s.Free;
           DM.FDTable2.Prior  
         else  
           DM.FDTable2.FindPrior;  
464        end;        end;
465    label1:      end
466        else
467          IWFrame8.IWImage1.Picture.Assign(nil);
468    finally    finally
469      png.Free;      png.Free;
470    end;    end;
# Line 429  begin Line 500  begin
500    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
501  end;  end;
502    
503  procedure TIWForm1.SetPage(const Value: TPage);  procedure TIWForm1.SetPage(const Value: Boolean);
 var  
   x: Boolean;  
504  begin  begin
505    UserSession.FPage := Value;    UserSession.FPage := Value;
506    x := Value = Info;    IWRegion7.Visible := not Value;
507    IWRegion7.Visible := x;    IWDBLabel1.Visible := not Value;
508    IWDBLabel1.Visible := x;    IWLink3.Visible := not Value;
509    IWLink3.Visible := x;    IWLink1.Visible := Value;
510    IWLink1.Visible := not x;    IWText1.Visible := Value;
511    IWText1.Visible := not x;    if Value = false then
   if x = true then  
512    begin    begin
513      IWLabel1.Caption := 'ようこそ';      IWLabel1.Caption := 'ようこそ';
514      IWLink2.Caption := 'ログアウト';      IWLink2.Caption := 'ログアウト';
515        WebApplication.Response.Cookies.AddCookie('user_cookie',
516          UserSession.user_number.ToString, '/', Date + 10);
517    end    end
518    else    else
519    begin    begin
520      IWLabel1.Caption := 'ようこそゲスト様';      IWLabel1.Caption := 'ようこそゲスト様';
521      IWLink2.Caption := 'ログイン';      IWLink2.Caption := 'ログイン';
522        Thumbnail := true;
523        IWText1.Text := '';
524        DM.FDTable2.Filtered := false;
525        Filter := false;
526        if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
527        begin
528          WebApplication.Response.Cookies.AddCookie('user_cookie',
529            UserSession.user_number.ToString, '/', Date - 1);
530          UserSession.user_number := 0;
531        end;
532    end;    end;
533  end;  end;
534    
535    procedure TIWForm1.SetThumbnail(const Value: Boolean);
536    begin
537      UserSession.FThumbnail := Value;
538      IWGrid1.Visible := Value;
539      IWFrame8.Visible := not Value;
540    end;
541    
542  initialization  initialization
543    
544  TIWForm1.SetAsMainForm;  TIWForm1.SetAsMainForm;
Legend:
Removed from v.5  
changed lines
  Added in v.11
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help