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 1 by yamat0jp, Sun Nov 22 11:18:44 2015 UTC revision 4 by yamat0jp, Sun Dec 27 07:05:56 2015 UTC
# Line 3  unit Unit1; Line 3  unit Unit1;
3  interface  interface
4    
5  uses  uses
6    Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWHTMLControls,    Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWVCLComponent,
   IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,  
   Vcl.Controls, Vcl.Forms, IWVCLBaseContainer, IWContainer, IWHTMLContainer,  
   IWHTML40Container, IWRegion, FireDAC.Stan.Intf, FireDAC.Stan.Option,  
   FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,  
   FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.IB,  
   FireDAC.Phys.IBDef, Data.DB, FireDAC.Comp.Client, Datasnap.DBClient,  
   Datasnap.Provider, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf,  
   FireDAC.DApt, FireDAC.Comp.DataSet, IWCompGrids, IWDBGrids, IWCompEdit,  
   IWDBStdCtrls, IWCompExtCtrls, IWDBExtCtrls, Unit3, IWVCLComponent,  
7    IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,    IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,
8    IWTemplateProcessorHTML, Data.Bind.EngExt, Vcl.Bind.DBEngExt, System.Rtti,    IWTemplateProcessorHTML, Vcl.Controls, Vcl.Forms, Unit2, IWVCLBaseContainer,
9    System.Bindings.Outputs, Vcl.Bind.Editors, Data.Bind.Components,    IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWDBStdCtrls,
10    Data.Bind.DBScope, IWCompListbox, IWCompButton, Web.HTTPApp, Web.HTTPProd,    IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,
11    Vcl.ImgList, IWImageList, PngImage, IWCompTabControl, IWCompMemo, IWCompText,    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
12    UserSessionUnit;    IWHTMLControls, IWCompExtCtrls, UserSessionUnit, PngImage, Data.DB,
13      IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14      IWCompMenu, Vcl.Menus, System.Variants;
15    
16  type  type
17    TTopForm = class(TIWAppForm)    TIWForm1 = class(TIWAppForm)
18      IWRegion1: TIWRegion;      IWFrame1: TIWFrame1;
19        IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
20      IWLabel1: TIWLabel;      IWLabel1: TIWLabel;
     IWList1: TIWList;  
     IWLink1: TIWLink;  
     IWLabel2: TIWLabel;  
21      IWDBLabel1: TIWDBLabel;      IWDBLabel1: TIWDBLabel;
22      IWFrame1: TIWFrame1;      IWRegion1: TIWRegion;
23        IWRegion2: TIWRegion;
24        IWText1: TIWText;
25        IWGrid1: TIWGrid;
26      IWRegion3: TIWRegion;      IWRegion3: TIWRegion;
     IWLabel3: TIWLabel;  
     IWLabel4: TIWLabel;  
27      IWRegion4: TIWRegion;      IWRegion4: TIWRegion;
28      IWLabel5: TIWLabel;      IWLink1: TIWLink;
29      IWList2: TIWList;      IWLabel2: TIWLabel;
30      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;      IWList1: TIWList;
31      IWRegion2: TIWRegion;      IWLabel3: TIWLabel;
     IWLabel6: TIWLabel;  
     IWRegion6: TIWRegion;  
32      IWEdit1: TIWEdit;      IWEdit1: TIWEdit;
33      IWButton1: TIWButton;      IWButton1: TIWButton;
     IWImageFile1: TIWImageFile;  
     IWRegion7: TIWRegion;  
     IWLabel8: TIWLabel;  
     IWGrid1: TIWGrid;  
     IWTabControl1: TIWTabControl;  
     IWTabControl1Page0: TIWTabPage;  
     IWTabControl1Page1: TIWTabPage;  
     IWText1: TIWText;  
     IWRegion8: TIWRegion;  
34      IWEdit2: TIWEdit;      IWEdit2: TIWEdit;
35      IWEdit3: TIWEdit;      IWEdit3: TIWEdit;
     IWLabel9: TIWLabel;  
     IWList3: TIWList;  
36      IWLink2: TIWLink;      IWLink2: TIWLink;
37        IWRegion5: TIWRegion;
38        IWLabel7: TIWLabel;
39        IWRegion6: TIWRegion;
40        IWLabel8: TIWLabel;
41        IWList2: TIWList;
42        IWLabel4: TIWLabel;
43        IWImageFile1: TIWImageFile;
44        IWRegion7: TIWRegion;
45        IWLabel5: TIWLabel;
46        IWLabel6: TIWLabel;
47        IWList3: TIWList;
48      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
49      procedure IWLink1Click(Sender: TObject);      procedure IWLink2Click(Sender: TObject);
50      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
51      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
52      procedure IWAppFormDestroy(Sender: TObject);      procedure IWLink1Click(Sender: TObject);
     procedure IWLink2Click(Sender: TObject);  
