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 5 by yamat0jp, Tue Dec 29 08:41:54 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 194  begin Line 206  begin
206        Close;        Close;
207      end;      end;
208    end;    end;
209    LoadImage;    if IWGrid1.Visible = true then
210      begin
211        IWLabel6.Visible := Filter;
212        LoadImage;
213      end
214      else
215        DM.FDTable2.Locate('SERIAL', UserSession.Serial, []);
216  end;  end;
217    
218  procedure TIWForm1.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
219    var
220      i: Integer;
221  begin  begin
222    DM.FDTable2.Filtered := false;    IWFrame8IWLink1Click(Sender);
223    if IWEdit1.Text <> '' then    if IWEdit1.Text <> '' then
224    begin    begin
225      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%'+IWEdit1.Text+'%');      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
226      DM.FDTable2.Filtered := true;      DM.FDTable2.Filtered := true;
227      IWLabel6.Caption := IWEdit1.Text + 'を検索しています';      i := DM.FDTable2.RecordCount;
228        IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
229        if i = 0 then
230          DM.FDTable2.Filtered := false;
231        Filter := true;
232      end
233      else
234      begin
235        DM.FDTable2.Filtered := false;
236        Filter := false;
237    end;    end;
238    IWLabel6.Visible := DM.FDTable2.Filtered;  end;
239    
240    procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
241    var
242      i: Integer;
243    begin
244      if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
245      begin
246        WebApplication.ShowMessage('個数が不正です');
247        Exit;
248      end;
249      if i = 0 then
250      begin
251        WebApplication.ShowMessage('１個以上のご注文が必要です');
252        Exit;
253      end;
254      with DM.FDQuery1 do
255      begin
256        SQL.Clear;
257        SQL.Add('select * from cart_data;');
258        Open;
259        if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
260          UserSession.Serial]), []) = true then
261        begin
262          Edit;
263          FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
264          Post;
265        end
266        else
267          AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
268      end;
269      IWFrame8.IWEdit1.Text := '0';
270      if MessageDlg('カートに移動しますか', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
271        TCartForm.Create(WebApplication).Show;
272    end;
273    
274    procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
275    begin
276      UserSession.Thumbnail := true;
277      IWFrame8.Visible := false;
278      IWGrid1.Visible := true;
279    end;
280    
281    procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
282      const ARow, AColumn: Integer);
283    begin
284      UserSession.Thumbnail := false;
285      IWFrame8.Visible := true;
286      IWFrame8.IWEdit1.Text := '1';
287      IWLabel6.Visible := false;
288      IWGrid1.Visible := false;
289      UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
290  end;  end;
291    
292  procedure TIWForm1.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWLink1Click(Sender: TObject);
293  begin  begin
294    TUserForm.Create(WebApplication).Show;    with TUserForm.Create(WebApplication) do
295      begin
296        Form := Self;
297        Show;
298      end;
299  end;  end;
300    
301  procedure TIWForm1.IWLink2Click(Sender: TObject);  procedure TIWForm1.IWLink2Click(Sender: TObject);
# Line 234  begin Line 318  begin
318        begin        begin
319          DM.FDTable1.Filtered := false;          DM.FDTable1.Filtered := false;
320          Page := Main;          Page := Main;
321            UserSession.user_number := 0;
322        end;        end;
323    end;    end;
324  end;  end;
325    
326    procedure TIWForm1.IWLink3Click(Sender: TObject);
327    begin
328      WebApplication.ShowMessage('ＯＫをクリックすると退会します');
329      Page := Main;
330      DM.FDTable1.Delete;
331    end;
332    
333    procedure TIWForm1.IWLink4Click(Sender: TObject);
334    begin
335      TCartForm.Create(WebApplication).Show;
336    end;
337    
338  procedure TIWForm1.LoadImage;  procedure TIWForm1.LoadImage;
339  var  var
340    s: TStream;    s: TStream;
341    png: TPngImage;    png: TPngImage;
342    pic: TIWImageFile;    pic: TIWImage;
343    i: Integer;    i: Integer;
344    j: Integer;    j: Integer;
345    k: Integer;    x: Boolean;
346      t: string;
347  label label1;  label label1;
348  begin  begin
349    ClearImage;    ClearImage;
350    exit;    png := TPngImage.Create;
   png:=TPngImage.Create;  
