V9.71
V9.71
This commit is contained in:
f1iwq2
Binary file not shown.
BIN
Binary file not shown.
+1
-1
@@ -104,7 +104,7 @@ procedure couleurs_cdf;
|
||||
var i : integer;
|
||||
c : tComponent;
|
||||
begin
|
||||
if sombre then with formCDF do
|
||||
if Modesombre then with formCDF do
|
||||
begin
|
||||
Color:=Couleurfond;
|
||||
for i:=0 to ComponentCount-1 do
|
||||
|
||||
+512
-601
File diff suppressed because it is too large
Load Diff
+543
-449
File diff suppressed because it is too large
Load Diff
+512
-512
File diff suppressed because it is too large
Load Diff
@@ -174,7 +174,7 @@ begin
|
||||
EditParam2.Text:=intToSTR(tco[indexTCO,XclicC,YclicC].sortie);
|
||||
EditParam1.Hint:='Adresse de la sortie';
|
||||
EditParam1.ShowHint:=true;
|
||||
EditParam2.Hint:='Valeur de la sortie (0-1-2)';
|
||||
EditParam2.Hint:='Valeur de la sortie'+#13+'0= nulle'+#13+intToSTR(const_devie)+'= dévié'+#13+intToSTR(const_droit)+'= droit';
|
||||
EditParam2.ShowHint:=true;
|
||||
end;
|
||||
// arret des trains
|
||||
@@ -425,7 +425,7 @@ begin
|
||||
cells[1,ligne]:=s;
|
||||
cells[2,ligne]:=intToSTR(trains[i].DetecteurArret[j].temps)+'s';
|
||||
cells[3,ligne]:=trains[i].nom_train;
|
||||
|
||||
|
||||
inc(ligne);
|
||||
end;
|
||||
end;
|
||||
@@ -777,7 +777,7 @@ begin
|
||||
top:=140;
|
||||
width:=273;
|
||||
height:=145;
|
||||
end;
|
||||
end;
|
||||
with GroupBoxOrientation do
|
||||
begin
|
||||
left:=8;
|
||||
@@ -797,6 +797,7 @@ begin
|
||||
width:=273;
|
||||
height:=145;
|
||||
end;
|
||||
|
||||
With StringGridDet do
|
||||
begin
|
||||
Height:=GroupBoxDet.Height-20;
|
||||
@@ -814,10 +815,10 @@ begin
|
||||
Cells[1,0]:='Précé.';
|
||||
Cells[2,0]:='Temps';
|
||||
Cells[3,0]:='Train';
|
||||
for i:=0 to RowCount-1 do
|
||||
for i:=0 to RowCount-1 do
|
||||
RowHeights[i]:=20;
|
||||
end;
|
||||
|
||||
|
||||
// fenetre toujours dessus
|
||||
position:=poMainFormCenter;
|
||||
if affevt then Affiche('FormConfCellTCO create',clLime);
|
||||
@@ -829,7 +830,7 @@ begin
|
||||
ImagePaletteCC.Height:=iconeY;
|
||||
RadioGroupSel.itemIndex:=0;
|
||||
|
||||
if sombre then
|
||||
if modesombre then
|
||||
begin
|
||||
Color:=Couleurfond;
|
||||
for i:=0 to ComponentCount-1 do
|
||||
|
||||
+1
-1
@@ -581,7 +581,7 @@ begin
|
||||
font.Color:=clBlack;
|
||||
end;
|
||||
|
||||
if sombre then
|
||||
if Modesombre then
|
||||
begin
|
||||
Color:=Couleurfond;
|
||||
for i:=0 to ComponentCount-1 do
|
||||
|
||||
+1
-1
@@ -171,7 +171,7 @@ procedure couleurs_debug;
|
||||
var c : tcomponent;
|
||||
i : integer;
|
||||
begin
|
||||
if sombre then with formdebug do
|
||||
if ModeSombre then with formdebug do
|
||||
begin
|
||||
Color:=Couleurfond;
|
||||
for i:=0 to ComponentCount-1 do
|
||||
|
||||
@@ -98,7 +98,8 @@ var c : tcomponent;
|
||||
i : integer;
|
||||
fond,texte : tColor;
|
||||
begin
|
||||
if sombre then
|
||||
{$IF CompilerVersion < 28.0}
|
||||
if Modesombre then
|
||||
begin
|
||||
fond:=couleurFond;
|
||||
texte:=couleurTexte;
|
||||
@@ -111,6 +112,8 @@ begin
|
||||
composant(c,fond,texte);
|
||||
end;
|
||||
end;
|
||||
{$IFEND}
|
||||
|
||||
end;
|
||||
|
||||
|
||||
@@ -337,12 +340,12 @@ begin
|
||||
|
||||
// couleur de fond
|
||||
couleur:=$E0E0E0;
|
||||
if d12 then couleur:=$505050;
|
||||
if d12 then couleur:=canvas.Pixels[1,1];
|
||||
with grid.canvas do
|
||||
begin
|
||||
Brush.Color := couleur;
|
||||
inc(Rect.top); inc(Rect.left); // rend visible les quadrillages
|
||||
FillRect(Rect);
|
||||
font.Color:=clBlack; // couleur de la fonte
|
||||
end;
|
||||
|
||||
DRect:=Rect;
|
||||
|
||||
+1
-1
@@ -235,7 +235,7 @@ var c : tcomponent;
|
||||
i : integer;
|
||||
fond,texte : tColor;
|
||||
begin
|
||||
if sombre then
|
||||
if Modesombre then
|
||||
begin
|
||||
fond:=couleurFond;
|
||||
texte:=couleurTexte;
|
||||
|
||||
@@ -13,6 +13,7 @@ object FormInfo: TFormInfo
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poDefault
|
||||
OnActivate = FormActivate
|
||||
OnCreate = FormCreate
|
||||
PixelsPerInch = 96
|
||||
|
||||
@@ -1,5 +1,7 @@
|
||||
unit UnitInfo;
|
||||
|
||||
// afiche une info dans le TCO
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
|
||||
+3
-3
@@ -60,7 +60,7 @@ object FormModifAction: TFormModifAction
|
||||
Top = 64
|
||||
Width = 729
|
||||
Height = 337
|
||||
ActivePage = TabSheetOp
|
||||
ActivePage = TabSheetDecl
|
||||
MultiLine = True
|
||||
TabOrder = 1
|
||||
object TabSheetDecl: TTabSheet
|
||||
@@ -516,7 +516,7 @@ object FormModifAction: TFormModifAction
|
||||
Top = 32
|
||||
Width = 217
|
||||
Height = 21
|
||||
ItemHeight = 13
|
||||
ItemHeight = 0
|
||||
TabOrder = 0
|
||||
OnChange = ComboBoxFamilleChange
|
||||
end
|
||||
@@ -718,7 +718,7 @@ object FormModifAction: TFormModifAction
|
||||
Height = 21
|
||||
Hint = 'Nom de l'#39'accessoire d'#233'fini dans l'#39'onglet "p'#233'riph'#233'riques COM/USB"'
|
||||
Style = csDropDownList
|
||||
ItemHeight = 13
|
||||
ItemHeight = 0
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 4
|
||||
|
||||
+7
-8
@@ -244,13 +244,13 @@ begin
|
||||
DeclFonction : icone:=IconeFonction;
|
||||
end;
|
||||
ListBoxDeclench.Items.Add(Format('%d%s', [icone, declencheurs[i].nom])); // valeur d'index de l'icone dans la ImagelistIcones
|
||||
ListBoxDeclench.itemHeight:=17;
|
||||
ListBoxDeclench.itemHeight:=16;
|
||||
end;
|
||||
|
||||
for i:=1 to NbreOperations do
|
||||
begin
|
||||
affecte_operation(i,formModifAction.ListBoxOper);
|
||||
ListBoxOper.itemHeight:=17; // 16 mini taille des éléments pour l'icone
|
||||
ListBoxOper.itemHeight:=16; // 16 mini taille des éléments pour l'icone
|
||||
end;
|
||||
|
||||
for i:=1 to NbreConditions do
|
||||
@@ -271,7 +271,7 @@ begin
|
||||
|
||||
end;
|
||||
ListBoxCondTot.Items.Add(Format('%d%s', [icone, Conditions[i].nom])); // valeur d'index de l'icone dans la ImagelistIcones
|
||||
ListBoxCondTot.itemHeight:=17; // 16 mini taille des éléments pour l'icone
|
||||
ListBoxCondTot.itemHeight:=16; // 16 taille des éléments pour l'icone
|
||||
end;
|
||||
|
||||
with ComboBoxFamille do
|
||||
@@ -409,7 +409,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
// conditions
|
||||
s:=s+#13;
|
||||
nop:=Tablo_Action[i].NbCond;
|
||||
@@ -541,7 +540,7 @@ begin
|
||||
if act<=ActionTempo then formConfig.ListBoxOperations.Items.add(Format('%d%s', [act-1, s]));
|
||||
if act=ActionBoutonTCO then formConfig.ListBoxOperations.items.Add(Format('%d%s', [IconeBouton, s]));
|
||||
|
||||
itemHeight:=17;
|
||||
itemHeight:=16;
|
||||
end;
|
||||
end;
|
||||
if indexaction<>0 then itemIndex:=indexaction-1;
|
||||
@@ -571,7 +570,7 @@ begin
|
||||
|
||||
items.Add(Format('%d%s', [icone, s])); // valeur d'index de l'icone dans la ImagelistIcones
|
||||
|
||||
itemHeight:=17;
|
||||
itemHeight:=16;
|
||||
end;
|
||||
if indexCond<>0 then itemIndex:=indexCond-1;
|
||||
end;
|
||||
@@ -1209,7 +1208,7 @@ begin
|
||||
no:=Tablo_Action[idBD].tabloOp[i].numoperation;
|
||||
//items.Add(Format('%d%s', [no-1, operations[no].nom])); // valeur d'index de l'icone dans la ImagelistIcones
|
||||
affecte_operation(no,ListBoxOperations);
|
||||
itemHeight:=17;
|
||||
itemHeight:=16;
|
||||
end;
|
||||
ItemIndex:=indexSrc-1;
|
||||
end;
|
||||
@@ -1246,7 +1245,7 @@ begin
|
||||
begin
|
||||
no:=Tablo_Action[idBD].tabloOp[i].numoperation;
|
||||
affecte_operation(no,ListBoxOperations);
|
||||
itemHeight:=17;
|
||||
itemHeight:=16;
|
||||
end;
|
||||
|
||||
ItemIndex:=indexSrc+1;
|
||||
|
||||
+5
-5
@@ -27,7 +27,7 @@ Const
|
||||
// Ajoute une règle au pare feu pour un programme en utilisant Microsoft Windows Firewall APIs.
|
||||
// sp=Nom indicatif du programme (nom de la règle qui sera insérée dans le par-feu
|
||||
// chemin : chemin partiel et executable
|
||||
function AddApplicationRule(sp,chemin : string) : boolean;
|
||||
function AjouteRegle(sp,chemin : string) : boolean;
|
||||
var
|
||||
CurrentProfiles,fwPolicy2,RulesObject,NewRule : OleVariant;
|
||||
s,fichier : string;
|
||||
@@ -56,7 +56,7 @@ begin
|
||||
NewRule.Profiles:=CurrentProfiles;
|
||||
NewRule.Action:=NET_FW_ACTION_ALLOW;
|
||||
|
||||
//Ajouter une règle
|
||||
//Ajouter la règle
|
||||
try
|
||||
RulesObject.Add(NewRule);
|
||||
r:=true;
|
||||
@@ -81,7 +81,7 @@ begin
|
||||
try
|
||||
CoResult:=CoInitializeEx(nil,COINIT_MULTITHREADED);
|
||||
try
|
||||
r:=AddApplicationRule(sp,chemin);
|
||||
r:=AjouteRegle(sp,chemin);
|
||||
finally
|
||||
begin
|
||||
CoUninitialize;
|
||||
@@ -113,7 +113,7 @@ end;
|
||||
// retour =0 : pas dans le pare feu
|
||||
// =1 oui mais inactive
|
||||
// =2 oui et active sp=Nom regle CDM
|
||||
function CheckingRuleEnabled(sp : string) : integer;
|
||||
function VerifieReglePF(sp : string) : integer;
|
||||
var
|
||||
fwPolicy2,RulesObject,regle : OleVariant;
|
||||
CurrentProfiles : Integer;
|
||||
@@ -171,7 +171,7 @@ begin
|
||||
try
|
||||
CoInitialize(nil);
|
||||
try
|
||||
i:=CheckingRuleEnabled(sp);
|
||||
i:=VerifieReglePF(sp);
|
||||
finally
|
||||
CoUninitialize;
|
||||
end;
|
||||
|
||||
+1
-1
@@ -372,7 +372,7 @@ var i : integer;
|
||||
c : tcomponent;
|
||||
begin
|
||||
{$IF CompilerVersion<28.0 }
|
||||
if sombre then with formPilote do
|
||||
if Modesombre then with formPilote do
|
||||
begin
|
||||
Color:=Couleurfond;
|
||||
for i:=0 to ComponentCount-1 do
|
||||
|
||||
+1
-2
@@ -2050,14 +2050,13 @@ object FormPrinc: TFormPrinc
|
||||
end
|
||||
end
|
||||
end
|
||||
object Button3: TButton
|
||||
object ButtonEssai: TButton
|
||||
Left = 504
|
||||
Top = 8
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'Essai'
|
||||
TabOrder = 2
|
||||
OnClick = Button3Click
|
||||
end
|
||||
object Timer1: TTimer
|
||||
Interval = 100
|
||||
|
||||
+412
-57
@@ -10,21 +10,17 @@ unit Unitprinc;
|
||||
on utilise AsyncPro pour les liaisons série/USB - ce composant est compilable en 32 et en 64 bits.
|
||||
clientSocket et ServerSocker pour les connexions réseau socket
|
||||
|
||||
un essai avec IdTCPClient (Indy) est fait avec D7/D12. En D7 nécéssite le fichier Idtcpclient.dcu.
|
||||
un essai avec IdTCPClient (Indy) a été fait avec D7/D12. En D7 nécéssite le fichier Idtcpclient.dcu.
|
||||
En D12 l'event Rx nécessite un thread et ne fonctionne pas bien. C'est ok en D7.
|
||||
|
||||
Options de compilation: options du debugger/exception du langage : décocher "arreter sur exceptions delphi"
|
||||
Options de compilation D7: options du debugger/exception du langage : décocher "arreter sur exceptions delphi"
|
||||
sinon une exception surgira au moment de l'ouverture du com
|
||||
Dans projet/option/fiches : fiches disponibles : formtco uniquement
|
||||
En cas d'erreur interne L1333, supprimer les fichiers DCU ou simplement faire construire
|
||||
|
||||
Notes pour compilation sous Embarcadero : --------------------------------------------------
|
||||
Pour compilation avec Rad Studio (Delphi12): Projet / Options // Application / Apparence /
|
||||
Embarcadero technologies / cocher tous les thèmes : carbon Auric etc / et choisir le style par défaut : windows sinon plantage
|
||||
|
||||
Pour le mode sombre sous Embarcadero, il faut sélectionner:
|
||||
Projet / Options // Application / manifeste / fichier manifeste : personnaliser
|
||||
à la sauvegarde, ce champ appraitra sous "générer automatiquement"
|
||||
à la sauvegarde, ce champ apparaitra sous "générer automatiquement"
|
||||
et : décocher "activer les thèmes d'exécution"
|
||||
|
||||
********************************************
|
||||
@@ -90,6 +86,7 @@ uses
|
||||
{$ENDIF}
|
||||
{$IF CompilerVersion >= 28.0} // si delphi>=12
|
||||
,Vcl.Themes // pour les thèmes d'affichage (auric etc)
|
||||
,Vcl.Styles.Ext // styles étendus
|
||||
,AdPort, OoMisc // AsyncPro pour COM/USB
|
||||
,idGlobal // pour utiliser tidBytes
|
||||
{$ELSE}
|
||||
@@ -263,7 +260,7 @@ type
|
||||
N16: TMenuItem;
|
||||
Afficherlhorloge1: TMenuItem;
|
||||
Codificationdescantons1: TMenuItem;
|
||||
Button3: TButton;
|
||||
ButtonEssai: TButton;
|
||||
Routes1: TMenuItem;
|
||||
N17: TMenuItem;
|
||||
Codificationdestrains1: TMenuItem;
|
||||
@@ -428,7 +425,6 @@ type
|
||||
procedure Codificationdestrains1Click(Sender: TObject);
|
||||
procedure Afficheroutespartrain1Click(Sender: TObject);
|
||||
procedure Sauvegarderlaconfiguration1Click(Sender: TObject);
|
||||
procedure Button3Click(Sender: TObject);
|
||||
procedure MesurerlavitessedestrainsClick(Sender: TObject);
|
||||
procedure Affichelamesuredesvitesses1Click(Sender: TObject);
|
||||
procedure Button0Click(Sender: TObject);
|
||||
@@ -733,6 +729,13 @@ Tfonction =
|
||||
train : string;
|
||||
end;
|
||||
|
||||
Tstyle = record
|
||||
NomCheminFichier : string; // avec le chemin
|
||||
NomFichier : string;
|
||||
NomStyle : string; // nom à utiliser pour l'ouverture
|
||||
clarte : (tous,sombre,moyen,clair);
|
||||
end;
|
||||
|
||||
Taiguillage = record
|
||||
Adresse : integer; // adresse de l'aiguillage
|
||||
AncienAdresse : integer;
|
||||
@@ -921,7 +924,7 @@ var
|
||||
NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant,
|
||||
Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM,index_couleur,
|
||||
ServeurRetroCDM,TailleFonte,Nb_Det_Dist,Tdoubleclic,algo_Unisemaf,fA,fB,
|
||||
etape,idEl,intervalle_courant,filtrageDet0,Nactionneurs,
|
||||
etape,idEl,intervalle_courant,filtrageDet0,Nactionneurs,nombreStyles,
|
||||
TpsTimeoutSL,formatY,OsBits,NbreDecPers,NbDecodeur,NbDecodeurdeBase,
|
||||
LargeurF,HauteurF,OffsetXF,OffsetYF,PosSplitter,NbPeriph,NbPeriph_COMUSB,NbPeriph_Socket,
|
||||
AigMal,AncMinute,axFP,ayFP,NbreOperations,NbreDeclencheurs,index_seqAct,NbreConditions,
|
||||
@@ -937,9 +940,11 @@ var
|
||||
AvecDemandeInterfaceUSB,AvecDemandeInterfaceEth,aff_acc,affiche_aigdcc,modeStkRetro,
|
||||
retEtatDet,roulage,init_aig_cours,affevt,placeAffiche,clicComboTrain,clicAdrTrain,
|
||||
fichier_module_cdm,Diffusion,cdmDevant,serveurIPCDM_Touche,avecAckCDM,Stop_Maj_Sig,
|
||||
sombre,serveur_ouvert,pasChgTBV,FpBouge,debugPN,simuInterface,option_demitour,
|
||||
Modesombre,serveur_ouvert,pasChgTBV,FpBouge,debugPN,simuInterface,option_demitour,
|
||||
mesureTrains : boolean;
|
||||
|
||||
Style : array[0..200] of Tstyle;
|
||||
|
||||
tick,Premier_tick : longint;
|
||||
|
||||
{$IF CompilerVersion >= 28.0}
|
||||
@@ -1334,7 +1339,7 @@ procedure composant(c : tComponent;fond,texte : tColor);
|
||||
procedure maj_couleurs;
|
||||
procedure AffTexteIncliBordeTexture(c : TCanvas; x,y : integer; Fonte : tFont;
|
||||
clBord : TColor; EpBord : integer; PenMode : TPenMode;
|
||||
clfond : tColor; texte : string; AngleDD : longint);
|
||||
texte : string; AngleDD : longint);
|
||||
procedure change_style;
|
||||
function isDirectionnel(index : integer) : boolean;
|
||||
procedure stop_trains;
|
||||
@@ -1470,24 +1475,299 @@ begin
|
||||
end;
|
||||
}
|
||||
|
||||
// lire les styles vsf - Uniquement D12
|
||||
procedure lire_styles;
|
||||
var path,ext : string;
|
||||
DirList : TStrings;
|
||||
ok : boolean;
|
||||
Sr : TSearchRec;
|
||||
commande,chem,s : string;
|
||||
nombre,i,j : integer;
|
||||
Style1 : tStyle;
|
||||
{$IF CompilerVersion >= 28.0}
|
||||
ss : TArray<string>;
|
||||
si : tStyleInfo;
|
||||
{$IFEND}
|
||||
Nbss : integer;
|
||||
begin
|
||||
// liste des fichiers chemin destination
|
||||
{$IF CompilerVersion >= 28.0}
|
||||
|
||||
ss:=TStyleManager.StyleNames; // contient les styles déja chargés en mémoire
|
||||
Nbss:=high(ss);
|
||||
|
||||
s:=GetCurrentDir;
|
||||
|
||||
Path:=s+'\Styles\';
|
||||
|
||||
// trouver les fichiers
|
||||
DirList:=TStringList.Create;
|
||||
nombreStyles:=0;
|
||||
if FindFirst(Path+'*.*',faAnyFile,Sr) = 0 then
|
||||
begin
|
||||
repeat
|
||||
s:=sr.Name;
|
||||
if (s<>'.') and (s<>'..') and ((sr.Attr and faDirectory)=0) then
|
||||
begin
|
||||
DirList.Add(SR.Name); //remplir la liste
|
||||
i:=pos('.',s);
|
||||
s:=copy(s,1,i-1);
|
||||
ext:=lowercase(copy(sr.Name,i+1));
|
||||
ok:=true;
|
||||
if ext='vsf' then
|
||||
begin
|
||||
try TStylemanager.loadFromFile(path+sr.Name);
|
||||
except begin Affiche('Impossible de charger le style '+sr.name,clOrange);ok:=false;end;
|
||||
end;
|
||||
if ok then // style chargé
|
||||
begin
|
||||
if debug=1 then Affiche('chargement du style '+sr.name,clYellow);
|
||||
inc(nombreStyles);
|
||||
style[NombreStyles].NomCheminFichier:=path+sr.name;
|
||||
style[NombreStyles].NomFichier:=sr.name;
|
||||
|
||||
if tStyleManager.IsValidStyle(path+sr.name,si)=false then
|
||||
begin
|
||||
Affiche('Le style '+sr.name+' est invalide. Version='+si.Version,clOrange);
|
||||
dec(nombreStyles);
|
||||
end
|
||||
else
|
||||
begin
|
||||
style[NombreStyles].NomStyle:=si.Name;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until FindNext(Sr)<>0;
|
||||
FindClose(Sr);
|
||||
end;
|
||||
|
||||
// trier par NomStyle
|
||||
Style[0].NomStyle:=tStyleManager.StyleNames[0];
|
||||
|
||||
for i:=1 to nombreStyles-1 do
|
||||
begin
|
||||
for j:=i+1 to nombreStyles do
|
||||
begin
|
||||
if Style[i].NomStyle>Style[j].NomStyle then
|
||||
begin
|
||||
style1:=Style[i];
|
||||
Style[i]:=Style[j];
|
||||
Style[j]:=style1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$IFEND}
|
||||
|
||||
// renseigner clair/sombre
|
||||
for i:=1 to nombreStyles do
|
||||
begin
|
||||
s:=lowercase(style[i].NomStyle);
|
||||
|
||||
if s='amakrits' then style[i].clarte:=sombre;
|
||||
if s='amethyst kamri' then style[i].clarte:=sombre;
|
||||
if s='aqua graphite' then style[i].clarte:=sombre; // très beau
|
||||
if s='aqua light slate' then style[i].clarte:=clair;
|
||||
if s='aqua light slate 2' then style[i].clarte:=clair;
|
||||
if s='auric' then style[i].clarte:=sombre; // très beau
|
||||
if s='calypso' then style[i].clarte:=sombre;
|
||||
if s='calypso le' then style[i].clarte:=sombre;
|
||||
if s='calypso se' then style[i].clarte:=sombre;
|
||||
if s='calypso sle' then style[i].clarte:=sombre;
|
||||
if s='carbon' then style[i].clarte:=sombre;
|
||||
if s='charcoal dark slate' then style[i].clarte:=sombre;
|
||||
if s='cobalt xemedia' then style[i].clarte:=sombre;
|
||||
if s='copper' then style[i].clarte:=sombre;
|
||||
if s='copperdark' then style[i].clarte:=sombre;
|
||||
if s='coppervari' then style[i].clarte:=clair;
|
||||
if s='coppervaridark' then style[i].clarte:=clair;
|
||||
if s='coppervarii' then style[i].clarte:=clair;
|
||||
if s='Coppervariiblack' then style[i].clarte:=clair;
|
||||
if s='Coppervariii' then style[i].clarte:=clair;
|
||||
if s='Coppervariiiblack' then style[i].clarte:=clair;
|
||||
if s='Coppervariv' then style[i].clarte:=clair;
|
||||
if s='Coppervarivblack' then style[i].clarte:=clair;
|
||||
if s='Coppervarv' then style[i].clarte:=clair;
|
||||
if s='Coppervarvblack' then style[i].clarte:=clair;
|
||||
if s='Coppervarvi' then style[i].clarte:=clair;
|
||||
if s='Coppervarviblack' then style[i].clarte:=clair;
|
||||
if s='Coppervarvii' then style[i].clarte:=clair;
|
||||
if s='Coppervarviiblack' then style[i].clarte:=clair;
|
||||
if s='coral' then style[i].clarte:=clair;
|
||||
if s='cyan dusk' then style[i].clarte:=clair;
|
||||
if s='cyan night' then style[i].clarte:=clair;
|
||||
if s='diamond' then style[i].clarte:=clair;
|
||||
if s='emerald' then style[i].clarte:=clair; // moche
|
||||
if s='emerald Light Slate' then style[i].clarte:=clair;
|
||||
if s='flat ui light' then style[i].clarte:=clair;
|
||||
if s='gnome hybrid' then style[i].clarte:=clair;
|
||||
if s='glossy' then style[i].clarte:=sombre;
|
||||
if s='glossy2' then style[i].clarte:=sombre;
|
||||
if s='glow' then style[i].clarte:=sombre;
|
||||
if s='golden graphite' then style[i].clarte:=sombre;
|
||||
if s='iceberg classico' then style[i].clarte:=clair; //beau
|
||||
if s='jet' then style[i].clarte:=sombre;
|
||||
if s='golden graphite' then style[i].clarte:=sombre; // beau avec boutons or
|
||||
if s='glossy' then style[i].clarte:=sombre;
|
||||
if s='glossy2' then style[i].clarte:=sombre;
|
||||
if s='glow' then style[i].clarte:=sombre;
|
||||
if s='golden graphite' then style[i].clarte:=sombre;
|
||||
if s='iceberg classico' then style[i].clarte:=clair;
|
||||
if s='jet' then style[i].clarte:=sombre;
|
||||
if s='lavender classico' then style[i].clarte:=clair;
|
||||
if s='light' then style[i].clarte:=clair;
|
||||
if s='light green' then style[i].clarte:=clair;
|
||||
if s='light' then style[i].clarte:=clair;
|
||||
if s='lilac' then style[i].clarte:=clair;
|
||||
if s='luna' then style[i].clarte:=clair;
|
||||
if s='lucky point' then style[i].clarte:=sombre;
|
||||
if s='material' then style[i].clarte:=sombre;
|
||||
if s='material oxford blue' then style[i].clarte:=sombre;
|
||||
if s='material oxford blue se' then style[i].clarte:=sombre;
|
||||
if s='material patterns blue' then style[i].clarte:=clair;
|
||||
if s='material white texture' then style[i].clarte:=clair;
|
||||
if s='metro black' then style[i].clarte:=sombre;
|
||||
if s='metropolis ui dark' then style[i].clarte:=sombre;
|
||||
if s='mountain mist' then style[i].clarte:=clair;
|
||||
if s='obsidian' then style[i].clarte:=sombre;
|
||||
if s='onyx blue' then style[i].clarte:=sombre; // beau
|
||||
if s='puerto rico' then style[i].clarte:=clair;
|
||||
if s='radiant' then style[i].clarte:=clair;
|
||||
if s='ruby graphite' then style[i].clarte:=sombre; // beau, boutons rouge
|
||||
if s='sapphire kamri' then style[i].clarte:=clair; // beau , fond orange
|
||||
if s='sky' then style[i].clarte:=clair;
|
||||
if s='sky2' then style[i].clarte:=clair;
|
||||
if s='smokey quartz kamri' then style[i].clarte:=clair;
|
||||
if s='stellar' then style[i].clarte:=clair;
|
||||
if s='stellar dark' then style[i].clarte:=clair;
|
||||
if s='sterling' then style[i].clarte:=clair;
|
||||
if s='state classico' then style[i].clarte:=clair;
|
||||
if s='tablet dark' then style[i].clarte:=sombre;
|
||||
if s='tablet light' then style[i].clarte:=clair;
|
||||
if s='turquoise gray' then style[i].clarte:=clair;
|
||||
if s='vapor' then style[i].clarte:=sombre;
|
||||
if s='wedgewood light' then style[i].clarte:=clair;
|
||||
if s='win10ide_dark' then style[i].clarte:=sombre; //beau fond bleu clair
|
||||
if s='win10ide_light' then style[i].clarte:=clair; //beau fond bleu clair
|
||||
if s='windows' then style[i].clarte:=clair;
|
||||
if s='windows designer' then style[i].clarte:=clair;
|
||||
if s='windows designer dark' then style[i].clarte:=clair;
|
||||
if s='windows10' then style[i].clarte:=clair;
|
||||
if s='windows10 black pearl' then style[i].clarte:=sombre;
|
||||
if s='windows10 blue' then style[i].clarte:=sombre; // moche
|
||||
if s='windows10 blue whale' then style[i].clarte:=sombre;
|
||||
if s='windows10 blue whale le' then style[i].clarte:=sombre;
|
||||
if s='windows10 charcoal' then style[i].clarte:=sombre;
|
||||
if s='windows10 clear day' then style[i].clarte:=clair;
|
||||
if s='windows10 dark' then style[i].clarte:=sombre;
|
||||
if s='windows10 green' then style[i].clarte:=sombre;
|
||||
if s='windows10 malibu' then style[i].clarte:=clair;
|
||||
if s='windows10 purple' then style[i].clarte:=sombre;
|
||||
if s='windows10 stategray' then style[i].clarte:=sombre; //beau
|
||||
if s='windows11 impressive dark se' then style[i].clarte:=sombre; //beau
|
||||
if s='windows11 impressive dark se' then style[i].clarte:=sombre; //beau
|
||||
if s='windows11 impressive light' then style[i].clarte:=clair; //beau
|
||||
if s='windows11 impressive light se' then style[i].clarte:=clair; //beau
|
||||
if s='windows11 mineShaft' then style[i].clarte:=sombre; //beau
|
||||
if s='windows11 modern dark' then style[i].clarte:=sombre;
|
||||
if s='windows11 modern light' then style[i].clarte:=clair;
|
||||
if s='windows11 polar dark' then style[i].clarte:=sombre;
|
||||
if s='windows11 polar light' then style[i].clarte:=clair; // beau
|
||||
if s='windows11 white smoke' then style[i].clarte:=clair;
|
||||
if s='zircon' then style[i].clarte:=clair;
|
||||
if s='zircon se' then style[i].clarte:=clair;
|
||||
end;
|
||||
end;
|
||||
|
||||
// change le style en fonction de Style_aff pour Delphi12 (compilateur>=28)
|
||||
// Cette procédure doit être appellée depuis le module principal UnitPrinc sinon exception violation
|
||||
// Pour les RichEdit, il faut les réafficher après chaque changement de style, sinon elles peuvent être mal contrastées.
|
||||
// ceci doit être fait dans l'evt OnActivate de chaque feuille.
|
||||
procedure change_style;
|
||||
var i : integer;
|
||||
var i,j,index : integer;
|
||||
Re : tRichEdit;
|
||||
s : string;
|
||||
comp : Tcomponent;
|
||||
{$IF CompilerVersion >= 28.0}
|
||||
si : tStyleInfo;
|
||||
{$IFEND}
|
||||
begin
|
||||
{$IF CompilerVersion >= 28.0}
|
||||
if Ancien_Style<>Style_Aff then
|
||||
{$IF CompilerVersion >= 28.0}
|
||||
if Ancien_Nom_Style<>Nom_style_aff then
|
||||
begin
|
||||
TStyleManager.TrySetStyle(TStyleManager.StyleNames[0]); // repasse en windows (style 0) pour éviter exception
|
||||
TStyleManager.TrySetStyle(TStyleManager.StyleNames[Style_Aff]); // passe dans le style demandé
|
||||
// repasser certains composants dans le style windows permet que le composant affiche en couleurs
|
||||
TStyleManager.TrySetStyle(TStyleManager.StyleNames[0]); // repasse en windows (style 0) pour éviter exception après changement du nouveau style
|
||||
if Nom_Style_Aff='Windows' then exit;
|
||||
index:=trouve_index_style;
|
||||
if index<0 then
|
||||
begin
|
||||
Affiche('Style '+Nom_Style_aff+' non trouvé',clred);
|
||||
exit;
|
||||
end;
|
||||
s:=style[index].NomCheminFichier;
|
||||
|
||||
// vérificztion si le fichier de style existe
|
||||
if FileExists(s)=false then
|
||||
begin
|
||||
Affiche('Le fichier de style '+Nom_Style_aff+' est inexistant',clOrange);
|
||||
Affiche(s,clOrange);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// vérification de la validité du style, et récupération de la structure si qui contient le vrai nom
|
||||
// du style qu'il faudra utiliser pour son application
|
||||
try
|
||||
if tStyleManager.IsValidStyle(s,si)=false then
|
||||
begin
|
||||
Affiche('Le style '+Nom_Style_Aff+' est invalide. Version='+si.Version,clOrange);
|
||||
exit;
|
||||
end;
|
||||
except
|
||||
begin
|
||||
Affiche('Le style '+Nom_Style_Aff+' est inexistant',clOrange);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// reprendre le vrai nom du style depuis SI.name car le nom du fichier peur être différent du nom du style
|
||||
// exemple le style Metropolis UI Dark (avec espaces) a pour nom de fichier MetropolisUIDark.vsf
|
||||
Nom_style_aff:=si.Name;
|
||||
|
||||
try
|
||||
TStyleManager.ReloadStyle(Nom_Style_aff); // librairie Vcl.Styles.Ext
|
||||
except
|
||||
Affiche('Erreur d''application du style '+Nom_style_aff+' version='+si.version,clOrange);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// repasser certains composants dans le styleName windows permet que le composant affiche en couleurs voulues
|
||||
// car changer de style sur un composant dont le styleName n'est plus windows interdit de changer sa couleur
|
||||
|
||||
Formprinc.FenRich.StyleName:='Windows';
|
||||
if formDebug<>nil then
|
||||
begin
|
||||
FormDebug.RichDebug.StyleName:='Windows';
|
||||
formDebug.MemoEvtDet.StyleName:='Windows';
|
||||
end;
|
||||
|
||||
// énumérer tous les composants pour repaint les richedit - ne marche pas
|
||||
{
|
||||
for i:=0 to Screen.FormCount-1 do
|
||||
begin
|
||||
//Affiche(Screen.Forms[i].Name,clYellow);
|
||||
for j:=0 to Screen.Forms[i].ComponentCount-1 do
|
||||
begin
|
||||
comp:=Screen.Forms[i].Components[j];
|
||||
if comp is tRichEdit then
|
||||
begin
|
||||
re:=comp as tRichEdit;
|
||||
re.repaint;
|
||||
//Affiche(comp.name,clWhite);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
}
|
||||
|
||||
{
|
||||
if formConfig<>nil then
|
||||
begin
|
||||
FormConfig.RichBranche.StyleName:='Windows';
|
||||
@@ -1496,8 +1776,8 @@ begin
|
||||
for i:=1 to NbreTCO do
|
||||
begin
|
||||
if FormTCO[i]<>nil then FormTCO[i].ScrollBox.StyleName:='Windows';
|
||||
end;
|
||||
Ancien_style:=Style_aff;
|
||||
end; }
|
||||
Ancien_nom_style:=nom_Style_aff;
|
||||
end;
|
||||
{$IFEND}
|
||||
end;
|
||||
@@ -1585,7 +1865,7 @@ end;
|
||||
|
||||
|
||||
procedure fin_preliminaire;
|
||||
var i : integer;
|
||||
var i,j : integer;
|
||||
s : string;
|
||||
begin
|
||||
s:='Début du préliminaire';
|
||||
@@ -3162,7 +3442,7 @@ end;
|
||||
// AngleDD = Angle d'inclinaison en Dixièmes de degré.
|
||||
procedure AffTexteIncliBordeTexture(c : TCanvas; x,y : integer; Fonte : tFont;
|
||||
clBord : TColor; EpBord : integer; PenMode : TPenMode;
|
||||
clfond : tColor; texte : string; AngleDD : longint);
|
||||
texte : string; AngleDD : longint);
|
||||
var dc : Hdc;
|
||||
lgFont : Logfont; // structure d'attributs de police
|
||||
AncFonte,NouvFonte : Hfont;
|
||||
@@ -3174,11 +3454,11 @@ begin
|
||||
dc:=C.Handle;
|
||||
|
||||
c.pen.Mode:=PmCopy;
|
||||
c.pen.Color:=clfond; //clfond;
|
||||
c.Brush.color:=clfond;
|
||||
//c.pen.Color:=clfond; //clfond;
|
||||
//c.Brush.color:=clfond;
|
||||
c.pen.width:=1;
|
||||
i:=round(length(texte)*0.5*abs(fonte.size));
|
||||
c.Rectangle(x+2,y,x+15,y-i);
|
||||
// c.Rectangle(x+2,y,x+15,y-i);
|
||||
|
||||
// Initialisation de la fonte
|
||||
zeroMemory(@lgFont,sizeOf(lgFont)); // remplit la structure de 0
|
||||
@@ -3452,7 +3732,7 @@ begin
|
||||
3 : angle:=900;
|
||||
4 : angle:=1800;
|
||||
end;
|
||||
AffTexteIncliBordeTexture(Acanvas,XTexte,YTexte,Acanvas.Font,clYellow,0,pmcopy,clblack,intToSTR(vitesse),angle);
|
||||
AffTexteIncliBordeTexture(Acanvas,XTexte,YTexte,Acanvas.Font,clYellow,0,pmcopy,intToSTR(vitesse),angle);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
@@ -17418,16 +17698,17 @@ begin
|
||||
KeybdInput(Ord('I'),KEYEVENTF_KEYUP);
|
||||
|
||||
KeybdInput(VK_MENU,KEYEVENTF_KEYUP); // relache ALT
|
||||
KeybdInput(Ord('I'),0);
|
||||
KeybdInput(Ord('I'),0); // I
|
||||
KeybdInput(Ord('I'),KEYEVENTF_KEYUP);
|
||||
|
||||
KeybdInput(VK_RETURN,0);
|
||||
KeybdInput(VK_RETURN,0); // return
|
||||
KeybdInput(VK_RETURN,KEYEVENTF_KEYUP);
|
||||
KeybdInput(VK_RETURN,0);
|
||||
KeybdInput(VK_RETURN,KEYEVENTF_KEYUP);
|
||||
KeybdInput(VK_RETURN,KEYEVENTF_KEYUP); // return
|
||||
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); // affiche la fenetre d'interface
|
||||
Sleep(240*tempoTC);
|
||||
|
||||
// la fenêtre interface est ouverte
|
||||
// descendre le curseur n fois pour sélectionner le serveur
|
||||
for i:=1 to ServeurInterfaceCDM-1 do
|
||||
begin
|
||||
@@ -17439,13 +17720,13 @@ begin
|
||||
KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP);
|
||||
KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP); // 3 TAB depuis version 24.10
|
||||
|
||||
KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE,KEYEVENTF_KEYUP);
|
||||
KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE,KEYEVENTF_KEYUP); // valide la fenetre
|
||||
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
Sleep(240*tempoTC);
|
||||
|
||||
// Interface
|
||||
// Xpressnet RS
|
||||
if (ServeurInterfaceCDM=1) or (ServeurInterfaceCDM=5) then
|
||||
// Xpressnet RS2pc
|
||||
if (ServeurInterfaceCDM=1) or (ServeurInterfaceCDM=6) then
|
||||
begin
|
||||
for i:=1 to ServeurRetroCDM-1 do
|
||||
begin
|
||||
@@ -17483,14 +17764,86 @@ begin
|
||||
application.ProcessMessages;
|
||||
KeybdInput(VK_RETURN,0);KeybdInput(VK_RETURN, KEYEVENTF_KEYUP); // valide la fenetre finale
|
||||
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
|
||||
Sleep(300*tempoTC);
|
||||
application.ProcessMessages;
|
||||
KeybdInput(VK_RETURN,0);KeybdInput(VK_RETURN, KEYEVENTF_KEYUP); // valide la fenetre finale
|
||||
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
if (ServeurInterfaceCDM=4) then // HSI
|
||||
begin
|
||||
for i:=1 to 4 do
|
||||
begin
|
||||
KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP);
|
||||
SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
end;
|
||||
|
||||
KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE,KEYEVENTF_KEYUP); // valide la fenetre d'interface
|
||||
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
Application.processMessages;
|
||||
Sleep(200*tempoTC);
|
||||
end;
|
||||
|
||||
if (ServeurInterfaceCDM=5) then // FIS88
|
||||
begin
|
||||
for i:=1 to 3 do
|
||||
begin
|
||||
KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP);
|
||||
SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
end;
|
||||
|
||||
KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE,KEYEVENTF_KEYUP); // valide la fenetre d'interface
|
||||
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
Application.processMessages;
|
||||
Sleep(200*tempoTC);
|
||||
end;
|
||||
|
||||
if (ServeurInterfaceCDM=7) then // dccpp
|
||||
begin
|
||||
Sleep(500*tempoTC); // attendre l'affichage de la fenetre
|
||||
for i:=1 to 5 do
|
||||
begin
|
||||
KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP);
|
||||
SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
end;
|
||||
|
||||
KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE,KEYEVENTF_KEYUP); // valide la fenetre d'interface
|
||||
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
Application.processMessages;
|
||||
Sleep(200*tempoTC);
|
||||
end;
|
||||
|
||||
if (ServeurInterfaceCDM=8) then // Ecos ESU
|
||||
begin
|
||||
for i:=1 to 6 do
|
||||
begin
|
||||
KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP);
|
||||
SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
end;
|
||||
|
||||
KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE,KEYEVENTF_KEYUP); // valide la fenetre d'interface
|
||||
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
Application.processMessages;
|
||||
Sleep(200*tempoTC);
|
||||
end;
|
||||
|
||||
if (ServeurInterfaceCDM=9) then // Dcc++
|
||||
begin
|
||||
Sleep(500*tempoTC); // attendre l'affichage de la fenetre
|
||||
for i:=1 to 2 do
|
||||
begin
|
||||
KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP);
|
||||
SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
end;
|
||||
|
||||
KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE,KEYEVENTF_KEYUP); // valide la fenetre d'interface
|
||||
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
Application.processMessages;
|
||||
Sleep(200*tempoTC);
|
||||
end;
|
||||
|
||||
Sleep(300*tempoTC);
|
||||
application.ProcessMessages;
|
||||
KeybdInput(VK_RETURN,0);KeybdInput(VK_RETURN, KEYEVENTF_KEYUP); // valide la fenetre finale
|
||||
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
|
||||
|
||||
end;
|
||||
Lance_CDM:=true;
|
||||
end;
|
||||
@@ -17912,7 +18265,7 @@ var fond,texte : tColor;
|
||||
begin
|
||||
fond:=couleurFond;
|
||||
texte:=couleurTexte;
|
||||
if sombre then
|
||||
if Modesombre then
|
||||
begin
|
||||
formprinc.Color:=fond;
|
||||
for i:=0 to formprinc.ComponentCount-1 do
|
||||
@@ -18408,8 +18761,11 @@ var n,t,i,j,index,OrgMilieu : integer;
|
||||
s,vc : string;
|
||||
trouve : boolean;
|
||||
Sr : TSearchRec;
|
||||
comp : Tcomponent;
|
||||
tmP,tmA : tMenuItem;
|
||||
begin
|
||||
Ancien_Nom_Style:='';
|
||||
Nom_style_aff:='windows';
|
||||
af:='Client TCP-IP ou USB CDM Rail - Système XpressNet DCC++ Version '+VersionSC+sousVersion;
|
||||
vc:='';
|
||||
{$IF CompilerVersion >= 28.0}
|
||||
@@ -18512,7 +18868,7 @@ begin
|
||||
option_demitour:=false;
|
||||
debugroulage:=false;
|
||||
mesureTrains:=false;
|
||||
sombre:=false;
|
||||
Modesombre:=false;
|
||||
simuInterface:=false;
|
||||
Stop_Maj_Sig:=false;
|
||||
MaxParcours:=100; // Nombre maxi d'éléments d'une route
|
||||
@@ -18520,7 +18876,7 @@ begin
|
||||
Diffusion:=true; // &&&& mode diffusion publique + debug mise au point etc
|
||||
AffAigDet:=false;
|
||||
|
||||
Button3.Visible:=not(diffusion);
|
||||
ButtonEssai.Visible:=not(diffusion);
|
||||
GetLocaleFormatSettings(0,FormatSettings);
|
||||
FormatSettings.DecimalSeparator:='.';
|
||||
|
||||
@@ -18799,9 +19155,13 @@ begin
|
||||
Application.HintPause:=400; // 400ms
|
||||
//visible:=true; // rend la form visible plus tot
|
||||
for i:=1 to MaxCdeDccpp do CdeDccpp[i]:='';
|
||||
lire_styles;
|
||||
|
||||
// lecture fichiers de configuration
|
||||
procetape('Lecture de la configuration');
|
||||
lit_config;
|
||||
|
||||
|
||||
{$IF CompilerVersion >= 28.0}
|
||||
//https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions
|
||||
change_style;
|
||||
@@ -18999,6 +19359,8 @@ begin
|
||||
ConfCellTCO:=false;
|
||||
if debug=1 then Affiche('Fini',clLime);
|
||||
|
||||
|
||||
|
||||
end;
|
||||
|
||||
|
||||
@@ -19121,7 +19483,10 @@ begin
|
||||
if confasauver then sauve_config;
|
||||
if sauve_tco then sauve_fichiers_tco;
|
||||
|
||||
for i:=1 to NbreTCO do FormTCO[i].Close;
|
||||
for i:=1 to NbreTCO do
|
||||
begin
|
||||
if FormTCO[i]<>nil then FormTCO[i].Close;
|
||||
end;
|
||||
|
||||
timer1.Enabled:=false;
|
||||
FermeSC:=true;
|
||||
@@ -19163,7 +19528,7 @@ begin
|
||||
begin
|
||||
if (grilleHoraire[i].NomTrain=train) and (grilleHoraire[i].arretDepart) then
|
||||
begin
|
||||
if ( (grilleHoraire[i].heure<heure) or
|
||||
if ( (grilleHoraire[i].heure<heure) or
|
||||
((grilleHoraire[i].heure=heure) and (grilleHoraire[i].minute>minute))
|
||||
) and (seconde<10) then
|
||||
begin
|
||||
@@ -21339,9 +21704,6 @@ begin
|
||||
if ConfigPrete then
|
||||
begin
|
||||
formconfig.showmodal;
|
||||
{$IF CompilerVersion >= 28.0}
|
||||
change_style;
|
||||
{$IFEND}
|
||||
// ne pas faire close : déja provoqué par le self de la fermeture
|
||||
end;
|
||||
end;
|
||||
@@ -21585,7 +21947,7 @@ begin
|
||||
{$IFDEF WIN64} // si compilé en 64 bits
|
||||
s:=s+' x64';
|
||||
{$ENDIF}
|
||||
s:=s+' (C) 2022-24 F1IWQ Gily TDR';
|
||||
s:=s+' (C) 2022-25 F1IWQ Gily TDR';
|
||||
Affiche(s,clWhite);
|
||||
|
||||
Affiche('Double cliquez sur un des liens ci-dessous',clWhite);
|
||||
@@ -22018,7 +22380,7 @@ begin
|
||||
end;
|
||||
|
||||
// informations sur les ports série/usb disponibles
|
||||
procedure GetWin32_SerialPortInfo;
|
||||
procedure DemandeSerialPortInfo;
|
||||
const
|
||||
WbemUser='';
|
||||
WbemPassword='';
|
||||
@@ -22068,12 +22430,13 @@ begin
|
||||
if i=0 then Affiche('R2 : Aucun port com sur usb',clLime);
|
||||
end;
|
||||
|
||||
// affiche les ports com série ou usb
|
||||
procedure liste_portcom ;
|
||||
begin
|
||||
try
|
||||
CoInitialize(nil); // on va utiliser Ole
|
||||
try
|
||||
GetWin32_SerialPortInfo; // chercher les ports com avec Ole
|
||||
DemandeSerialPortInfo; // chercher les ports com avec Ole
|
||||
finally
|
||||
CoUninitialize; // on a fini d'utiliser Ole
|
||||
end;
|
||||
@@ -24995,14 +25358,6 @@ begin
|
||||
Sauve_config;
|
||||
end;
|
||||
|
||||
procedure TFormPrinc.Button3Click(Sender: TObject);
|
||||
begin
|
||||
if routes_identiques(trains[3].routePref[1],trains[4].routePref[1]) then
|
||||
Affiche('oui',clred);
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TFormPrinc.MesurerlavitessedestrainsClick(Sender: TObject);
|
||||
begin
|
||||
if CDM_connecte then
|
||||
|
||||
+1
-1
@@ -222,7 +222,7 @@ object FormRoute: TFormRoute
|
||||
Top = 54
|
||||
Width = 209
|
||||
Height = 17
|
||||
Caption = 'Afficher les routes longues (en orange)'
|
||||
Caption = 'Afficher les routes longues (en gras)'
|
||||
TabOrder = 10
|
||||
OnClick = CheckBoxRoutesLonguesClick
|
||||
end
|
||||
|
||||
+16
-6
@@ -59,6 +59,7 @@ var
|
||||
FormRoute: TFormRoute;
|
||||
parcoursDet : TUneroute;
|
||||
CoulText : Tcolor;
|
||||
StyleText : integer;
|
||||
AncLigneRoute,NumRoute,AncRoute,IndexLigneRoute,IdTrainCourant,Nprop,NpropTot : integer;
|
||||
list_det_obl,list_det_int : array[1..20] of record
|
||||
adresse : integer;
|
||||
@@ -405,14 +406,18 @@ begin
|
||||
if afLongue then
|
||||
begin
|
||||
coulText:=clOrange;
|
||||
FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(CoulText)); // permet d'afficher un texte en couleurs avec l'evt onDrawItem
|
||||
StyleText:=1; // gras
|
||||
FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(integer(StyleText))); //
|
||||
//FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(CoulText)); //ne pas utiliser à cause des styles D12 - permet d'afficher un texte en couleurs avec l'evt onDrawItem
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
inc(Nprop);
|
||||
coulText:=clYellow;
|
||||
FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(CoulText)); // permet d'afficher un texte en couleurs avec l'evt onDrawItem
|
||||
StyleText:=0; // normal
|
||||
FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(integer(StyleText)));
|
||||
//FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(CoulText)); // ne pas utiliser à cause des styles D12 - permet d'afficher un texte en couleurs avec l'evt onDrawItem
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@@ -584,7 +589,7 @@ begin
|
||||
EditObligeCanton.Hint:='Numéro de cantons séparés par des virgules (10 maxi)'+#13+'Laisser vide pour aucune obligation';
|
||||
EditInterditCanton.Hint:='Numéro de cantons séparés par des virgules (10 maxi)'+#13+'Laisser vide pour aucune interdiction';
|
||||
|
||||
ListBoxRoutes.Style:=lbOwnerDrawFixed; // pour déclencher l'evt on drawitem
|
||||
ListBoxRoutes.Style:=lbOwnerDrawFixed; //pour déclencher l'evt on drawitem
|
||||
// fenêtre toujours devant
|
||||
SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize);
|
||||
end;
|
||||
@@ -728,6 +733,8 @@ end;
|
||||
|
||||
procedure TFormRoute.ListBoxRoutesDrawItem(Control: TWinControl;
|
||||
Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
||||
var fs : integer;
|
||||
s : string;
|
||||
begin
|
||||
//myBrush := TBrush.Create;
|
||||
with (Control as TListBox).Canvas do // draw on control canvas, not on the form
|
||||
@@ -746,9 +753,12 @@ begin
|
||||
//Brush.Style := bsClear;
|
||||
// TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]);
|
||||
//MyBrush.Free;
|
||||
FillRect(Rect);
|
||||
Font.Color:=TColor(ListBoxRoutes.Items.Objects[Index]);
|
||||
TextOut(Rect.Left+2, Rect.Top, ListBoxRoutes.Items[Index]);
|
||||
FillRect(Rect); // on à cause des styles
|
||||
s:=ListBoxRoutes.Items[Index];
|
||||
fs:=integer(ListBoxRoutes.Items.Objects[Index]);
|
||||
if fs=0 then font.style:=[] else font.Style:=[fsBold];
|
||||
// Font.Color:=TColor(ListBoxRoutes.Items.Objects[Index]); ne pas changer de couleur à cause des styles
|
||||
TextOut(Rect.Left+2, Rect.Top, s);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
+4
-2
@@ -53,7 +53,7 @@ object FormRouteTrain: TFormRouteTrain
|
||||
Top = 8
|
||||
Width = 585
|
||||
Height = 177
|
||||
ActivePage = TabSheetRM
|
||||
ActivePage = TabSheetRA
|
||||
TabOrder = 1
|
||||
object TabSheetRA: TTabSheet
|
||||
Caption = 'Route affect'#233'e'
|
||||
@@ -121,7 +121,9 @@ object FormRouteTrain: TFormRouteTrain
|
||||
Top = 108
|
||||
Width = 81
|
||||
Height = 33
|
||||
Hint = 'Sauve la route et l'#39'affecte '#224' ce train'
|
||||
Hint =
|
||||
'Sauve la route dans la liste des routes m'#233'moris'#233'es si elle est u' +
|
||||
'nique'
|
||||
Caption = 'Sauve route'
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
|
||||
+3
-4
@@ -294,7 +294,8 @@ begin
|
||||
else LabelRC.Caption:='Pas de route courante affectée au train '+trains[idtrain].nom_train;
|
||||
|
||||
j:=trains[idtrain].routePref[0][0].adresse;
|
||||
if j<>0 then // route mémorisée du train
|
||||
TabSheetRM.Caption:='Routes mémorisées ('+intToSTR(j)+')';
|
||||
if j<>0 then // nombre de route mémorisée du train
|
||||
begin
|
||||
s:=intToSTR(j)+' route';
|
||||
if j=1 then s:=s+' mémorisée au train ';
|
||||
@@ -351,7 +352,6 @@ begin
|
||||
if trains[indexTrainFR].roulage=0 then affiche_route_tco;
|
||||
end;
|
||||
|
||||
|
||||
procedure TFormRouteTrain.ButtonEffaceClick(Sender: TObject);
|
||||
begin
|
||||
efface_route_tco(false);
|
||||
@@ -711,7 +711,7 @@ procedure couleurs_routeTrains;
|
||||
var c : tcomponent;
|
||||
i : integer;
|
||||
begin
|
||||
if sombre then with formRouteTrain do
|
||||
if Modesombre then with formRouteTrain do
|
||||
begin
|
||||
Color:=Couleurfond;
|
||||
for i:=0 to ComponentCount-1 do
|
||||
@@ -731,7 +731,6 @@ begin
|
||||
PageControlRoutes.ActivePageIndex:=0;
|
||||
ButtonM.hint:='Affecter la route à ce train lors de sa sauvegarde et '+#13+'affecter le train au canton dans le sens de démarrage de la route';
|
||||
couleurs_RouteTrains;
|
||||
|
||||
end;
|
||||
|
||||
// choisir cette route mémorisée
|
||||
|
||||
+1
-1
@@ -420,7 +420,7 @@ procedure couleurs_SR;
|
||||
var i : integer;
|
||||
c : tComponent;
|
||||
begin
|
||||
if sombre then with formSR do
|
||||
if modesombre then with formSR do
|
||||
begin
|
||||
color:=couleurfond;
|
||||
for i:=0 to ComponentCount-1 do
|
||||
|
||||
+7
-7
@@ -24,8 +24,8 @@ object FormTCO: TFormTCO
|
||||
OnKeyPress = FormKeyPress
|
||||
OnMouseWheel = FormMouseWheel
|
||||
DesignSize = (
|
||||
997
|
||||
548)
|
||||
1005
|
||||
556)
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object LabelZoom: TLabel
|
||||
@@ -43,17 +43,17 @@ object FormTCO: TFormTCO
|
||||
ParentFont = False
|
||||
end
|
||||
object ImageTemp: TImage
|
||||
Left = 816
|
||||
Top = 8
|
||||
Width = 121
|
||||
Height = 121
|
||||
Left = 704
|
||||
Top = 0
|
||||
Width = 249
|
||||
Height = 257
|
||||
Hint = 'haha'
|
||||
Anchors = [akTop, akRight]
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
end
|
||||
object ImageTemp2: TImage
|
||||
Left = 688
|
||||
Left = 504
|
||||
Top = 137
|
||||
Width = 248
|
||||
Height = 256
|
||||
|
||||
+151
-130
@@ -416,15 +416,23 @@ const
|
||||
SensBas=4;
|
||||
// sens dans les TCO
|
||||
SensTCO_O=5; // gauche
|
||||
SensTCO_NO=9; // NO
|
||||
SensTCO_E=6; // droite
|
||||
SensTCO_N=7; // N
|
||||
SensTCO_NE=10; // NE
|
||||
SensTCO_S=8; // S
|
||||
SensTCO_NO=9; // NO
|
||||
SensTCO_NE=10; // NE
|
||||
SensTCO_SE=11; // SE
|
||||
SensTCO_SO=12; // SO
|
||||
|
||||
|
||||
// fonction replace (2=NE 3=Est 4=SE 5=S )
|
||||
Nord=1;
|
||||
NordEst=2;
|
||||
Est=3;
|
||||
SudEst=4;
|
||||
Sud=5;
|
||||
SudOuest=6;
|
||||
Ouest=7;
|
||||
NordOuest=8;
|
||||
|
||||
MaxCellX=150;MaxCellY=70;
|
||||
licone=26; // largeur icone du bas 35
|
||||
hicone=licone;
|
||||
@@ -462,7 +470,8 @@ const
|
||||
Id_cantonV=70; // "
|
||||
|
||||
|
||||
// liaisons des voies pour chaque icone par bit (0=NO 1=Nord 2=NE 3=Est 4=SE 5=S 6=SO 7=Ouest)
|
||||
// liaisons des voies pour chaque icone par N° de bit (0=NO 1=Nord 2=NE 3=Est 4=SE 5=S 6=SO 7=Ouest) 7
|
||||
// un bit à 1 indique une liaison
|
||||
Liaisons : array[0..53] of integer=
|
||||
// 0 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
|
||||
(0,$88,$c8,$8c,$98,$89,$9,$84,$90,$48,$44,$11,$19,$c4,$91,$4c,$21,$24,$42,$12,$22,$cc,$99,$66,$23,$33,$26,$62,$32,$31,0,0,
|
||||
@@ -508,7 +517,7 @@ type
|
||||
// élément graphique "canton"
|
||||
Tcanton = record
|
||||
numero : integer; // numéro du canton
|
||||
SensLoco : integer; // sens de la loco stockée sur le canton 1=gauche 2=droit 3=haut 4=bas
|
||||
SensLoco : integer; // sens de la loco stockée sur le canton 1=Sensgauche 2=Sensdroit 3=Senshaut 4=Sensbas
|
||||
Ntco : integer; // numéro du tco
|
||||
Nelements : integer; // nombre de cellules du canton
|
||||
nom : string; // nom du canton
|
||||
@@ -7001,6 +7010,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
// dessin de la loco ----------------------
|
||||
if (trains[indexTrain].icone=nil) or (Trains[indexTrain].Icone.height=0) then exit;
|
||||
|
||||
//---redimensionnement
|
||||
@@ -7037,8 +7047,11 @@ begin
|
||||
l:=TextWidth(s);
|
||||
if l<dx-xt then
|
||||
begin
|
||||
font.Style:=[];
|
||||
font.Size:=((Larg*10) div 40)+1; //((LargCell*5) div 29);
|
||||
// Affiche(intToSTR(numC)+' '+intToSTR(font.size),clYellow);
|
||||
brush.color:=coul;
|
||||
textout(xt,yt+2,s);
|
||||
textout(xt,yt,s);
|
||||
end;
|
||||
Canton[i].Xicone:=xi;
|
||||
Canton[i].Yicone:=y0;
|
||||
@@ -7065,7 +7078,6 @@ begin
|
||||
|
||||
PlgBlt(FormTCO[indexTCO].ImageTemp2.Canvas.Handle,p,
|
||||
Trains[indexTrain].Icone.canvas.Handle,0,0,largSrc,HautSrc,0,0,0); // image 180°
|
||||
// FormTCO[indexTCO].ImageTemp2.repaint;
|
||||
|
||||
// !!! TransparentBLt ne mirroire pas les images. et StretchBlt pour inverser mais assombrit l'image
|
||||
TransparentBlt(PcanvasTCO[indexTCO].Handle,xi,y0+offsetY,largDest,hautDest,
|
||||
@@ -7219,7 +7231,7 @@ begin
|
||||
Textout(xi,yi,s);
|
||||
{$ELSE}
|
||||
AffTexteIncliBordeTexture(PCanvasTCO[indexTCO],xi,yi,
|
||||
PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,coul,s+' ',900);
|
||||
PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,s+' ',900);
|
||||
{$IFEND}
|
||||
end;
|
||||
exit;
|
||||
@@ -7228,6 +7240,8 @@ begin
|
||||
// pas d'icone
|
||||
if (trains[indexTrain].icone=nil) or (Trains[indexTrain].Icone.height=0) then exit;
|
||||
|
||||
|
||||
|
||||
// ----- prépare l'icone du train
|
||||
hautdest:=round(haut/1.2);
|
||||
|
||||
@@ -7244,7 +7258,6 @@ begin
|
||||
hautdest:=(n-1)*haut;
|
||||
largDest:=round(HautDest/rd);
|
||||
end;
|
||||
//---- fin du redimensionnement
|
||||
|
||||
sens:=canton[i].SensLoco;
|
||||
case sens of
|
||||
@@ -7259,12 +7272,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Canton[i].Xicone:=x0+round(8*frx);
|
||||
Canton[i].Yicone:=y0;
|
||||
Canton[i].Licone:=LargDest;
|
||||
Canton[i].Hicone:=HautDest;
|
||||
|
||||
//PCanvasTCO[indexTCO].font.Size:=PCanvasTCO[indexTCO].font.Size+1;
|
||||
s:=canton[i].NomTrain;
|
||||
l:=TextWidth(s);
|
||||
Brush.Color:=coul;
|
||||
@@ -7276,8 +7283,15 @@ begin
|
||||
end;
|
||||
{$ELSE}
|
||||
AffTexteIncliBordeTexture(PCanvasTCO[indexTCO],xt,yt,
|
||||
PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,ClBlack,s,-900);
|
||||
PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,s,-900);
|
||||
{$IFEND}
|
||||
|
||||
|
||||
Canton[i].Xicone:=x0+round(8*frx);
|
||||
Canton[i].Yicone:=yi;
|
||||
Canton[i].Licone:=LargDest;
|
||||
Canton[i].Hicone:=HautDest;
|
||||
|
||||
if canton[i].SensLoco=SensHaut then
|
||||
begin
|
||||
with FormTCO[indexTCO].ImageTemp2.Canvas do
|
||||
@@ -7286,49 +7300,55 @@ begin
|
||||
brush.Color:=clblack;
|
||||
Rectangle(0,0,500,500);
|
||||
end;
|
||||
// matrice de copie à -90°G sans mise à l'échelle dans l'image provisoire
|
||||
// ok mais tournée dans mauvais sens (270 CW)
|
||||
p[0].X:=0;
|
||||
p[0].Y:=largSrc;
|
||||
p[1].X:=0;
|
||||
p[1].Y:=0;
|
||||
p[2].X:=HautSrc;
|
||||
p[2].Y:=LargSrc;
|
||||
{ p[0].X:=0;
|
||||
|
||||
// Mise à 90°
|
||||
p[0].X:=HautSrc;
|
||||
p[0].Y:=0;
|
||||
p[1].X:=LargDest;
|
||||
p[1].Y:=0;
|
||||
p[2].X:=LargSrc;
|
||||
p[2].Y:=HautSrc;}
|
||||
{
|
||||
If Index = 0 Then 'Rotate Left
|
||||
udtNewPoints(0).x = 0
|
||||
udtNewPoints(0).y = Picture2.ScaleHeight
|
||||
p[1].X:=HautSrc;
|
||||
p[1].Y:=LargSrc;
|
||||
p[2].X:=0;
|
||||
p[2].Y:=0;
|
||||
|
||||
udtNewPoints(1).x = 0
|
||||
udtNewPoints(1).y = 0
|
||||
PlgBlt(FormTCO[indexTCO].ImageTemp.Canvas.Handle,p,
|
||||
Trains[indexTrain].Icone.canvas.Handle,0,0,largSrc,HautSrc,0,0,0); // image 90°
|
||||
|
||||
udtNewPoints(2).x = Picture2.ScaleWidth
|
||||
udtNewPoints(2).y = Picture2.ScaleHeight
|
||||
|
||||
Else 'rotate right
|
||||
udtNewPoints(0).x = Picture2.ScaleWidth
|
||||
udtNewPoints(0).y = 0
|
||||
|
||||
udtNewPoints(1).x = Picture2.ScaleWidth
|
||||
udtNewPoints(1).y = Picture2.ScaleHeight
|
||||
|
||||
udtNewPoints(2).x = 0
|
||||
udtNewPoints(2).y = 0
|
||||
|
||||
}
|
||||
// et inversion miroir
|
||||
p[0].X:=0;
|
||||
p[0].Y:=LargSrc;
|
||||
p[1].X:=HautSrc;
|
||||
p[1].Y:=LargSrc;
|
||||
p[2].X:=0;
|
||||
p[2].Y:=0;
|
||||
|
||||
PlgBlt(FormTCO[indexTCO].ImageTemp2.Canvas.Handle,p,
|
||||
Trains[indexTrain].Icone.canvas.Handle,0,0,largSrc,HautSrc,0,0,0); // image 90°
|
||||
// FormTCO[indexTCO].ImageTemp2.repaint;
|
||||
FormTCO[indexTCO].ImageTemp.Canvas.Handle,0,0,HautSrc,largSrc,0,0,0); // image 90°
|
||||
|
||||
// copie l'image du signal retournée depuis image temporaire vers tco avec une réduction en mode transparent
|
||||
// c'est moche
|
||||
TransparentBlt(pcanvasTCO[indexTCO].Handle,x0+round(8*frx),yi,largDest,hautDest, // destination avec mise à l'échelle
|
||||
FormTCO[indexTCO].ImageTemp2.Canvas.Handle,0,0,HautSRC,LargSrc,clWhite);
|
||||
FormTCO[indexTCO].ImageTemp2.Canvas.Handle,0,0,HautSRC,LargSrc,clWhite);
|
||||
|
||||
|
||||
// StretchBlt est beau mais ne copie pas en transparent!
|
||||
//SetStretchBltMode(pCanvasTCO[indexTCO].Handle,halftone); // blackonwhite
|
||||
|
||||
|
||||
//formTCO[indexTCO].ImageTCO.Transparent:=true;
|
||||
//formTCO[indexTCO].TransparentColor:=true;
|
||||
//formTCO[indexTCO].ImageTCO.Picture.Bitmap.TransparentColor:=clwhite;
|
||||
//pCanvasTCO[indexTCO].Brush.Color:=clwhite;
|
||||
//StretchBlt(pCanvasTCO[indexTCO].Handle,x0+round(8*frx),yi,largDest,hautDest,
|
||||
// FormTCO[indexTCO].ImageTemp2.canvas.Handle,0,0,HautSRC,LargSrc,patcopy);
|
||||
|
||||
//formTCO[indexTCO].ImageTCO.Transparent:=true;
|
||||
//formTCO[indexTCO].TransparentColor:=true;
|
||||
//formTCO[indexTCO].ImageTCO.Stretch:=true;
|
||||
//pCanvasTCO[indexTCO].CopyRect(rect( x0+round(8*frx),yi,largDest,hautDest),
|
||||
// FormTCO[indexTCO].ImageTemp2.Canvas,rect(0,0,HautSrc,LargSrc));
|
||||
|
||||
//pCanvasTCO[indexTCO].Draw(x0+round(8*frx),yi,FormTCO[indexTCO].ImageTemp2.Picture.Bitmap);
|
||||
//StretchBitmapRectTransparent
|
||||
|
||||
end
|
||||
else
|
||||
begin
|
||||
@@ -7342,11 +7362,10 @@ begin
|
||||
p[2].Y:=0; //0;
|
||||
PlgBlt(FormTCO[indexTCO].ImageTemp2.Canvas.Handle,p,
|
||||
Trains[indexTrain].Icone.canvas.Handle,0,0,largSrc,HautSrc,0,0,0); // image 90°
|
||||
// FormTCO[indexTCO].ImageTemp2.repaint;
|
||||
// copie l'image du signal retournée depuis image temporaire vers tco avec une réduction en mode transparent
|
||||
TransparentBlt(pcanvasTCO[indexTCO].Handle,x0+round(8*frx),yi,largDest,hautDest, // destination avec mise à l'échelle
|
||||
FormTCO[indexTCO].ImageTemp2.Canvas.Handle,0,0,HautSrc,LargSrc,clWhite);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@@ -11468,7 +11487,7 @@ begin
|
||||
Textout(xt,yt,s);
|
||||
{$ELSE}
|
||||
AffTexteIncliBordeTexture(PCanvasTCO[indexTCO],xt,yt,
|
||||
PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,clfond,s+' ',900);
|
||||
PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,s+' ',900);
|
||||
{$IFEND}
|
||||
end;
|
||||
end;
|
||||
@@ -11854,6 +11873,8 @@ begin
|
||||
|
||||
ImageTemp2.Width:=500;
|
||||
ImageTemp2.Height:=500;
|
||||
ImageTemp.Width:=500;
|
||||
ImageTemp.Height:=500;
|
||||
|
||||
couleurAdresse:=clCyan;
|
||||
xMiniSel:=99999;yMiniSel:=99999; // coordonnées cellules
|
||||
@@ -14013,8 +14034,8 @@ begin
|
||||
|
||||
with ScrollBox do
|
||||
begin
|
||||
Width:=clLarge-55; // laisser 50 pixels pour la trackbarzoom + scrollBar
|
||||
// Width:=clLarge-400; // &&& mode pour voir les imageTemp
|
||||
if diffusion then Width:=clLarge-55 // laisser 50 pixels pour la trackbarzoom + scrollBar
|
||||
else Width:=clLarge-500; // &&& mode pour voir les imageTemp
|
||||
top:=0;
|
||||
left:=0;
|
||||
end;
|
||||
@@ -14909,7 +14930,7 @@ begin
|
||||
IdCantonDragOrg:=Id;
|
||||
lDrag:=canton[id].Licone-1;
|
||||
hDrag:=canton[id].Hicone-1;
|
||||
xg:=canton[id].Xicone+1;
|
||||
xg:=canton[id].Xicone+1; // début de l'image du train (coord absolues)
|
||||
yg:=canton[id].Yicone+1;
|
||||
|
||||
// ImageTemp <- image du canton du tco
|
||||
@@ -15493,7 +15514,7 @@ begin
|
||||
end;
|
||||
|
||||
// renvoie une icone en fonction des 4 tracés désirés
|
||||
// exemple : deux lignes qui se croisent renvoie un croisement
|
||||
// exemple : deux lignes qui se croisent renvoient un croisement
|
||||
// el = élement à remplacer
|
||||
// quadrant des 4 tracés (2=NE 3=Est 4=SE 5=S )
|
||||
// premier : si c'est le premier élément du tracé
|
||||
@@ -15509,7 +15530,7 @@ begin
|
||||
case bim of
|
||||
0 : result:=el;
|
||||
1 : begin
|
||||
if quadrant=2 then
|
||||
if quadrant=NordEst then
|
||||
begin
|
||||
if premier then
|
||||
begin
|
||||
@@ -15521,7 +15542,7 @@ begin
|
||||
end;
|
||||
if not(premier) and not(dernier) then result:=21;
|
||||
end;
|
||||
if quadrant=4 then
|
||||
if quadrant=SudEst then
|
||||
begin
|
||||
if dernier then
|
||||
begin
|
||||
@@ -15540,53 +15561,53 @@ begin
|
||||
if not(testbit(tco[indextco,x+1,y].liaisons,7)) and testbit(tco[indextco,x-1,y].liaisons,3) then result:=14;
|
||||
end;
|
||||
end;
|
||||
if quadrant=3 then result:=1;
|
||||
if quadrant=Est then result:=1;
|
||||
end;
|
||||
|
||||
2 : begin
|
||||
if quadrant=2 then
|
||||
if quadrant=NordEst then
|
||||
begin
|
||||
if premier then result:=21;
|
||||
if dernier then result:=2;
|
||||
if not(premier) and not(dernier) then result:=21;
|
||||
end;
|
||||
if quadrant=3 then result:=2;
|
||||
if quadrant=Est then result:=2;
|
||||
end;
|
||||
3 : begin
|
||||
if quadrant=2 then
|
||||
if quadrant=NordEst then
|
||||
begin
|
||||
if premier then result:=3;
|
||||
if dernier then result:=21;
|
||||
if not(premier) and not(dernier) then result:=21;
|
||||
end;
|
||||
if quadrant=3 then result:=3;
|
||||
if quadrant=Est then result:=3;
|
||||
end;
|
||||
4 : begin
|
||||
if quadrant=4 then
|
||||
if quadrant=SudEst then
|
||||
begin
|
||||
if premier then result:=4;
|
||||
if dernier then result:=22;
|
||||
if not(premier) and not(dernier) then result:=22;
|
||||
end;
|
||||
if quadrant=3 then result:=4;
|
||||
if quadrant=Est then result:=4;
|
||||
end;
|
||||
5 : begin
|
||||
if quadrant=4 then
|
||||
if quadrant=SudEst then
|
||||
begin
|
||||
if premier then result:=22;
|
||||
if dernier then result:=5;
|
||||
if not(premier) and not(dernier) then result:=22;
|
||||
end;
|
||||
if quadrant=3 then result:=5;
|
||||
if quadrant=Est then result:=5;
|
||||
end;
|
||||
6 : begin
|
||||
if quadrant=3 then
|
||||
if quadrant=Est then
|
||||
begin
|
||||
if premier then result:=6;
|
||||
if dernier then result:=5;
|
||||
if not(premier) and not(dernier) then result:=5;
|
||||
end;
|
||||
if quadrant=4 then
|
||||
if quadrant=SudEst then
|
||||
begin
|
||||
if premier then result:=12;
|
||||
if dernier then result:=6;
|
||||
@@ -15594,13 +15615,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
7 : begin
|
||||
if quadrant=3 then
|
||||
if quadrant=Est then
|
||||
begin
|
||||
if premier then result:=3;
|
||||
if dernier then result:=7;
|
||||
if not(premier) and not(dernier) then result:=3;
|
||||
end;
|
||||
if quadrant=2 then
|
||||
if quadrant=NordEst then
|
||||
begin
|
||||
if premier then result:=7;
|
||||
if dernier then result:=13;
|
||||
@@ -15608,13 +15629,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
8 : begin
|
||||
if quadrant=3 then
|
||||
if quadrant=Est then
|
||||
begin
|
||||
if premier then result:=4;
|
||||
if dernier then result:=8;
|
||||
if not(premier) and not(dernier) then result:=4;
|
||||
end;
|
||||
if quadrant=4 then
|
||||
if quadrant=SudEst then
|
||||
begin
|
||||
if premier then result:=8;
|
||||
if dernier then result:=14;
|
||||
@@ -15622,13 +15643,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
9 : begin
|
||||
if quadrant=3 then
|
||||
if quadrant=Est then
|
||||
begin
|
||||
if premier then result:=9;
|
||||
if dernier then result:=2;
|
||||
if not(premier) and not(dernier) then result:=2;
|
||||
end;
|
||||
if quadrant=2 then
|
||||
if quadrant=NordEst then
|
||||
begin
|
||||
if premier then result:=15;
|
||||
if dernier then result:=9;
|
||||
@@ -15636,8 +15657,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
10 : begin
|
||||
if quadrant=2 then result:=10;
|
||||
if quadrant=3 then
|
||||
if quadrant=NordEst then result:=10;
|
||||
if quadrant=Est then
|
||||
begin
|
||||
if premier then begin if testbit(tco[indextco,x+1,y-1].liaisons,6) then result:=15 else result:=9;end
|
||||
else
|
||||
@@ -15650,7 +15671,7 @@ begin
|
||||
if testbit(tco[indextco,x-1,y+1].liaisons,2) and not(testbit(tco[indextco,x+1,y-1].liaisons,6)) then result:=2;
|
||||
end;
|
||||
end;
|
||||
if quadrant=5 then
|
||||
if quadrant=Sud then
|
||||
begin
|
||||
if premier then
|
||||
begin
|
||||
@@ -15666,8 +15687,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
11 : begin
|
||||
if quadrant=1 then result:=19;
|
||||
if quadrant=3 then
|
||||
if quadrant=Nord then result:=19;
|
||||
if quadrant=Est then
|
||||
begin
|
||||
if dernier then begin if testbit(tco[indextco,x-1,y-1].liaisons,4) then result:=14 else result:=8;end
|
||||
else
|
||||
@@ -15680,8 +15701,8 @@ begin
|
||||
if testbit(tco[indextco,x-1,y-1].liaisons,4) and not(testbit(tco[indextco,x+1,y+1].liaisons,0)) then result:=5;
|
||||
end;
|
||||
end;
|
||||
if quadrant=4 then result:=11;
|
||||
if quadrant=5 then
|
||||
if quadrant=SudEst then result:=11;
|
||||
if quadrant=Sud then
|
||||
begin
|
||||
if dernier then
|
||||
begin
|
||||
@@ -15697,8 +15718,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
12 : begin
|
||||
if quadrant=4 then result:=12;
|
||||
if quadrant=3 then
|
||||
if quadrant=SudEst then result:=12;
|
||||
if quadrant=Est then
|
||||
begin
|
||||
if dernier then result:=22;
|
||||
if premier then result:=12;
|
||||
@@ -15706,8 +15727,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
13 : begin
|
||||
if quadrant=2 then result:=13;
|
||||
if quadrant=3 then
|
||||
if quadrant=NordEst then result:=13;
|
||||
if quadrant=Est then
|
||||
begin
|
||||
if dernier then result:=13;
|
||||
if premier then result:=21;
|
||||
@@ -15715,8 +15736,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
14 : begin
|
||||
if quadrant=4 then result:=14;
|
||||
if quadrant=3 then
|
||||
if quadrant=SudEst then result:=14;
|
||||
if quadrant=Est then
|
||||
begin
|
||||
if dernier then result:=14;
|
||||
if premier then result:=22;
|
||||
@@ -15725,8 +15746,8 @@ begin
|
||||
end;
|
||||
|
||||
15 : begin
|
||||
if quadrant=2 then result:=15;
|
||||
if quadrant=3 then
|
||||
if quadrant=NordEst then result:=15;
|
||||
if quadrant=Est then
|
||||
begin
|
||||
if dernier then result:=21;
|
||||
if premier then result:=15;
|
||||
@@ -15735,26 +15756,26 @@ begin
|
||||
end;
|
||||
|
||||
16 : begin
|
||||
if quadrant=4 then
|
||||
if quadrant=SudEst then
|
||||
begin
|
||||
if premier then result:=29;
|
||||
if dernier then result:=16;
|
||||
if not(premier) and not(dernier) then result:=29;
|
||||
end;
|
||||
if quadrant=5 then
|
||||
if quadrant=Sud then
|
||||
begin
|
||||
if testbit(tco[indextco,x,y-1].liaisons,5) then result:=24 else result:=16;
|
||||
end;
|
||||
end;
|
||||
|
||||
17 : begin
|
||||
if quadrant=2 then
|
||||
if quadrant=NordEst then
|
||||
begin
|
||||
if premier then result:=17;
|
||||
if dernier then result:=32;
|
||||
if not(premier) and not(dernier) then result:=32;
|
||||
end;
|
||||
if quadrant=5 then
|
||||
if quadrant=Sud then
|
||||
begin
|
||||
if premier then result:=17;
|
||||
if dernier then result:=26;
|
||||
@@ -15763,8 +15784,8 @@ begin
|
||||
end;
|
||||
|
||||
18 : begin
|
||||
if quadrant=2 then result:=34;
|
||||
if quadrant=5 then
|
||||
if quadrant=NordEst then result:=34;
|
||||
if quadrant=Sud then
|
||||
begin
|
||||
if premier then result:=27;
|
||||
if dernier then
|
||||
@@ -15776,15 +15797,15 @@ begin
|
||||
end;
|
||||
|
||||
19 : begin
|
||||
if quadrant=4 then result:=19;
|
||||
if quadrant=5 then
|
||||
if quadrant=SudEst then result:=19;
|
||||
if quadrant=Sud then
|
||||
begin
|
||||
result:=28;
|
||||
end;
|
||||
end;
|
||||
|
||||
20 : begin
|
||||
if (quadrant=2) then
|
||||
if (quadrant=NordEst) then
|
||||
begin
|
||||
if premier then
|
||||
begin
|
||||
@@ -15802,7 +15823,7 @@ begin
|
||||
end;
|
||||
if not(premier) and not(dernier) then result:=23;
|
||||
end;
|
||||
if quadrant=4 then
|
||||
if quadrant=SudEst then
|
||||
begin
|
||||
if dernier then
|
||||
begin
|
||||
@@ -15821,13 +15842,13 @@ begin
|
||||
end;
|
||||
if not(premier) and not(dernier) then result:=25;
|
||||
end;
|
||||
if quadrant=5 then result:=20;
|
||||
if quadrant=Sud then result:=20;
|
||||
end;
|
||||
21 : result:=21;
|
||||
22 : result:=22;
|
||||
23 : result:=23;
|
||||
24 : begin
|
||||
if quadrant=4 then
|
||||
if quadrant=SudEst then
|
||||
begin
|
||||
if dernier then
|
||||
begin
|
||||
@@ -15837,11 +15858,11 @@ begin
|
||||
if premier then result:=25;
|
||||
if not(premier) and not(dernier) then result:=25;
|
||||
end;
|
||||
if quadrant=5 then result:=24;
|
||||
if quadrant=Sud then result:=24;
|
||||
end;
|
||||
25 : result:=25;
|
||||
26 : begin
|
||||
if quadrant=2 then
|
||||
if quadrant=NordEst then
|
||||
begin
|
||||
if premier then result:=26;
|
||||
if dernier then result:=23;
|
||||
@@ -15850,17 +15871,17 @@ begin
|
||||
end;
|
||||
|
||||
27 : begin
|
||||
if quadrant=2 then
|
||||
if quadrant=NordEst then
|
||||
begin
|
||||
if premier then result:=23;
|
||||
if dernier then result:=27;
|
||||
if not(premier) and not(dernier) then result:=23;
|
||||
end;
|
||||
if quadrant=5 then result:=27;
|
||||
if quadrant=Sud then result:=27;
|
||||
end;
|
||||
|
||||
28 : begin
|
||||
if quadrant=4 then
|
||||
if quadrant=SudEst then
|
||||
begin
|
||||
if premier then result:=28;
|
||||
if dernier then
|
||||
@@ -15869,11 +15890,11 @@ begin
|
||||
end;
|
||||
if not(premier) and not(dernier) then result:=25;
|
||||
end;
|
||||
if quadrant=5 then result:=28;
|
||||
if quadrant=Sud then result:=28;
|
||||
end;
|
||||
29 : begin
|
||||
if quadrant=4 then result:=29;
|
||||
if quadrant=5 then
|
||||
if quadrant=SudEst then result:=29;
|
||||
if quadrant=Sud then
|
||||
begin
|
||||
if dernier then result:=25;
|
||||
if premier then result:=29;
|
||||
@@ -15881,8 +15902,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
32 : begin
|
||||
if quadrant=2 then result:=32;
|
||||
if quadrant=5 then
|
||||
if quadrant=NordEst then result:=32;
|
||||
if quadrant=Sud then
|
||||
begin
|
||||
if dernier then result:=23;
|
||||
if premier then
|
||||
@@ -15898,23 +15919,23 @@ begin
|
||||
end;
|
||||
end;
|
||||
33 : begin
|
||||
if quadrant=1 then
|
||||
if quadrant=Nord then
|
||||
begin
|
||||
if premier then result:=32;
|
||||
if dernier then result:=25;
|
||||
if not(premier) and not(dernier) then result:=25;
|
||||
end;
|
||||
if quadrant=5 then
|
||||
if quadrant=Sud then
|
||||
begin
|
||||
if premier then result:=25;
|
||||
if dernier then result:=33;
|
||||
if not(premier) and not(dernier) then result:=25;
|
||||
end;
|
||||
if quadrant=4 then result:=33;
|
||||
if quadrant=SudEst then result:=33;
|
||||
end;
|
||||
34 : begin
|
||||
if quadrant=2 then result:=34;
|
||||
if quadrant=5 then
|
||||
if quadrant=NordEst then result:=34;
|
||||
if quadrant=Sud then
|
||||
begin
|
||||
if dernier then result:=34;
|
||||
if premier then result:=23;
|
||||
@@ -16419,7 +16440,7 @@ begin
|
||||
begin
|
||||
stocke_undo(indextco,i,xt,yt); // stocke les points de la ligne entière dessinée
|
||||
inc(i);
|
||||
Bimage:=replace(indexTCO,xt,yt,1,3,xt=traceXY[1].x,xt=traceXY[2].x);
|
||||
Bimage:=replace(indexTCO,xt,yt,1,Est,xt=traceXY[1].x,xt=traceXY[2].x);
|
||||
tco[indextco,xt,yt].BImage:=Bimage;
|
||||
tco[indextco,xt,yt].liaisons:=liaisons[Bimage];
|
||||
end;
|
||||
@@ -16440,7 +16461,7 @@ begin
|
||||
begin
|
||||
stocke_undo(indexTCO,i,xt,yt);
|
||||
inc(i);
|
||||
Bimage:=replace(indexTCO,xt,yt,20,5,yt=traceXY[1].y,yt=traceXY[2].y);
|
||||
Bimage:=replace(indexTCO,xt,yt,20,Sud,yt=traceXY[1].y,yt=traceXY[2].y);
|
||||
tco[indextco,xt,yt].BImage:=Bimage;
|
||||
tco[indextco,xt,yt].liaisons:=liaisons[Bimage];
|
||||
end;
|
||||
@@ -16467,7 +16488,7 @@ begin
|
||||
begin
|
||||
stocke_undo(indexTCO,i,xt,yt);
|
||||
inc(i);
|
||||
Bimage:=replace(indexTCO,xt,yt,11,4,xt=traceXY[1].x,xt=traceXY[2].x);
|
||||
Bimage:=replace(indexTCO,xt,yt,11,SudEst,xt=traceXY[1].x,xt=traceXY[2].x);
|
||||
tco[indextco,xt,yt].BImage:=Bimage;
|
||||
tco[indextco,xt,yt].liaisons:=liaisons[Bimage];
|
||||
inc(yt);
|
||||
@@ -16483,8 +16504,8 @@ begin
|
||||
for xt:=traceXY[1].x to traceXY[2].x do
|
||||
begin
|
||||
stocke_undo(indexTCO,i,xt,yt);
|
||||
inc(i);
|
||||
Bimage:=replace(indexTCO,xt,yt,10,2,xt=traceXY[1].x,xt=traceXY[2].x);
|
||||
inc(i);
|
||||
Bimage:=replace(indexTCO,xt,yt,10,NordEst,xt=traceXY[1].x,xt=traceXY[2].x);
|
||||
tco[indextco,xt,yt].BImage:=Bimage;
|
||||
tco[indextco,xt,yt].liaisons:=liaisons[Bimage];
|
||||
dec(yt);
|
||||
@@ -18915,7 +18936,7 @@ begin
|
||||
Ypix:=(y-1)*HauteurCell[indexTCO];
|
||||
|
||||
milieuX_pix:=xpix+(canton[idcantonDest].Nelements*largeurCell[indexTCO] div 2);
|
||||
milieuY_pix:=Ypix+(canton[idcantonDest].Nelements*HauteurCell[indexTCO] div 2);
|
||||
milieuY_pix:=ypix+(canton[idcantonDest].Nelements*HauteurCell[indexTCO] div 2);
|
||||
|
||||
if canton[idcantonDest].horizontal then
|
||||
begin
|
||||
@@ -18933,10 +18954,11 @@ begin
|
||||
begin
|
||||
s:='Le sens de circulation du canton '+intToSTR(canton[idcantonDest].numero)+' ne permet pas de positionner le train dans ce sens';
|
||||
formTCO[indexTCO].Caption:=s;
|
||||
//Affiche(intToSTR(ypix),clred);
|
||||
Affiche_TCO(indexTCO);
|
||||
FormInfo.LabelInfo.caption:=s;
|
||||
FormInfo.Top:=Ypix;
|
||||
FormInfo.Left:=Xpix;
|
||||
FormInfo.Top:=Ypix-ScrollBox.VertScrollBar.Position;
|
||||
FormInfo.Left:=Xpix-ScrollBox.HorzScrollBar.Position;
|
||||
|
||||
FormInfo.Show;
|
||||
exit;
|
||||
@@ -19046,6 +19068,5 @@ end;
|
||||
|
||||
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+1902
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,855 @@
|
||||
// **************************************************************************************************
|
||||
//
|
||||
// Unit Vcl.Styles.Utils.Misc
|
||||
// unit for the VCL Styles Utils
|
||||
// https://github.com/RRUZ/vcl-styles-utils/
|
||||
//
|
||||
// The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");
|
||||
// you may not use this file except in compliance with the License. You may obtain a copy of the
|
||||
// License at http://www.mozilla.org/MPL/
|
||||
//
|
||||
// Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF
|
||||
// ANY KIND, either express or implied. See the License for the specific language governing rights
|
||||
// and limitations under the License.
|
||||
//
|
||||
// The Original Code is Vcl.Styles.Utils.Misc.pas.
|
||||
//
|
||||
// Portions created by Rodrigo Ruz V. are Copyright (C) 2013-2023 Rodrigo Ruz V.
|
||||
// All Rights Reserved.
|
||||
//
|
||||
// **************************************************************************************************
|
||||
unit Vcl.Styles.Utils.Misc;
|
||||
|
||||
{$I VCL.Styles.Utils.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Winapi.Messages,
|
||||
Winapi.Windows;
|
||||
|
||||
{ .$DEFINE EventLog }
|
||||
function GetWindowClassName(Window: HWND): String;
|
||||
function RectVCenter(var R: TRect; const Bounds: TRect): TRect;
|
||||
procedure MoveWindowOrg(DC: HDC; const DX, DY: Integer);
|
||||
{$IFDEF EventLog}
|
||||
procedure AddToLog(const Msg: TMessage); overload;
|
||||
procedure AddToLog(const S: string; const Value: Integer); overload;
|
||||
procedure AddToLog(const Msg: string); overload;
|
||||
function WM_To_String(const WM_Message: Integer): string;
|
||||
{$ENDIF}
|
||||
function ExecutingInMainThread: boolean;
|
||||
function GetSysMetrics(nIndex: Integer): Integer;
|
||||
|
||||
var
|
||||
GlobalMainThreadID: TThreadID = 0;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Winapi.CommCtrl,
|
||||
System.SysUtils,
|
||||
Vcl.Forms;
|
||||
|
||||
function ExecutingInMainThread: boolean;
|
||||
begin
|
||||
// VCL is not thread safe and some components like CEF will create Windows
|
||||
// controls in secondary threads. It's strongly recommended to define
|
||||
// LimitStylesToMainApplicationThread in VCL.Styles.Utils.inc if you see
|
||||
// dialogs or controls partially themed.
|
||||
{$IFDEF LimitStylesToMainApplicationThread}
|
||||
Result := (GetCurrentThreadId = MainThreadId);
|
||||
{$ELSE}
|
||||
Result := True;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function GetSysMetrics(nIndex: Integer): Integer;
|
||||
begin
|
||||
{$IF (CompilerVersion >= 33)}
|
||||
if TOSVersion.Check(10) and (TOSVersion.Build >= 14393) then
|
||||
begin
|
||||
// Windows 10, version 1607 or higher
|
||||
if Assigned(Application.Mainform) then
|
||||
Result := GetSystemMetricsForDPI(nIndex, Application.Mainform.Monitor.PixelsPerInch)
|
||||
else
|
||||
Result := GetSystemMetricsForDPI(nIndex, Screen.PixelsPerInch);
|
||||
end
|
||||
else
|
||||
Result := GetSystemMetrics(nIndex);
|
||||
{$ELSE}
|
||||
Result := GetSystemMetrics(nIndex);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{$IFDEF EventLog}
|
||||
|
||||
{ Useful functions when debugging }
|
||||
procedure AddToLog(const Msg: TMessage);
|
||||
begin
|
||||
with Msg do
|
||||
OutputDebugString(PChar(FormatDateTime('hh:nn:ss.zzz', Now) + ' Msg = ' + WM_To_String(Msg) + ' wParam = ' +
|
||||
IntToStr(wParam) + ' LParam = ' + IntToStr(lParam)));
|
||||
end;
|
||||
|
||||
procedure AddToLog(const S: string; const Value: Integer);
|
||||
begin
|
||||
OutputDebugString(PChar((S) + ' = ' + IntToStr(Value)));
|
||||
end;
|
||||
|
||||
procedure AddToLog(const Msg: string);
|
||||
begin
|
||||
OutputDebugString(PChar(Msg));
|
||||
end;
|
||||
|
||||
function WM_To_String(const WM_Message: Integer): string;
|
||||
begin
|
||||
case WM_Message of
|
||||
$0000:
|
||||
Result := 'WM_NULL';
|
||||
$0001:
|
||||
Result := 'WM_CREATE';
|
||||
$0002:
|
||||
Result := 'WM_DESTROY';
|
||||
$0003:
|
||||
Result := 'WM_MOVE';
|
||||
$0005:
|
||||
Result := 'WM_SIZE';
|
||||
$0006:
|
||||
Result := 'WM_ACTIVATE';
|
||||
$0007:
|
||||
Result := 'WM_SETFOCUS';
|
||||
$0008:
|
||||
Result := 'WM_KILLFOCUS';
|
||||
$000A:
|
||||
Result := 'WM_ENABLE';
|
||||
$000B:
|
||||
Result := 'WM_SETREDRAW';
|
||||
$000C:
|
||||
Result := 'WM_SETTEXT';
|
||||
$000D:
|
||||
Result := 'WM_GETTEXT';
|
||||
$000E:
|
||||
Result := 'WM_GETTEXTLENGTH';
|
||||
$000F:
|
||||
Result := 'WM_PAINT';
|
||||
$0010:
|
||||
Result := 'WM_CLOSE';
|
||||
$0011:
|
||||
Result := 'WM_QUERYENDSESSION';
|
||||
$0012:
|
||||
Result := 'WM_QUIT';
|
||||
$0013:
|
||||
Result := 'WM_QUERYOPEN';
|
||||
$0014:
|
||||
Result := 'WM_ERASEBKGND';
|
||||
$0015:
|
||||
Result := 'WM_SYSCOLORCHANGE';
|
||||
$0016:
|
||||
Result := 'WM_EndSESSION';
|
||||
$0017:
|
||||
Result := 'WM_SYSTEMERROR';
|
||||
$0018:
|
||||
Result := 'WM_SHOWWINDOW';
|
||||
$0019:
|
||||
Result := 'WM_CTLCOLOR';
|
||||
$001A:
|
||||
Result := 'WM_WININICHANGE or WM_SETTINGCHANGE';
|
||||
$001B:
|
||||
Result := 'WM_DEVMODECHANGE';
|
||||
$001C:
|
||||
Result := 'WM_ACTIVATEAPP';
|
||||
$001D:
|
||||
Result := 'WM_FONTCHANGE';
|
||||
$001E:
|
||||
Result := 'WM_TIMECHANGE';
|
||||
$001F:
|
||||
Result := 'WM_CANCELMODE';
|
||||
$0020:
|
||||
Result := 'WM_SETCURSOR';
|
||||
$0021:
|
||||
Result := 'WM_MOUSEACTIVATE';
|
||||
$0022:
|
||||
Result := 'WM_CHILDACTIVATE';
|
||||
$0023:
|
||||
Result := 'WM_QUEUESYNC';
|
||||
$0024:
|
||||
Result := 'WM_GETMINMAXINFO';
|
||||
$0026:
|
||||
Result := 'WM_PAINTICON';
|
||||
$0027:
|
||||
Result := 'WM_ICONERASEBKGND';
|
||||
$0028:
|
||||
Result := 'WM_NEXTDLGCTL';
|
||||
$002A:
|
||||
Result := 'WM_SPOOLERSTATUS';
|
||||
$002B:
|
||||
Result := 'WM_DRAWITEM';
|
||||
$002C:
|
||||
Result := 'WM_MEASUREITEM';
|
||||
$002D:
|
||||
Result := 'WM_DELETEITEM';
|
||||
$002E:
|
||||
Result := 'WM_VKEYTOITEM';
|
||||
$002F:
|
||||
Result := 'WM_CHARTOITEM';
|
||||
$0030:
|
||||
Result := 'WM_SETFONT';
|
||||
$0031:
|
||||
Result := 'WM_GETFONT';
|
||||
$0032:
|
||||
Result := 'WM_SETHOTKEY';
|
||||
$0033:
|
||||
Result := 'WM_GETHOTKEY';
|
||||
$0037:
|
||||
Result := 'WM_QUERYDRAGICON';
|
||||
$0039:
|
||||
Result := 'WM_COMPAREITEM';
|
||||
$003D:
|
||||
Result := 'WM_GETOBJECT';
|
||||
$0041:
|
||||
Result := 'WM_COMPACTING';
|
||||
$0044:
|
||||
Result := 'WM_COMMNOTIFY { obsolete in Win32}';
|
||||
$0046:
|
||||
Result := 'WM_WINDOWPOSCHANGING';
|
||||
$0047:
|
||||
Result := 'WM_WINDOWPOSCHANGED';
|
||||
$0048:
|
||||
Result := 'WM_POWER';
|
||||
$004A:
|
||||
Result := 'WM_COPYDATA';
|
||||
$004B:
|
||||
Result := 'WM_CANCELJOURNAL';
|
||||
$004E:
|
||||
Result := 'WM_NOTIFY';
|
||||
$0050:
|
||||
Result := 'WM_INPUTLANGCHANGEREQUEST';
|
||||
$0051:
|
||||
Result := 'WM_INPUTLANGCHANGE';
|
||||
$0052:
|
||||
Result := 'WM_TCARD';
|
||||
$0053:
|
||||
Result := 'WM_HELP';
|
||||
$0054:
|
||||
Result := 'WM_USERCHANGED';
|
||||
$0055:
|
||||
Result := 'WM_NOTIFYFORMAT';
|
||||
$007B:
|
||||
Result := 'WM_CONTEXTMENU';
|
||||
$007C:
|
||||
Result := 'WM_STYLECHANGING';
|
||||
$007D:
|
||||
Result := 'WM_STYLECHANGED';
|
||||
$007E:
|
||||
Result := 'WM_DISPLAYCHANGE';
|
||||
$007F:
|
||||
Result := 'WM_GETICON';
|
||||
$0080:
|
||||
Result := 'WM_SETICON';
|
||||
$0081:
|
||||
Result := 'WM_NCCREATE';
|
||||
$0082:
|
||||
Result := 'WM_NCDESTROY';
|
||||
$0083:
|
||||
Result := 'WM_NCCALCSIZE';
|
||||
$0084:
|
||||
Result := 'WM_NCHITTEST';
|
||||
$0085:
|
||||
Result := 'WM_NCPAINT';
|
||||
$0086:
|
||||
Result := 'WM_NCACTIVATE';
|
||||
$0087:
|
||||
Result := 'WM_GETDLGCODE';
|
||||
$0088:
|
||||
Result := 'WM_SYNCPAINT';
|
||||
$00A0:
|
||||
Result := 'WM_NCMOUSEMOVE';
|
||||
$00A1:
|
||||
Result := 'WM_NCLBUTTONDOWN';
|
||||
$00A2:
|
||||
Result := 'WM_NCLBUTTONUP';
|
||||
$00A3:
|
||||
Result := 'WM_NCLBUTTONDBLCLK';
|
||||
$00A4:
|
||||
Result := 'WM_NCRBUTTONDOWN';
|
||||
$00A5:
|
||||
Result := 'WM_NCRBUTTONUP';
|
||||
$00A6:
|
||||
Result := 'WM_NCRBUTTONDBLCLK';
|
||||
$00A7:
|
||||
Result := 'WM_NCMBUTTONDOWN';
|
||||
$00A8:
|
||||
Result := 'WM_NCMBUTTONUP';
|
||||
$00A9:
|
||||
Result := 'WM_NCMBUTTONDBLCLK';
|
||||
// edit control messages start (todo: add more if needed)
|
||||
$00B0:
|
||||
Result := 'EM_GETSEL';
|
||||
$00B1:
|
||||
Result := 'EM_SETSEL';
|
||||
$00B2:
|
||||
Result := 'EM_GETRECT';
|
||||
$00B3:
|
||||
Result := 'EM_SETRECT';
|
||||
$00B4:
|
||||
Result := 'EM_SETRECTNP';
|
||||
$00B5:
|
||||
Result := 'EM_SCROLL';
|
||||
$00B6:
|
||||
Result := 'EM_LINESCROLL';
|
||||
$00B7:
|
||||
Result := 'EM_SCROLLCARET';
|
||||
$00B8:
|
||||
Result := 'EM_GETMODIFY';
|
||||
$00B9:
|
||||
Result := 'EM_SETMODIFY';
|
||||
$00BA:
|
||||
Result := 'EM_GETLINECOUNT';
|
||||
$00BB:
|
||||
Result := 'EM_LINEINDEX';
|
||||
$00BC:
|
||||
Result := 'EM_SETHANDLE';
|
||||
$00BD:
|
||||
Result := 'EM_GETHANDLE';
|
||||
$00BE:
|
||||
Result := 'EM_GETTHUMB';
|
||||
$00C1:
|
||||
Result := 'EM_LINELENGTH';
|
||||
$00C2:
|
||||
Result := 'EM_REPLACESEL';
|
||||
$00C4:
|
||||
Result := 'EM_GETLINE';
|
||||
$00C5:
|
||||
Result := 'EM_LIMITTEXT';
|
||||
$00C6:
|
||||
Result := 'EM_CANUNDO';
|
||||
$00C7:
|
||||
Result := 'EM_UNDO';
|
||||
$00C8:
|
||||
Result := 'EM_FMTLINES';
|
||||
$00C9:
|
||||
Result := 'EM_LINEFROMCHAR';
|
||||
$00CB:
|
||||
Result := 'EM_SETTABSTOPS';
|
||||
$00CC:
|
||||
Result := 'EM_SETPASSWORDCHAR';
|
||||
$00CD:
|
||||
Result := 'EM_EMPTYUNDOBUFFER';
|
||||
$00CE:
|
||||
Result := 'EM_GETFIRSTVISIBLELINE';
|
||||
$00CF:
|
||||
Result := 'EM_SETREADONLY';
|
||||
$00D0:
|
||||
Result := 'EM_SETWORDBREAKPROC';
|
||||
$00D1:
|
||||
Result := 'EM_GETWORDBREAKPROC';
|
||||
$00D2:
|
||||
Result := 'EM_GETPASSWORDCHAR';
|
||||
$00D3:
|
||||
Result := 'EM_SETMARGINS';
|
||||
$00D4:
|
||||
Result := 'EM_GETMARGINS';
|
||||
$00D5:
|
||||
Result := 'EM_GETLIMITTEXT';
|
||||
$00D6:
|
||||
Result := 'EM_POSFROMCHAR';
|
||||
$00D7:
|
||||
Result := 'EM_CHARFROMPOS';
|
||||
// edit control messages end
|
||||
// scrollbar control messages start
|
||||
$00E0:
|
||||
Result := 'SBM_SETPOS';
|
||||
$00E1:
|
||||
Result := 'SBM_GETPOS';
|
||||
$00E2:
|
||||
Result := 'SBM_SETRANGE';
|
||||
$00E3:
|
||||
Result := 'SBM_GETRANGE';
|
||||
$00E4:
|
||||
Result := 'SBM_ENABLE_ARROWS';
|
||||
$00E6:
|
||||
Result := 'SBM_SETRANGEREDRAW';
|
||||
$00E9:
|
||||
Result := 'SBM_SETSCROLLINFO';
|
||||
$00EA:
|
||||
Result := 'SBM_GETSCROLLINFO';
|
||||
$00EB:
|
||||
Result := 'SBM_GETSCROLLBARINFO';
|
||||
// scrollbar control messages end
|
||||
// button control messages start
|
||||
$00F0:
|
||||
Result := 'BM_GETCHECK';
|
||||
$00F1:
|
||||
Result := 'BM_SETCHECK';
|
||||
$00F2:
|
||||
Result := 'BM_GETSTATE';
|
||||
$00F3:
|
||||
Result := 'BM_SETSTATE';
|
||||
$00F4:
|
||||
Result := 'BM_SETSTYLE';
|
||||
$00F5:
|
||||
Result := 'BM_CLICK';
|
||||
$00F6:
|
||||
Result := 'BM_GETIMAGE';
|
||||
$00F7:
|
||||
Result := 'BM_SETIMAGE';
|
||||
$00F8:
|
||||
Result := 'BM_SETDONTCLICK';
|
||||
|
||||
$0090:
|
||||
Result := 'WM_UAHDESTROYWINDOW';
|
||||
$0091:
|
||||
Result := 'WM_UAHDRAWMENU';
|
||||
$0092:
|
||||
Result := 'WM_UAHDRAWMENUITEM';
|
||||
$0093:
|
||||
Result := 'WM_UAHINITMENU';
|
||||
$0094:
|
||||
Result := 'WM_UAHMEASUREMENUITEM';
|
||||
$0095:
|
||||
Result := 'WM_UAHNCPAINTMENUPOPUP';
|
||||
|
||||
$01E0:
|
||||
Result := 'MN_SETHMENU';
|
||||
$01E1:
|
||||
Result := 'MN_GETHMENU';
|
||||
$01E2:
|
||||
Result := 'MN_SIZEWINDOW';
|
||||
$01E3:
|
||||
Result := 'MN_OPENHIERARCHY';
|
||||
$01E4:
|
||||
Result := 'MN_CLOSEHIERARCHY';
|
||||
$01E5:
|
||||
Result := 'MN_SELECTITEM';
|
||||
$01E6:
|
||||
Result := 'MN_CANCELMENUS';
|
||||
$01E7:
|
||||
Result := 'MN_SELECTFIRSTVALIDITEM';
|
||||
|
||||
$01EA:
|
||||
Result := 'MN_GETPPOPUPMENU';
|
||||
$01EB:
|
||||
Result := 'MN_FINDMENUWINDOWFROMPOINT';
|
||||
$01EC:
|
||||
Result := 'MN_SHOWPOPUPWINDOW';
|
||||
$01ED:
|
||||
Result := 'MN_BUTTONDOWN';
|
||||
$01F0:
|
||||
Result := 'MN_SETTIMERTOOPENHIERARCHY';
|
||||
$01F1:
|
||||
Result := 'MN_DBLCLK';
|
||||
$01F2:
|
||||
Result := 'MN_ENDMENU';
|
||||
$01F3:
|
||||
Result := 'MN_DODRAGDROP';
|
||||
|
||||
// button control messages end
|
||||
$0100:
|
||||
Result := 'WM_KEYFIRST or WM_KEYDOWN';
|
||||
$0101:
|
||||
Result := 'WM_KEYUP';
|
||||
$0102:
|
||||
Result := 'WM_CHAR';
|
||||
$0103:
|
||||
Result := 'WM_DEADCHAR';
|
||||
$0104:
|
||||
Result := 'WM_SYSKEYDOWN';
|
||||
$0105:
|
||||
Result := 'WM_SYSKEYUP';
|
||||
$0106:
|
||||
Result := 'WM_SYSCHAR';
|
||||
$0107:
|
||||
Result := 'WM_SYSDEADCHAR';
|
||||
$0108:
|
||||
Result := 'WM_KEYLAST';
|
||||
$010D:
|
||||
Result := 'WM_IME_STARTCOMPOSITION';
|
||||
$010E:
|
||||
Result := 'WM_IME_ENDCOMPOSITION';
|
||||
$010F:
|
||||
Result := 'WM_IME_COMPOSITION or WM_IME_KEYLAST';
|
||||
$0110:
|
||||
Result := 'WM_INITDIALOG';
|
||||
$0111:
|
||||
Result := 'WM_COMMAND';
|
||||
$0112:
|
||||
Result := 'WM_SYSCOMMAND';
|
||||
$0113:
|
||||
Result := 'WM_TIMER';
|
||||
$0114:
|
||||
Result := 'WM_HSCROLL';
|
||||
$0115:
|
||||
Result := 'WM_VSCROLL';
|
||||
$0116:
|
||||
Result := 'WM_INITMENU';
|
||||
$0117:
|
||||
Result := 'WM_INITMENUPOPUP';
|
||||
$011F:
|
||||
Result := 'WM_MENUSELECT';
|
||||
$0120:
|
||||
Result := 'WM_MENUCHAR';
|
||||
$0121:
|
||||
Result := 'WM_ENTERIDLE';
|
||||
$0122:
|
||||
Result := 'WM_MENURBUTTONUP';
|
||||
$0123:
|
||||
Result := 'WM_MENUDRAG';
|
||||
$0124:
|
||||
Result := 'WM_MENUGETOBJECT';
|
||||
$0125:
|
||||
Result := 'WM_UNINITMENUPOPUP';
|
||||
$0126:
|
||||
Result := 'WM_MENUCOMMAND';
|
||||
$0127:
|
||||
Result := 'WM_CHANGEUISTATE';
|
||||
$0128:
|
||||
Result := 'WM_UPDATEUISTATE';
|
||||
$0129:
|
||||
Result := 'WM_QUERYUISTATE';
|
||||
$0132:
|
||||
Result := 'WM_CTLCOLORMSGBOX';
|
||||
$0133:
|
||||
Result := 'WM_CTLCOLOREDIT';
|
||||
$0134:
|
||||
Result := 'WM_CTLCOLORLISTBOX';
|
||||
$0135:
|
||||
Result := 'WM_CTLCOLORBTN';
|
||||
$0136:
|
||||
Result := 'WM_CTLCOLORDLG';
|
||||
$0137:
|
||||
Result := 'WM_CTLCOLORSCROLLBAR';
|
||||
$0138:
|
||||
Result := 'WM_CTLCOLORSTATIC';
|
||||
$0140:
|
||||
Result := 'CB_GETEDITSEL';
|
||||
$0141:
|
||||
Result := 'CB_LIMITTEXT';
|
||||
$0142:
|
||||
Result := 'CB_SETEDITSEL';
|
||||
$0143:
|
||||
Result := 'CB_ADDSTRING';
|
||||
$0144:
|
||||
Result := 'CB_DELETESTRING';
|
||||
$0145:
|
||||
Result := 'CB_DIR';
|
||||
$0146:
|
||||
Result := 'CB_GETCOUNT';
|
||||
$0147:
|
||||
Result := 'CB_GETCURSEL';
|
||||
$0148:
|
||||
Result := 'CB_GETLBTEXT';
|
||||
$0149:
|
||||
Result := 'CB_GETLBTEXTLEN';
|
||||
$014A:
|
||||
Result := 'CB_INSERTSTRING';
|
||||
$014B:
|
||||
Result := 'CB_RESETCONTENT';
|
||||
$014C:
|
||||
Result := 'CB_FINDSTRING';
|
||||
$014D:
|
||||
Result := 'CB_SELECTSTRING';
|
||||
$014E:
|
||||
Result := 'CB_SETCURSEL';
|
||||
$014F:
|
||||
Result := 'CB_SHOWDROPDOWN';
|
||||
$0150:
|
||||
Result := 'CB_GETITEMDATA';
|
||||
$0151:
|
||||
Result := 'CB_SETITEMDATA';
|
||||
$0152:
|
||||
Result := 'CB_GETDROPPEDCONTROLRECT';
|
||||
$0153:
|
||||
Result := 'CB_SETITEMHEIGHT';
|
||||
$0154:
|
||||
Result := 'CB_GETITEMHEIGHT';
|
||||
$0155:
|
||||
Result := 'CB_SETEXTENDEDUI';
|
||||
$0156:
|
||||
Result := 'CB_GETEXTENDEDUI';
|
||||
$0157:
|
||||
Result := 'CB_GETDROPPEDSTATE';
|
||||
$0158:
|
||||
Result := 'CB_FINDSTRINGEXACT';
|
||||
$0159:
|
||||
Result := 'CB_SETLOCALE';
|
||||
$015A:
|
||||
Result := 'CB_GETLOCALE';
|
||||
$015B:
|
||||
Result := 'CB_GETTOPINDEX';
|
||||
$015C:
|
||||
Result := 'CB_SETTOPINDEX';
|
||||
$015D:
|
||||
Result := 'CB_GETHORIZONTALEXTENT';
|
||||
$015E:
|
||||
Result := 'CB_SETHORIZONTALEXTENT';
|
||||
$015F:
|
||||
Result := 'CB_GETDROPPEDWIDTH';
|
||||
$0160:
|
||||
Result := 'CB_SETDROPPEDWIDTH';
|
||||
$0161:
|
||||
Result := 'CB_INITSTORAGE';
|
||||
$0163:
|
||||
Result := 'CB_MULTIPLEADDSTRING';
|
||||
$0164:
|
||||
Result := 'CB_GETCOMBOBOXINFO';
|
||||
$0200:
|
||||
Result := 'WM_MOUSEFIRST or WM_MOUSEMOVE';
|
||||
$0201:
|
||||
Result := 'WM_LBUTTONDOWN';
|
||||
$0202:
|
||||
Result := 'WM_LBUTTONUP';
|
||||
$0203:
|
||||
Result := 'WM_LBUTTONDBLCLK';
|
||||
$0204:
|
||||
Result := 'WM_RBUTTONDOWN';
|
||||
$0205:
|
||||
Result := 'WM_RBUTTONUP';
|
||||
$0206:
|
||||
Result := 'WM_RBUTTONDBLCLK';
|
||||
$0207:
|
||||
Result := 'WM_MBUTTONDOWN';
|
||||
$0208:
|
||||
Result := 'WM_MBUTTONUP';
|
||||
$0209:
|
||||
Result := 'WM_MBUTTONDBLCLK';
|
||||
$020A:
|
||||
Result := 'WM_MOUSEWHEEL or WM_MOUSELAST';
|
||||
$0210:
|
||||
Result := 'WM_PARENTNOTIFY';
|
||||
$0211:
|
||||
Result := 'WM_ENTERMENULOOP';
|
||||
$0212:
|
||||
Result := 'WM_EXITMENULOOP';
|
||||
$0213:
|
||||
Result := 'WM_NEXTMENU';
|
||||
$0214:
|
||||
Result := 'WM_SIZING';
|
||||
$0215:
|
||||
Result := 'WM_CAPTURECHANGED';
|
||||
$0216:
|
||||
Result := 'WM_MOVING';
|
||||
$0218:
|
||||
Result := 'WM_POWERBROADCAST';
|
||||
$0219:
|
||||
Result := 'WM_DEVICECHANGE';
|
||||
$0220:
|
||||
Result := 'WM_MDICREATE';
|
||||
$0221:
|
||||
Result := 'WM_MDIDESTROY';
|
||||
$0222:
|
||||
Result := 'WM_MDIACTIVATE';
|
||||
$0223:
|
||||
Result := 'WM_MDIRESTORE';
|
||||
$0224:
|
||||
Result := 'WM_MDINEXT';
|
||||
$0225:
|
||||
Result := 'WM_MDIMAXIMIZE';
|
||||
$0226:
|
||||
Result := 'WM_MDITILE';
|
||||
$0227:
|
||||
Result := 'WM_MDICASCADE';
|
||||
$0228:
|
||||
Result := 'WM_MDIICONARRANGE';
|
||||
$0229:
|
||||
Result := 'WM_MDIGETACTIVE';
|
||||
$0230:
|
||||
Result := 'WM_MDISETMENU';
|
||||
$0231:
|
||||
Result := 'WM_ENTERSIZEMOVE';
|
||||
$0232:
|
||||
Result := 'WM_EXITSIZEMOVE';
|
||||
$0233:
|
||||
Result := 'WM_DROPFILES';
|
||||
$0234:
|
||||
Result := 'WM_MDIREFRESHMENU';
|
||||
$0281:
|
||||
Result := 'WM_IME_SETCONTEXT';
|
||||
$0282:
|
||||
Result := 'WM_IME_NOTIFY';
|
||||
$0283:
|
||||
Result := 'WM_IME_CONTROL';
|
||||
$0284:
|
||||
Result := 'WM_IME_COMPOSITIONFULL';
|
||||
$0285:
|
||||
Result := 'WM_IME_SELECT';
|
||||
$0286:
|
||||
Result := 'WM_IME_CHAR';
|
||||
$0288:
|
||||
Result := 'WM_IME_REQUEST';
|
||||
$0290:
|
||||
Result := 'WM_IME_KEYDOWN';
|
||||
$0291:
|
||||
Result := 'WM_IME_KEYUP';
|
||||
$02A1:
|
||||
Result := 'WM_MOUSEHOVER';
|
||||
$02A2:
|
||||
Result := 'WM_NCMOUSELEAVE';
|
||||
$02A3:
|
||||
Result := 'WM_MOUSELEAVE';
|
||||
$0300:
|
||||
Result := 'WM_CUT';
|
||||
$0301:
|
||||
Result := 'WM_COPY';
|
||||
$0302:
|
||||
Result := 'WM_PASTE';
|
||||
$0303:
|
||||
Result := 'WM_CLEAR';
|
||||
$0304:
|
||||
Result := 'WM_UNDO';
|
||||
$0305:
|
||||
Result := 'WM_RENDERFORMAT';
|
||||
$0306:
|
||||
Result := 'WM_RENDERALLFORMATS';
|
||||
$0307:
|
||||
Result := 'WM_DESTROYCLIPBOARD';
|
||||
$0308:
|
||||
Result := 'WM_DRAWCLIPBOARD';
|
||||
$0309:
|
||||
Result := 'WM_PAINTCLIPBOARD';
|
||||
$030A:
|
||||
Result := 'WM_VSCROLLCLIPBOARD';
|
||||
$030B:
|
||||
Result := 'WM_SIZECLIPBOARD';
|
||||
$030C:
|
||||
Result := 'WM_ASKCBFORMATNAME';
|
||||
$030D:
|
||||
Result := 'WM_CHANGECBCHAIN';
|
||||
$030E:
|
||||
Result := 'WM_HSCROLLCLIPBOARD';
|
||||
$030F:
|
||||
Result := 'WM_QUERYNEWPALETTE';
|
||||
$0310:
|
||||
Result := 'WM_PALETTEISCHANGING';
|
||||
$0311:
|
||||
Result := 'WM_PALETTECHANGED';
|
||||
$0312:
|
||||
Result := 'WM_HOTKEY';
|
||||
$0317:
|
||||
Result := 'WM_PRINT';
|
||||
$0318:
|
||||
Result := 'WM_PRINTCLIENT';
|
||||
$031F:
|
||||
Result := 'WM_DWMNCRENDERINGCHANGED';
|
||||
$0358:
|
||||
Result := 'WM_HANDHELDFIRST';
|
||||
$035F:
|
||||
Result := 'WM_HANDHELDLAST';
|
||||
$0380:
|
||||
Result := 'WM_PENWINFIRST';
|
||||
$038F:
|
||||
Result := 'WM_PENWINLAST';
|
||||
$0390:
|
||||
Result := 'WM_COALESCE_FIRST';
|
||||
$039F:
|
||||
Result := 'WM_COALESCE_LAST';
|
||||
$03E0:
|
||||
Result := 'WM_DDE_FIRST or WM_DDE_INITIATE';
|
||||
$03E1:
|
||||
Result := 'WM_DDE_TERMINATE';
|
||||
$03E2:
|
||||
Result := 'WM_DDE_ADVISE';
|
||||
$03E3:
|
||||
Result := 'WM_DDE_UNADVISE';
|
||||
$03E4:
|
||||
Result := 'WM_DDE_ACK';
|
||||
$03E5:
|
||||
Result := 'WM_DDE_DATA';
|
||||
$03E6:
|
||||
Result := 'WM_DDE_REQUEST';
|
||||
$03E7:
|
||||
Result := 'WM_DDE_POKE';
|
||||
$03E8:
|
||||
Result := 'WM_DDE_EXECUTE or WM_DDE_LAST';
|
||||
$0400:
|
||||
Result := 'WM_USER';
|
||||
// progress bar
|
||||
$0401:
|
||||
Result := 'PBM_SETRANGE';
|
||||
$0402:
|
||||
Result := 'PBM_SETPOS';
|
||||
$0403:
|
||||
Result := 'PBM_DELTAPOS';
|
||||
$0404:
|
||||
Result := 'PBM_SETSTEP';
|
||||
$0405:
|
||||
Result := 'PBM_STEPIT';
|
||||
$0406:
|
||||
Result := 'PBM_SETRANGE32';
|
||||
$0407:
|
||||
Result := 'PBM_GETRANGE';
|
||||
$0408:
|
||||
Result := 'PBM_GETPOS';
|
||||
$0409:
|
||||
Result := 'PBM_SETBARCOLOR';
|
||||
$040A:
|
||||
Result := 'PBM_SETMARQUEE';
|
||||
$040D:
|
||||
Result := 'PBM_GETSTEP';
|
||||
$040E:
|
||||
Result := 'PBM_GETBKCOLOR';
|
||||
$040F:
|
||||
Result := 'PBM_GETBARCOLOR';
|
||||
$0410:
|
||||
Result := 'PBM_SETSTATE';
|
||||
$0411:
|
||||
Result := 'PBM_GETSTATE';
|
||||
// misc
|
||||
$0469:
|
||||
Result := 'UDM_SETBUDDY';
|
||||
$046A:
|
||||
Result := 'UDM_GETBUDDY';
|
||||
$102C:
|
||||
Result := 'LVM_GETITEMSTATE';
|
||||
$8000:
|
||||
Result := 'WM_APP';
|
||||
|
||||
LM_HITTEST:
|
||||
Result := 'LM_HITTEST';
|
||||
LM_GETIDEALHEIGHT:
|
||||
Result := 'LM_GETIDEALHEIGHT';
|
||||
LM_SETITEM:
|
||||
Result := 'LM_SETITEM';
|
||||
LM_GETITEM:
|
||||
Result := 'LM_GETITEM';
|
||||
// LM_GETIDEALSIZE: Result:= 'LM_GETIDEALSIZE';
|
||||
|
||||
else
|
||||
begin
|
||||
if WM_Message > WM_USER then
|
||||
Result := 'WM_USER + (' + IntToHex(WM_Message - WM_USER, 4) + ')'
|
||||
|
||||
else
|
||||
Result := 'Unknown(' + IntToHex(WM_Message, 4) + ')';
|
||||
end;
|
||||
end; { Case }
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
function GetWindowClassName(Window: HWND): String;
|
||||
var
|
||||
lpClassName: array [0 .. 255] of Char;
|
||||
begin
|
||||
Result := '';
|
||||
if GetClassName(Window, @lpClassName, Length(lpClassName)) > 0 then
|
||||
Result := lpClassName;
|
||||
end;
|
||||
|
||||
function RectVCenter(var R: TRect; const Bounds: TRect): TRect;
|
||||
begin
|
||||
OffsetRect(R, -R.Left, -R.Top);
|
||||
OffsetRect(R, 0, (Bounds.Height - R.Height) div 2);
|
||||
OffsetRect(R, Bounds.Left, Bounds.Top);
|
||||
Result := R;
|
||||
end;
|
||||
|
||||
procedure MoveWindowOrg(DC: HDC; const DX, DY: Integer);
|
||||
var
|
||||
P: TPoint;
|
||||
begin
|
||||
GetWindowOrgEx(DC, P);
|
||||
SetWindowOrgEx(DC, P.X - DX, P.Y - DY, nil);
|
||||
end;
|
||||
|
||||
end.
|
||||
+8
-37
@@ -46,7 +46,6 @@ var
|
||||
|
||||
procedure actualise_seltrains;
|
||||
procedure affecte_Train_canton(AdrTrain,idcanton,sens : integer);
|
||||
procedure xxxraz_trains_Idcanton(idc : integer);
|
||||
procedure raz_cantons_train(AdrTrain : integer;raz : boolean);
|
||||
procedure trouve_det_canton(idcanton : integer;var el1,el2 : integer);
|
||||
function trouve_det_suiv_canton(idcanton,detecteur,sensTCO : integer) : integer;
|
||||
@@ -54,8 +53,7 @@ procedure Maj_detecteurs_canton(i,AdrTrain,adresse : integer);
|
||||
|
||||
implementation
|
||||
|
||||
uses UnitConfigCellTCO,UnitTCO,unitconfig,unitDebug, UnitRouteTrains,
|
||||
UnitInfo;
|
||||
uses UnitConfigCellTCO,UnitTCO,unitconfig,unitDebug, UnitRouteTrains,UnitInfo;
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
@@ -179,32 +177,6 @@ begin
|
||||
result:=xcanton;
|
||||
end;
|
||||
|
||||
// raz des trains affectés au canton d'index "idc"
|
||||
procedure xxxraz_trains_idcanton(idc : integer);
|
||||
var ax,ay,i,ic : integer;
|
||||
begin
|
||||
if traceliste then Affiche('Raz train affectés au canton index='+intToSTR(idc),clyellow);
|
||||
for i:=1 to Ntrains do
|
||||
begin
|
||||
ic:=index_canton_numero(trains[i].canton);
|
||||
if ic=idc then
|
||||
begin
|
||||
routeSav:=trains[i].route; // sauvegarde la route
|
||||
trains[i].canton:=0;
|
||||
trains[i].route[0].adresse:=0;
|
||||
if ic<>0 then
|
||||
begin
|
||||
ax:=canton[Ic].x;
|
||||
ay:=canton[Ic].y;
|
||||
tco[IndexTCOCourant,ax,ay].train:=0;
|
||||
canton[Ic].indexTrain:=0;
|
||||
canton[Ic].adresseTrain:=0;
|
||||
canton[Ic].NomTrain:='';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// supprime le train AdrTrain de tous les cantons, et réaffiche les cantons effacés concernés
|
||||
// si raz=true : raz aussi le train du détecteur
|
||||
procedure raz_cantons_train(AdrTrain : integer;raz : boolean);
|
||||
@@ -347,10 +319,10 @@ begin
|
||||
with StringGridTrains do
|
||||
begin
|
||||
case canton[idcanton].SensLoco of
|
||||
1 : Image:=ImageGauche;
|
||||
2 : Image:=ImageDroite;
|
||||
3 : Image:=ImageHaut;
|
||||
4 : Image:=ImageBas;
|
||||
SensGauche : Image:=ImageGauche;
|
||||
SensDroit : Image:=ImageDroite;
|
||||
SensHaut : Image:=ImageHaut;
|
||||
SensBas : Image:=ImageBas;
|
||||
else exit;
|
||||
end;
|
||||
StretchBlt(canvas.Handle,r.left,r.Top,ColWidths[6],RowHeights[6], // destination avec mise à l'échelle
|
||||
@@ -516,8 +488,8 @@ begin
|
||||
Canvas.Brush.Color:=coul;
|
||||
Canvas.FillRect(Rect); // Efface la cellule qu'on va réécrire en mode WORDBREAK
|
||||
// rectangle du texte
|
||||
Inc(Rect.Left,2);
|
||||
Inc(Rect.Top,2);
|
||||
Inc(Rect.Left,1);
|
||||
Inc(Rect.Top,1);
|
||||
DrawText(Canvas.Handle,PChar(Cells[ACol, ARow]),-1,Rect,DT_NOPREFIX or DT_WORDBREAK);
|
||||
end;
|
||||
end;
|
||||
@@ -684,7 +656,7 @@ begin
|
||||
|
||||
f:=canton[IdAutreCanton].SensLoco;
|
||||
|
||||
inc(f);
|
||||
inc(f); // les sens vont de 1 à 4
|
||||
if canton[IdAutreCanton].horizontal then
|
||||
begin
|
||||
if (f<SensGauche) or (f>SensDroit) then f:=SensGauche;
|
||||
@@ -813,6 +785,5 @@ end;
|
||||
|
||||
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+1
-1
@@ -26,7 +26,7 @@ var
|
||||
f : text;
|
||||
|
||||
Const
|
||||
VersionSC ='9.7'; // sert à la comparaison de la version publiée
|
||||
VersionSC ='9.71'; // sert à la comparaison de la version publiée
|
||||
SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace
|
||||
// pour unzip
|
||||
SHCONTCH_NOPROGRESSBOX=4;
|
||||
|
||||
+6
-3
@@ -45,7 +45,7 @@ version 2.21 : Param
|
||||
version 2.3 : Changement de la méthode de réception des trames du protocole IPC de CDM-Rail
|
||||
Affichage au démarrage des variables manquantes du fichier config-gl.cfg
|
||||
version 2.31 : Amélioration calcul des routes depuis buttoir
|
||||
Lancement du TCO à la validation dans la configuration
|
||||
Lancement du TCO à la validation dans la configuration
|
||||
version 2.4 : Optimisation de la gestion des évènements aiguillages
|
||||
Gestion des aiguillages inversés dans CDM pour le mode autonome
|
||||
Debug pilotage feux LEB
|
||||
@@ -53,9 +53,9 @@ version 2.5 : Panneau de configuration:
|
||||
Correction gestion des conditions supplémentaires d'affichage du carré
|
||||
Affichage de champs modifiables supplémentaires
|
||||
version 3.0 : Ajout des fonctions Nouveau / supprimer feu, accessoires dans le panneau de configuration.
|
||||
Tous les éléments des feux, aiguillages, branches et actionneurs peuvent être modifiés depuis le panneau.
|
||||
Tous les éléments des feux, aiguillages, branches et actionneurs peuvent être modifiés depuis le panneau.
|
||||
Nécessite de nommer les sections dans le fichier config.cfg
|
||||
Il n'est donc plus nécessaire de modifier les fichiers de configuration.
|
||||
Il n'est donc plus nécessaire de modifier les fichiers de configuration.
|
||||
version 3.1 : Renforcement de la vérification de la configuration.
|
||||
Modification de la liste d'initialisation des aiguillages en mode autonome.
|
||||
Indépendance des modifications entre les onglets du panneau de configuration.
|
||||
@@ -295,5 +295,8 @@ version 9.7 : Boutons dans le TCO int
|
||||
Mémoires actionnables dans les actions.
|
||||
Gestion du décodeur de signaux LEA de Ligéa.
|
||||
Correction bug PN sur mémoires de zones.
|
||||
version 9.71 : Nouveaux styles d'affichages pour les versions D12.
|
||||
Création des opérateurs NonOU et NonET dans les fonctions
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user