53    private    private
     procedure SetPage(const Value: TPage);  
54      function GetPage: TPage;      function GetPage: TPage;
55        procedure SetPage(const Value: TPage);
56      procedure LoadImage;      procedure LoadImage;
57      procedure ClearImage;      procedure ClearImage;
58    public    public
# Line 74  implementation Line 63  implementation
63    
64  {$R *.dfm}  {$R *.dfm}
65    
66  uses Unit2, ServerController, Unit4, Unit6;  uses Unit3, ServerController, Unit6;
67    
68  procedure TTopForm.ClearImage;  procedure TIWForm1.ClearImage;
69  var  var
70    i, j: integer;    i: Integer;
71      j: Integer;
72  begin  begin
73    for i := 0 to IWGrid1.ColumnCount - 1 do    for i := 0 to IWGrid1.RowCount - 1 do
74      for j := 0 to IWGrid1.RowCount - 1 do      for j := 0 to IWGrid1.ColumnCount - 1 do
75      begin        IWGrid1.Cell[i, j].Control.Free;
       IWGrid1.Cell[j, i].Control.Free;  
       IWGrid1.Cell[j, i].Control := nil;  
     end;  
76  end;  end;
77    
78  function TTopForm.GetPage: TPage;  function TIWForm1.GetPage: TPage;
79  begin  begin
80    result := UserSession.FPage;    result := UserSession.FPage;
81  end;  end;
82    
83  procedure TTopForm.IWAppFormCreate(Sender: TObject);  procedure TIWForm1.IWAppFormCreate(Sender: TObject);
84  const  const
85    i = 150;    i = 120;
86  var  var
87    s: integer;    s: Integer;
88  begin  begin
89    s:=DM.FDTable3.FieldByName('BGCOLOR').AsInteger;    Page := UserSession.FPage;
90    IWLabel1.BGColor := s;    s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
91      IWLabel2.BGColor := s;
92    IWLabel3.BGColor := s;    IWLabel3.BGColor := s;
93    IWLabel5.BGColor := s;    IWLabel5.BGColor := s;
94    IWLabel6.BGColor := s;    IWLabel7.BGColor := s;
95    IWLabel8.BGColor := s;    IWLabel8.BGColor := s;
96    IWRegion1.Width := i;    IWRegion1.Width := i;
97    IWRegion2.Width := i;    IWRegion2.Width := i;
   IWRegion3.Width := i;  
98    IWRegion4.Width := i;    IWRegion4.Width := i;
99      IWRegion5.Width := i;
100      IWRegion6.Width := i;
101    IWRegion7.Width := i;    IWRegion7.Width := i;
   IWRegion8.Width := i;  
   Page := UserSession.FPage;  
102  end;  end;
103    
104  procedure TTopForm.IWAppFormDestroy(Sender: TObject);  procedure TIWForm1.IWAppFormRender(Sender: TObject);
 begin  
   ClearImage;  
 end;  
   
 procedure TTopForm.IWAppFormRender(Sender: TObject);  
105  var  var
106    s: string;    s: string;
107    i, j: integer;    i, j: Integer;
   x: Boolean;  
108  begin  begin
109    IWList1.Items.Clear;    IWList1.Items.Clear;
110    with DM.FDTable2 do    with DM.FDTable2 do
111      if RecordCount > 0 then    begin
112        if Filtered = true then
113      begin      begin
114        First;        FindFirst;
115        while Eof = false do        while Found = true do
116        begin        begin
117          s := FieldByName('CATEGORY').AsString;          s := FieldByName('CATEGORY').AsString;
118          if s = '' then          if s = '' then
119          begin          begin
120            Next;            FindNext;
121            continue;            continue;
122          end;          end;
123          if Filtered = true then          i := IWList1.Items.IndexOfName(s);
124          begin          if i = -1 then
125            i := IWList1.Items.IndexOfName(s);            IWList1.Items.Add(s + '=1')
           if i = -1 then  
             IWList1.Items.Add(s + '=1')  
           else  
           begin  
             j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;  
             IWList1.Items[i] := s + '=' + j.ToString;  
           end;  
         end  
