JP CASSOU

Deux petits wrappers pour l'enregistrement et l'ouverture de fichiers

Le type TStringDirectoryFilename

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
// type de chaînes pour les noms de fichier
type TStringDirectoryFilename = type UTF8String;

Constante pour filtres de fichiers

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
resourcestring
   rsGHTOPO_FILE_FILTER_WO_TEXT = 'Fichiers GHTopo (*.xtb)|*.xtb|' +
                         'Fichiers GHTopo XML (*.gtx)|*.gtx|' +
                         'Fichiers Toporobot Tab [deprecated] (*.Tab)|*.Tab|' +
                         'Tous (*.*)|*.*';

Sauvegarde de fichiers:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
function DoDialogSaveFile(const QFilter: string;
                                     const QDefaultExt: string;
                                     var QFileName: TStringDirectoryFilename;
                                     out idxFilter: integer): boolean;
begin
  Result := False;
  with TSaveDialog.Create(Application) do
  begin
    try
      Options      := Options + [ofOverWritePrompt];
      InitialDir   := ExtractFilePath(QFileName);
      FileName     := ExtractFileName(QFileName);
      Filter       := QFilter + '|Tous (*.*)|*.*';
      DefaultExt   := QDefaultExt;
      if (Execute) then
      begin
        QFileName := UTF8ToSys(FileName);
        idxFilter := FilterIndex;
        Result := True;
      end;
    finally
      Free;
    end;
  end;
end;

Ouverture de fichiers

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
function DoDialogOpenFile(const QFilter: string; const QDefaultExt: string; var QFileName: TStringDirectoryFilename): boolean;
begin
  Result := False;
  with TOpenDialog.Create(Application) do
  begin
    try
      FileName   := QFileName;
      InitialDir := GetGHTopoDirectory;
      Filter     := QFilter + '|Tous (*.*)|*.*';
      DefaultExt := QDefaultExt;
      if (Execute) then
      begin
        QFileName := UTF8ToSys(FileName);
        Result    := True;
      end;
    finally
      Free;
    end;
  end;
end;

Exemples d'Utilisation (tirés de GHTopo):

Sauvegarde d'un document avec utilisation du paramètre idxFilter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
procedure TBarreMenuPpal.acSaveAsExecute(Sender: TObject);
var
  EWE: String;
  QFileName: TStringDirectoryFilename;
  QFilterIndex: integer;
begin
  QFileName := '';
  if (DoDialogSaveFile(GetResourceString(rsGHTOPO_FILE_FILTER_WO_TEXT), '.xtb', QFileName, QFilterIndex)) then
  begin
    case QFilterIndex of
      1: FDocumentToporobot.SaveToFile(QFileName,mtabEXTENDEDTAB, tfWINDOWS);
      2: FDocumentToporobot.SaveToXML(QFileName); // futur format standard de GHTopo
      3: FDocumentToporobot.SaveToFile(QFileName,mtabTOPOROBOT, tfMAC);
    end; // case FilterIndex
    // actualisation du nouveau nom de fichier
    FNomFichierXTB := QFileName;
    self.Caption:=Format(rsMAINMENUCAPTION,[FNomFichierXTB]);
  end;
end;

Ouverture d'une topographie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TBarreMenuPpal.acOuvrirTopoExtExecute(Sender: TObject);
var
  QFileName: TStringDirectoryFilename;
begin
  QFileName := ExtractFilePath(ParamStr(0));
  if (DoDialogOpenFile(GetResourceString(rsGHTOPO_FILE_FILTER_WO_TEXT), '.xtb', QFileName)) then
  begin
    //traitement
    CloseAllDocuments();
    ChargerLaTopoExt(QFilename, GHTopoQuestionOuiNon('Recalculer le réseau'));
    AfficherMessage('PRET');
    ActiverMenus(True);
  end;
end;

Une fonction QuestionOuiNon()

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
function QuestionOuiNon(const Msg: string): boolean;
{$IFDEF TABLET_VERSION}
var
  DD: TdlgTabletteQuestionOuiNon;
{$ENDIF}
begin
  {$IFDEF TABLET_VERSION}
    // avec une Form personnalisée
     DD := TdlgTabletteQuestionOuiNon.Create(Application);
     try
       DD.SetPrompt(Msg);
       DD.ShowModal;
       Result := (DD.ModalResult = mrYes);
     finally
       DD.Release;
     end;
  {$ELSE}
     // en utilisant MessageDlg
     Result := (MessageDlg(Msg, mtConfirmation,[mbYES, mbNO], 0) = mrYES);
  {$ENDIF}
end;