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 11 by yamat0jp, Fri Jul 22 23:40:03 2016 UTC revision 18 by yamat0jp, Sat Aug 27 11:00:30 2016 UTC
# Line 50  type Line 50  type
50      IWLink5: TIWLink;      IWLink5: TIWLink;
51      IWFrame1: TIWFrame1;      IWFrame1: TIWFrame1;
52      IWLink6: TIWLink;      IWLink6: TIWLink;
53        IWLink7: TIWLink;
54        IWLink8: TIWLink;
55      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
56      procedure IWLink2Click(Sender: TObject);      procedure IWLink2Click(Sender: TObject);
57      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
# Line 62  type Line 64  type
64      procedure IWLink3Click(Sender: TObject);      procedure IWLink3Click(Sender: TObject);
65      procedure IWLink5Click(Sender: TObject);      procedure IWLink5Click(Sender: TObject);
66      procedure IWLink6Click(Sender: TObject);      procedure IWLink6Click(Sender: TObject);
67        procedure IWLink8Click(Sender: TObject);
68    private    private
69      Filter: Boolean;      Filter: Boolean;
70      function GetPage: Boolean;      function GetPage: Boolean;
# Line 83  implementation Line 86  implementation
86    
87  {$R *.dfm}  {$R *.dfm}
88    
89  uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5;  uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5, Unit11,
90      Unit13, Unit14;
91    
92    const
93      table2filter = 'AGREE = true and ACTIVATE = true';
94    
95  procedure TIWForm1.CallBack(EventParams: TStringList);  procedure TIWForm1.CallBack(EventParams: TStringList);
96  begin  begin
# Line 135  begin Line 142  begin
142    IWRegion6.Width := i;    IWRegion6.Width := i;
143    IWRegion7.Width := i;    IWRegion7.Width := i;
144    WebApplication.RegisterCallBack('callback', CallBack);    WebApplication.RegisterCallBack('callback', CallBack);
145      DM.FDTable2.Filter := table2filter;
146  end;  end;
147    
148  procedure TIWForm1.IWAppFormRender(Sender: TObject);  procedure TIWForm1.IWAppFormRender(Sender: TObject);
# Line 145  begin Line 153  begin
153    IWList1.Items.Clear;    IWList1.Items.Clear;
154    with DM.FDTable2 do    with DM.FDTable2 do
155    begin    begin
156      if Filtered = true then      FindFirst;
157        while Found = true do
158      begin      begin
159        FindFirst;        s := FieldByName('CATEGORY').AsString;
160        while Found = true do        if s = '' then
161          begin
162            FindNext;
163            continue;
164          end;
165          if DM.FDTable2.Filter = table2filter then
166          begin
167            i := IWList1.Items.IndexOf(s);
168            if i = -1 then
169              IWList1.Items.Add(s);
170          end
171          else
172        begin        begin
         s := FieldByName('CATEGORY').AsString;  
         if s = '' then  
         begin  
           FindNext;  
           continue;  
         end;  
173          i := IWList1.Items.IndexOfName(s);          i := IWList1.Items.IndexOfName(s);
174          if i = -1 then          if i = -1 then
175            IWList1.Items.Add(s + '=1')            IWList1.Items.Add(s + '=1')
# Line 164  begin Line 178  begin
178            j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;            j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
179            IWList1.Items[i] := s + '=' + j.ToString;            IWList1.Items[i] := s + '=' + j.ToString;
180          end;          end;
         FindNext;  
       end;  
     end  
     else  
     begin  
       First;  
       while Eof = false do  
       begin  
         s := FieldByName('CATEGORY').AsString;  
         if s = '' then  
         begin  
           Next;  
           continue;  
         end;  
         i := IWList1.Items.IndexOf(s);  
         if i = -1 then  
           IWList1.Items.Add(s);  
         Next;  
181        end;        end;
182          FindNext;
183      end;      end;
184    end;    end;
185    if DM.FDTable2.Filtered = true then    if DM.FDTable2.Filter <> table2filter then
186      for i := 0 to IWList1.Items.Count - 1 do      for i := 0 to IWList1.Items.Count - 1 do
187      begin      begin
188        s := IWList1.Items.ValueFromIndex[i];        s := IWList1.Items.ValueFromIndex[i];
189        if s = '1' then        IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
         IWList1.Items[i] := IWList1.Items.Names[i]  
       else  
         IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';  
