FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); 
var 
  Text: string; 
  TextWidth, TextHeight, RectHeight: Integer; 
begin 
  with (Control as TListBox) do 
    if Index < Items.Count then 
    begin 
      Canvas.FillRect(Rect); 
      Text:= Items[Index]; 
      Dec(Rect.Right, 2); // Il ne faut pas que le texte soit trop collé au bord droit 
      TextWidth:= Canvas.TextWidth(Text); 
      TextHeight:= Canvas.TextHeight(Text); 
      RectHeight:= Rect.Bottom - Rect.Top; 
      // On écrit le texte 
      Canvas.TextOut(Rect.Right - TextWidth, 
        Rect.Top + (RectHeight - TextHeight) div 2, 
        Text);  
    end; 
end;

1
2
3
4
5
6
7
8
9
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); 
var  
  Txt: string;  
begin  
    Txt := (Control as TListBox).Items[Index];  
    DrawText((Control as TListBox).Canvas.Handle, PChar(Txt), StrLen(PChar(Txt)), Rect, DT_RIGHT  
or DT_NOPREFIX or DT_SINGLELINE);  
    // DT_NOPREFIX = désactiver le soulignement si & dans le texte  
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
begin 
  with(Control as TListBox).Canvas do  // Le dessin se fait sur le canevas du contrôle, pas dans la fiche 
    begin 
    // On choisit les couleurs en fonction de l'index 
    if Index=1 then 
    begin 
       // Fond 
       Brush.Color:=clRed; 
       // Police 
       Font.Color:=clYellow; 
    end; 
    FillRect(Rect); // Efface le rectangle 
    // Dessin du texte 
    TextOut(Rect.Left,Rect.Top,(Control as TListBox).Items[Index]);//affiche le texte 
  
  end; 
end;

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
procedure SetScrollWidth(ListBox: TListBox); 
var 
  DC: HDC; 
  Size: TSize; 
  W, I, Offset: Integer; 
begin 
  Offset := 2 * GetSystemMetrics(SM_CXFRAME) + GetSystemMetrics(SM_CXVSCROLL); 
  
  with ListBox do 
  begin 
    DC := GetDC(Handle); 
    try 
      SelectObject(DC, Font.Handle); 
      W := 0; 
  
      for I := 0 to Items.Count - 1 do 
      begin 
        if GetTextExtentPoint32(DC, PChar(Items[I]), StrLen(PChar(Items[I])), Size) then 
          if W < Size.cx + Offset then 
            W := Size.cx + Offset; 
      end; 
  
      ScrollWidth := W; 
    finally 
      ReleaseDC(Handle, DC); 
    end; 
  end; 
end;