Develop and Download Open Source Software

Browse Subversion Repository

Diff of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 17 by yamat0jp, Wed Aug 24 12:31:07 2016 UTC revision 18 by yamat0jp, Sat Aug 27 11:00:30 2016 UTC
# Line 51  type Line 51  type
51      IWFrame1: TIWFrame1;      IWFrame1: TIWFrame1;
52      IWLink6: TIWLink;      IWLink6: TIWLink;
53      IWLink7: TIWLink;      IWLink7: TIWLink;
54        IWLink8: TIWLink;
55      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
56      procedure IWLink2Click(Sender: TObject);      procedure IWLink2Click(Sender: TObject);
57      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
# Line 63  type Line 64  type
64      procedure IWLink3Click(Sender: TObject);      procedure IWLink3Click(Sender: TObject);
65      procedure IWLink5Click(Sender: TObject);      procedure IWLink5Click(Sender: TObject);
66      procedure IWLink6Click(Sender: TObject);      procedure IWLink6Click(Sender: TObject);
67        procedure IWLink8Click(Sender: TObject);
68    private    private
69      Filter: Boolean;      Filter: Boolean;
70      function GetPage: Boolean;      function GetPage: Boolean;
# Line 84  implementation Line 86  implementation
86    
87  {$R *.dfm}  {$R *.dfm}
88    
89  uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5, Unit11;  uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5, Unit11,
90      Unit13, Unit14;
91    
92    const
93      table2filter = 'AGREE = true and ACTIVATE = true';
94    
95  procedure TIWForm1.CallBack(EventParams: TStringList);  procedure TIWForm1.CallBack(EventParams: TStringList);
96  begin  begin
# Line 136  begin Line 142  begin
142    IWRegion6.Width := i;    IWRegion6.Width := i;
143    IWRegion7.Width := i;    IWRegion7.Width := i;
144    WebApplication.RegisterCallBack('callback', CallBack);    WebApplication.RegisterCallBack('callback', CallBack);
145      DM.FDTable2.Filter := table2filter;
146  end;  end;
147    
148  procedure TIWForm1.IWAppFormRender(Sender: TObject);  procedure TIWForm1.IWAppFormRender(Sender: TObject);
# Line 146  begin Line 153  begin
153    IWList1.Items.Clear;    IWList1.Items.Clear;
154    with DM.FDTable2 do    with DM.FDTable2 do
155    begin    begin
156      if Filtered = true then      FindFirst;
157        while Found = true do
158      begin      begin
159        FindFirst;        s := FieldByName('CATEGORY').AsString;
160        while Found = true do        if s = '' then
161          begin
162            FindNext;
163            continue;
164          end;
165          if DM.FDTable2.Filter = table2filter then
166          begin
167            i := IWList1.Items.IndexOf(s);
168            if i = -1 then
169              IWList1.Items.Add(s);
170          end
171          else
172        begin        begin
         s := FieldByName('CATEGORY').AsString;  
         if s = '' then  
         begin  
           FindNext;  
           continue;  
         end;  
173          i := IWList1.Items.IndexOfName(s);          i := IWList1.Items.IndexOfName(s);
174          if i = -1 then          if i = -1 then
175            IWList1.Items.Add(s + '=1')            IWList1.Items.Add(s + '=1')
# Line 165  begin Line 178  begin
178            j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;            j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
179            IWList1.Items[i] := s + '=' + j.ToString;            IWList1.Items[i] := s + '=' + j.ToString;
180          end;          end;
         FindNext;  
       end;  
     end  
     else  
     begin  
       First;  
       while Eof = false do  
       begin  
         s := FieldByName('CATEGORY').AsString;  
         if s = '' then  
         begin  
           Next;  
           continue;  
         end;  
         i := IWList1.Items.IndexOf(s);  
         if i = -1 then  
           IWList1.Items.Add(s);  
         Next;  
181        end;        end;
182          FindNext;
183      end;      end;
184    end;    end;
185    if DM.FDTable2.Filtered = true then    if DM.FDTable2.Filter <> table2filter then
186      for i := 0 to IWList1.Items.Count - 1 do      for i := 0 to IWList1.Items.Count - 1 do
187      begin      begin
188        s := IWList1.Items.ValueFromIndex[i];        s := IWList1.Items.ValueFromIndex[i];
189        if s = '1' then        IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
         IWList1.Items[i] := IWList1.Items.Names[i]  
       else  
         IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';  
190      end;      end;
191    IWList2.Items.Clear;    IWList2.Items.Clear;
192    with DM.FDQuery1 do    with DM.FDQuery1 do
# Line 231  begin Line 224  begin
224      Close;      Close;
225    end;    end;
226    LoadImage;    LoadImage;
227    if IWGrid1.Visible = true then    if IWGrid1.Visible = false then
     IWLabel6.Visible := Filter  
   else  
228      DM.FDTable2.Locate('SERIAL', UserSession.Serial);      DM.FDTable2.Locate('SERIAL', UserSession.Serial);
229  end;  end;
230    
231  procedure TIWForm1.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
232  var  var
233    i: Integer;    i: Integer;
234    label searchout;
235  begin  begin
236    IWFrame8IWLink1Click(Sender);    IWFrame8IWLink1Click(Sender);
237    if IWEdit1.Text <> '' then    if IWEdit1.Text <> '' then
238    begin    begin
239      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');      DM.FDTable2.Filter := table2filter + ' and NAME like ' +
240      DM.FDTable2.Filtered := true;        QuotedStr('%' + IWEdit1.Text + '%');
241      i := DM.FDTable2.RecordCount;      i := DM.FDTable2.RecordCount;
     IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);  
242      if i = 0 then      if i = 0 then
243        DM.FDTable2.Filtered := false;        goto searchout
244      Filter := true;      else
245        begin
246          IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
247          IWLabel6.Visible := true;
248        end;
249    end    end
250    else    else
251    begin    begin
252      DM.FDTable2.Filtered := false;    searchout:
253      Filter := false;      DM.FDTable2.Filter := table2filter;
254        IWLabel6.Visible := false;
255    end;    end;
256  end;  end;
257    
# Line 386  begin Line 382  begin
382      TAdminFile.Create(WebApplication).Show;      TAdminFile.Create(WebApplication).Show;
383  end;  end;
384    
385    procedure TIWForm1.IWLink8Click(Sender: TObject);
386    begin
387      TMasterForm.Create(WebApplication).Show;
388    end;
389    
390  procedure TIWForm1.LoadImage;  procedure TIWForm1.LoadImage;
391  var  var
392    pic: TIWImage;    pic: TIWImage;
# Line 401  begin Line 402  begin
402      if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then      if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
403        inc(i);        inc(i);
404      IWGrid1.RowCount := i;      IWGrid1.RowCount := i;
405      if DM.FDTable2.Filtered = false then      DM.FDTable2.FindLast;
       DM.FDTable2.Last  
     else  
       DM.FDTable2.FindLast;  
406      for i := 0 to IWGrid1.RowCount - 1 do      for i := 0 to IWGrid1.RowCount - 1 do
407        for j := 0 to IWGrid1.ColumnCount - 1 do        for j := 0 to IWGrid1.ColumnCount - 1 do
408        begin        begin
409          if DM.FDTable2.Filtered = false then          if DM.FDTable2.Found = false then
         begin  
           if DM.FDTable2.Bof = true then  
             goto label1;  
         end  
         else if DM.FDTable2.Found = false then  
410            goto label1;            goto label1;
411          pic := TIWImage.Create(IWGrid1);          pic := TIWImage.Create(IWGrid1);
412          UserSession.FieldToImg(pic.Picture,          UserSession.FieldToImg(pic.Picture,
# Line 427  begin Line 420  begin
420          IWGrid1.Cell[i, j].Text := t;          IWGrid1.Cell[i, j].Text := t;
421          IWGrid1.Cell[i, j].Alignment := taCenter;          IWGrid1.Cell[i, j].Alignment := taCenter;
422          IWGrid1.Cell[i, j].Clickable := true;          IWGrid1.Cell[i, j].Clickable := true;
423          if DM.FDTable2.Filtered = false then          DM.FDTable2.FindPrior;
           DM.FDTable2.Prior  
         else  
           DM.FDTable2.FindPrior;  
424        end;        end;
425    label1:    label1:
426    end    end

Legend:
Removed from v.17  
changed lines
  Added in v.18

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26