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 8 by yamat0jp, Thu Dec 31 08:51:02 2015 UTC revision 15 by yamat0jp, Fri Aug 5 10:33:26 2016 UTC
# Line 49  type Line 49  type
49      IWLink3: TIWLink;      IWLink3: TIWLink;
50      IWLink5: TIWLink;      IWLink5: TIWLink;
51      IWFrame1: TIWFrame1;      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);
# Line 60  type Line 62  type
62      procedure IWLink4Click(Sender: TObject);      procedure IWLink4Click(Sender: TObject);
63      procedure IWLink3Click(Sender: TObject);      procedure IWLink3Click(Sender: TObject);
64      procedure IWLink5Click(Sender: TObject);      procedure IWLink5Click(Sender: TObject);
65        procedure IWLink6Click(Sender: TObject);
66    private    private
67      Filter: Boolean;      Filter: Boolean;
68      function GetPage: Boolean;      function GetPage: Boolean;
# Line 67  type Line 70  type
70      procedure LoadImage;      procedure LoadImage;
71      procedure ClearImage;      procedure ClearImage;
72      function GetThumbnail: Boolean;      function GetThumbnail: Boolean;
73        procedure CallBack(EventParams: TStringList);
74      procedure SetThumbnail(const Value: Boolean);      procedure SetThumbnail(const Value: Boolean);
     property Thumbnail: Boolean read GetThumbnail write SetThumbnail;  
75    public    public
76      property Page: Boolean 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  var
# Line 80  implementation Line 84  implementation
84    
85  {$R *.dfm}  {$R *.dfm}
86    
87  uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10;  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 124  begin Line 135  begin
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 184  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 = false 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;
       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[0].AsInteger * 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;  
215      end;      end;
216        IWList2.Items.Add(i.ToString + '円');
217        Close;
218        IWList3.Items.Clear;
219        SQL.Clear;
220        SQL.Add('select name from recent_data,item_data');
221        SQL.Add(' where recent_data.serial = item_data.serial');
222        SQL.Add(' and number = :num;');
223        ParamByName('num').AsInteger := UserSession.user_number;
224        Open;
225        First;
226        while Eof = false do
227        begin
228          IWList3.Items.Add(Fields.Fields[0].AsString);
229          Next;
230        end;
231        Close;
232    end;    end;
233    LoadImage;    LoadImage;
234    if IWGrid1.Visible = true then    if IWGrid1.Visible = true then
235      IWLabel6.Visible := Filter;      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);
# Line 250  end; Line 261  end;
261    
262  procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);  procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
263  var  var
264    i: Integer;    i, j: Integer;
265      s: string;
266  begin  begin
267    if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then    if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
268    begin    begin
# Line 262  begin Line 274  begin
274      WebApplication.ShowMessage('１個以上のご注文が必要です');      WebApplication.ShowMessage('１個以上のご注文が必要です');
275      Exit;      Exit;
276    end;    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    with DM.FDQuery1 do
291    begin    begin
292      SQL.Clear;      Open('select * from cart_data;');
     SQL.Add('select * from cart_data;');  
     Open;  
293      if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,      if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
294        UserSession.Serial]), []) = true then        UserSession.Serial]), []) = true then
295      begin      begin
# Line 277  begin Line 300  begin
300      else      else
301        AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);        AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
302    end;    end;
303    IWFrame8.IWEdit1.Text := '0';    WebApplication.ShowConfirm('カートに移動しますか', 'callback', '移動', 'はい', 'いいえ');
   if MessageDlg('カートに移動しますか', mtConfirmation, [mbYes, mbNo], 0) = mrYes then  
     TCartForm.Create(WebApplication).Show;  
304  end;  end;
305    
306  procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);  procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
# Line 291  procedure TIWForm1.IWGrid1CellClick(ASen Line 312  procedure TIWForm1.IWGrid1CellClick(ASen
312    const ARow, AColumn: Integer);    const ARow, AColumn: Integer);
313  begin  begin
314    Thumbnail := false;    Thumbnail := false;
   IWFrame8.IWEdit1.Text := '1';  
