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 15 by yamat0jp, Fri Aug 5 10:33:26 2016 UTC revision 20 by yamat0jp, Sat Aug 27 21:03:47 2016 UTC
# Line 51  type Line 51  type
51      IWFrame1: TIWFrame1;      IWFrame1: TIWFrame1;
52      IWLink6: TIWLink;      IWLink6: TIWLink;
53      IWLink7: TIWLink;      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 63  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;      function SearchCount: Integer;
70      function GetPage: Boolean;      function GetPage: Boolean;
71      procedure SetPage(const Value: Boolean);      procedure SetPage(const Value: Boolean);
72      procedure LoadImage;      procedure LoadImage;
# Line 84  implementation Line 86  implementation
86    
87  {$R *.dfm}  {$R *.dfm}
88    
89  uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5, Unit11;  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 136  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 146  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 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 165  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      begin
187      for i := 0 to IWList1.Items.Count - 1 do      for i := 0 to IWList1.Items.Count - 1 do
188      begin      begin
189        s := IWList1.Items.ValueFromIndex[i];        s := IWList1.Items.ValueFromIndex[i];
190        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 + ')';  
191      end;      end;
192      end;
193    IWList2.Items.Clear;    IWList2.Items.Clear;
194    with DM.FDQuery1 do    with DM.FDQuery1 do
195    begin    begin
# Line 231  begin Line 226  begin
226      Close;      Close;
227    end;    end;
228    LoadImage;    LoadImage;
229    if IWGrid1.Visible = true then    if IWGrid1.Visible = false then
230      IWLabel6.Visible := Filter      DM.FDTable2.Locate('SERIAL', UserSession.Serial);
   else  
     DM.FDTable2.Locate('SERIAL',UserSession.Serial);  
231  end;  end;
232    
233  procedure TIWForm1.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
234  var  var
235      s: TStringList;
236      t: string;
237    i: Integer;    i: Integer;
238  begin  begin
239    IWFrame8IWLink1Click(Sender);    Thumbnail := true;
240    if IWEdit1.Text <> '' then    if IWEdit1.Text <> '' then
241    begin    begin
242      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');      s := TStringList.Create;
243      DM.FDTable2.Filtered := true;      try
244      i := DM.FDTable2.RecordCount;        s.Delimiter := ' ';
245      IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);        s.DelimitedText := IWEdit1.Text;
246      if i = 0 then        for i := 0 to s.Count - 1 do
247        DM.FDTable2.Filtered := false;        begin
248      Filter := true;          t := t + 'NAME like ' + QuotedStr('%' + s[i] + '%');
249            if i < s.Count - 1 then
250              t := t + ' or '
251            else
252              t := '(' + t + ')';
253          end;
254          DM.FDTable2.Filter := table2filter + ' and ' + t;
255          i := SearchCount;
256          if i = 0 then
257          begin
258            DM.FDTable2.Filter := table2filter;
259            IWLabel6.Caption := '該当する商品が見つかりませんでした';
260          end
261          else
262            IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
263          IWLabel6.Visible := true;
264        finally
265          s.Free;
266        end;
267    end    end
268    else    else
269    begin    begin
270      DM.FDTable2.Filtered := false;      DM.FDTable2.Filter := table2filter;
271      Filter := false;      IWLabel6.Visible := false;
272    end;    end;
273  end;  end;
274    
# Line 386  begin Line 399  begin
399      TAdminFile.Create(WebApplication).Show;      TAdminFile.Create(WebApplication).Show;
400  end;  end;
401    
402    procedure TIWForm1.IWLink8Click(Sender: TObject);
403    begin
404      TMasterForm.Create(WebApplication).Show;
405    end;
406    
407  procedure TIWForm1.LoadImage;  procedure TIWForm1.LoadImage;
408  var  var
   s: TStream;  
   png: TPngImage;  
409    pic: TIWImage;    pic: TIWImage;
410    i: Integer;    i: Integer;
411    j: Integer;    j: Integer;
# Line 397  var Line 413  var
413  label label1;  label label1;
414  begin  begin
415    ClearImage;    ClearImage;
416    png := TPngImage.Create;    if Thumbnail = true then
417    try    begin
418      if Thumbnail = true then      i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
419      begin      if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
420        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;        inc(i);
421        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then      IWGrid1.RowCount := i;
422          inc(i);      DM.FDTable2.FindLast;
423        IWGrid1.RowCount := i;      for i := 0 to IWGrid1.RowCount - 1 do
424        if DM.FDTable2.Filtered = false then        for j := 0 to IWGrid1.ColumnCount - 1 do
         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').IsNull = false 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 then  
       if DM.FDTable2.FieldByName('IMAGE').IsNull = false then  