126          else          else
127          begin          begin
128            i := IWList1.Items.IndexOf(s);            j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
129            if i = -1 then            IWList1.Items[i] := s + '=' + j.ToString;
130              IWList1.Items.Add(s);          end;
131            FindNext;
132          end;
133        end
134        else
135        begin
136          First;
137          while Eof = false do
138          begin
139            s := FieldByName('CATEGORY').AsString;
140            if s = '' then
141            begin
142              Next;
143              continue;
144          end;          end;
145            i := IWList1.Items.IndexOf(s);
146            if i = -1 then
147              IWList1.Items.Add(s);
148          Next;          Next;
149        end;        end;
150      end;      end;
151      end;
152    if DM.FDTable2.Filtered = true then    if DM.FDTable2.Filtered = true then
153      for i := 0 to IWList1.Items.Count - 1 do      for i := 0 to IWList1.Items.Count - 1 do
154      begin      begin
# Line 167  begin Line 158  begin
158        else        else
159          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
160      end;      end;
161    IWList3.Items.Clear;    IWList2.Items.Clear;
162    if Page = Info then    if Page = TPage.Info then
163    begin    begin
164      with DM.FDQuery1 do      with DM.FDQuery1 do
165      begin      begin
# Line 178  begin Line 169  begin
169        SQL.Add(' where number = :num;');        SQL.Add(' where number = :num;');
170        Params.ParamByName('num').AsInteger := UserSession.user_number;        Params.ParamByName('num').AsInteger := UserSession.user_number;
171        Open;        Open;
172        if RecordCount > 0 then        First;
173          i := 0;
174          while Eof = false do
175        begin        begin
176          First;          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
177          i := 0;          i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
178          while Eof = false do          IWList2.Items.Add(s);
179          begin          Next;
           s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;  
           inc(i, Fields.Fields[2].AsInteger);  
           IWList3.Items.Add(s);  
           Next;  
         end;  
         IWList3.Items.Add(i.ToString + '円');  
180        end;        end;
181          IWList2.Items.Add(i.ToString + '円');
182        Close;        Close;
183      end;        IWList3.Items.Clear;
     IWList2.Items.Clear;  
     with DM.FDQuery1 do  
     begin  
184        SQL.Clear;        SQL.Clear;
185        SQL.Add('select name from recent_data join item_data');        SQL.Add('select name from recent_data join item_data');
186        SQL.Add(' on (recent_data.serial = item_data.serial)');        SQL.Add(' on (recent_data.serial = item_data.serial)');
187        SQL.Add(' where number = :num;');        SQL.Add(' where number = :num;');
188        //Params.ParamByName('num').AsInteger:=UserSession.user_number;        Params.ParamByName('num').AsInteger := UserSession.user_number;
189        Open;        Open;
190        if RecordCount > 0 then        First;
191          while Eof = false do
192        begin        begin
193          First;          IWList3.Items.Add(Fields.Fields[0].AsString);
194          while Eof = false do          Next;
         begin  
           IWList2.Items.Add(Fields.Fields[0].AsString);  
           Next;  
         end;  
195        end;        end;
196        Close;        Close;
197      end;      end;
198    end;    end;
   x := Page = Info;  
   IWRegion4.Visible := x;  
   IWLabel2.Visible := x;  
   IWDBLabel1.Visible := x;  
   IWLink2.Visible := not x;  
199    LoadImage;    LoadImage;
200      IWLabel6.Visible:=DM.FDTable2.Filtered;
201  end;  end;
202    
203  procedure TTopForm.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
 const  
   filter = 'NAME LIKE ''%s''';  
204  begin  begin
205    if IWEdit1.Text = '' then    DM.FDTable2.Filtered := false;
206      DM.FDTable2.Filtered := false    if IWEdit1.Text <> '' then
   else  
