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 7 by yamat0jp, Wed Dec 30 09:56:24 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, Unit8, Vcl.Dialogs;
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        IWRegion7: TIWRegion;
44        IWLabel5: TIWLabel;
45        IWLabel6: TIWLabel;
46        IWList3: TIWList;
47        IWImage1: TIWImage;
48        IWFrame8: TIWFrame8;
49        IWLink4: TIWLink;
50        IWLink3: TIWLink;
51      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
52      procedure IWLink1Click(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 IWAppFormDestroy(Sender: TObject);      procedure IWLink1Click(Sender: TObject);
56      procedure IWLink2Click(Sender: TObject);      procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
57        procedure IWFrame8IWButton1Click(Sender: TObject);
58        procedure IWFrame8IWLink1Click(Sender: TObject);
59        procedure IWLink4Click(Sender: TObject);
60        procedure IWLink3Click(Sender: TObject);
61    private    private
62      procedure SetPage(const Value: TPage);      Filter: Boolean;
63      function GetPage: TPage;      function GetPage: Boolean;
64        procedure SetPage(const Value: Boolean);
65      procedure LoadImage;      procedure LoadImage;
66      procedure ClearImage;      procedure ClearImage;
67    public    public
68      property Page: TPage read GetPage write SetPage;      property Page: Boolean read GetPage write SetPage;
69    end;    end;
70    
71  implementation  implementation
72    
73  {$R *.dfm}  {$R *.dfm}
74    
75  uses Unit2, ServerController, Unit4, Unit6;  uses Unit3, ServerController, Unit6, Unit4, Unit9;
76    
77  procedure TTopForm.ClearImage;  procedure TIWForm1.ClearImage;
78  var  var
79    i, j: integer;    i: Integer;
80      j: Integer;
81  begin  begin
82    for i := 0 to IWGrid1.ColumnCount - 1 do    for i := 0 to IWGrid1.RowCount - 1 do
83      for j := 0 to IWGrid1.RowCount - 1 do      for j := 0 to IWGrid1.ColumnCount - 1 do
84      begin        IWGrid1.Cell[i, j].Control.Free;
85        IWGrid1.Cell[j, i].Control.Free;    IWGrid1.RowCount := 0;
       IWGrid1.Cell[j, i].Control := nil;  
     end;  
86  end;  end;
87    
88  function TTopForm.GetPage: TPage;  function TIWForm1.GetPage: Boolean;
89  begin  begin
90    result := UserSession.FPage;    result := UserSession.FPage;
91  end;  end;
92    
93  procedure TTopForm.IWAppFormCreate(Sender: TObject);  procedure TIWForm1.IWAppFormCreate(Sender: TObject);
94  const  const
95    i = 150;    i = 120;
96  var  var
97    s: integer;    s: Integer;
98  begin  begin
99    s:=DM.FDTable3.FieldByName('BGCOLOR').AsInteger;    Page := UserSession.FPage;
100    IWLabel1.BGColor := s;    s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
101      IWLabel2.BGColor := s;
102    IWLabel3.BGColor := s;    IWLabel3.BGColor := s;
103    IWLabel5.BGColor := s;    IWLabel5.BGColor := s;
104    IWLabel6.BGColor := s;    IWLabel7.BGColor := s;
105    IWLabel8.BGColor := s;    IWLabel8.BGColor := s;
106    IWRegion1.Width := i;    IWRegion1.Width := i;
107    IWRegion2.Width := i;    IWRegion2.Width := i;
   IWRegion3.Width := i;  
108    IWRegion4.Width := i;    IWRegion4.Width := i;
109      IWRegion5.Width := i;
110      IWRegion6.Width := i;
111    IWRegion7.Width := i;    IWRegion7.Width := i;
   IWRegion8.Width := i;  
   Page := UserSession.FPage;  
112  end;  end;
113    
114  procedure TTopForm.IWAppFormDestroy(Sender: TObject);  procedure TIWForm1.IWAppFormRender(Sender: TObject);
 begin  
   ClearImage;  
 end;  
   
 procedure TTopForm.IWAppFormRender(Sender: TObject);  
115  var  var
116    s: string;    s: string;
117    i, j: integer;    i, j: Integer;
   x: Boolean;  
118  begin  begin
119    IWList1.Items.Clear;    IWList1.Items.Clear;
120    with DM.FDTable2 do    with DM.FDTable2 do
121      if RecordCount > 0 then    begin
122        if Filtered = true then
123      begin      begin
124        First;        FindFirst;
125        while Eof = false do        while Found = true do
126        begin        begin
127          s := FieldByName('CATEGORY').AsString;          s := FieldByName('CATEGORY').AsString;
128          if s = '' then          if s = '' then
129          begin          begin
130            Next;            FindNext;
131            continue;            continue;
132          end;          end;
133          if Filtered = true then          i := IWList1.Items.IndexOfName(s);
134          begin          if i = -1 then
135            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  
136          else          else
137          begin          begin
138            i := IWList1.Items.IndexOf(s);            j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
139            if i = -1 then            IWList1.Items[i] := s + '=' + j.ToString;
140              IWList1.Items.Add(s);          end;
141            FindNext;
142          end;
143        end
144        else
145        begin
146          First;
147          while Eof = false do
148          begin
149            s := FieldByName('CATEGORY').AsString;
150            if s = '' then
151            begin
152              Next;
153              continue;
154          end;          end;
155            i := IWList1.Items.IndexOf(s);
156            if i = -1 then
157              IWList1.Items.Add(s);
158          Next;          Next;
159        end;        end;
160      end;      end;
161      end;
162    if DM.FDTable2.Filtered = true then    if DM.FDTable2.Filtered = true then
163      for i := 0 to IWList1.Items.Count - 1 do      for i := 0 to IWList1.Items.Count - 1 do
164      begin      begin
# Line 167  begin Line 168  begin
168        else        else
169          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
170      end;      end;
171    IWList3.Items.Clear;    IWList2.Items.Clear;
172    if Page = Info then    if Page = false then
173    begin    begin
174      with DM.FDQuery1 do      with DM.FDQuery1 do
175      begin      begin
# Line 178  begin Line 179  begin
179        SQL.Add(' where number = :num;');        SQL.Add(' where number = :num;');
180        Params.ParamByName('num').AsInteger := UserSession.user_number;        Params.ParamByName('num').AsInteger := UserSession.user_number;
181        Open;        Open;
182        if RecordCount > 0 then        First;
183          i := 0;
184          while Eof = false do
185        begin        begin
186          First;          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
187          i := 0;          i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
188          while Eof = false do          IWList2.Items.Add(s);
189          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 + '円');  
190        end;        end;
191          IWList2.Items.Add(i.ToString + '円');
192        Close;        Close;
193      end;        IWList3.Items.Clear;
     IWList2.Items.Clear;  
     with DM.FDQuery1 do  
     begin  
