Entwickler-Ecke :: Thema anzeigen

Delete - Mi 07.09.05 16:44

Habs hinbekommen und für jeden, der mal das gleiche Problem hat hier hingestellt:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:

unit token;

interface

function GetToken(aString: String; SepChar: Char; TokenNum: Integer):String;
function NumToken(aString: String; SepChar: Char):Integer;

implementation

function GetToken(aString: String; SepChar: Char; TokenNum: Integer):String;
var
   Token     : String;
   StrLen    : Integer;
   TNum      : Integer;
   TEnd      : Integer;

begin
     StrLen := Length(aString);
     TNum   := 1;
     TEnd   := StrLen;
     while ((TNum <= TokenNum) and (TEnd <> 0)) do
     begin
          TEnd := Pos(SepChar,aString);
          if TEnd <> 0 then
          begin
               Token := Copy(aString,1,TEnd-1);
               Delete(aString,1,TEnd);
               Inc(TNum);
          end
          else
          begin
               Token := aString;
          end;
     end;
     if TNum >= TokenNum then
     begin
          Result := Token;
     end
     else
     begin
          Result := '';
     end;
end;

function NumToken(aString: String; SepChar: Char):Integer;
var
   RChar     : Char;
   StrLen    : Integer;
   TNum      : Integer;
   TEnd      : Integer;

begin
     if SepChar = '#' then
     begin
          RChar := '*'
     end
     else
     begin
         RChar := '#'
     end;
     StrLen := Length(aString);
     TNum   := 0;
     TEnd   := StrLen;
     while TEnd <> 0 do
     begin
          Inc(TNum);
          TEnd := Pos(SepChar,aString);
          if TEnd <> 0 then
          begin
               aString[TEnd] := RChar;
          end;
     end;
     Result := TNum;
end;

end.

Der folgende ist der eigentliche Code:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:

