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 6 by yamat0jp, Tue Dec 29 10:58:29 2015 UTC
# Line 11  uses Line 11  uses
11    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
12    IWHTMLControls, IWCompExtCtrls, UserSessionUnit, PngImage, Data.DB,    IWHTMLControls, IWCompExtCtrls, UserSessionUnit, PngImage, Data.DB,
13    IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,    IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14    IWCompMenu, Vcl.Menus, System.Variants;    IWCompMenu, Vcl.Menus, System.Variants, Unit8, Vcl.Dialogs;
15    
16  type  type
17    TIWForm1 = class(TIWAppForm)    TIWForm1 = class(TIWAppForm)
# Line 40  type Line 40  type
40      IWLabel8: TIWLabel;      IWLabel8: TIWLabel;
41      IWList2: TIWList;      IWList2: TIWList;
42      IWLabel4: TIWLabel;      IWLabel4: TIWLabel;
     IWImageFile1: TIWImageFile;  
43      IWRegion7: TIWRegion;      IWRegion7: TIWRegion;
44      IWLabel5: TIWLabel;      IWLabel5: TIWLabel;
45      IWLabel6: TIWLabel;      IWLabel6: TIWLabel;
46      IWList3: TIWList;      IWList3: TIWList;
47        IWImage1: TIWImage;
48        IWFrame8: TIWFrame8;
49        IWLink3: TIWLink;
50        IWLink4: TIWLink;
51      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
52      procedure IWLink2Click(Sender: TObject);      procedure IWLink2Click(Sender: TObject);
53      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
54      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
55      procedure IWLink1Click(Sender: TObject);      procedure IWLink1Click(Sender: TObject);
56        procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
57        procedure IWFrame8IWButton1Click(Sender: TObject);
58        procedure IWFrame8IWLink1Click(Sender: TObject);
59        procedure IWLink3Click(Sender: TObject);
60        procedure IWLink4Click(Sender: TObject);
61    private    private
62        Filter: Boolean;
63      function GetPage: TPage;      function GetPage: TPage;
64      procedure SetPage(const Value: TPage);      procedure SetPage(const Value: TPage);
65      procedure LoadImage;      procedure LoadImage;
# Line 63  implementation Line 72  implementation
72    
73  {$R *.dfm}  {$R *.dfm}
74    
75  uses Unit3, ServerController, Unit6;  uses Unit3, ServerController, Unit6, Unit4;
76    
77  procedure TIWForm1.ClearImage;  procedure TIWForm1.ClearImage;
78  var  var
# Line 73  begin Line 82  begin
82    for i := 0 to IWGrid1.RowCount - 1 do    for i := 0 to IWGrid1.RowCount - 1 do
83      for j := 0 to IWGrid1.ColumnCount - 1 do      for j := 0 to IWGrid1.ColumnCount - 1 do
84        IWGrid1.Cell[i, j].Control.Free;        IWGrid1.Cell[i, j].Control.Free;
85      IWGrid1.RowCount := 0;
86  end;  end;
87    
88  function TIWForm1.GetPage: TPage;  function TIWForm1.GetPage: TPage;
# Line 91  begin Line 101  begin
101    IWLabel2.BGColor := s;    IWLabel2.BGColor := s;
102    IWLabel3.BGColor := s;    IWLabel3.BGColor := s;
103    IWLabel5.BGColor := s;    IWLabel5.BGColor := s;
104      IWLabel7.BGColor := s;
105      IWLabel8.BGColor := s;
106    IWRegion1.Width := i;    IWRegion1.Width := i;
107    IWRegion2.Width := i;    IWRegion2.Width := i;
108    IWRegion4.Width := i;    IWRegion4.Width := i;
# Line 172  begin Line 184  begin
184        while Eof = false do        while Eof = false do
185        begin        begin
186          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
187          i := i + Fields.Fields[2].AsInteger;          i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
188          IWList2.Items.Add(s);          IWList2.Items.Add(s);
189          Next;          Next;
190        end;        end;
# Line 195  begin Line 207  begin
207      end;      end;
208    end;    end;
209    LoadImage;    LoadImage;
210      if IWGrid1.Visible = true then
211        IWLabel6.Visible := Filter;
212  end;  end;
213    
214  procedure TIWForm1.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
215    var
216      i: Integer;
217  begin  begin
218    DM.FDTable2.Filtered := false;    IWFrame8IWLink1Click(Sender);
219    if IWEdit1.Text <> '' then    if IWEdit1.Text <> '' then
220    begin    begin
221      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%'+IWEdit1.Text+'%');      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
222      DM.FDTable2.Filtered := true;      DM.FDTable2.Filtered := true;
223      IWLabel6.Caption := IWEdit1.Text + 'を検索しています';      i := DM.FDTable2.RecordCount;
224        IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
225        if i = 0 then
226          DM.FDTable2.Filtered := false;
227        Filter := true;
228      end
229      else
230      begin
231        DM.FDTable2.Filtered := false;
232        Filter := false;
233      end;
234    end;
235    
236    procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
237    var
238      i: Integer;
239    begin
240      if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
241      begin
242        WebApplication.ShowMessage('個数が不正です');
243        Exit;
244      end;
245      if i = 0 then
246      begin
247        WebApplication.ShowMessage('１個以上のご注文が必要です');
248        Exit;
249      end;
250      with DM.FDQuery1 do
251      begin
252        SQL.Clear;
253        SQL.Add('select * from cart_data;');
254        Open;
255        if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
256          UserSession.Serial]), []) = true then
257        begin
258          Edit;
259          FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
260          Post;
261        end
262        else
263          AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
264    end;    end;
265    IWLabel6.Visible := DM.FDTable2.Filtered;    IWFrame8.IWEdit1.Text := '0';
266      if MessageDlg('カートに移動しますか', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
267        TCartForm.Create(WebApplication).Show;
268    end;
269    
270    procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
271    begin
272      UserSession.Thumbnail := true;
273      IWFrame8.Visible := false;
274      IWGrid1.Visible := true;
275    end;
276    
277    procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
278      const ARow, AColumn: Integer);
279    begin
280      UserSession.Thumbnail := false;
281      IWFrame8.Visible := true;
282      IWFrame8.IWEdit1.Text := '1';
283      IWLabel6.Visible := false;
284      IWGrid1.Visible := false;
285      UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
286  end;  end;
287    
288  procedure TIWForm1.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWLink1Click(Sender: TObject);
289  begin  begin
290    TUserForm.Create(WebApplication).Show;    with TUserForm.Create(WebApplication) do
291      begin
292        Form := Self;
293        Show;
294      end;
295  end;  end;
296    
297  procedure TIWForm1.IWLink2Click(Sender: TObject);  procedure TIWForm1.IWLink2Click(Sender: TObject);
# Line 234  begin Line 314  begin
314        begin        begin
315          DM.FDTable1.Filtered := false;          DM.FDTable1.Filtered := false;
316          Page := Main;          Page := Main;
317            UserSession.user_number := 0;
318        end;        end;
319    end;    end;
320  end;  end;
321    
322    procedure TIWForm1.IWLink3Click(Sender: TObject);
323    begin
324      WebApplication.ShowMessage('ＯＫをクリックすると退会します');
325      Page := Main;
326      DM.FDTable1.Delete;
327    end;
328    
329    procedure TIWForm1.IWLink4Click(Sender: TObject);
330    begin
331      TCartForm.Create(WebApplication).Show;
332    end;
333    
334  procedure TIWForm1.LoadImage;  procedure TIWForm1.LoadImage;
335  var  var
336    s: TStream;    s: TStream;
337    png: TPngImage;    png: TPngImage;
338    pic: TIWImageFile;    pic: TIWImage;
339    i: Integer;    i: Integer;
340    j: Integer;    j: Integer;
341    k: Integer;    x: Boolean;
342      t: string;
343  label label1;  label label1;
344  begin  begin
345    ClearImage;    ClearImage;
346    exit;    png := TPngImage.Create;
   png:=TPngImage.Create;  
