LCL: added TFileDialog.ExtractAllFilterMasks

git-svn-id: trunk@29600 -

docs/xml/lcl/dialogs.xml

@@ -3125,6 +3125,9 @@ If a valid directory is given, the selected directory in the tree will be set to
       <element name="TColorDialog.WSRegisterClass" link="#LCL.LCLClasses.TLCLComponent.WSRegisterClass"/>
       <element name="TColorButton.WSRegisterClass" link="#LCL.LCLClasses.TLCLComponent.WSRegisterClass"/>
       <element name="TFontDialog.WSRegisterClass" link="#LCL.LCLClasses.TLCLComponent.WSRegisterClass"/>
+      <element name="TFileDialog.ExtractAllFilterMasks">
+        <short>Extracts all file masks from a filter</short>
+      </element>
     </module>
     <!-- Dialogs -->
   </package>

ide/main.pp

@@ -2673,20 +2673,25 @@ var
   AFilename: string;
   I: Integer;
   OpenFlags: TOpenFlags;
+  Filter: String;
+  AllExt: String;
 begin
   OpenDialog:=TOpenDialog.Create(nil);
   try
     InputHistories.ApplyFileDialogSettings(OpenDialog);
     OpenDialog.Title:=lisOpenFile;
     OpenDialog.Options:=OpenDialog.Options+[ofAllowMultiSelect];
-    OpenDialog.Filter := lisLazarusFile + ' (*.lpi;*.lpr;*.lpk;*.pas;*.pp;*.inc;*.lfm;*.dfm)|' +
-                                            '*.lpi;*.lpr;*.lpk;*.pas;*.pp;*.inc;*.lfm;*.dfm'
-                 + '|' + lisLazarusUnit + ' (*.pas;*.pp)|*.pas;*.pp'
-                 + '|' + lisLazarusProject + ' (*.lpi)|*.lpi'
-                 + '|' + lisLazarusForm + ' (*.lfm;*.dfm)|*.lfm;*.dfm'
-                 + '|' + lisLazarusPackage + ' (*.lpk)|*.lpk'
-                 + '|' + lisLazarusProjectSource + ' (*.lpr)|*.lpr'
-                 + '|' + dlgAllFiles + ' (' + GetAllFilesMask + ')|' + GetAllFilesMask;
+    Filter := lisLazarusUnit + ' (*.pas;*.pp)|*.pas;*.pp'
+      + '|' + lisLazarusProject + ' (*.lpi)|*.lpi'
+      + '|' + lisLazarusForm + ' (*.lfm;*.dfm)|*.lfm;*.dfm'
+      + '|' + lisLazarusPackage + ' (*.lpk)|*.lpk'
+      + '|' + lisLazarusProjectSource + ' (*.lpr)|*.lpr'
+      + '|' + dlgAllFiles + ' (' + GetAllFilesMask + ')|' + GetAllFilesMask;
+    AllExt:=TFileDialog.ExtractAllFilterMasks(Filter);
+ debugln(['TMainIDE.mnuOpenClicked ',AllExt]);
+    // append an all filter
+    Filter:=  lisLazarusFile + ' ('+AllExt+')|' + AllExt + '|' + Filter;
+    OpenDialog.Filter := Filter;
     if OpenDialog.Execute and (OpenDialog.Files.Count>0) then begin
       OpenFlags:=[ofAddToRecent];
       //debugln('TMainIDE.mnuOpenClicked OpenDialog.Files.Count=',dbgs(OpenDialog.Files.Count));

lcl/dialogs.pp

@@ -132,6 +132,8 @@ type
     property Files: TStrings read FFiles;
     property HistoryList: TStrings read FHistoryList write SetHistoryList;
     procedure IntfFileTypeChanged(NewFilterIndex: Integer);
+    class function ExtractAllFilterMasks(aFilter: string;
+                                   SkipAllFilesMask: boolean = true): string;
   published
     property Title;
     property DefaultExt: string read FDefaultExt write SetDefaultExt;

lcl/include/filedialog.inc

@@ -76,6 +76,76 @@ begin
   end;
 end;
 