// myChar und mychar2 sind global und können jedes beliebige Character-Zeichen sein!
procedure TfrmMain.CheckBox6Click(Sender: TObject);
var
  bFound: Boolean;
  i : integer;
  strFilter : String;
  sl, sl1, slD1: TStringList;
  slFilterList: TStringList;
  s, sPath: string;
  ANode: TTreeNode;
  YPosToken, XPosToken: Integer;

  procedure CheckDAT(sPID: String);
  var
    i2: Integer;
    s1: String;
  begin
    for i2 := 0 to sl.Count - 1 do begin
      s1 := sl[i2];
      if GetToken(s1, myChar2, 1) = sPID then begin
        sPath := GetToken(s1, myChar2, 2) + myChar2 + sPath;
        if GetToken(s1, myChar2, 3) <> '' then CheckDAT(GetToken(s1, myChar2, 3));
        Break;
      end;
    end;
  end;

  procedure setTokenPos(const sMatch: String);
  var
    i,i2 : integer;
  begin
    YPosToken := -1;
    XPosToken := -1;
    for i := 0 to slD1.Count -1 do begin  // Y-Richtung
      for i2 := 1 to NumToken(slD1[i],myChar2) do begin  // X-Richtung
        if sMatch = Copy (getToken(slD1[i],myChar2,i2),pos(myChar,getToken(slD1[i],myChar2,i2))+1,length(getToken(slD1[i],myChar2,i2))) then begin
          YPosToken := i+1;
          XPosToken := i2;
          exit;
        end;
      end;
    end;
  end;

  function getFilterStr: String;
  var
    i,i2 : integer;
    strFilter: String;
  begin
    strFilter := '';
    slFilterList := TStringList.Create;
    try
      slFilterList.Clear;
      if slFilterList.IndexOf(tblTreeBilderTreeID.AsString) = -1 then slFilterList.Add(tblTreeBilderTreeID.AsString);
      for i := YPosToken-1 to slD1.Count-1 do begin

        if tblTreeBilderTreeID.AsString <> Copy (getToken(slD1[i],myChar2,XPosToken),
                                                 pos(myChar,getToken(slD1[i],myChar2,XPosToken))+1,
                                                 length(getToken(slD1[i],myChar2,XPosToken))) then break;
        for i2 := XPosToken+1 to NumToken(slD1[i],myChar2) do begin
          if slFilterList.IndexOf(Copy (getToken(slD1[i],myChar2,i2),
                                  pos(myChar,getToken(slD1[i],myChar2,i2))+1,
                                  length(getToken(slD1[i],myChar2,i2)))) = -1 then
            slFilterList.Add(Copy (getToken(slD1[i],myChar2,i2),
                             pos(myChar,getToken(slD1[i],myChar2,i2))+1,
                             length(getToken(slD1[i],myChar2,i2))));
        end;
      end;

      strFilter := '';
      for i := 0 to slFilterList.Count -1 do begin  // doppelte Einträge herausfiltern...
        if strFilter <> '' then strFilter := strFilter + ' OR ';
        strFilter := strFilter + '(TreeID = ' + slFilterList[i] + ')';
      end;

      Result := strFilter;
    finally
      slFilterList.free;
    end;
  end;

  function getFilterString: String;
  var
    i : integer;
  begin
    sl := TStringList.Create;
    try
      sl.Sorted := true;
      tblTreeGetSubCategories.Active := true;
      tblTreeGetSubCategories.First;
      for i := 0 to tblTreeGetSubCategories.RecordCount - 1 do
      begin
        sl.Add(tblTreeGetSubCategoriesTreeID.AsString + myChar2 +
        //tblTreeGetSubCategoriesName.AsString + myChar2 + tblTreeGetSubCategoriesParentID.AsString);
        tblTreeGetSubCategoriesName.AsString+myChar+ tblTreeGetSubCategoriesTreeID.AsString + myChar2 + tblTreeGetSubCategoriesParentID.AsString);
        tblTreeGetSubCategories.Next;
      end;

      sl1 := TStringList.Create;
      try
        sl1.Sorted := true;
        for i := 0 to sl.Count - 1 do begin
          s := sl[i];
          if GetToken(s, myChar2, 3) = '' then begin  // war vorher leer statt 10000
            sl1.Add(GetToken(s, myChar2, 2))
          end else begin
            sPath := GetToken(s, myChar2, 2);
            CheckDAT(GetToken(s, myChar2, 3));
            sl1.Add(sPath);
          end;
        end;

        slD1 := TStringList.Create;
        try
          slD1.Clear;
          slD1.Assign(sl1);  // eigentlich unsinnig, da die Forschleife (eine Zeile runter) nicht mehr(!) effektiv genutzt wird.
          {
          for i := 0 to sl1.Count -1 do begin
            //if Copy (getToken(sl1[i],myChar2,1),pos(myChar,getToken(sl1[i],myChar2,1))+1,length(getToken(sl1[i],myChar2,1))) = tblTreeBilderTreeID.AsString then begin
              //slD1.Add(Copy (getToken(sl1[i],myChar2,1),pos(myChar,getToken(sl1[i],myChar2,1))+1,length(getToken(sl1[i],myChar2,1))));
              slD1.Add(sl1[i]);
            //end;
          end;
          }
          setTokenPos(tblTreeBilderTreeID.AsString);
          Result := getFilterStr;
        finally
          slD1.free;
        end;
      finally
        sl1.free;
      end;
    finally
      sl.free;
    end;
  end;
  
begin
  if not (isRegisteredPro) then begin
    CheckBox6.Checked := false;
    CheckBoxSubCategories.Checked := false;
    rdShowInfo(frmMain.LabelUpgradeToPro.Caption);  // 1. "Für dieses Feature ist ein Upgrade auf die Pro-Version nötig."
    Exit;
  end;

  try
    if not (tblTreeBilder.Active) then Exit;
    if not (tblFaults.Active) then Exit;
    if tblTreeBilderTreeID.AsVariant = null then Exit;  // wenn keiner ausgewählt, dann exit!!

    Screen.Cursor := crHourGlass;
    try
      if CheckBox6.Checked then begin
        // Filtern

       //JvDBTreeView1.

        strFilter := '';
        strFilter := '(TreeID = ' + IntToStr(dsTreeBilder.DataSet.FieldByName('TreeID').AsInteger) + ')';
        if CheckBoxSubCategories.Checked then begin

          if not (tblTreeGetSubCategories.Active) then tblTreeGetSubCategories.Open;
          if not (frmMain.DBISAMSession1.StrictChangeDetection) then tblTreeGetSubCategories.Refresh;
          
          strFilter := getFilterString;
        end;
        tblFaults.Filter := strFilter;
        try
          tblFaults.Filtered := true;
        except
          tblFaults.Filter := '';
          tblFaults.Filtered := False;
        end;
      end else begin
        // Nicht filtern
        tblFaults.Filter := '';
        tblFaults.Filtered := false;
      end;
      CheckenObGefiltert;
    finally
      Screen.Cursor := crDefault;
    end;
  except
    tblFaults.Filtered := false;
    CheckBox6.Checked := false;
  end;
end;

Grüße
Ralph

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2026 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!