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 8 by yamat0jp, Thu Dec 31 08:51:02 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, PngImage, Data.DB,
13      IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14      IWCompMenu, Vcl.Menus, System.Variants, Vcl.Dialogs, System.UITypes, Unit8;
15    
16  type  type
17    TTopForm = class(TIWAppForm)    TIWForm1 = class(TIWAppForm)
18      IWRegion1: TIWRegion;      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
19      IWLabel1: TIWLabel;      IWLabel1: TIWLabel;
     IWList1: TIWList;  
     IWLink1: TIWLink;  
     IWLabel2: TIWLabel;  
20      IWDBLabel1: TIWDBLabel;      IWDBLabel1: TIWDBLabel;
21      IWFrame1: TIWFrame1;      IWRegion1: TIWRegion;
22        IWRegion2: TIWRegion;
23        IWText1: TIWText;
24        IWGrid1: TIWGrid;
25      IWRegion3: TIWRegion;      IWRegion3: TIWRegion;
     IWLabel3: TIWLabel;  
     IWLabel4: TIWLabel;  
26      IWRegion4: TIWRegion;      IWRegion4: TIWRegion;
27      IWLabel5: TIWLabel;      IWLink1: TIWLink;
28      IWList2: TIWList;      IWLabel2: TIWLabel;
29      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;      IWList1: TIWList;
30      IWRegion2: TIWRegion;      IWLabel3: TIWLabel;
     IWLabel6: TIWLabel;  
     IWRegion6: TIWRegion;  
31      IWEdit1: TIWEdit;      IWEdit1: TIWEdit;
32      IWButton1: TIWButton;      IWButton1: TIWButton;
     IWImageFile1: TIWImageFile;  
     IWRegion7: TIWRegion;  
     IWLabel8: TIWLabel;  
     IWGrid1: TIWGrid;  
     IWTabControl1: TIWTabControl;  
     IWTabControl1Page0: TIWTabPage;  
     IWTabControl1Page1: TIWTabPage;  
     IWText1: TIWText;  
     IWRegion8: TIWRegion;  
33      IWEdit2: TIWEdit;      IWEdit2: TIWEdit;
34      IWEdit3: TIWEdit;      IWEdit3: TIWEdit;
     IWLabel9: TIWLabel;  
     IWList3: TIWList;  
35      IWLink2: TIWLink;      IWLink2: TIWLink;
36        IWRegion5: TIWRegion;
37        IWLabel7: TIWLabel;
38        IWRegion6: TIWRegion;
39        IWLabel8: TIWLabel;
40        IWList2: TIWList;
41        IWLabel4: TIWLabel;
42        IWRegion7: TIWRegion;
43        IWLabel5: TIWLabel;
44        IWLabel6: TIWLabel;
45        IWList3: TIWList;
46        IWImage1: TIWImage;
47        IWFrame8: TIWFrame8;
48        IWLink4: TIWLink;
49        IWLink3: TIWLink;
50        IWLink5: TIWLink;
51        IWFrame1: TIWFrame1;
52      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
53      procedure IWLink1Click(Sender: TObject);      procedure IWLink2Click(Sender: TObject);
54      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
55      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
56      procedure IWAppFormDestroy(Sender: TObject);      procedure IWLink1Click(Sender: TObject);
57      procedure IWLink2Click(Sender: TObject);      procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
58        procedure IWFrame8IWButton1Click(Sender: TObject);
59        procedure IWFrame8IWLink1Click(Sender: TObject);
60        procedure IWLink4Click(Sender: TObject);
61        procedure IWLink3Click(Sender: TObject);
62        procedure IWLink5Click(Sender: TObject);
63    private    private
64      procedure SetPage(const Value: TPage);      Filter: Boolean;
65      function GetPage: TPage;      function GetPage: Boolean;
66        procedure SetPage(const Value: Boolean);
67      procedure LoadImage;      procedure LoadImage;
68      procedure ClearImage;      procedure ClearImage;
69        function GetThumbnail: Boolean;
70        procedure SetThumbnail(const Value: Boolean);
71        property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
72    public    public
73      property Page: TPage read GetPage write SetPage;      property Page: Boolean read GetPage write SetPage;
74    end;    end;
75    
76    var
77      IWForm1: TIWForm1;
78    
79  implementation  implementation
80    
81  {$R *.dfm}  {$R *.dfm}
82    
83  uses Unit2, ServerController, Unit4, Unit6;  uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10;
84    
85  procedure TTopForm.ClearImage;  procedure TIWForm1.ClearImage;
86  var  var
87    i, j: integer;    i: Integer;
88      j: Integer;
89  begin  begin
90    for i := 0 to IWGrid1.ColumnCount - 1 do    for i := 0 to IWGrid1.RowCount - 1 do
91      for j := 0 to IWGrid1.RowCount - 1 do      for j := 0 to IWGrid1.ColumnCount - 1 do
92      begin        IWGrid1.Cell[i, j].Control.Free;
93        IWGrid1.Cell[j, i].Control.Free;    IWGrid1.RowCount := 0;
       IWGrid1.Cell[j, i].Control := nil;  
     end;  