+class function TFileDialog.ExtractAllFilterMasks(aFilter: string;
+  SkipAllFilesMask: boolean): string;
+{ The filter is a list of pairs of captions and masks separated by pipe |
+  The masks are separated by semicolon ;
+  For example:
+    Pascal Files|*.pas;*.pp|All files|*.*
+}
+var
+  AllFilesMask: string;
+
+  procedure AddMask(MaskStart: PChar; MaskLen: integer; var Masks: string);
+  var
+    p: PChar;
+    NewMask: string;
+    Start: PChar;
+  begin
+    if (AllFilesMask<>'')
+    and (CompareFilenames(@AllFilesMask[1],length(AllFilesMask),MaskStart,MaskLen,false)=0)
+    then exit; // skip all files mask
+
+    if Masks<>'' then
+    begin
+      p:=PChar(Masks);
+      repeat
+        Start:=p;
+        while not (p^ in [#0,';']) do inc(p);
+        if (CompareFilenames(Start,p-Start,MaskStart,MaskLen,false)=0) then
+          exit;
+        if p^=#0 then break;
+        inc(p);
+      until false;
+    end;
+    if Masks<>'' then
+      Masks:=Masks+';';
+    SetLength(NewMask,MaskLen);
+    System.Move(MaskStart^,NewMask[1],length(NewMask));
+    Masks:=Masks+NewMask;
+  end;
+
+var
+  p: PChar;
+  MaskStart: PChar;
+begin
+  Result:='';
+  if aFilter='' then exit;
+  if SkipAllFilesMask then
+    AllFilesMask:=GetAllFilesMask
+  else
+    AllFilesMask:='';
+  //debugln(['TFileDialog.ExtractAllFilterMasks Filter=',aFilter]);
+  p:=PChar(aFilter);
+  while p^<>#0 do
+  begin
+    // skip caption
+    while not (p^ in ['|',#0]) do inc(p);
+    if p^=#0 then break;
+    // parse masks
+    repeat
+      inc(p);
+      MaskStart:=p;
+      while not (p^ in [';','|',#0]) do inc(p);
+      //debugln(['TFileDialog.ExtractAllFilterMasks Mask=',copy(aFilter,MaskStart-PChar(aFilter)+1,p-MaskStart)]);
+      if p>MaskStart then
+        AddMask(MaskStart,p-MaskStart,Result);
+      if p^='|' then break;
+    until p^=#0;
+    inc(p);
+  end;
+end;
+
 {------------------------------------------------------------------------------
   procedure TFileDialog.SetDefaultExt(const AValue: string);
 ------------------------------------------------------------------------------}
@@ -99,9 +169,9 @@ begin
   RegisterFileDialog;
 end;
 
-{------------------------------------------------------------------------------}
-{  TFileDialog DoExecute                                                         }
-{------------------------------------------------------------------------------}
+{------------------------------------------------------------------------------
+  TFileDialog DoExecute
+------------------------------------------------------------------------------}
 function TFileDialog.DoExecute : boolean;
 begin
   Result:= inherited DoExecute;

lcl/lclbase.lpk

@@ -19,6 +19,9 @@
           <ShowHints Value="False"/>
           <ShowGenInfo Value="False"/>
         </Verbosity>
+        <CompilerMessages>
+          <UseMsgFile Value="True"/>
+        </CompilerMessages>
         <CustomOptions Value="$(IDEBuildOptions)"/>
         <CompilerPath Value="$(CompPath)"/>
       </Other>
@@ -1196,13 +1199,14 @@
       <Item291>
         <Filename Value="registerlcl.pas"/>
         <HasRegisterProc Value="True"/>
-        <UnitName Value="registerlcl"/>
+        <UnitName Value="RegisterLCL"/>
       </Item291>
       <Item292>
         <Filename Value="include/lclcolordialog.inc"/>
         <Type Value="Include"/>
       </Item292>
     </Files>
+    <LazDoc Paths="../docs/xml/lcl"/>
     <i18n>
       <EnableI18N Value="True"/>
       <OutDir Value="languages"/>