207    begin    begin
208      DM.FDTable2.filter := Format(filter, ['%' + IWEdit1.Text + '%']);      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
209      DM.FDTable2.Filtered := true;      DM.FDTable2.Filtered := true;
210      IWLabel9.Text := IWEdit1.Text + 'を検索しています';      IWLabel6.Caption := IWEdit1.Text + 'を検索しています';
211    end;    end;
212    IWLabel9.Visible := DM.FDTable2.Filtered;    IWLabel6.Visible := DM.FDTable2.Filtered;
213  end;  end;
214    
215  procedure TTopForm.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWLink1Click(Sender: TObject);
216  const  begin
217    filter = 'EMAIL = ''%s'' and PASSWORD = ''%s''';    TUserForm.Create(WebApplication).Show;
218    end;
219    
220    procedure TIWForm1.IWLink2Click(Sender: TObject);
221  begin  begin
222    case Page of    case Page of
223      Main:      Main:
224        begin        begin
225          DM.FDTable1.filter := Format(filter, [IWEdit2.Text, IWEdit3.Text]);          if DM.FDTable1.Locate('EMAIL;PASSWORD',
226          DM.FDTable1.Filtered := true;            VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true
227          if DM.FDTable1.RecordCount = 1 then          then
228          begin          begin
           IWLink1.Caption := 'ログアウト';  
229            Page := Info;            Page := Info;
230            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')
231              .AsInteger;              .AsInteger;
# Line 259  begin Line 236  begin
236      Info:      Info:
237        begin        begin
238          DM.FDTable1.Filtered := false;          DM.FDTable1.Filtered := false;
         IWLink1.Caption := 'ログイン';  
239          Page := Main;          Page := Main;
         DM.FDQuery1.Params.ParamByName('num').AsInteger := 0;  
240        end;        end;
241    end;    end;
   IWLabel9.Visible := UserSession.user_number <> 0;  
 end;  
   
 procedure TTopForm.IWLink2Click(Sender: TObject);  
 begin  
   UserSession.FPage := Info;  
   TUserForm.Create(WebApplication).Show;  
242  end;  end;
243    
244  procedure TTopForm.LoadImage;  procedure TIWForm1.LoadImage;
245  var  var
246    i, j, k: integer;    s: TStream;
247    png: TPngImage;    png: TPngImage;
248    pic: TIWImageFile;    pic: TIWImageFile;
249    st: TStream;    i: Integer;
250      j: Integer;
251      k: Integer;
252  label label1;  label label1;
253  begin  begin
254    ClearImage;    ClearImage;
255    if DM.FDTable2.RecordCount > 0 then    png := TPngImage.Create;
256    begin    try
257      IWGrid1.RowCount := (DM.FDTable2.RecordCount div IWGrid1.ColumnCount) + 1;      IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
258      k := 1;      k := 1;
259      DM.FDTable2.Last;      for i := 0 to IWGrid1.RowCount - 1 do
260      png := TPngImage.Create;        for j := 0 to IWGrid1.ColumnCount - 1 do
     try  
       for i := 0 to IWGrid1.RowCount - 1 do  
261        begin        begin
262          for j := 0 to IWGrid1.ColumnCount - 1 do          if DM.FDTable2.FieldByName('THUMBNAIL') = nil then
263          begin            continue;
264            st := DM.FDTable2.CreateBlobStream          s := DM.FDTable2.CreateBlobStream
265              (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);            (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
266            try          try
267              png.LoadFromStream(st);            png.LoadFromStream(s);
268              pic := TIWImageFile.Create(Self);            pic := TIWImageFile.Create(IWGrid1);
269              pic.Picture.Assign(png);            pic.Picture.Assign(png);
270              IWGrid1.Cell[i, j].Control := pic;            IWGrid1.Cell[i, j].Control := pic;
271              IWGrid1.Cell[i, j].Text := k.ToString;            IWGrid1.Cell[i, j].Text := k.ToString;
272              inc(k);            inc(k);
273              DM.FDTable2.Prior;          finally
274            finally            s.Free;
             st.Free;  
           end;  
           if DM.FDTable2.Bof = true then  
             goto label1;  
275          end;          end;
276            if DM.FDTable2.Bof = true then
277              goto label1;
278        end;        end;
279      label1:    label1:
280      finally    finally
281        png.Free;      png.Free;
282      end;    end;
   end  
   else  
     IWGrid1.RowCount := 0;  
   st := nil;  
283    png := nil;    png := nil;
284      s := nil;
285    Randomize;    Randomize;
286    DM.FDTable2.Last;    DM.FDTable2.Last;
287    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
288    st := DM.FDTable2.CreateBlobStream    if DM.FDTable2.FieldByName('THUMBNAIL') <> nil then
289      (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);    begin
290    png := TPngImage.Create;      s := DM.FDTable2.CreateBlobStream
291    try        (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
292      png.LoadFromStream(st);      png := TPngImage.Create;
293      IWImageFile1.Picture.Assign(png);      try
294    finally        png.LoadFromStream(s);
295      st.Free;        IWImageFile1.Picture.Assign(png);
296      png.Free;      finally
297          png.Free;
298          s.Free;
299        end;
300    end;    end;
301    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
302  end;  end;
303    
304  procedure TTopForm.SetPage(const Value: TPage);  procedure TIWForm1.SetPage(const Value: TPage);
305  var  var
306    s: string;    x: Boolean;
307  begin  begin
308    UserSession.FPage := Value;    UserSession.FPage := Value;
309    case Value of    x := Value = Info;
310      Main:    IWRegion7.Visible := x;
311        s := 'toppage.htm';    IWDBLabel1.Visible := x;
312      Info:    IWLink1.Visible := not x;
313        s := 'mypage.htm';    IWText1.Visible := not x;
314      if x = true then
315      begin
316        IWLabel1.Caption := 'ようこそ';
317        IWLink2.Caption := 'ログアウト';
318      end
319      else
320      begin
321        IWLabel1.Caption := 'ようこそゲスト様';
322        IWLink2.Caption := 'ログイン';
323    end;    end;
   IWTemplateProcessorHTML1.Templates.Default := s;  
324  end;  end;
325    
326  initialization  initialization
327    
328  TTopForm.SetAsMainForm;  TIWForm1.SetAsMainForm;
329    
330  end.  end.
Legend:
Removed from v.1  
changed lines
  Added in v.4
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help