Afficher une surface Cairo dans une fenêtre créée au moyen de l'API Win32

Version imprimable

Bonjour !

Je voudrais afficher une surface Cairo dans une fenêtre créée au moyen de l'API Win32.

Je suis parti de l'exemple winhello.pp qui est livré avec Free Pascal. Mon code se compile bien, mais l'image (un rectangle bleu de la taille de la zone client) ne s'affiche pas, ni en utilisant la fonction cairo_win32_surface_create(), ni en utilisant la fonction cairo_win32_surface_create_with_dib() associée à la fonction BitBlt().

Je me dis que le problème vient peut-être de la variable Window de type hWnd, que j'ai mise là où il y avait (dans l'exemple de code dont je me suis inspiré) la propriété Handle d'un TPaintBox. Mais je ne vois pas ce que je pourrais mettre d'autre.

Auriez-vous une idée de ce qui ne va pas dans mon code ?

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
139
140
141
142
143
144
145
146
147
148
149
150
{
  Copyright (c) 1996 by Charlie Calvert
  Modifications by Florian Klaempfl
 
  Standard Windows API application written in Object Pascal.
  No VCL code included. This is all done on the Windows API
  level.
}
 
{$APPTYPE GUI}
{$MODE DELPHI}
program WinHello;
 
uses
  Windows, Cairo, CairoWin32;
 
const
  AppName = 'WinHello';
 
function WindowProc(Window: HWnd; AMessage: UINT; WParam: WPARAM;
  LParam: LPARAM): LRESULT; stdcall; export;
var
  dc: hdc;
  ps: paintstruct;
  r: rect;
  cr: Pcairo_t;
  surface: Pcairo_surface_t;
begin
  WindowProc := 0;
 
  case AMessage of
    wm_paint:
      begin
        dc := BeginPaint(Window, @ps);
        GetClientRect(Window, @r);
        //DrawText(dc, 'Hello world by Free Pascal', -1, @r, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
 
        surface := cairo_win32_surface_create({pb.Canvas.Handle}Window);
        (*
        surface := cairo_win32_surface_create_with_dib(
          CAIRO_FORMAT_ARGB32,
          //pb.Width,
          r.right - r.left,
          //pb.Height
          r.bottom - r.top
        );
        *)
        cr := cairo_create(surface);
 
        cairo_set_source_rgb(cr, 0, 0, 1);
        cairo_paint(cr); // Peindre tout le rectangle en bleu.
 
        cairo_surface_write_to_png(surface, pchar('image.png')); // Pour vérifier que l'image Cairo est correctement créée et peinte.
 
        (*
        BitBlt(
          //pb.Canvas.Handle,
          Window,
          0,
          0,
          //pb.Width,
          r.right - r.left,
          //pb.Height,
          r.bottom - r.top,
          cairo_win32_surface_get_dc(surface),
          0,
          0,
          SRCCOPY
        );
        *)
        cairo_destroy(cr);
        cairo_surface_destroy(surface);
 
        EndPaint(Window, ps);
        Exit;
      end;
    wm_Destroy:
      begin
        PostQuitMessage(0);
        Exit;
      end;
  end;
 
  WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;
 
{ Register the Window Class }
 
function WinRegister: Boolean;
var
  WindowClass: WndClass;
begin
  WindowClass.Style := cs_hRedraw or cs_vRedraw;
  WindowClass.lpfnWndProc := WndProc(@WindowProc);
  WindowClass.cbClsExtra := 0;
  WindowClass.cbWndExtra := 0;
  WindowClass.hInstance := system.MainInstance;
  WindowClass.hIcon := LoadIcon(0, idi_Application);
  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
  WindowClass.lpszMenuName := nil;
  WindowClass.lpszClassName := AppName;
 
  Result := RegisterClass(WindowClass) <> 0;
end;
 
{ Create the Window Class }
 
function WinCreate: HWnd;
var
  hWindow: HWnd;
begin
  hWindow := CreateWindow(AppName, 'Hello world program',
    ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
    cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);
 
  if hWindow <> 0 then
  begin
    ShowWindow(hWindow, CmdShow);
    ShowWindow(hWindow, SW_SHOW);
    UpdateWindow(hWindow);
  end;
 
  Result := hWindow;
end;
 
var
  AMessage: Msg;
  hWindow: HWnd;
 
begin
  if not WinRegister then
  begin
    MessageBox(0, 'Register failed', nil, mb_Ok);
    Exit;
  end;
  hWindow := WinCreate;
  if longint(hWindow) = 0 then
  begin
    MessageBox(0, 'WinCreate failed', nil, mb_Ok);
    Exit;
  end;
 
  while GetMessage(@AMessage, 0, 0, 0) do
  begin
    TranslateMessage(AMessage);
    DispatchMessage(AMessage);
  end;
  Halt(AMessage.wParam);
end.

20/03/2017, 21h02
Roland Chastain

J'ai trouvé la solution juste après avoir posté mon message. :oops:

Il faut remplacer Window par dc.
22/03/2017, 09h30
Roland Chastain

1 pièce(s) jointe(s)

Bonjour !