94  end;  end;
95    
96  function TTopForm.GetPage: TPage;  function TIWForm1.GetPage: Boolean;
97  begin  begin
98    result := UserSession.FPage;    result := UserSession.FPage;
99  end;  end;
100    
101  procedure TTopForm.IWAppFormCreate(Sender: TObject);  function TIWForm1.GetThumbnail: Boolean;
102    begin
103      result := UserSession.FThumbnail;
104    end;
105    
106    procedure TIWForm1.IWAppFormCreate(Sender: TObject);
107  const  const
108    i = 150;    i = 120;
109  var  var
110    s: integer;    s: Integer;
111  begin  begin
112    s:=DM.FDTable3.FieldByName('BGCOLOR').AsInteger;    IWForm1 := Self;
113    IWLabel1.BGColor := s;    Page := UserSession.FPage;
114      Thumbnail := UserSession.FThumbnail;
115      s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
116      IWLabel2.BGColor := s;
117    IWLabel3.BGColor := s;    IWLabel3.BGColor := s;
118    IWLabel5.BGColor := s;    IWLabel5.BGColor := s;
119    IWLabel6.BGColor := s;    IWLabel7.BGColor := s;
120    IWLabel8.BGColor := s;    IWLabel8.BGColor := s;
121    IWRegion1.Width := i;    IWRegion1.Width := i;
122    IWRegion2.Width := i;    IWRegion2.Width := i;
   IWRegion3.Width := i;  
123    IWRegion4.Width := i;    IWRegion4.Width := i;
124      IWRegion5.Width := i;
125      IWRegion6.Width := i;
126    IWRegion7.Width := i;    IWRegion7.Width := i;
   IWRegion8.Width := i;  
   Page := UserSession.FPage;  
 end;  
   
 procedure TTopForm.IWAppFormDestroy(Sender: TObject);  
 begin  
   ClearImage;  
127  end;  end;
128    
129  procedure TTopForm.IWAppFormRender(Sender: TObject);  procedure TIWForm1.IWAppFormRender(Sender: TObject);
130  var  var
131    s: string;    s: string;
132    i, j: integer;    i, j: Integer;
   x: Boolean;  
133  begin  begin
134    IWList1.Items.Clear;    IWList1.Items.Clear;
135    with DM.FDTable2 do    with DM.FDTable2 do
136      if RecordCount > 0 then    begin
137        if Filtered = true then
138      begin      begin
139        First;        FindFirst;
140        while Eof = false do        while Found = true do
141        begin        begin
142          s := FieldByName('CATEGORY').AsString;          s := FieldByName('CATEGORY').AsString;
143          if s = '' then          if s = '' then
144          begin          begin
145            Next;            FindNext;
146            continue;            continue;
147          end;          end;
148          if Filtered = true then          i := IWList1.Items.IndexOfName(s);
149          begin          if i = -1 then
150            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  
151          else          else
152          begin          begin
153            i := IWList1.Items.IndexOf(s);            j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
154            if i = -1 then            IWList1.Items[i] := s + '=' + j.ToString;
             IWList1.Items.Add(s);  
