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
|
{%MainUnit GtkInt.pp}
{------------------------------------------------------------------------------
Function: ExtractFilterList
Params: const Filter: string; var FilterIndex: integer;
var ListOfPFileSelFilterEntry: TStringList
Returns: -
Converts a Delphi file filter of the form
'description1|mask1|description2|mask2|...'
into a TFPList of PFileSelFilterEntry(s).
Multi masks:
- multi masks like '*.pas;*.pp' are converted into multiple entries.
- if the masks are found in the description they are adjusted
- if the mask is not included in the description it will be concatenated
For example:
'Pascal files (*.pas;*.pp)|*.pas;*.lpr;*.pp;
is converted to three filter entries:
'Pascal files (*.pas)' + '*.pas'
'Pascal files (*.pp)' + '*.pp'
'Pascal files (*.lpr)' + '*.lpr'
------------------------------------------------------------------------------}
procedure ExtractFilterList(const Filter: string;
out ListOfFileSelFilterEntry: TFPList;
SplitMultiMask: boolean);
var
Masks: TStringList;
CurFilterIndex: integer;
procedure ExtractMasks(const MultiMask: string);
var CurMaskStart, CurMaskEnd: integer;
s: string;
begin
if Masks=nil then
Masks:=TStringList.Create
else
Masks.Clear;
CurMaskStart:=1;
while CurMaskStart<=length(MultiMask) do begin
CurMaskEnd:=CurMaskStart;
if SplitMultiMask then begin
while (CurMaskEnd<=length(MultiMask)) and (MultiMask[CurMaskEnd]<>';')
do
inc(CurMaskEnd);
end else begin
CurMaskEnd:=length(MultiMask)+1;
end;
s:=Trim(copy(MultiMask,CurMaskStart,CurMaskEnd-CurMaskStart));
Masks.Add(s);
CurMaskStart:=CurMaskEnd+1;
end;
end;
procedure AddEntry(const Desc, Mask: string);
var NewFilterEntry: TFileSelFilterEntry;
begin
NewFilterEntry:=TFileSelFilterEntry.Create(Desc,Mask);
NewFilterEntry.FilterIndex:=CurFilterIndex;
ListOfFileSelFilterEntry.Add(NewFilterEntry);
end;
// remove all but one masks from description string
function RemoveOtherMasks(const Desc: string; MaskIndex: integer): string;
var i, StartPos, EndPos: integer;
begin
Result:=Desc;
for i:=0 to Masks.Count-1 do begin
if i=MaskIndex then continue;
StartPos:=Pos(Masks[i],Result);
EndPos:=StartPos+length(Masks[i]);
if StartPos<1 then continue;
while (StartPos>1) and (Result[StartPos-1] in [' ',#9,';']) do
dec(StartPos);
while (EndPos<=length(Result)) and (Result[EndPos] in [' ',#9]) do
inc(EndPos);
if (StartPos>1) and (Result[StartPos-1]='(')
and (EndPos<=length(Result)) then begin
if (Result[EndPos]=')') then begin
dec(StartPos);
inc(EndPos);
end else if Result[EndPos]=';' then begin
inc(EndPos);
end;
end;
System.Delete(Result,StartPos,EndPos-StartPos);
end;
end;
procedure AddEntries(const Desc: string; MultiMask: string);
var i: integer;
CurDesc: string;
begin
ExtractMasks(MultiMask);
for i:=0 to Masks.Count-1 do begin
CurDesc:=RemoveOtherMasks(Desc,i);
if (Masks.Count>1) and (Pos(Masks[i],CurDesc)<1) then begin
if (CurDesc='') or (CurDesc[length(CurDesc)]<>' ') then
CurDesc:=CurDesc+' ';
CurDesc:=CurDesc+'('+Masks[i]+')';
end;
//debugln('AddEntries ',CurDesc,' ',Masks[i]);
AddEntry(CurDesc,Masks[i]);
end;
inc(CurFilterIndex);
end;
var
CurDescStart, CurDescEnd, CurMultiMaskStart, CurMultiMaskEnd: integer;
CurDesc, CurMultiMask: string;
begin
ListOfFileSelFilterEntry:=TFPList.Create;
Masks:=nil;
CurFilterIndex:=0;
CurDescStart:=1;
while CurDescStart<=length(Filter) do begin
// extract next filter description
CurDescEnd:=CurDescStart;
while (CurDescEnd<=length(Filter)) and (Filter[CurDescEnd]<>'|') do
inc(CurDescEnd);
CurDesc:=copy(Filter,CurDescStart,CurDescEnd-CurDescStart);
// extract next filter multi mask
CurMultiMaskStart:=CurDescEnd+1;
CurMultiMaskEnd:=CurMultiMaskStart;
while (CurMultiMaskEnd<=length(Filter)) and (Filter[CurMultiMaskEnd]<>'|') do
inc(CurMultiMaskEnd);
CurMultiMask:=copy(Filter,CurMultiMaskStart,CurMultiMaskEnd-CurMultiMaskStart);
if CurDesc='' then CurDesc:=CurMultiMask;
// add filter(s)
if (CurMultiMask<>'') or (CurDesc<>'') then
AddEntries(CurDesc,CurMultiMask);
// next filter
CurDescStart:=CurMultiMaskEnd+1;
end;
Masks.Free;
end;
procedure FreeListOfFileSelFilterEntry(ListOfFileSelFilterEntry: TFPList);
var
i: Integer;
begin
if ListOfFileSelFilterEntry=nil then exit;
for i:=0 to ListOfFileSelFilterEntry.Count-1 do
TObject(ListOfFileSelFilterEntry[i]).Free;
ListOfFileSelFilterEntry.Free;
end;
|