425        begin        begin
426          s := DM.FDTable2.CreateBlobStream          if DM.FDTable2.Found = false then
427            (DM.FDTable2.FieldByName('IMAGE'), bmRead);            goto label1;
428          try          pic := TIWImage.Create(IWGrid1);
429            png.LoadFromStream(s);          UserSession.FieldToImg(pic.Picture,
430          finally            DM.FDTable2.FieldByName('THUMBNAIL'));
431            s.Free;          IWGrid1.Cell[i, j].Control := pic;
432          end;          t := DM.FDTable2.FieldByName('NAME').AsString;
433          IWFrame8.IWImage1.Picture.Assign(png);          if Length(t) > 10 then
434        end            t := Copy(t, 1, 8) + '..';
435        else          IWGrid1.Cell[i, j].Tag :=
436          IWFrame8.IWImage1.Picture.Assign(nil);            Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
437    finally          IWGrid1.Cell[i, j].Text := t;
438      png.Free;          IWGrid1.Cell[i, j].Alignment := taCenter;
439    end;          IWGrid1.Cell[i, j].Clickable := true;
440            DM.FDTable2.FindPrior;
441          end;
442      label1:
443      end
444      else if DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true then
445        UserSession.FieldToImg(IWFrame8.IWImage1.Picture,
446          DM.FDTable2.FieldByName('IMAGE'));
447    Randomize;    Randomize;
448    DM.FDTableView.Filter := 'DATE > '+QuotedStr(DateTimeToStr(Date-10));    DM.FDTableView.Filter := 'DATE > ' + QuotedStr(DateTimeToStr(Date - 10));
449    DM.FDTableView.First;    DM.FDTableView.First;
450    DM.FDTableView.MoveBy(Random(DM.FDTableView.RecordCount));    DM.FDTableView.MoveBy(Random(DM.FDTableView.RecordCount));
451    if DM.FDTableView.FieldByName('THUMBNAIL').IsNull = false then    UserSession.FieldToImg(IWImage1.Picture,
452        DM.FDTableView.FieldByName('THUMBNAIL'));
453      IWLabel4.Caption := DM.FDTableView.FieldByName('NAME').AsString;
454    end;
455    
456    function TIWForm1.SearchCount: Integer;
457    begin
458      with DM.FDTable2 do
459    begin    begin
460      s := DM.FDTableView.CreateBlobStream      if FindFirst = true then
461        (DM.FDTableView.FieldByName('THUMBNAIL'), bmRead);      begin
462      png := TPngImage.Create;        result := 1;
463      try        while FindNext = true do
464        png.LoadFromStream(s);          inc(result);
465        IWImage1.Picture.Assign(png);      end
466      finally      else
467        png.Free;        result := 0;
       s.Free;  
     end;  
468    end;    end;
   IWLabel4.Caption := DM.FDTableView.FieldByName('NAME').AsString;  
469  end;  end;
470    
471  procedure TIWForm1.SetPage(const Value: Boolean);  procedure TIWForm1.SetPage(const Value: Boolean);
# Line 505  begin Line 489  begin
489      IWLink2.Caption := 'ログイン';      IWLink2.Caption := 'ログイン';
490      Thumbnail := true;      Thumbnail := true;
491      IWText1.Text := '';      IWText1.Text := '';
492      DM.FDTable2.Filtered := false;      DM.FDTable2.Filter := table2filter;
     Filter := false;  
493      if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then      if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
494      begin      begin
495        WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/',        WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/',
# Line 520  procedure TIWForm1.SetThumbnail(const Va Line 503  procedure TIWForm1.SetThumbnail(const Va
503  begin  begin
504    UserSession.FThumbnail := Value;    UserSession.FThumbnail := Value;
505    IWGrid1.Visible := Value;    IWGrid1.Visible := Value;
506      IWFrame8.IWEdit1.Text := '1';
507    IWFrame8.Visible := not Value;    IWFrame8.Visible := not Value;
508  end;  end;
509    
Legend:
Removed from v.15  
changed lines
  Added in v.20
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help