194        SQL.Clear;        SQL.Clear;
195        SQL.Add('select name from recent_data join item_data');        SQL.Add('select name from recent_data join item_data');
196        SQL.Add(' on (recent_data.serial = item_data.serial)');        SQL.Add(' on (recent_data.serial = item_data.serial)');
197        SQL.Add(' where number = :num;');        SQL.Add(' where number = :num;');
198        //Params.ParamByName('num').AsInteger:=UserSession.user_number;        Params.ParamByName('num').AsInteger := UserSession.user_number;
199        Open;        Open;
200        if RecordCount > 0 then        First;
201          while Eof = false do
202        begin        begin
203          First;          IWList3.Items.Add(Fields.Fields[0].AsString);
204          while Eof = false do          Next;
         begin  
           IWList2.Items.Add(Fields.Fields[0].AsString);  
           Next;  
         end;  
205        end;        end;
206        Close;        Close;
207      end;      end;
208    end;    end;
   x := Page = Info;  
   IWRegion4.Visible := x;  
   IWLabel2.Visible := x;  
   IWDBLabel1.Visible := x;  
   IWLink2.Visible := not x;  
209    LoadImage;    LoadImage;
210      if IWGrid1.Visible = true then
211        IWLabel6.Visible := Filter;
212  end;  end;
213    
214  procedure TTopForm.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
215  const  var
216    filter = 'NAME LIKE ''%s''';    i: Integer;
217  begin  begin
218    if IWEdit1.Text = '' then    IWFrame8IWLink1Click(Sender);
219      DM.FDTable2.Filtered := false    if IWEdit1.Text <> '' then
   else  
220    begin    begin
221      DM.FDTable2.filter := Format(filter, ['%' + IWEdit1.Text + '%']);      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
222      DM.FDTable2.Filtered := true;      DM.FDTable2.Filtered := true;
223      IWLabel9.Text := 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;    end;
   IWLabel9.Visible := DM.FDTable2.Filtered;  