190      end;      end;
191    IWList2.Items.Clear;    IWList2.Items.Clear;
192    with DM.FDQuery1 do    with DM.FDQuery1 do
193    begin    begin
194      SQL.Clear;      SQL.Clear;
195      SQL.Add('select volume,name,price from cart_data join item_data');      SQL.Add('select volume,name,price from cart_data,item_data');
196      SQL.Add(' on (cart_data.serial = item_data.serial)');      SQL.Add(' where cart_data.serial = item_data.serial');
197      SQL.Add(' where number = :num;');      SQL.Add(' and number = :num;');
198      Params.ParamByName('num').AsInteger := UserSession.user_number;      ParamByName('num').AsInteger := UserSession.user_number;
199      Open;      Open;
200      First;      First;
201      i := 0;      i := 0;
# Line 216  begin Line 210  begin
210      Close;      Close;
211      IWList3.Items.Clear;      IWList3.Items.Clear;
212      SQL.Clear;      SQL.Clear;
213      SQL.Add('select name from recent_data join item_data');      SQL.Add('select name from recent_data,item_data');
214      SQL.Add(' on (recent_data.serial = item_data.serial)');      SQL.Add(' where recent_data.serial = item_data.serial');
215      SQL.Add(' where number = :num;');      SQL.Add(' and number = :num;');
216      Params.ParamByName('num').AsInteger := UserSession.user_number;      ParamByName('num').AsInteger := UserSession.user_number;
217      Open;      Open;
218      First;      First;
219      while Eof = false do      while Eof = false do
# Line 230  begin Line 224  begin
224      Close;      Close;
225    end;    end;
226    LoadImage;    LoadImage;
227    if IWGrid1.Visible = true then    if IWGrid1.Visible = false then
228      IWLabel6.Visible := Filter;      DM.FDTable2.Locate('SERIAL', UserSession.Serial);
229  end;  end;
230    
231  procedure TIWForm1.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
232  var  var
233    i: Integer;    i: Integer;
234    label searchout;
235  begin  begin
236    IWFrame8IWLink1Click(Sender);    IWFrame8IWLink1Click(Sender);
237    if IWEdit1.Text <> '' then    if IWEdit1.Text <> '' then
238    begin    begin
239      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');      DM.FDTable2.Filter := table2filter + ' and NAME like ' +
240      DM.FDTable2.Filtered := true;        QuotedStr('%' + IWEdit1.Text + '%');
241      i := DM.FDTable2.RecordCount;      i := DM.FDTable2.RecordCount;
     IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);  
242      if i = 0 then      if i = 0 then
243        DM.FDTable2.Filtered := false;        goto searchout
244      Filter := true;      else
245        begin
246          IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
247          IWLabel6.Visible := true;
248        end;
249    end    end
250    else    else
251    begin    begin
252      DM.FDTable2.Filtered := false;    searchout:
253      Filter := false;      DM.FDTable2.Filter := table2filter;
254        IWLabel6.Visible := false;
255    end;    end;
256  end;  end;
257    
# Line 279  begin Line 278  begin
278      while DM.FDTable1.Lookup('NUMBER', j, 'NUMBER') = j do      while DM.FDTable1.Lookup('NUMBER', j, 'NUMBER') = j do
279        inc(j);        inc(j);
280      UserSession.user_number := j;      UserSession.user_number := j;
281      DM.FDTable1.AppendRecord([nil, nil, nil, nil, nil,      DM.FDTable1.AppendRecord([nil, nil, nil, nil, nil, nil,
282        UserSession.user_number, Date]);        UserSession.user_number, Date]);
283      WebApplication.Response.Cookies.AddCookie('user_cookie',      WebApplication.Response.Cookies.AddCookie('user_cookie',
284        UserSession.user_number.ToString, '/', Date + 10);        UserSession.user_number.ToString, '/', Date + 10);
285    end;    end;
286    with DM.FDQuery1 do    with DM.FDQuery1 do
287    begin    begin
288      SQL.Clear;      Open('select * from cart_data;');
     SQL.Add('select * from cart_data;');  
     Open;  