Voici, au cas où cela intéresserait quelqu'un, les exemples mis au propre.

Si vous avez besoin des DLL Cairo, vous pouvez par exemple les trouver là. ;)

Un autre essai, avec des choses prises dans les Lemmings de Paul TOTH.

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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
 
{$APPTYPE GUI}
{$MODE DELPHI}
 
uses
  Windows, Cairo, CairoWin32;
 
{$R wincairo.res}
 
const
  CLASSNAME = 'FENETRE_DESSIN';
 
var
  gHandle: THandle;
 
procedure CairoDraw(aDC: HDC; aClientWidth, aClientHeight: integer);
var
  cr: pcairo_t;
  surface: pcairo_surface_t;
begin
  surface := cairo_win32_surface_create_with_dib(CAIRO_FORMAT_ARGB32, aClientWidth, aClientHeight);
 
  cr := cairo_create(surface);
  cairo_scale(cr, aClientWidth, aClientHeight);
  cairo_set_source_rgb(cr, 1, 1, 1);
  cairo_paint(cr);
  cairo_set_source_rgb(cr, 1, 0, 0);
  cairo_set_line_width(cr, 0.1);
  cairo_move_to(cr, 0.2, 0.2);
  cairo_line_to(cr, 0.8, 0.8);
  cairo_stroke(cr);
  cairo_destroy(cr);
 
  BitBlt(
    aDC,
    0,
    0,
    aClientWidth,
    aClientHeight,
    cairo_win32_surface_get_dc(surface),
    0,
    0,
    SRCCOPY
  );
 
  cairo_surface_destroy(surface);
end;
 
function WinProc(aHandle: THandle; aMsg: UINT; aWP: WPARAM; aLP: LPARAM): LRESULT; stdcall;
var
  vPS: TPaintStruct;
  vDC: HDC;
  vRECT: RECT;
begin
  case aMsg of
    WM_SIZE:
      begin
        {
        InvalidateRect(aHandle, nil, TRUE);
        UpdateWindow(aHandle);
        }
      end;
    WM_KEYDOWN:
      if aWP = VK_ESCAPE then
      begin
        PostQuitMessage(0);
        result := 0;
        exit;
      end;
    WM_DESTROY:
      begin
        PostQuitMessage(0);
        result := 0;
        exit;
      end;
    WM_PAINT:
      begin
        vDC := BeginPaint(gHandle, vPS);
        GetClientRect(aHandle, @vRECT);
        CairoDraw(vDC, vRECT.right - vRECT.left, vRECT.bottom - vRECT.top);
        EndPaint(gHandle, vPS);
        result := 0;
        exit;
      end;
  end;
  result := DefWindowProc(aHandle, aMsg, aWP, aLP);
end;
 
procedure TextMode;
begin
  DestroyWindow(gHandle);
end;
 
procedure DoEvents;
var
  vMsg: TMsg;
begin
  while PeekMessage(vMsg, 0, 0, 0, PM_REMOVE) do
  begin
    TranslateMessage(vMsg);
    DispatchMessage(vMsg);
    if vMsg.Message = WM_QUIT then
    begin
      TextMode;
      Halt;
    end;
  end; 
end;
 
procedure GraphMode(aClientWidth, aClientHeight: integer);
var
  vClass: TWndClass;
  vBorder, vCaption, vWidth, vHeight, vLeft, vTop: integer;
begin
  vClass.style := CS_HREDRAW or CS_VREDRAW;;
  vClass.lpfnWndProc := @WinProc;
  vClass.cbClsExtra := 0;
  vClass.cbWndExtra := 0;
  vClass.hInstance := system.hInstance;
  vClass.hIcon := LoadImage(hInstance, MAKEINTRESOURCE(1), IMAGE_ICON, 0, 0, 0);
  vClass.hCursor := LoadCursor(0, IDC_ARROW);
  vClass.hbrBackground := GetStockObject(WHITE_BRUSH);;
  vClass.lpszMenuName := nil;
  vClass.lpszClassName := CLASSNAME;
 
  if RegisterClass(vClass) = 0 then
    Halt;
 
  vBorder := 2 * (GetSystemMetrics(SM_CXDLGFRAME) + GetSystemMetrics(SM_CXBORDER));
  vCaption := GetSystemMetrics(SM_CYCAPTION);
 
  vWidth := aClientWidth + 2 * vBorder;
  vHeight := aClientHeight + 2 * vBorder + vCaption;
  vLeft := (GetSystemMetrics(SM_CXFULLSCREEN) - vWidth) div 2;
  vTop := (GetSystemMetrics(SM_CYFULLSCREEN) - vHeight) div 2;
 
  gHandle := CreateWindow(
    CLASSNAME,
    'Dessin avec Cairo',
    WS_OVERLAPPEDWINDOW or WS_VISIBLE,
    vLeft,
    vTop,
    vWidth,
    vHeight,
    0,
    0,
    hInstance,
    nil
  );
 
  if gHandle = 0 then
    Halt;
end;
 
begin
  GraphMode(400, 400);
  while TRUE do
    DoEvents;
end.

Il serait amusant de faire une réplique de l'unité Graph, avec des procédures Cairo. :)