DateTimePicker .Font.Color := clWhite 'fonctionne pas'?

Avec les Thèmes XP, changer les couleurs est souvent difficile avec les Contrôle Windows

sur un code en 2004, j'avais des TEditMask et le comportement n'était pas fiable (on pouvait saisir des date comme 87/50/7590) et un bouton affichait un calendrier non stantard !
On m'a demandé d'améliorer cela en conservant la valeur vide mais je devais utiliser le TDateTimePicker pour la cohérence avec d'autres fenêtres en terme d'esthétique !
Je créais donc des TDateTimePicker au même endroit que les TEditMask
Pour donner l'illusion, les TEditMask était redimensionné mais c'était toujours avec eux que l'on saisissait la date !
Le Masque était !00/00/0099;1;_ car les utilisateurs pouvaient utiliser des dates sur deux digits !

C'est un code Delphi 3 mais il est toujours d'actualité (même si il est assez moche)

Code:

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
//------------------------------------------------------------------------------
procedure TFrm***.CreateDateTimePicker;
type
  PMaskEditButton = ^TMaskEditButton;
  TMaskEditButton = record
    MaskEdit: Pointer;
    Button: Pointer;
  end;
 
  // --- Fonction interne ----------------------------------------------------
  procedure GetListEdDateRecursive(ParentControl: TControl; var List: TList);
  var
     ic: integer;
     ButtonName: String;
     lpMaskEditButton: PMaskEditButton;
  begin
       // La liste Controls contient les Objets dépendant visuellement (imbrication) de leur parent
       // La liste Components contient les Objets dépendant logiquement (mémoire) de leur propriétaire (Owner)
       if ParentControl is TMaskEdit then begin
          if Copy(ParentControl.Name, 1, Length('EdDate')) = 'EdDate' then begin
             if Assigned(ParentControl.Parent) then begin
                ButtonName := 'Btn' + Copy(ParentControl.Name, 3, Length(ParentControl.Name) - 2);
                for ic := 0 to TWinControl(ParentControl.Parent).ControlCount  - 1 do begin
                    if TWinControl(ParentControl.Parent).Controls[ic].Name = ButtonName then begin
                       New(lpMaskEditButton);
                       lpMaskEditButton^.MaskEdit := TMaskEdit(ParentControl);
                       lpMaskEditButton^.Button := TButton(TWinControl(ParentControl.Parent).Controls[ic]);
                       List.Add(lpMaskEditButton);
                       Break;
                    end;
                end;
             end;
          end;
          Exit;
       end;
 
       // "is" renvoie True si ParentControl est un TWinControl ou un Objet d'une Classe dérivée
       if ParentControl is TWinControl then begin
          for ic := 0 to TWinControl(ParentControl).ControlCount  - 1 do begin
              GetListEdDateRecursive(TWinControl(ParentControl).Controls[ic], List);
          end;
       end;
  end;
var
   ListEdDate: TList;
   TmpDateTimePicker: TDateTimePicker;
   iled: Integer;
   TmpMaskEditButton: TMaskEditButton;
begin
     ListEdDate := TList.Create();
     try
        GetListEdDateRecursive(Self, ListEdDate);
        for iled := 0 to ListEdDate.Count - 1 do begin
            // Stockage de la Structure dans une Variable Temporaire
            TmpMaskEditButton := TMaskEditButton(ListEdDate.Items[iled]^);
 
            // Création du TDateTimePicker
            TmpDateTimePicker := TDateTimePicker.Create(Self); // le Owner le détruira !
            TmpDateTimePicker.Name := 'Picker' + Copy(TWinControl(TmpMaskEditButton.MaskEdit).Name, 3, Length(TWinControl(TmpMaskEditButton.MaskEdit).Name) - 2);
            TmpDateTimePicker.BoundsRect := TWinControl(TmpMaskEditButton.MaskEdit).BoundsRect;
            TmpDateTimePicker.Parent := TWinControl(TmpMaskEditButton.MaskEdit).Parent;
            TmpDateTimePicker.OnCloseUp := AllDateTimePickerCloseUp;
            TmpDateTimePicker.TabStop := False;
            TmpDateTimePicker.Visible := True;
            TmpDateTimePicker.SendToBack();
 
            // "Suppression" de l'ancien Bouton ...
            TWinControl(TmpMaskEditButton.Button).Visible := False;
 
            // Redimensionnement du MaskEdit
            TMaskEdit(TmpMaskEditButton.MaskEdit).Left   := TMaskEdit(TmpMaskEditButton.MaskEdit).Left   + 3;
            TMaskEdit(TmpMaskEditButton.MaskEdit).Top    := TMaskEdit(TmpMaskEditButton.MaskEdit).Top    + 3;
            TMaskEdit(TmpMaskEditButton.MaskEdit).Width  := TMaskEdit(TmpMaskEditButton.MaskEdit).Width  - 6;
            TMaskEdit(TmpMaskEditButton.MaskEdit).Height := TMaskEdit(TmpMaskEditButton.MaskEdit).Height - 6;
            TMaskEdit(TmpMaskEditButton.MaskEdit).BorderStyle := bsNone;
            TMaskEdit(TmpMaskEditButton.MaskEdit).Width  := TMaskEdit(TmpMaskEditButton.MaskEdit).Width  - GetSystemMetrics(SM_CXVSCROLL);
        end;
     finally
            for iled := ListEdDate.Count - 1 downto 0 do begin
                Dispose(ListEdDate.Items[iled]);
            end;
            ListEdDate.Free();
     end;