351    try    try
352      IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;      i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
353      k := 1;      if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
354          inc(i);
355        IWGrid1.RowCount := i;
356        if DM.FDTable2.Filtered = false then
357          DM.FDTable2.Last
358        else
359          DM.FDTable2.FindLast;
360      for i := 0 to IWGrid1.RowCount - 1 do      for i := 0 to IWGrid1.RowCount - 1 do
361        for j := 0 to IWGrid1.ColumnCount - 1 do        for j := 0 to IWGrid1.ColumnCount - 1 do
362        begin        begin
363          s := DM.FDTable2.CreateBlobStream          if DM.FDTable2.Filtered = false then
364            (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);          begin
365          try            if DM.FDTable2.Bof = true then
366            png.LoadFromStream(s);              goto label1;
367            pic := TIWImageFile.Create(IWGrid1);          end
368            pic.Picture.Assign(png);          else if DM.FDTable2.Found = false then
           IWGrid1.Cell[i, j].Control := pic;  
           IWGrid1.Cell[i, j].Text := k.ToString;  
           inc(k);  
         finally  
           s.Free;  
         end;  
         if DM.FDTable2.Bof = true then  
369            goto label1;            goto label1;
370            if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
371            begin
372              s := DM.FDTable2.CreateBlobStream
373                (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
374              try
375                png.LoadFromStream(s);
376              finally
377                s.Free;
378              end;
379            end;
380            t := DM.FDTable2.FieldByName('NAME').AsString;
381            if Length(t) > 10 then
382              t := Copy(t, 1, 8) + '..';
383            pic := TIWImage.Create(IWGrid1);
384            pic.Picture.Assign(png);
385            IWGrid1.Cell[i, j].Control := pic;
386            IWGrid1.Cell[i, j].Tag :=
387              Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
388            IWGrid1.Cell[i, j].Text := t;
389            IWGrid1.Cell[i, j].Alignment := taCenter;
390            IWGrid1.Cell[i, j].Clickable := true;
391            if DM.FDTable2.Filtered = false then
392              DM.FDTable2.Prior
393            else
394              DM.FDTable2.FindPrior;
395        end;        end;
396    label1:    label1:
397    finally    finally
# Line 279  begin Line 400  begin
400    png := nil;    png := nil;
401    s := nil;    s := nil;
402    Randomize;    Randomize;
403      if DM.FDTable2.Filtered = true then
404      begin
405        x := true;
406        DM.FDTable2.Filtered := false;
407      end
408      else
409        x := false;
410    DM.FDTable2.Last;    DM.FDTable2.Last;
411      if DM.FDTable2.Bof = true then
412        Exit;
413    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
414    s := DM.FDTable2.CreateBlobStream    if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
415      (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);    begin
416    png := TPngImage.Create;      s := DM.FDTable2.CreateBlobStream
417    try        (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
418      png.LoadFromStream(s);      png := TPngImage.Create;
419      IWImageFile1.Picture.Assign(png);      try
420    finally        png.LoadFromStream(s);
421      png.Free;        IWImage1.Picture.Assign(png);
422      s.Free;      finally
423          png.Free;
424          s.Free;
425        end;
426    end;    end;
427      if x = true then
428        DM.FDTable2.Filtered := true;
429    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
430  end;  end;
431    
# Line 301  begin Line 436  begin
436    UserSession.FPage := Value;    UserSession.FPage := Value;
437    x := Value = Info;    x := Value = Info;
438    IWRegion7.Visible := x;    IWRegion7.Visible := x;
   IWLabel6.Visible := x;  
439    IWDBLabel1.Visible := x;    IWDBLabel1.Visible := x;
440      IWLink3.Visible := x;
441    IWLink1.Visible := not x;    IWLink1.Visible := not x;
442    IWText1.Visible := not x;    IWText1.Visible := not x;
443    if x = true then    if x = true then
Legend:
Removed from v.3  
changed lines
  Added in v.5
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help