289      if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,      if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
290        UserSession.Serial]), []) = true then        UserSession.Serial]), []) = true then
291      begin      begin
# Line 311  procedure TIWForm1.IWGrid1CellClick(ASen Line 308  procedure TIWForm1.IWGrid1CellClick(ASen
308    const ARow, AColumn: Integer);    const ARow, AColumn: Integer);
309  begin  begin
310    Thumbnail := false;    Thumbnail := false;
   IWFrame8.IWEdit1.Text := '1';  
311    UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);    UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
312  end;  end;
313    
# Line 338  begin Line 334  begin
334        begin        begin
335          with DM.FDQuery1 do          with DM.FDQuery1 do
336          begin          begin
337            SQL.Clear;            Open('select * from user_data where number = :num', [i]);
           SQL.Add('select * from user_data where number = :num');  
           Params.ParamByName('num').AsInteger := i;  
           Open;  
338            Delete;            Delete;
339            SQL.Clear;            Open('select number from cart_data where number = :num;', [i]);
           SQL.Add('select number from cart_data where number = :num;');  
           Params.ParamByName('num').AsInteger := i;  
           Open;  
340            First;            First;
341            while Eof = false do            while Eof = false do
342            begin            begin
# Line 386  end; Line 376  end;
376  procedure TIWForm1.IWLink6Click(Sender: TObject);  procedure TIWForm1.IWLink6Click(Sender: TObject);
377  begin  begin
378    Page := true;    Page := true;
379    TIWForm3.Create(WebApplication).Show;    if Sender = IWLink6 then
380        TAdminPage.Create(WebApplication).Show
381      else
382        TAdminFile.Create(WebApplication).Show;
383    end;
384    
385    procedure TIWForm1.IWLink8Click(Sender: TObject);
386    begin
387      TMasterForm.Create(WebApplication).Show;
388  end;  end;
389    
390  procedure TIWForm1.LoadImage;  procedure TIWForm1.LoadImage;
391  var  var
   s: TStream;  
   png: TPngImage;  
392    pic: TIWImage;    pic: TIWImage;
393    i: Integer;    i: Integer;
394    j: Integer;    j: Integer;
   x: Boolean;  
395    t: string;    t: string;
396  label label1;  label label1;
397  begin  begin
398    ClearImage;    ClearImage;
399    png := TPngImage.Create;    if Thumbnail = true then
   try  
     if Thumbnail = true then  
     begin  
       i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;  
       if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then  
         inc(i);  
       IWGrid1.RowCount := i;  
       if DM.FDTable2.Filtered = false then  
         DM.FDTable2.Last  
       else  
         DM.FDTable2.FindLast;  
       for i := 0 to IWGrid1.RowCount - 1 do  
         for j := 0 to IWGrid1.ColumnCount - 1 do  
         begin  
           if DM.FDTable2.Filtered = false then  
           begin  
             if DM.FDTable2.Bof = true then  
               goto label1;  
           end  
           else if DM.FDTable2.Found = false then  
             goto label1;  
           if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then  
           begin  
             s := DM.FDTable2.CreateBlobStream  
               (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);  
             try  
               png.LoadFromStream(s);  
             finally  
               s.Free;  
             end;  
             pic := TIWImage.Create(IWGrid1);  
             pic.Picture.Assign(png);  
             IWGrid1.Cell[i, j].Control := pic;  
           end;  
           t := DM.FDTable2.FieldByName('NAME').AsString;  
           if Length(t) > 10 then  
             t := Copy(t, 1, 8) + '..';  
           IWGrid1.Cell[i, j].Tag :=  
             Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);  
           IWGrid1.Cell[i, j].Text := t;  
           IWGrid1.Cell[i, j].Alignment := taCenter;  
           IWGrid1.Cell[i, j].Clickable := true;  
           if DM.FDTable2.Filtered = false then  
             DM.FDTable2.Prior  
           else  
             DM.FDTable2.FindPrior;  
         end;  
     label1:  
     end  
     else if (DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true) and  
       (DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil) then  
     begin  
       s := DM.FDTable2.CreateBlobStream  
         (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);  
       try  
         png.LoadFromStream(s);  
         IWFrame8.IWImage1.Picture.Assign(png);  
       finally  
         s.Free;  
       end;  
     end  
     else  
       IWFrame8.IWImage1.Picture.Assign(nil);  
   finally  
     png.Free;  
   end;  
   png := nil;  
   s := nil;  
   Randomize;  
   if DM.FDTable2.Filtered = true then  