347    try    try
348      IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;      if UserSession.Thumbnail = true then
349      k := 1;      begin
350      for i := 0 to IWGrid1.RowCount - 1 do        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
351        for j := 0 to IWGrid1.ColumnCount - 1 do        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
352        begin          inc(i);
353          s := DM.FDTable2.CreateBlobStream        IWGrid1.RowCount := i;
354            (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);        if DM.FDTable2.Filtered = false then
355          try          DM.FDTable2.Last
356            png.LoadFromStream(s);        else
357            pic := TIWImageFile.Create(IWGrid1);          DM.FDTable2.FindLast;
358            pic.Picture.Assign(png);        for i := 0 to IWGrid1.RowCount - 1 do
359            IWGrid1.Cell[i, j].Control := pic;          for j := 0 to IWGrid1.ColumnCount - 1 do
360            IWGrid1.Cell[i, j].Text := k.ToString;          begin
361            inc(k);            if DM.FDTable2.Filtered = false then
362          finally            begin
363            s.Free;              if DM.FDTable2.Bof = true then
364                  goto label1;
365              end
366              else if DM.FDTable2.Found = false then
367                goto label1;
368              if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
369              begin
370                s := DM.FDTable2.CreateBlobStream
371                  (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
372                try
373                  png.LoadFromStream(s);
374                finally
375                  s.Free;
376                end;
377                pic := TIWImage.Create(IWGrid1);
378                pic.Picture.Assign(png);
379                IWGrid1.Cell[i, j].Control := pic;
380              end;
381              t := DM.FDTable2.FieldByName('NAME').AsString;
382              if Length(t) > 10 then
383                t := Copy(t, 1, 8) + '..';
384              IWGrid1.Cell[i, j].Tag :=
385                Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
386              IWGrid1.Cell[i, j].Text := t;
387              IWGrid1.Cell[i, j].Alignment := taCenter;
388              IWGrid1.Cell[i, j].Clickable := true;
389              if DM.FDTable2.Filtered = false then
390                DM.FDTable2.Prior
391              else
392                DM.FDTable2.FindPrior;
393          end;          end;
394          if DM.FDTable2.Bof = true then      label1:
395            goto label1;      end
396        else if (DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true) and
397          (DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil) then
398        begin
399          s := DM.FDTable2.CreateBlobStream
400            (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
401          try
402            png.LoadFromStream(s);
403            IWFrame8.IWImage1.Picture.Assign(png);
404          finally
405            s.Free;
406        end;        end;
407    label1:      end
408        else
409          IWFrame8.IWImage1.Picture.Assign(nil);
410    finally    finally
411      png.Free;      png.Free;
412    end;    end;
413    png := nil;    png := nil;
414    s := nil;    s := nil;
415    Randomize;    Randomize;
416      if DM.FDTable2.Filtered = true then
417      begin
418        x := true;
419        DM.FDTable2.Filtered := false;
420      end
421      else
422        x := false;
423    DM.FDTable2.Last;    DM.FDTable2.Last;
424      if DM.FDTable2.Bof = true then
425        Exit;
426    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
427    s := DM.FDTable2.CreateBlobStream    if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
428      (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);    begin
429    png := TPngImage.Create;      s := DM.FDTable2.CreateBlobStream
430    try        (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
431      png.LoadFromStream(s);      png := TPngImage.Create;
432      IWImageFile1.Picture.Assign(png);      try
433    finally        png.LoadFromStream(s);
434      png.Free;        IWImage1.Picture.Assign(png);
435      s.Free;      finally
436          png.Free;
437          s.Free;
438        end;
439    end;    end;
440      if x = true then
441        DM.FDTable2.Filtered := true;
442    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
443  end;  end;
444    
# Line 301  begin Line 449  begin
449    UserSession.FPage := Value;    UserSession.FPage := Value;
450    x := Value = Info;    x := Value = Info;
451    IWRegion7.Visible := x;    IWRegion7.Visible := x;
   IWLabel6.Visible := x;  
452    IWDBLabel1.Visible := x;    IWDBLabel1.Visible := x;
453      IWLink3.Visible := x;
454    IWLink1.Visible := not x;    IWLink1.Visible := not x;
455    IWText1.Visible := not x;    IWText1.Visible := not x;
456    if x = true then    if x = true then
Legend:
Removed from v.3  
changed lines
  Added in v.6
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help