234  end;  end;
235    
236  procedure TTopForm.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
237  const  var
238    filter = 'EMAIL = ''%s'' and PASSWORD = ''%s''';    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;
265      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  begin
272    case Page of    UserSession.Thumbnail := true;
273      Main:    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;
287    
288    procedure TIWForm1.IWLink1Click(Sender: TObject);
289    begin
290      with TUserForm.Create(WebApplication) do
291      begin
292        Form := Self;
293        Show;
294      end;
295    end;
296    
297    procedure TIWForm1.IWLink2Click(Sender: TObject);
298    begin
299      if Page = true then
300        begin        begin
301          DM.FDTable1.filter := Format(filter, [IWEdit2.Text, IWEdit3.Text]);          if DM.FDTable1.Locate('EMAIL;PASSWORD',
302          DM.FDTable1.Filtered := true;            VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true
303          if DM.FDTable1.RecordCount = 1 then          then
304          begin          begin
305            IWLink1.Caption := 'ログアウト';            Page := false;
           Page := Info;  
306            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')
307              .AsInteger;              .AsInteger;
308            IWEdit2.Text := '';            IWEdit2.Text := '';
309          end;          end;
310          IWEdit3.Text := '';          IWEdit3.Text := '';
311        end;        end
312      Info:        else
313        begin        begin
314          DM.FDTable1.Filtered := false;          DM.FDTable1.Filtered := false;
315          IWLink1.Caption := 'ログイン';          Page := true;
316          Page := Main;          UserSession.user_number := 0;
         DM.FDQuery1.Params.ParamByName('num').AsInteger := 0;  
317        end;        end;
318    end;
319    
320    procedure TIWForm1.IWLink3Click(Sender: TObject);
321    begin
322      with TMyPage.Create(WebApplication) do
323      begin
324        Form := Self;
325        Show;
326    end;    end;
   IWLabel9.Visible := UserSession.user_number <> 0;  
327  end;  end;
328    
329  procedure TTopForm.IWLink2Click(Sender: TObject);  procedure TIWForm1.IWLink4Click(Sender: TObject);
330  begin  begin
331    UserSession.FPage := Info;    TCartForm.Create(WebApplication).Show;
   TUserForm.Create(WebApplication).Show;  
332  end;  end;
333    
334  procedure TTopForm.LoadImage;  procedure TIWForm1.LoadImage;
335  var  var
336    i, j, k: integer;    s: TStream;
337    png: TPngImage;    png: TPngImage;
338    pic: TIWImageFile;    pic: TIWImage;
339    st: TStream;    i: Integer;
340      j: Integer;
341      x: Boolean;
342      t: string;
343  label label1;  label label1;
344  begin  begin
345    ClearImage;    ClearImage;
346    if DM.FDTable2.RecordCount > 0 then    png := TPngImage.Create;
347    begin    try
348      IWGrid1.RowCount := (DM.FDTable2.RecordCount div IWGrid1.ColumnCount) + 1;      if UserSession.Thumbnail = true then
349      k := 1;      begin
350      DM.FDTable2.Last;        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
351      png := TPngImage.Create;        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
352      try          inc(i);
353          IWGrid1.RowCount := i;
354          if DM.FDTable2.Filtered = false then
355            DM.FDTable2.Last
356          else
357            DM.FDTable2.FindLast;
358        for i := 0 to IWGrid1.RowCount - 1 do        for i := 0 to IWGrid1.RowCount - 1 do
       begin  
359          for j := 0 to IWGrid1.ColumnCount - 1 do          for j := 0 to IWGrid1.ColumnCount - 1 do
360          begin          begin
361            st := DM.FDTable2.CreateBlobStream            if DM.FDTable2.Filtered = false then
362              (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);            begin
363            try              if DM.FDTable2.Bof = true then
364              png.LoadFromStream(st);                goto label1;
365              pic := TIWImageFile.Create(Self);            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);              pic.Picture.Assign(png);
379              IWGrid1.Cell[i, j].Control := pic;              IWGrid1.Cell[i, j].Control := pic;
             IWGrid1.Cell[i, j].Text := k.ToString;  
             inc(k);  
             DM.FDTable2.Prior;  
           finally  
             st.Free;  
380            end;            end;
381            if DM.FDTable2.Bof = true then            t := DM.FDTable2.FieldByName('NAME').AsString;
382              goto label1;            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;
       end;  
394      label1:      label1:
395      finally      end
396        png.Free;      else if (DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true) and
397      end;        (DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil) then
398    end      begin
399    else        s := DM.FDTable2.CreateBlobStream
400      IWGrid1.RowCount := 0;          (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
401    st := nil;        try
402            png.LoadFromStream(s);
403            IWFrame8.IWImage1.Picture.Assign(png);
404          finally
405            s.Free;
406          end;
407        end
408        else
409          IWFrame8.IWImage1.Picture.Assign(nil);
410      finally
411        png.Free;
412      end;
413    png := nil;    png := nil;
414      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    st := 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(st);      png := TPngImage.Create;
432      IWImageFile1.Picture.Assign(png);      try
433    finally        png.LoadFromStream(s);
434      st.Free;        IWImage1.Picture.Assign(png);
435      png.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    
445  procedure TTopForm.SetPage(const Value: TPage);  procedure TIWForm1.SetPage(const Value: Boolean);
 var  
   s: string;  
446  begin  begin
447    UserSession.FPage := Value;    UserSession.FPage := Value;
448    case Value of    IWRegion7.Visible := not Value;
449      Main:    IWDBLabel1.Visible := not Value;
450        s := 'toppage.htm';    IWLink3.Visible := not Value;
451      Info:    IWLink1.Visible := Value;
452        s := 'mypage.htm';    IWText1.Visible := Value;
453      if Value = false then
454      begin
455        IWLabel1.Caption := 'ようこそ';
456        IWLink2.Caption := 'ログアウト';
457      end
458      else
459      begin
460        IWLabel1.Caption := 'ようこそゲスト様';
461        IWLink2.Caption := 'ログイン';
462    end;    end;
   IWTemplateProcessorHTML1.Templates.Default := s;  
463  end;  end;
464    
465  initialization  initialization
466    
467  TTopForm.SetAsMainForm;  TIWForm1.SetAsMainForm;
468    
469  end.  end.
Legend:
Removed from v.1  
changed lines
  Added in v.7
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help