SAVE PROJET (V1.2.0.0)
John Dogget
Messages postés
384
Date d'inscription
vendredi 18 juin 2004
Statut
Membre
Dernière intervention
7 mai 2009
-
26 mars 2007 à 22:06
jackalunion Messages postés 128 Date d'inscription mercredi 8 janvier 2003 Statut Membre Dernière intervention 14 juillet 2008 - 22 juin 2008 à 13:03
jackalunion Messages postés 128 Date d'inscription mercredi 8 janvier 2003 Statut Membre Dernière intervention 14 juillet 2008 - 22 juin 2008 à 13:03
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/41961-save-projet-v1-2-0-0
https://codes-sources.commentcamarche.net/source/41961-save-projet-v1-2-0-0
22 juin 2008 à 13:03
27 mars 2007 à 04:16
function f_BackslashNoExist(path : string): boolean;
begin
result :Path[Length(Path)] '\';
end;
( il exists une fonction qui permet de l'ajouter au cas ou : IncludeTrailingBackslash ou encore IncludeTrailingPathDelimiter (voir l'aide pour les differences)
var
Dir : array[1..5] of string;
DirBack : array[1..5] of string;
procedure TFormPrincipale.p_ChoixDuBackup;
begin
DirSource := Dir[Flag];
DirDest := DirBack[Flag];
end;
procedure TFormPrincipale.BtnDirSourceClick(Sender: TObject);
begin
If SelectDirectory(DirSource,[sdAllowCreate,sdPerformCreate,sdPrompt],0) then
begin
IncludeTrailingBackSlash(dirSource);
Dir[Drapeau] := DirSource;
p_MiseAJourCaption;
end;
end;
procedure TFormPrincipale.BtnDirDestinationClick(Sender: TObject);
begin
If SelectDirectory(DirDest,[sdAllowCreate,sdPerformCreate,sdPrompt],0) Then
begin
IncludeTrailingBackSlash(dirDest);
DirBack[Drapeau] := DirDest;
p_MiseAJourCaption;
end;
end;
procedure TFormPrincipale.BtnQuitterClick(Sender: TObject);
begin
p_TableauCfgTmp;
p_EcritureFichierConfig;
Close;
end;
procedure TFormPrincipale.p_MiseAJourCaption;
begin
L_DirSource.Caption := Dir[Flag];
L_DirDestination.Caption := DirBack[Flag];
end;
procedure TFormPrincipale.p_TableauCfgTmp;
var N : integer;
begin
if Length(dirSource) > 2 then tablTmp[0] := dirSource;
if Length(dirDest) > 2 then tablTmp[1] := dirDest;
if Length(RadioButton1.Caption) > 2 then tablTmp[2] := RadioButton1.Caption;
if Length(RadioButton2.Caption) > 2 then tablTmp[3] := RadioButton2.Caption;
if Length(RadioButton3.Caption) > 2 then tablTmp[14] := RadioButton3.Caption;
if Length(RadioButton4.Caption) > 2 then tablTmp[15] := RadioButton4.Caption;
if Length(RadioButton5.Caption) > 2 then tablTmp[16] := RadioButton5.Caption;
for N := 1 to 5 do
begin
if Length(Dir[N]) > 2 then tablTmp[3+N] := Dir[N];
if Length(DirBack[N]) > 2 then tablTmp[4+N] := DirBack[N];
end;
end;
procedure TFormPrincipale.p_EcritureFichierConfig;
var
N : integer;
begin
with TStringList.Create do
try
For N := 0 to 16 do
Add(tablTmp[N]);
SaveToFile(ExtractFilePath(Application.ExeName)+fichierCFG);
finally
Free;
end;
end;
procedure TFormPrincipale.p_CfgInitialisation;
var
FLN : string;
N : integer;
begin
FLN := ExtractFilePath(Application.ExeName)+fichierCFG;
if not FileExists(FLN) then
begin
MessageDlg('Il n''existe pas encore de fichier de configuration !', mtWarning, [mbOk], 0);
exit;
end;
with TStringList.Create do
try
LoadFromFile(FLN);
dirSource := Strings[0];
dirDest := Strings[1];
RadioButton1.Caption := Strings[2];
RadioButton2.Caption := Strings[3];
RadioButton3.Caption := Strings[14];
RadioButton4.Caption := Strings[15];
RadioButton5.Caption := Strings[16];
for N := 1 to 5 do
begin
Dir[N] := IncludeTrailingBackSlash(Strings[3+N]);
DirBack[N] := IncludeTrailingBackSlash(Strings[4+N]);
end;
finally
Free;
end;
end;
et d'autres choses possible a ameliorer ...
27 mars 2007 à 01:20
Je fais la mise à jour et j'attend les réactions (si il y en a).
Sorry pour le dérangement !
27 mars 2007 à 01:17
l'erreur est liée à l'utilisation de Delphi4 :
Déclaré dans Delphi4 dans l'unité Consts.pas :
SFCreateError = 'Impossible de créer le fichier %s';
SFOpenError = 'Impossible d''ouvrir le fichier %s';
Dans les versions plus récentes de Delphi elles se trouvent dans l'unité RTLConsts.pas
Voilà, rien d'insurmontable, le problème peut être réglé soit par un ajout des deux constantes dans l'unité principale soit par une compilation conditionnelle. ^_^
27 mars 2007 à 00:59
confirme moi ton envie de suppression ... ici ou par MP et ce sera fait ...
26 mars 2007 à 23:50
Fais juste les mises à jour où tu as constaté des problèmes.
Si tu veux malgré tout le supprimer, alors prends contact avec un administrateur ;-)
26 mars 2007 à 23:45
Il fonctionne bien mais seulement quand on ne le bouscule pas trop. :+(
Je viens de remarquer qu'il existe encore des bug's et j'aimerais l'enlever du site pour prendre le temps de le tester à fond avant de l'y remettre... chose que je ferai toujours dorénavant, loll
26 mars 2007 à 22:58
26 mars 2007 à 22:55
Ok pour ton fichier bat... mais je viens de découvrir GExpert... qui fait la même chose et bcp plus... j'étais occupé sur un projet de gestion de code source mais je vois que GExpert a cela aussi... en bcp mieux :+)
26 mars 2007 à 22:06
J'arrive pas à compiler ta source :(
[Erreur] fmxutils.pas(49): Identificateur non déclaré : 'SFOpenError'
[Erreur] fmxutils.pas(52): Identificateur non déclaré : 'SFCreateError'
Je vois que mon petit BAT de nettoyage a fait des emules, ça fait plaisir :D