File: unitscalefont.pas

package info (click to toggle)
optgeo 2.25-1
  • links: PTS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 6,948 kB
  • sloc: pascal: 58,877; xml: 63; makefile: 58
file content (138 lines) | stat: -rw-r--r-- 6,337 bytes parent folder | download
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
unit UnitScaleFont;
{redimensionne les tailles des polices entre les differentes plateformes;
conditions d'utilisation: l'interface doit etre faite sous windows;
la police de chaque form ne doit pas avoir d'attribus speciaux et doit etre "default";
la police de chaque controle est soit parenfont, soit la police "default" avec eventuellement
leseul attribut fsbold}
{$mode objfpc}{$H+}

interface
uses
   Classes, SysUtils, LazFileUtils, LResources, Forms, Controls, Graphics, Dialogs,
  Menus, ExtCtrls, StdCtrls, Spin, Buttons, ComCtrls,LCLType;

const
  ma_jolie_chaine='Ma jolie chaîne pour faire l''amélioration.';
taille_ma_jolie_chaine:array[0..200] of integer=
(189,35,35,35,63,65,100,100,130,130,164,164,177,189,213,213,231,235,284,284,284,297,335,335,359,376,392,392,401,426,462,462,462,475,511,511,532,545,567,567,581,604,636,636,636,648,689,689,706,728,742,742,763,779,795,795,816,838,867,867,881,881,917,917,942,945,977,977,988,1011,1037,1037,1064,1064,1099,1099,1111,1139,1145,1145,1172,1176,1218,1218,1239,1239,1271,1271,1291,1309,1321,1321,1338,1367,1395,1395,1395,1412,1456,1456,1470,1483,1502,1502,1523,1540,1574,1574,1574,1590,1622,1622,1643,1649,1686,1686,1700,1712,1755,1755,1755,1765,1805,1805,1821,1821,1857,1857,1875,1885,1916,1916,1924,1944,1983,1983,1993,1993,2028,2028,2055,2072,2088,2088,2102,2117,2154,2154,2176,2176,2217,2217,2221,2250,2260,2260,2274,2298,2332,2332,2332,2348,2385,2385,2406,2417,2443,2443,2455,2474,2505,2505,2505,2534,2560,2560,2580,2600,2618,2618,2633,2651,2696,2696,2696,2704,2733,2733,2762,2762,2791,2791,2809,2831,2848,2848,2863,2886,2924,2924,2936);

taille_ma_jolie_chaine_gras:array[0..200] of integer=
(226,44,44,44,65,77,132,132,137,137,202,202,202,226,244,244,258,271,331,331,331,345,387,387,409,423,450,450,472,482,532,532,532,547,595,595,612,628,651,651,672,687,736,736,736,752,791,791,818,831,854,854,884,889,921,921,932,955,992,992,1021,1021,1058,1058,1081,1094,1122,1122,1139,1158,1198,1198,1223,1223,1262,1262,1276,1301,1327,1327,1344,1361,1403,1403,1426,1426,1464,1464,1483,1502,1531,1531,1544,1565,1609,1609,1609,1623,1671,1671,1684,1705,1726,1726,1744,1769,1811,1811,1811,1828,1875,1875,1891,1910,1935,1935,1948,1969,2010,2010,2010,2029,2075,2075,2095,2095,2139,2139,2152,2168,2203,2203,2216,2232,2284,2284,2297,2297,2345,2345,2356,2374,2407,2407,2418,2438,2480,2480,2501,2501,2544,2544,2563,2574,2611,2611,2628,2639,2680,2680,2680,2706,2748,2748,2765,2782,2807,2807,2827,2847,2891,2891,2891,2909,2945,2945,2965,2985,3011,3011,3029,3048,3093,3093,3093,3111,3151,3151,3173,3173,3218,3218,3234,3250,3274,3274,3292,3318,3359,3359,3372);

var taille_ma_jolie_chaine_dans_ce_systeme,taille_ma_jolie_chaine_dans_ce_systeme_gras:array[0..200] of integer;
tableau_correspondance_tailles_polices,tableau_correspondance_tailles_polices_gras:array[0..200] of integer;
 taille_dans_ce_systeme_qui_correspond_a_0_sous_windows,taille_dans_ce_systeme_qui_correspond_a_0_sous_windows_gras:integer;
  procedure ScaleFont(AFenetre : TForm);