155          end;          end;
156            FindNext;
157          end;
158        end
159        else
160        begin
161          First;
162          while Eof = false do
163          begin
164            s := FieldByName('CATEGORY').AsString;
165            if s = '' then
166            begin
167              Next;
168              continue;
169            end;
170            i := IWList1.Items.IndexOf(s);
171            if i = -1 then
172              IWList1.Items.Add(s);
173          Next;          Next;
174        end;        end;
175      end;      end;
176      end;
177    if DM.FDTable2.Filtered = true then    if DM.FDTable2.Filtered = true then
178      for i := 0 to IWList1.Items.Count - 1 do      for i := 0 to IWList1.Items.Count - 1 do
179      begin      begin
# Line 167  begin Line 183  begin
183        else        else
184          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
185      end;      end;
186    IWList3.Items.Clear;    IWList2.Items.Clear;
187    if Page = Info then    if Page = false then
188    begin    begin
189      with DM.FDQuery1 do      with DM.FDQuery1 do
190      begin      begin
# Line 178  begin Line 194  begin
194        SQL.Add(' where number = :num;');        SQL.Add(' where number = :num;');
195        Params.ParamByName('num').AsInteger := UserSession.user_number;        Params.ParamByName('num').AsInteger := UserSession.user_number;
196        Open;        Open;
197        if RecordCount > 0 then        First;
198          i := 0;
199          while Eof = false do
200        begin        begin
201          First;          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
202          i := 0;          i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
203          while Eof = false do          IWList2.Items.Add(s);
204          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 + '円');  
205        end;        end;
206          IWList2.Items.Add(i.ToString + '円');
207        Close;        Close;
208      end;        IWList3.Items.Clear;
     IWList2.Items.Clear;  
     with DM.FDQuery1 do  
     begin  
209        SQL.Clear;        SQL.Clear;
210        SQL.Add('select name from recent_data join item_data');        SQL.Add('select name from recent_data join item_data');
211        SQL.Add(' on (recent_data.serial = item_data.serial)');        SQL.Add(' on (recent_data.serial = item_data.serial)');
212        SQL.Add(' where number = :num;');        SQL.Add(' where number = :num;');
213        //Params.ParamByName('num').AsInteger:=UserSession.user_number;        Params.ParamByName('num').AsInteger := UserSession.user_number;
214        Open;        Open;
215        if RecordCount > 0 then        First;
216          while Eof = false do
217        begin        begin
218          First;          IWList3.Items.Add(Fields.Fields[0].AsString);
219          while Eof = false do          Next;
         begin  
           IWList2.Items.Add(Fields.Fields[0].AsString);  
           Next;  
         end;  
220        end;        end;
221        Close;        Close;
222      end;      end;
223    end;    end;
   x := Page = Info;  
   IWRegion4.Visible := x;  
   IWLabel2.Visible := x;  
   IWDBLabel1.Visible := x;  
   IWLink2.Visible := not x;  
224    LoadImage;    LoadImage;
225      if IWGrid1.Visible = true then
226        IWLabel6.Visible := Filter;
227  end;  end;
228    
229  procedure TTopForm.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
230  const  var
231    filter = 'NAME LIKE ''%s''';    i: Integer;
232  begin  begin
233    if IWEdit1.Text = '' then    IWFrame8IWLink1Click(Sender);
234      DM.FDTable2.Filtered := false    if IWEdit1.Text <> '' then
   else  
235    begin    begin
236      DM.FDTable2.filter := Format(filter, ['%' + IWEdit1.Text + '%']);      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
237      DM.FDTable2.Filtered := true;      DM.FDTable2.Filtered := true;
238      IWLabel9.Text := IWEdit1.Text + 'を検索しています';      i := DM.FDTable2.RecordCount;
239        IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
240        if i = 0 then
241          DM.FDTable2.Filtered := false;
242        Filter := true;
243      end
244      else
245      begin
246        DM.FDTable2.Filtered := false;
247        Filter := false;
248    end;    end;
   IWLabel9.Visible := DM.FDTable2.Filtered;  
