Discussion :

[BleCyrille]

Salut a tous,

Cela fait trois mois que je travaille sur une application graphique avec les objets de Delphi 6. ais j ai un probleme car je desire ecrire un texte de facon verticale sur un TPanel.
Pouvez vous m y aider?

[Rayek]

Je pense que ce post pourra t'aider

http://www.developpez.net/forums/sho...light=vertical

[Tardiff Jean-François]

Bonjour,

La réponse est simple, le TPanel n'a pas de canvas, on ne peut donc pas écrire dessus.

La solution est moins simple, il faut intercepter les message erase background et paint du tpanel, et dans le paint créer le canvas pour ecrire dessus.

Exemple:

Dans la declaration private, je redeclare les evenements erase background et paint

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;

Dans l'implementation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
procedure TBitmapBackGroundPanel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  if (Bitmap = nil) then
    inherited
  else  if (not UseBitmap) or (FBitmap.Width <= 0) or (FBitmap.Height <= 0) then
    inherited
  else
    Message.Result := 0;
end;

Attention à supprimer le "erase backgground" dans certain cas si l'on veut éviter les scintillements

.
et

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
 
procedure TBitmapBackGroundPanel.WMPaint(var Message: TWMPaint);
var
  DC, MemDC: HDC;
  MemBitmap, OldBitmap: HBITMAP;
  PS: TPaintStruct;
  AZeroPos, AEndPos: TPoint;
begin
 
  if (not UseBitmap) or (FBitmap.Width <= 0) or (FBitmap.Height <= 0) then begin
    inherited;
    exit;
  end;
 
  begin
    DC := GetDC(0);
    MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
    ReleaseDC(0, DC);
    MemDC := CreateCompatibleDC(0);
    OldBitmap := SelectObject(MemDC, MemBitmap);
    try
      DC := BeginPaint(Handle, PS);
  //    Perform(WM_ERASEBKGND, MemDC, MemDC);
      Message.DC := MemDC;
 
   AZeroPos := ClientToScreen(Point(0, 0));
      AEndPos  := ClientToScreen(Point(Width, Height));
      PaintBackGroundOnCanvas(memDc, Bitmap, AZeroPos, AEndPos);
      //PaintHandler(Message);
 
    PaintControls(memDc, nil);
      Message.DC := 0;
      BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
      EndPaint(Handle, PS);
    finally
      SelectObject(MemDC, OldBitmap);
      DeleteDC(MemDC);
      DeleteObject(MemBitmap);
    end;
  end;
end;

En retournat sur le forum, je vien de me rendre compte que le temps que je tape ma réponse, Malatr avait eu le temps d'en envoyer une. Décidement, je mérite bien mon nom.

[Sub0]

La faq propose une solution pour créer un canvas au panel :
http://www.developpez.com/delphi/faq...inersanscanvas

Regarde ce qui est dit dans ce message aussi :
http://www.developpez.net/forums/sho....php?t=74250#8