end;

Code:

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
//------------------------------------------------------------------------------
procedure TFrm***.SetDateTimePicker(const DateEdit: TObject);
var
   TmpDateTimePicker: TDateTimePicker;
begin
  // Chaque OnChange de MaskEdit appelle cette fonction !
      if DateEdit is TMaskEdit then begin
        // Recherche de l'EditMask associé, remarque : 3 pour Length('Ed') + 1
        TmpDateTimePicker := TDateTimePicker(Self.FindComponent('Picker'+Copy(TControl(DateEdit).Name, 3, Length(TControl(DateEdit).Name) - 2)));
        if Assigned(TmpDateTimePicker) then begin
           try
              TmpDateTimePicker.Date := StrToDate(TMaskEdit(DateEdit).Text);
           except
                 Exit;
           end;
        end;
     end;
end;
 
//------------------------------------------------------------------------------
procedure TFrm***.AllDateKeyPress(Sender: TObject; var Key: Char);
var
   TempText: String;
   {sYear,} sMonth, sDay: String;
   {Year,} Month, Day: Word;
   i: Integer;
begin
     // Tous les Champs date doivent respectés le Masque mais aussi certains critères !
     if Sender is TMaskEdit then begin
        if (Key >= '0') and (Key <= '9') then begin
           TempText := TEdit(Sender).Text;
           if Length(TempText) = Length(DATE_MASK) then begin
              for i := 1 to Length(TempText) do begin
                  if TempText[i] = '_' then begin
                     TempText[i] := ' ';
                  end;
                  if i = TMaskEdit(Sender).SelStart + 1 then begin
                     TempText[i] := Key;
                  end;
              end;
              sDay   := Trim(Copy(TempText, 1, 2));
              sMonth := Trim(Copy(TempText, 4, 2));
              if Length(sDay) = 2 then begin
                 Day := StrToInt(sDay);
                 if (Day < 1) or (Day > 31) then begin
                    Key := #0;
                 end;
              end else begin
                  if Length(sDay) = 1 then begin
                     if sDay[1] > '3' then begin
                        Key := #0;
                     end;
                  end;
              end;
              if Length(sMonth) = 2 then begin
                 Month := StrToInt(sMonth);
                 if (Month < 1) or (Month > 12) then begin
                    Key := #0;
                 end;
              end else begin
                  if Length(sMonth) = 1 then begin
                     if sMonth[1] > '1' then begin
                        Key := #0;
                     end;
                  end;
              end;
           end;
        end;
     end;
end;
 
//------------------------------------------------------------------------------
procedure TFrm***.AllDateTimePickerCloseUp(Sender: TObject);
var
   TmpMaskEdit: TMaskEdit;
begin
     if Sender is TDateTimePicker then begin
        // Recherche de l'EditMask associé, remarque : 7 pour Length('Picker') + 1
        TmpMaskEdit := TMaskEdit(Self.FindComponent('Ed'+Copy(TControl(Sender).Name, 7, Length(TControl(Sender).Name) - 6)));
        if Assigned(TmpMaskEdit) then begin
           TmpMaskEdit.Text := FormatDateTime(DATE_FORMAT, TDateTimePicker(Sender).Date);
        end;
     end;
end;
 
//------------------------------------------------------------------------------
procedure TFrm***.AllDateExit(Sender: TObject);
var
   TempText: String;
   sYear, sMonth, sDay: String;
   Year, Month, Day: Word;
   i: Integer;
begin
     // Tous les Champs date doivent respectés le Masque mais aussi certains critères !
     if Sender is TMaskEdit then begin
        TempText := TEdit(Sender).Text;
        if Length(TempText) = Length(DATE_MASK) then begin
           for i := 1 to Length(TempText) do begin
               if TempText[i] = '_' then begin
                  TempText[i] := ' ';
               end;
           end;
           sDay   := Trim(Copy(TempText, 1, 2));
           sMonth := Trim(Copy(TempText, 4, 2));
           sYear  := Trim(Copy(TempText, 7, 4));
           if Length(sDay) = 2 then begin
              Day := StrToInt(sDay);
              if (Day < 1) or (Day > 31) then begin
                 Day := 0;
              end;
           end else begin
               Day := 0;
           end;
           if Length(sMonth) = 2 then begin
              Month := StrToInt(sMonth);
              if (Month < 1) or (Month > 12) then begin
                 Month := 0;
              end;
           end else begin
               Month := 0;
           end;
           if Length(sYear) = 2 then begin
              Year := StrToInt(sYear);
              if Year <= 99 then begin // Word Entier NON Signé
                 if (Month <> 0) and (Day <> 0) then begin
                    if Year < 49 then begin
                       Year := 2000 + Year;
                    end else begin
                        Year := 1900 + Year;
                    end;
                    TMaskEdit(Sender).Text := FormatDateTime(DATE_FORMAT, EncodeDate(Year, Month, Day));
                    TMaskEdit(Sender).SelStart := Length(TMaskEdit(Sender).Text);
                 end;
              end;
           end;
        end;
     end;
end;