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
|
// Pour ListBox à couleurs alternées + Formules de molécules chimiques ou de
// réactions chimiques avec particules en indice et en exposant : OK testé marche
procedure TfrmOcc.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
const num = ['1'..'9','+','-'];
var Texte : string;
cc,cp,cs : Char; // caract : courant, précédent, suivant
niveau : string[3]; // sup, med, inf
i,w,h : byte; x,y : integer;
begin ListBox1.Style:=(lbOwnerDrawFixed);
with ListBox1.Canvas do
begin Font.Color:=clBlack; // Couleur de fonte
if Odd(Index) then Brush.Color:=clAqua // Couleur d'arrière plan
else Brush.Color:=clWhite; // alternée bleu/blanc
FillRect(Rect); // Remplit le rect de l'Index sur canvas avec Brush.color
// Texte de l'Item
Texte:=ListBox1.Items[Index];
Font.name:='Arial';
x:=Rect.Left+3; y:=Rect.Top; cp:=' ';
for i:=1 to length(Texte) do
begin cc:=Texte[i];
if i<length(Texte) then cs:=Texte[i+1] else cs:=' ';
if (Not (cc in Num)) or ((cc in num) and (cp=' '))
then niveau:='med'
else begin if ((cp<>' ') and ((cc='+') or (cc='-'))) // H+ Mg++ He2+
then niveau:='sup'
else niveau:='inf';
end;
if niveau='med' then // caract en position normale
begin Font.Size:=8;
TextOut(x, y, cc);
w:=TextWidth(cc); x:=x+w;
end else
if niveau='inf' then // caract en indice
begin Font.Size:=5; h:=TextHeight(cc);
TextOut(x, Rect.Bottom - h, cc);
w:=TextWidth(cc); x:=x+w;
end else
if niveau='sup' then // caract en exposant
begin Font.Size:=6; h:=TextHeight(cc);
TextOut(x, Rect.Top-1, cc);
//sms(cc);
w:=TextWidth(cc); x:=x+w;
end;
niveau:='';
cp:=cc;
end;
end;
end;
procedure TfrmOcc.ListBox1Click(Sender: TObject);
var i:integer;
begin for i:=0 to ListBox1.Items.Count-1
do ListBox1DrawItem(ListBox1,i,ListBox1.ItemRect(i),[odDefault]);
end; |
Partager