1. #1
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    décembre 2011
    Messages
    3 006
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : Sénégal

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : décembre 2011
    Messages : 3 006
    Points : 10 851
    Points
    10 851
    Billets dans le blog
    4

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

    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 : 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
    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.

  2. #2
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    décembre 2011
    Messages
    3 006
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : Sénégal

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : décembre 2011
    Messages : 3 006
    Points : 10 851
    Points
    10 851
    Billets dans le blog
    4

    Par défaut

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

    Il faut remplacer Window par dc.

  3. #3
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    décembre 2011
    Messages
    3 006
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : Sénégal

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : décembre 2011
    Messages : 3 006
    Points : 10 851
    Points
    10 851
    Billets dans le blog
    4

    Par défaut

    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 .
    Fichiers attachés Fichiers attachés

  4. #4
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    décembre 2011
    Messages
    3 006
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : Sénégal

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : décembre 2011
    Messages : 3 006
    Points : 10 851
    Points
    10 851
    Billets dans le blog
    4

    Par défaut

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

    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
    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.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 1
    Dernier message: 12/12/2011, 11h07
  2. Réponses: 6
    Dernier message: 13/11/2009, 17h06
  3. Réponses: 7
    Dernier message: 13/12/2008, 10h31
  4. Afficher la valeur choisie d'une liste déroulante dans une textbox
    Par bouchette63 dans le forum Balisage (X)HTML et validation W3C
    Réponses: 3
    Dernier message: 20/06/2006, 15h26
  5. Réponses: 4
    Dernier message: 17/05/2006, 00h15

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo