Discussion :

[Roland Chastain]

Bonjour !

Je m'intéresse depuis quelque temps à la programmation Win32 que j'ai essayée, avec VP d'un côté, avec Delphi de l'autre. Maintenant j'essaie de fondre les deux versions de mes programmes dans un seul fichier.

Je n'ai pas trouvé comment compiler un fichier PAS avec Delphi ; en revanche j'ai constaté que Virtual Pascal compile les fichiers DPR.

Je vous propose un programme qui affiche la date de Pâques pour l'année courante (à partir d'une table contenant les années 1900 à 2199). La compilation a été testée avec Virtual Pascal 2.1 et Delphi 6.

La seule partie du code que j'ai dédoublée est relative à l'année courante. Virtual Pascal ne reconnaissant pas, apparemment, le type SystemTime, j'ai bricolé ce que j'ai pu provisoirement.

Autre chose que je n'ai pas trouvée, l'équivalent Delphi du $IfDef VPascal ou du $IfDef FPC. J'ai vu comment on pouvait indiquer une version de Delphi mais pas l'environnement Delphi en général.

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
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
// PAQUES.DPR
// Delphi 6, Free Pascal 2.6, Virtual Pascal 2.1
 
program Paques;
 
{$IFDEF VPASCAL}
  {&PMTYPE PM}
{$ELSE}
  {$APPTYPE GUI}
{$ENDIF}
 
uses
  Windows, Messages, SysUtils;
 
{$I Paques.inc}
{$I Couleurs.inc}
 
var
  t: tSystemTime;
  c: array[0..99] of char;
 
procedure MainPaint(hWindow: HWND; ps: TPaintStruct);
 
  function f(s: string): string;
  var
    temp: string;
  begin
    temp := Copy(s, 1, 1);
    if temp = 'M' then temp := 'mars' else temp := 'avril';
    temp := Copy(s, 2, 2) + ' ' + temp;
    f := temp;
  end;
 
var
  NewFont, OldFont: hFont;
  s: string;
  r: tRect;
 
begin
  NewFont := CreateFont(20,
                        0,0,0,
                        FW_LIGHT,
                        0,0,0,
                        DEFAULT_CHARSET,
                        0,0,0,0,
                        'Courier New');
 
  OldFont := SelectObject(ps.hdc, NewFont);
 
  SetTextColor(ps.hdc, White);
  SetBkMode(ps.hdc, Transparent);
 
  GetLocalTime(t);
 
  s := 'En '
     + IntToStr(t.wYear)
     + ', le dimanche de Pâques est le '
     + f(DateDePaques[t.wYear])
     + '.'
     ;
 
  StrPCopy(c, s);
  SetRect(r, 10, 10, 640-20, 300-20);
  DrawText(ps.hdc, c, StrLen(c), r, DT_LEFT);
  DeleteObject(SelectObject(ps.hdc, OldFont));
end;
 
procedure MainDestroy(hWindow: HWND);
begin
  PostQuitMessage(0);
end;
 
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                     LParam: LPARAM): LRESULT; stdcall; export;
var
  ps: TPaintStruct;
begin
  MainWndProc := 0;
  case Msg of
    WM_PAINT: begin
                BeginPaint(hWindow, ps);
                MainPaint(hWindow, ps);
                EndPaint(hWindow, ps);
              end;
    WM_DESTROY: MainDestroy(hWindow);
  else begin
         MainWndProc := DefWindowProc(hWindow, Msg, wParam, lParam);
         Exit;
       end;
  end;
end;
 
var
  wc: TWndClass;
  hWindow: HWND;
  Msg: TMsg;
 
begin
  wc.lpszClassName := 'GenericAppClass';
  wc.lpfnWndProc := @MainWndProc;
  wc.style := CS_VREDRAW or CS_HREDRAW;
  wc.hInstance := hInstance;
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hbrBackground := CreateSolidBrush(RoyalBlue);
  wc.lpszMenuName := nil;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  RegisterClass(wc);
  hWindow := CreateWindowEx(WS_EX_OVERLAPPEDWINDOW,
                            wc.lpszClassName,
                            'Date de Pâques',
                            WS_OVERLAPPEDWINDOW,
                            10,
                            10,
                            640+16,
                            300+38,
                            0,
                            0,
                            hInstance,
                            nil);
  ShowWindow(hWindow, CmdShow);
  UpDateWindow(hWindow);
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
  Halt(Msg.wParam);
end.