400    begin    begin
401      x := true;      i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
402      DM.FDTable2.Filtered := false;      if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
403          inc(i);
404        IWGrid1.RowCount := i;
405        DM.FDTable2.FindLast;
406        for i := 0 to IWGrid1.RowCount - 1 do
407          for j := 0 to IWGrid1.ColumnCount - 1 do
408          begin
409            if DM.FDTable2.Found = false then
410              goto label1;
411            pic := TIWImage.Create(IWGrid1);
412            UserSession.FieldToImg(pic.Picture,
413              DM.FDTable2.FieldByName('THUMBNAIL'));
414            IWGrid1.Cell[i, j].Control := pic;
415            t := DM.FDTable2.FieldByName('NAME').AsString;
416            if Length(t) > 10 then
417              t := Copy(t, 1, 8) + '..';
418            IWGrid1.Cell[i, j].Tag :=
419              Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
420            IWGrid1.Cell[i, j].Text := t;
421            IWGrid1.Cell[i, j].Alignment := taCenter;
422            IWGrid1.Cell[i, j].Clickable := true;
423            DM.FDTable2.FindPrior;
424          end;
425      label1:
426    end    end
427    else    else if DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true then
428      x := false;      UserSession.FieldToImg(IWFrame8.IWImage1.Picture,
429    DM.FDTable2.Last;        DM.FDTable2.FieldByName('IMAGE'));
430    if DM.FDTable2.Bof = true then    Randomize;
431      Exit;    DM.FDTableView.Filter := 'DATE > ' + QuotedStr(DateTimeToStr(Date - 10));
432    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));    DM.FDTableView.First;
433    if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then    DM.FDTableView.MoveBy(Random(DM.FDTableView.RecordCount));
434    begin    UserSession.FieldToImg(IWImage1.Picture,
435      s := DM.FDTable2.CreateBlobStream      DM.FDTableView.FieldByName('THUMBNAIL'));
436        (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);    IWLabel4.Caption := DM.FDTableView.FieldByName('NAME').AsString;
     png := TPngImage.Create;  
     try  
       png.LoadFromStream(s);  
       IWImage1.Picture.Assign(png);  
     finally  
       png.Free;  
       s.Free;  
     end;  
   end;  
   if x = true then  
     DM.FDTable2.Filtered := true;  
   IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;  
437  end;  end;
438    
439  procedure TIWForm1.SetPage(const Value: Boolean);  procedure TIWForm1.SetPage(const Value: Boolean);
# Line 525  begin Line 461  begin
461      Filter := false;      Filter := false;
462      if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then      if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
463      begin      begin
464        WebApplication.Response.Cookies.AddCookie('user_cookie',        WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/',
465          UserSession.user_number.ToString, '/', Date - 1);          Date - 1);
466        UserSession.user_number := 0;        UserSession.user_number := 0;
467      end;      end;
468    end;    end;
# Line 536  procedure TIWForm1.SetThumbnail(const Va Line 472  procedure TIWForm1.SetThumbnail(const Va
472  begin  begin
473    UserSession.FThumbnail := Value;    UserSession.FThumbnail := Value;
474    IWGrid1.Visible := Value;    IWGrid1.Visible := Value;
475      IWFrame8.IWEdit1.Text := '1';
476    IWFrame8.Visible := not Value;    IWFrame8.Visible := not Value;
477  end;  end;
478    
Legend:
Removed from v.11  
changed lines
  Added in v.18
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help