implementation


Procedure Applique_A_Tous_LesControles( Aparent : TWinControl);
Var
 AWinControl: TWinControl;

  I : Integer;
Begin
  with AParent do
    for i := 0 to ControlCount - 1 do begin

  {on change la taille si parentfont est false}
 if not(TButton(controls[i]).parentfont) then begin
      if   Controls[i].Font.height=0 then  
	  begin
	  if (fsbold in Controls[i].Font.style) then begin
	  Controls[i].Font.height:=taille_dans_ce_systeme_qui_correspond_a_0_sous_windows_gras;
   //application.messagebox(pchar(inttostr(Controls[i].font.height)),
    //   pchar(inttostr(taille_dans_ce_systeme_qui_correspond_a_0_sous_windows_gras)),mb_ok);
    end else
	  Controls[i].Font.height:=taille_dans_ce_systeme_qui_correspond_a_0_sous_windows;
	  end else begin
	  if (fsbold in Controls[i].Font.style) then begin
         Controls[i].font.height:=tableau_correspondance_tailles_polices_gras[abs(Controls[i].font.height)];
      // application.messagebox(pchar(inttostr(Controls[i].font.height)),
      // pchar(inttostr(tableau_correspondance_tailles_polices_gras[abs(Controls[i].font.height)])),mb_ok);
          end else
		 Controls[i].font.height:=tableau_correspondance_tailles_polices[abs(Controls[i].font.height)];
		 end;
          end;

       {et on applique aux enfants si c'est un twincontrol}
    if Controls[i] is TWinControl then begin
        AWinControl := TWinControl(Controls[i]);
        if AWinControl.ControlCount > 0 then
          Applique_A_Tous_LesControles(AWinControl);
                end;

    end;
    end;


    procedure ScaleFont(AFenetre : TForm);
   
var i,j:integer;
s_i:tspeedbutton;
begin
s_i:=tspeedbutton.create(afenetre);
s_i.Parent:=afenetre;
                    s_i.visible:=false;


for i:=0 to 200 do
begin

s_i.canvas.font.height:=i;
taille_ma_jolie_chaine_dans_ce_systeme[i]:=
 s_i.Canvas.TextWidth(ma_jolie_chaine);
end;
for i:=0 to 200 do
begin

s_i.canvas.font.height:=i;
s_i.canvas.font.style:=[fsbold];
taille_ma_jolie_chaine_dans_ce_systeme_gras[i]:=
 s_i.Canvas.TextWidth(ma_jolie_chaine);
end;
s_i.Destroy;

AFenetre.Font.height:=abs(AFenetre.Font.height);





for i:=1 to 200 do begin
j:=1;
{on cherche l'indice des tailles encadrantes}
while ((j<200) and   (taille_ma_jolie_chaine_dans_ce_systeme[j]<taille_ma_jolie_chaine[i]))
do inc(j);
 tableau_correspondance_tailles_polices[i]:=j;
                                              end;
											  
											  for i:=1 to 200 do begin
j:=1;
{on cherche l'indice des tailles encadrantes}
while ((j<200) and   (taille_ma_jolie_chaine_dans_ce_systeme_gras[j]<taille_ma_jolie_chaine_gras[i]))
do inc(j);
 tableau_correspondance_tailles_polices_gras[i]:=j;
                                              end;
											  
											  

taille_dans_ce_systeme_qui_correspond_a_0_sous_windows:= tableau_correspondance_tailles_polices[13];
taille_dans_ce_systeme_qui_correspond_a_0_sous_windows_gras:= tableau_correspondance_tailles_polices_gras[13];
if AFenetre.Font.height=0 then begin
AFenetre.Font.height:=taille_dans_ce_systeme_qui_correspond_a_0_sous_windows;
end
else  begin
 {tout ce qui est en taille i doit passer en taille  tableau_correspondance_tailles_polices[i]}
 afenetre.font.height:=tableau_correspondance_tailles_polices[abs(afenetre.font.height)];
end;
Applique_A_Tous_LesControles(AFenetre);



end;

end.