249  end;  end;
250    
251  procedure TTopForm.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
252  const  var
253    filter = 'EMAIL = ''%s'' and PASSWORD = ''%s''';    i: Integer;
254  begin  begin
255    case Page of    if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
256      Main:    begin
257        begin      WebApplication.ShowMessage('個数が不正です');
258          DM.FDTable1.filter := Format(filter, [IWEdit2.Text, IWEdit3.Text]);      Exit;
259          DM.FDTable1.Filtered := true;    end;
260          if DM.FDTable1.RecordCount = 1 then    if i = 0 then
261          begin    begin
262            IWLink1.Caption := 'ログアウト';      WebApplication.ShowMessage('１個以上のご注文が必要です');
263            Page := Info;      Exit;
264            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')    end;
265              .AsInteger;    with DM.FDQuery1 do
266            IWEdit2.Text := '';    begin
267          end;      SQL.Clear;
268          IWEdit3.Text := '';      SQL.Add('select * from cart_data;');
269        end;      Open;
270      Info:      if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
271        begin        UserSession.Serial]), []) = true then
272          DM.FDTable1.Filtered := false;      begin
273          IWLink1.Caption := 'ログイン';        Edit;
274          Page := Main;        FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
275          DM.FDQuery1.Params.ParamByName('num').AsInteger := 0;        Post;
276        end;      end
277        else
278          AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
279    end;    end;
280    IWLabel9.Visible := UserSession.user_number <> 0;    IWFrame8.IWEdit1.Text := '0';
281      if MessageDlg('カートに移動しますか', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
282        TCartForm.Create(WebApplication).Show;
283    end;
284    
285    procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
286    begin
287      Thumbnail := true;
288    end;
289    
290    procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
291      const ARow, AColumn: Integer);
292    begin
293      Thumbnail := false;
294      IWFrame8.IWEdit1.Text := '1';
295      UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
296  end;  end;
297    
298  procedure TTopForm.IWLink2Click(Sender: TObject);  procedure TIWForm1.IWLink1Click(Sender: TObject);
299  begin  begin
   UserSession.FPage := Info;  