315    UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);    UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
316  end;  end;
317    
# Line 301  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    if Page = true then    if Page = true then
328    begin    begin
329      if DM.FDTable1.Locate('EMAIL;PASSWORD',      i := UserSession.user_number;
330        VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true then      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      begin
       Page := false;  
       UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;  
335        IWEdit2.Text := '';        IWEdit2.Text := '';
336          UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
337          if i <> 0 then
338          begin
339            with DM.FDQuery1 do
340            begin
341              Open('select * from user_data where number = :num', [i]);
342              Delete;
343              Open('select number from cart_data where number = :num;', [i]);
344              First;
345              while Eof = false do
346              begin
347                Edit;
348                FieldByName('number').AsInteger := UserSession.user_number;
349                Next;
350              end;
351            end;
352          end;
353          Page := false;
354      end;      end;
355      IWEdit3.Text := '';      IWEdit3.Text := '';
356    end    end
357    else    else
   begin  
     UserSession.user_number := 0;  
358      Page := true;      Page := true;
   end;  
359  end;  end;
360    
361  procedure TIWForm1.IWLink3Click(Sender: TObject);  procedure TIWForm1.IWLink3Click(Sender: TObject);
# Line 339  begin Line 377  begin
377    TIWForm10.Create(WebApplication).Show;    TIWForm10.Create(WebApplication).Show;
378  end;  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;    s: TStream;
# Line 346  var Line 393  var
393    pic: TIWImage;    pic: TIWImage;
394    i: Integer;    i: Integer;
395    j: Integer;    j: Integer;
   x: Boolean;  
396    t: string;    t: string;
397  label label1;  label label1;
398  begin  begin
# Line 373  begin Line 419  begin
419            end            end
420            else if DM.FDTable2.Found = false then            else if DM.FDTable2.Found = false then
421              goto label1;              goto label1;
422            if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then            if DM.FDTable2.FieldByName('THUMBNAIL').IsNull = false then
423            begin            begin
424              s := DM.FDTable2.CreateBlobStream              s := DM.FDTable2.CreateBlobStream
425                (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);                (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
# Line 401  begin Line 447  begin
447          end;          end;
448      label1:      label1:
449      end      end
450      else if (DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true) and      else if DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true then
451        (DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil) then        if DM.FDTable2.FieldByName('IMAGE').IsNull = false then
452      begin        begin
453        s := DM.FDTable2.CreateBlobStream          s := DM.FDTable2.CreateBlobStream
454          (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);            (DM.FDTable2.FieldByName('IMAGE'), bmRead);
455        try          try
456          png.LoadFromStream(s);            png.LoadFromStream(s);
457            finally
458              s.Free;
459            end;
460          IWFrame8.IWImage1.Picture.Assign(png);          IWFrame8.IWImage1.Picture.Assign(png);
461        finally        end
462          s.Free;        else
463        end;          IWFrame8.IWImage1.Picture.Assign(nil);
     end  
     else  
       IWFrame8.IWImage1.Picture.Assign(nil);  
464    finally    finally
465      png.Free;      png.Free;
466    end;    end;
   png := nil;  
   s := nil;  
467    Randomize;    Randomize;
468    if DM.FDTable2.Filtered = true then    DM.FDTableView.Filter := 'DATE > '+QuotedStr(DateTimeToStr(Date-10));
469      DM.FDTableView.First;
470      DM.FDTableView.MoveBy(Random(DM.FDTableView.RecordCount));
471      if DM.FDTableView.FieldByName('THUMBNAIL').IsNull = false then
472    begin    begin
473      x := true;      s := DM.FDTableView.CreateBlobStream
474      DM.FDTable2.Filtered := false;        (DM.FDTableView.FieldByName('THUMBNAIL'), bmRead);
   end  
   else  
     x := false;  
   DM.FDTable2.Last;  
   if DM.FDTable2.Bof = true then  
     Exit;  
   DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));  
   if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then  
   begin  
     s := DM.FDTable2.CreateBlobStream  
       (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);  
475      png := TPngImage.Create;      png := TPngImage.Create;
476      try      try
477        png.LoadFromStream(s);        png.LoadFromStream(s);
# Line 445  begin Line 481  begin
481        s.Free;        s.Free;
482      end;      end;
483    end;    end;
484    if x = true then    IWLabel4.Caption := DM.FDTableView.FieldByName('NAME').AsString;
     DM.FDTable2.Filtered := true;  
   IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;  
485  end;  end;
486    
487  procedure TIWForm1.SetPage(const Value: Boolean);  procedure TIWForm1.SetPage(const Value: Boolean);
# Line 462  begin Line 496  begin
496    begin    begin
497      IWLabel1.Caption := 'ようこそ';      IWLabel1.Caption := 'ようこそ';
498      IWLink2.Caption := 'ログアウト';      IWLink2.Caption := 'ログアウト';
499        WebApplication.Response.Cookies.AddCookie('user_cookie',
500          UserSession.user_number.ToString, '/', Date + 10);
501    end    end
502    else    else
503    begin    begin
# Line 471  begin Line 507  begin
507      IWText1.Text := '';      IWText1.Text := '';
508      DM.FDTable2.Filtered := false;      DM.FDTable2.Filtered := false;
509      Filter := false;      Filter := false;
510        if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
511        begin
512          WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/',
513            Date - 1);
514          UserSession.user_number := 0;
515        end;
516    end;    end;
517  end;  end;
518    
Legend:
Removed from v.8  
changed lines
  Added in v.15
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help