300    TUserForm.Create(WebApplication).Show;    TUserForm.Create(WebApplication).Show;
301  end;  end;
302    
303  procedure TTopForm.LoadImage;  procedure TIWForm1.IWLink2Click(Sender: TObject);
304    begin
305      if Page = true then
306      begin
307        if DM.FDTable1.Locate('EMAIL;PASSWORD',
308          VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true then
309        begin
310          Page := false;
311          UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
312          IWEdit2.Text := '';
313        end;
314        IWEdit3.Text := '';
315      end
316      else
317      begin
318        UserSession.user_number := 0;
319        Page := true;
320      end;
321    end;
322    
323    procedure TIWForm1.IWLink3Click(Sender: TObject);
324    begin
325      with TMyPage.Create(WebApplication) do
326      begin
327        Form := Self;
328        Show;
329      end;
330    end;
331    
332    procedure TIWForm1.IWLink4Click(Sender: TObject);
333    begin
334      TCartForm.Create(WebApplication).Show;
335    end;
336    
337    procedure TIWForm1.IWLink5Click(Sender: TObject);
338    begin
339      TIWForm10.Create(WebApplication).Show;
340    end;
341    
342    procedure TIWForm1.LoadImage;
343  var  var
344    i, j, k: integer;    s: TStream;
345    png: TPngImage;    png: TPngImage;
346    pic: TIWImageFile;    pic: TIWImage;
347    st: TStream;    i: Integer;
348      j: Integer;
349      x: Boolean;
350      t: string;
351  label label1;  label label1;
352  begin  begin
353    ClearImage;    ClearImage;
354    if DM.FDTable2.RecordCount > 0 then    png := TPngImage.Create;
355    begin    try
356      IWGrid1.RowCount := (DM.FDTable2.RecordCount div IWGrid1.ColumnCount) + 1;      if Thumbnail = true then
357      k := 1;      begin
358      DM.FDTable2.Last;        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
359      png := TPngImage.Create;        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
360      try          inc(i);
361          IWGrid1.RowCount := i;
362          if DM.FDTable2.Filtered = false then
363            DM.FDTable2.Last
364          else
365            DM.FDTable2.FindLast;
366        for i := 0 to IWGrid1.RowCount - 1 do        for i := 0 to IWGrid1.RowCount - 1 do
       begin  
367          for j := 0 to IWGrid1.ColumnCount - 1 do          for j := 0 to IWGrid1.ColumnCount - 1 do
368          begin          begin
369            st := DM.FDTable2.CreateBlobStream            if DM.FDTable2.Filtered = false then
370              (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);            begin
371            try              if DM.FDTable2.Bof = true then
372              png.LoadFromStream(st);                goto label1;
373              pic := TIWImageFile.Create(Self);            end
374              else if DM.FDTable2.Found = false then
375                goto label1;
376              if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
377              begin
378                s := DM.FDTable2.CreateBlobStream
379                  (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
380                try
381                  png.LoadFromStream(s);
382                finally
383                  s.Free;
384                end;
385                pic := TIWImage.Create(IWGrid1);
386              pic.Picture.Assign(png);              pic.Picture.Assign(png);
387              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;  
388            end;            end;
389            if DM.FDTable2.Bof = true then            t := DM.FDTable2.FieldByName('NAME').AsString;
390              goto label1;            if Length(t) > 10 then
391                t := Copy(t, 1, 8) + '..';
392              IWGrid1.Cell[i, j].Tag :=
393                Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
394              IWGrid1.Cell[i, j].Text := t;
395              IWGrid1.Cell[i, j].Alignment := taCenter;
396              IWGrid1.Cell[i, j].Clickable := true;
397              if DM.FDTable2.Filtered = false then
398                DM.FDTable2.Prior
399              else
400                DM.FDTable2.FindPrior;
401          end;          end;
       end;  
402      label1:      label1:
403      finally      end
404        png.Free;      else if (DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true) and
405      end;        (DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil) then
406    end      begin
407    else        s := DM.FDTable2.CreateBlobStream
408      IWGrid1.RowCount := 0;          (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
409    st := nil;        try
410            png.LoadFromStream(s);
411            IWFrame8.IWImage1.Picture.Assign(png);
412          finally
413            s.Free;
414          end;
415        end
416        else
417          IWFrame8.IWImage1.Picture.Assign(nil);
418      finally
419        png.Free;
420      end;
421    png := nil;    png := nil;
422      s := nil;
423    Randomize;    Randomize;
424      if DM.FDTable2.Filtered = true then
425      begin
426        x := true;
427        DM.FDTable2.Filtered := false;
428      end
429      else
430        x := false;
431    DM.FDTable2.Last;    DM.FDTable2.Last;
432      if DM.FDTable2.Bof = true then
433        Exit;
434    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
435    st := DM.FDTable2.CreateBlobStream    if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
436      (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);    begin
437    png := TPngImage.Create;      s := DM.FDTable2.CreateBlobStream
438    try        (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
439      png.LoadFromStream(st);      png := TPngImage.Create;
440      IWImageFile1.Picture.Assign(png);      try
441    finally        png.LoadFromStream(s);
442      st.Free;        IWImage1.Picture.Assign(png);
443      png.Free;      finally
444          png.Free;
445          s.Free;
446        end;
447    end;    end;
448      if x = true then
449        DM.FDTable2.Filtered := true;
450    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
451  end;  end;
452    
453  procedure TTopForm.SetPage(const Value: TPage);  procedure TIWForm1.SetPage(const Value: Boolean);
 var  
   s: string;  
454  begin  begin
455    UserSession.FPage := Value;    UserSession.FPage := Value;
456    case Value of    IWRegion7.Visible := not Value;
457      Main:    IWDBLabel1.Visible := not Value;
458        s := 'toppage.htm';    IWLink3.Visible := not Value;
459      Info:    IWLink1.Visible := Value;
460        s := 'mypage.htm';    IWText1.Visible := Value;
461      if Value = false then
462      begin
463        IWLabel1.Caption := 'ようこそ';
464        IWLink2.Caption := 'ログアウト';
465      end
466      else
467      begin
468        IWLabel1.Caption := 'ようこそゲスト様';
469        IWLink2.Caption := 'ログイン';
470        Thumbnail := true;
471        IWText1.Text := '';
472        DM.FDTable2.Filtered := false;
473        Filter := false;
474    end;    end;
475    IWTemplateProcessorHTML1.Templates.Default := s;  end;
476    
477    procedure TIWForm1.SetThumbnail(const Value: Boolean);
478    begin
479      UserSession.FThumbnail := Value;
480      IWGrid1.Visible := Value;
481      IWFrame8.Visible := not Value;
482  end;  end;
483    
484  initialization  initialization
485    
486  TTopForm.SetAsMainForm;  TIWForm1.SetAsMainForm;
487    
488  end.  end.
Legend:
Removed from v.1  
changed lines
  Added in v.8
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help