diff --git a/Notice d'utilisation des signaux_complexes_GL_V10.8.pdf b/Notice d'utilisation des signaux_complexes_GL_V10.82.pdf similarity index 83% rename from Notice d'utilisation des signaux_complexes_GL_V10.8.pdf rename to Notice d'utilisation des signaux_complexes_GL_V10.82.pdf index f722301..acb41e3 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V10.8.pdf and b/Notice d'utilisation des signaux_complexes_GL_V10.82.pdf differ diff --git a/UnitAnalyseSegCDM.dfm b/UnitAnalyseSegCDM.dfm index 29ca8a1..6c63c87 100644 --- a/UnitAnalyseSegCDM.dfm +++ b/UnitAnalyseSegCDM.dfm @@ -1,6 +1,6 @@ object FormAnalyseCDM: TFormAnalyseCDM - Left = 206 - Top = 145 + Left = 210 + Top = 94 AutoScroll = False Caption = 'Fen'#234'tre r'#233'seau CDM' ClientHeight = 596 @@ -62,7 +62,7 @@ object FormAnalyseCDM: TFormAnalyseCDM object Label5: TLabel Left = 1005 Top = 528 - Width = 24 + Width = 12 Height = 13 Anchors = [akTop, akRight] Caption = '+ -' diff --git a/UnitAnalyseSegCDM.pas b/UnitAnalyseSegCDM.pas index 94f4635..d13bb6c 100644 --- a/UnitAnalyseSegCDM.pas +++ b/UnitAnalyseSegCDM.pas @@ -73,7 +73,6 @@ type procedure ImageCDMMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ButtonAnimeClick(Sender: TObject); - procedure Button1Click(Sender: TObject); procedure ImageCDMMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImageCDMMouseUp(Sender: TObject; Button: TMouseButton; @@ -220,6 +219,8 @@ function isole_valeur(var s : string; chercher : string;afficheErr : boolean) : var i : integer; serr : string; begin + chercher:=lowercase(chercher); + s:=lowercase(s); i:=pos(chercher,s); if i=0 then begin @@ -235,8 +236,8 @@ begin delete(s,1,i+length(chercher)-1); repeat - if s[1]=' ' then delete(s,1,1); - until (s[1]<>' ') or (length(s)=0); + if (s[1]=' ') or (s[1]='=') then delete(s,1,1); + until ((s[1]<>' ') and (s[1]<>'=')) or (length(s)=0); i:=pos(' ',s); if i<>0 then isole_valeur:=copy(s,1,i-1) else isole_valeur:=s; @@ -301,7 +302,28 @@ begin Segment[nSeg-1].periph[nperiph-1].location:=i; s:=AnsiLowerCase(lignes[nligne]); - // ne pas faire inc(nligne) car on va regarder la ligne suivante en indiçant en +1 + inc(nligne); + + {non utilisé mais doit être pris en compte + Actionneurs Tickets horaire ou gestionnaire de voie unique, + tickets = le type de l'actionneur, soit : + 0 = ACT_STD, Actionneur standard. + 1 = ACT_MANO, Actionneur manuel, non actionné par les trains mais par un clic souris. + 2 = ACT_VUH Actionneur Voie Unique ou Tickets Horaire, actionné dans les deux sens par les trains. Ils vont toujours par paire. + Twined = RefIndex de l'actionneur associé en cas d'un ACT_VUH. + } + s2:=isole_valeur(s,'tckets',false); // nouveau + if s2<>'' then + begin + s:=AnsiLowerCase(lignes[nligne]); + inc(nLigne); + end; + s2:=isole_valeur(s,'tickets',false); // nouveau Tickets = 0 Twined = 0 + if s2<>'' then + begin + s:=AnsiLowerCase(lignes[nligne]); + inc(nLigne); + end; s2:=isole_valeur(s,'address',true); val(s2,i,erreur); @@ -325,7 +347,7 @@ begin val(s2,i,erreur); Segment[nSeg-1].periph[nperiph-1].status:=i; - // peut être suivi de 'On device port' si une adresse de détecteur ou d'actionneur se trouve sur l'appareil de voie + // peut être suivi de 'on device port' si une adresse de détecteur ou d'actionneur se trouve sur l'appareil de voie Segment[nSeg-1].periph[nperiph-1].OnDevicePort:=-1; // marqueur d'invalidité s:=AnsiLowerCase(lignes[nligne+1]); if pos('on device port',s)<>0 then @@ -343,6 +365,7 @@ begin end; + procedure compile_inter; var i,erreur : integer; s,s2: string; @@ -370,6 +393,7 @@ begin s2:=isole_valeur(s,'type:',true); Segment[nSeg-1].inter[nInter-1].typ:=s2; + // nouvelle ligne: Mirror: Z= 1416 s:=AnsiLowerCase(lignes[nligne]); inc(nLigne); s2:=isole_valeur(s,'z=',true); @@ -4328,7 +4352,7 @@ begin s:=lowercase(Formprinc.fenRich.Lines[0]); if pos('module',s)=0 then begin - Affiche('Pas de module CDM détecté',clred); + Affiche('Pas de module CDM détecté - Abandon',clred); exit; end; end @@ -4387,7 +4411,12 @@ begin end; inc(nligne); until (nligne>nombre); - Affiche('Fin de la compilation des segments',cllime); + if nseg<>0 then Affiche('Fin de la compilation des segments',cllime) + else + begin + Affiche('Aucun segment trouvé - Abandon',clred); + exit; + end; // balayer les segments pour transformer les bjd en créant 1 croisement et 4 aiguillages dans les segments, puis on supprime la bjd des segments i:=0; @@ -5555,19 +5584,9 @@ begin sleep(40); Application.processMessages; until x>800; - - //until x>500; - - end; - -procedure TFormAnalyseCDM.Button1Click(Sender: TObject); -begin - dessine_det(523); -end; - procedure TFormAnalyseCDM.ImageCDMMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin diff --git a/UnitClock.dfm b/UnitClock.dfm index f7904ca..d56f5fa 100644 --- a/UnitClock.dfm +++ b/UnitClock.dfm @@ -16,7 +16,7 @@ object FormClock: TFormClock OnResize = FormResize DesignSize = ( 234 - 212) + 211) PixelsPerInch = 96 TextHeight = 13 object BitBtnMarHor: TBitBtn diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 4552b8e..e36b720 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -1,6 +1,6 @@ object FormConfig: TFormConfig - Left = 265 - Top = 106 + Left = 404 + Top = 164 Hint = 'Modifie la configuration selon les s'#233'lections choisies' BorderStyle = bsDialog Caption = 'Configuration g'#233'n'#233'rale' @@ -1573,7 +1573,7 @@ object FormConfig: TFormConfig Top = 8 Width = 633 Height = 505 - ActivePage = TabSheetCDM + ActivePage = TabSheetSig Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 @@ -1668,6 +1668,17 @@ object FormConfig: TFormConfig Height = 13 Caption = 'Nom du fichier LAY '#224' utiliser au d'#233'marrage de CDM' end + object SpeedButtonLay: TSpeedButton + Left = 232 + Top = 192 + Width = 23 + Height = 22 + Hint = 'Choix du fichier LAY' + Caption = '...' + ParentShowHint = False + ShowHint = True + OnClick = SpeedButtonLayClick + end object CheckVerifVersion: TCheckBox Left = 8 Top = 56 @@ -1729,7 +1740,7 @@ object FormConfig: TFormConfig object EditLAY: TEdit Left = 8 Top = 192 - Width = 249 + Width = 217 Height = 21 Hint = 'Nom du LAY avec .lay' ParentShowHint = False @@ -2031,7 +2042,7 @@ object FormConfig: TFormConfig end object CheckBoxVerifXpressNet: TCheckBox Left = 8 - Top = 90 + Top = 88 Width = 233 Height = 17 Hint = @@ -2097,7 +2108,7 @@ object FormConfig: TFormConfig 'S'#233'lection du style d'#39#39'affichage - Le style sera chang'#233' '#224' la ferm' + 'eture de la fen'#234'tre'#39 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 0 @@ -2146,7 +2157,7 @@ object FormConfig: TFormConfig object Label4: TLabel Left = 16 Top = 45 - Width = 135 + Width = 196 Height = 26 Caption = '2. Temporisation d'#39'envoi des octets de la trame (ms)' WordWrap = True @@ -2154,7 +2165,7 @@ object FormConfig: TFormConfig object Label5: TLabel Left = 16 Top = 75 - Width = 148 + Width = 192 Height = 26 Caption = '3. Temporisation d'#39'attente de la r'#233'ponse de l'#39'interface (x 50 ms' + @@ -2419,8 +2430,11 @@ object FormConfig: TFormConfig Top = 24 Width = 145 Height = 21 + Hint = 'Echelle' Style = csDropDownList ItemHeight = 13 + ParentShowHint = False + ShowHint = True TabOrder = 0 OnChange = ComboBoxEchelleChange Items.Strings = ( @@ -3779,7 +3793,7 @@ object FormConfig: TFormConfig Top = 56 Width = 193 Height = 21 - ItemHeight = 13 + ItemHeight = 0 TabOrder = 0 OnChange = ComboBoxDecodeurPersoChange end @@ -3798,7 +3812,7 @@ object FormConfig: TFormConfig Width = 145 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 2 OnChange = ComboBoxNationChange end @@ -3844,7 +3858,7 @@ object FormConfig: TFormConfig Width = 193 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 6 OnChange = ComboBoxDecCdeChange end @@ -4057,7 +4071,7 @@ object FormConfig: TFormConfig Top = 96 Width = 137 Height = 21 - ItemHeight = 13 + ItemHeight = 0 TabOrder = 2 OnChange = ComboBoxOperateurChange OnDrawItem = ComboBoxOperateurDrawItem @@ -4077,7 +4091,7 @@ object FormConfig: TFormConfig Top = 96 Width = 161 Height = 21 - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 4 @@ -4189,7 +4203,7 @@ object FormConfig: TFormConfig Width = 145 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 7 OnChange = ComboBoxFLChange end @@ -4725,7 +4739,7 @@ object FormConfig: TFormConfig Hint = 'action par accessoire DCC ou commande COM/USB' Caption = 'Type d'#39'action' Items.Strings = ( - 'Accessoire' + 'Accessoire DCC' 'Commande COM/USB ou Socket') ParentShowHint = False ShowHint = True @@ -4739,7 +4753,7 @@ object FormConfig: TFormConfig 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 = 10 @@ -6499,7 +6513,7 @@ object FormConfig: TFormConfig Width = 153 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 0 OnChange = ComboBoxUSBTrChange end @@ -6633,6 +6647,10 @@ object FormConfig: TFormConfig Hint = 'Copie tout le contenu en tant que texte dans le presse-papier' OnClick = outcopierentatquetexte1Click end + object MenuListesCopier2: TMenuItem + Caption = 'Coller' + OnClick = MenuListesCopier2Click + end end object ColorDialogFond: TColorDialog OnShow = ColorDialogFondShow diff --git a/UnitConfig.pas b/UnitConfig.pas index 2824bb1..a729414 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -514,6 +514,8 @@ type Label15: TLabel; LabeledEditCr: TLabeledEdit; LabeledEditT: TLabeledEdit; + SpeedButtonLay: TSpeedButton; + MenuListesCopier2: TMenuItem; procedure ButtonAppliquerEtFermerClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ListBoxAigMouseDown(Sender: TObject; Button: TMouseButton; @@ -816,6 +818,8 @@ type procedure EditTempoSigChange(Sender: TObject); procedure LabeledEditCrChange(Sender: TObject); procedure LabeledEditTChange(Sender: TObject); + procedure SpeedButtonLayClick(Sender: TObject); + procedure MenuListesCopier2Click(Sender: TObject); private { Déclarations privées } @@ -931,6 +935,7 @@ Affcompteur_ch='AffCompteur'; LargCompteur_ch='LargCompteur'; LargComptC_ch='LargCompteurC'; HautComptC_ch='HautCompteurC'; +ZoomSignaux_ch='ZoomSignaux'; VerrouCompteur_ch='VerrouCompteur'; Echelle_ch='Echelle'; AffIconeTrCompteur_ch='AffIconeTrCompteur'; @@ -1238,7 +1243,7 @@ begin end; // vérifie si la config de la com série/usb est ok -// COM7:9600,n,8,1 +// exemple s='COM7:9600,n,8,1' function config_com(s : string) : boolean; var sa : string; i,erreur,vitesse : integer; @@ -1467,7 +1472,7 @@ begin result:=''; exit; end; - if affevt then Affiche('Encode_sig_feux('+IntToSTR(i)+') : adresse='+IntToSTR(adresse),clyellow); + if affevt then Affiche('Encode_signal('+IntToSTR(i)+') : adresse='+IntToSTR(adresse),clyellow); s:=IntToSTR(adresse)+','; // forme - D=directionnel ajouter 10 @@ -2048,7 +2053,7 @@ begin end; -// transforme l'action en chaine +// encode l'action en chaine function encode_actions(i : integer) : string; var s : string; decl,action,Nb,j: integer; @@ -2121,7 +2126,6 @@ begin ActionAffecteMemoire : s:=s+','+intToSTR(Tablo_Action[i].tabloOP[j].adresse)+','+intToSTR(Tablo_Action[i].tabloOP[j].etat); ActionIncMemoire: s:=s+','+intToSTR(Tablo_Action[i].tabloOP[j].adresse); ActionDecMemoire: s:=s+','+intToSTR(Tablo_Action[i].tabloOP[j].adresse); - end; if j= 28.0} // composants à repasser en style de base car on change la couleur de fond + EditP1.StyleName:='Windows'; EditP2.StyleName:='Windows'; EditP3.StyleName:='Windows'; @@ -7584,6 +7627,10 @@ begin end; {$IFEND} + MenuListesCopier2.Visible:=false; // coller liste dans la listbox des signaux est neutralisé, crée des problemes pour les structures de signaux + ComboBoxEchelle.hint:='L''échelle est utilisée pour le calcul des vitesses des trains'+#13+ + 'ainsi que pour les distances d''arrêt'; + editAdrIPCDM.Hint:='Adresse IP du PC sur lequel CDM rail s''exécute'+#13+'ou 127.0.0.1 pour indiquer ce pc'; ValueListEditor.Visible:=true; ImageAffiche.stretch:=true; @@ -8760,6 +8807,7 @@ begin if clicproprietesSig then clicListeSignal(IndexSignalClic); clicproprietesSig:=false; + if clicproprietesTrains then clicListeTrains(ligneclicTrain+1); clicproprietesTrains:=false; @@ -9328,10 +9376,9 @@ begin end; - // mise à jour des champs du signal d'après le tableau signaux Procedure aff_champs_signaux(index : integer); -var j,l,d,p,k,nc,decodeur : integer; +var j,l,d,p,k,nc,decodeur,lIcone,hIcone : integer; s : string; begin if Affevt then affiche('Aff_champs_sig_feux('+intToSTR(index)+')',clyellow); @@ -9344,7 +9391,7 @@ begin Picture.Bitmap.TransparentMode:=tmAuto; Picture.Bitmap.TransparentColor:=clblue; Transparent:=true; - picture.Bitmap:=Select_dessin_Signal(Signaux[index].aspect); + picture.Bitmap:=Select_dessin_Signal(Signaux[index].aspect,lIcone,hIcone); end; if Signaux[index].contrevoie then inverse_image(formConfig.ImageSignal,Formprinc.ImageSignal20); @@ -9434,26 +9481,26 @@ begin // affiche ou non les checkbox en fonction de l'aspect if (((d=2) or (d>=5)) and (d<10)) or (d=20) then begin - checkBoxFB.Visible:=true; + checkBoxFB.Visible:=true; // ne pas afficher checkbox feu blanc Label69.Visible:=true; MemoBlanc.Visible:=true; end else begin - checkBoxFB.Visible:=false; + checkBoxFB.Visible:=false; // ne pas afficher checkbox feu blanc Label69.Visible:=false; MemoBlanc.Visible:=false; end; if d>2 then begin - checkFVC.Visible:=true; - checkFRC.Visible:=true; + checkFVC.Visible:=true; // afficher checkbox feu vert clignotant + checkFRC.Visible:=true; // afficher checkbox feu rouge clignotant end else begin - checkFVC.Visible:=false; - checkFRC.Visible:=false; + checkFVC.Visible:=false; // ne pas afficher checkbox feu vert clignotant + checkFRC.Visible:=false; // na pas afficher checkbox feu rouge clignotant end; if ((d>3) and (d<10)) or (d=20) then CheckVerrouCarre.Visible:=true else CheckVerrouCarre.Visible:=false; @@ -10112,6 +10159,7 @@ begin formconfig.ListBoxAig.selected[ligneclicAig]:=true; end; +// vitesse spécifique franchissement aiguillage en position déviée procedure vitesse_spec; var s : string; AdrAig,erreur,index,v : integer; @@ -10167,6 +10215,7 @@ begin formconfig.ListBoxAig.selected[ligneclicAig]:=true; end; +// vérifie la cohérence entre le décodeur et la cible de signal (aspect) function verif_dec_sig(aff : boolean) : boolean; var Adr,i,dec,aspect,indexAspect : integer; begin @@ -10660,7 +10709,7 @@ begin end; procedure TFormConfig.ComboBoxAspChange(Sender: TObject); -var indexTCO,x,y,i,index,aspect,adresseFeu : integer; +var indexTCO,x,y,i,index,aspect,adresseSig,lIcone,hIcone : integer; s : string; bm :tbitmap; begin @@ -10680,7 +10729,7 @@ begin 11 : aspect:=20; else aspect:=i+6; end; - index:=ligneClicSig+1; // index du feu + index:=ligneClicSig+1; // index du signal if index<1 then begin ComboBoxAsp.ItemIndex:=-1; @@ -10702,8 +10751,8 @@ begin ListBoxSig.Selected[ligneClicSig]:=true; - // change l'image du feu dans la feuille graphique principale - bm:=Select_dessin_Signal(Signaux[index].aspect); + // change l'image du signal dans la feuille graphique principale + bm:=Select_dessin_Signal(Signaux[index].aspect,lIcone,hicone); if bm=nil then exit; Signaux[index].Img.picture.Bitmap:=bm; dessine_signal_mx(Signaux[index].Img.Canvas,0,0,1,1,Signaux[index].adresse,1); // dessine les feux du signal @@ -10718,8 +10767,8 @@ begin begin if TCO[indexTCO,x,y].BImage=Id_Signal then begin - AdresseFeu:=Signaux[index].adresse; - if tco[IndexTCO,x,y].Adresse=AdresseFeu then affiche_tco(indexTCO); + AdresseSig:=Signaux[index].adresse; + if tco[IndexTCO,x,y].Adresse=AdresseSig then affiche_tco(indexTCO); end; end; end; @@ -10767,7 +10816,7 @@ begin end; procedure TFormConfig.ButtonrestaureClick(Sender: TObject); -var index : integer; +var index,lIcone,hIcone : integer; begin if (Signal_sauve.adresse<>0) and (ligneClicSig>=0) then begin @@ -10778,9 +10827,9 @@ begin ListBoxSig.selected[ligneClicSig]:=true; aff_champs_signaux(index); // réaffiche les champs Maj_Hint_Signal(index); - // change l'image du feu dans la feuille graphique principale - Signaux[index].Img.picture.Bitmap:=Select_dessin_Signal(Signaux[index].aspect); - dessine_signal_mx(Signaux[index].Img.Canvas,0,0,1,1,Signaux[index].adresse,1); // dessine les feux du signal + // change l'image du signal dans la feuille graphique principale + Signaux[index].Img.picture.Bitmap:=Select_dessin_Signal(Signaux[index].aspect,lIcone,hIcone); + dessine_signal_mx(Signaux[index].Img.Canvas,0,0,1,1,Signaux[index].adresse,1); // dessine les feux du signal, échelle 1 clicListe:=false; end; end; @@ -10888,7 +10937,7 @@ begin if affevt then affiche('Evt bouton nouveau acc',clyellow); if maxtablo_act>=Max_action then begin - Affiche('Nombre maximal d''actionneurs atteint',clred); + Affiche('Nombre maximal d''actions atteint',clred); exit; end; clicliste:=true; @@ -11157,7 +11206,7 @@ begin end; if ss='' then exit; - s:='Voulez vous supprimer '; + s:='Voulez vous supprimer'; if n=1 then s:=s+' l''action ' else s:=s+' les actions '; s:=s+ss+' ?'; @@ -11171,6 +11220,7 @@ begin repeat if formconfig.ListBoxActions.selected[i-1] then begin + Affiche('Suppression action '+tablo_action[i].NomAction,clOrange); for j:=i to maxTablo_act-1 do begin formconfig.ListBoxActions.selected[j-1]:=formconfig.ListBoxActions.selected[j]; @@ -11404,7 +11454,7 @@ begin perform(WM_VSCROLL,SB_BOTTOM,0); end; - formCOnfig.LabelInfo.caption:=''; + formConfig.LabelInfo.caption:=''; ligneClicSig:=i-1; AncligneClicSig:=ligneClicSig; aff_champs_signaux(i); @@ -11467,15 +11517,14 @@ begin Signaux[i].Lbl.free; // supprime le label Signaux[i].Lbl:=nil; Tablo_Index_Signal[Signaux[i].adresse]:=0; - if Signaux[i].checkFB<>nil then - begin - Signaux[i].checkFB.Free; - Signaux[i].CheckFB:=nil; - end; // supprime le check du feu blanc s'il existait + if Signaux[i].checkFB<>nil then Signaux[i].checkFB.Free; // supprime le check du feu blanc s'il existait + Signaux[i].CheckFB:=nil; + Signaux[i].FeuBlanc:=false; for j:=i to NbreSignaux-1 do begin Signaux[j]:=Signaux[j+1]; + //Affiche('Signal '+intToSTR(j)+' affecté',clred); tablo_index_signal[signaux[j].adresse]:=j; if Signaux[j].img=nil then affiche('erreur',clred) else @@ -11504,7 +11553,20 @@ begin Left:=10+ (LargImg+5)*((j-1) mod (NbreImagePLigne)); end; end; + + { + Affiche('Efface signal'+intToSTR(NbreSignaux),clred); + Signaux[NbreSignaux].Img.free; // supprime l'image, ce qui efface le signal du tableau graphique + Signaux[NbreSignaux].Img:=nil; + Signaux[NbreSignaux].Lbl.free; // supprime le label + Signaux[NbreSignaux].Lbl:=nil; + Tablo_Index_Signal[Signaux[NbreSignaux].adresse]:=0; + if Signaux[NbreSignaux].checkFB<>nil then Signaux[NbreSignaux].checkFB.Free; // supprime le check du feu blanc s'il existait + Signaux[NbreSignaux].CheckFB:=nil; + Signaux[NbreSignaux].FeuBlanc:=false; + } dec(NbreSignaux); + i:=0; end; inc(i); @@ -12739,8 +12801,8 @@ begin if not(oksignal) then begin Affiche('Erreur 14: le signal '+IntToSTR(adresse)+' '+decodeur[dec]+' occupe '+intToSTR(nc)+' adresses de '+intToSTR(adresse)+ - ' à '+intToSTR(adresse+nc-1)+' et chevauche le(s) détecteur(s) ',clred); - affiche(s,clred); + ' à '+intToSTR(adresse+nc-1)+' et chevauche le(s) détecteur(s) suivant(s)',clred); + Affiche(s,clred); end; end; @@ -12989,7 +13051,7 @@ begin end; if ss='' then exit; - s:='Voulez vous supprimer '; + s:='Voulez vous supprimer'; if n=1 then s:=s+' l''aiguillage ' else s:=s+' les aiguillages '; s:=s+ss+' ?'; @@ -13556,11 +13618,20 @@ end; procedure valide_branches; var s: string; - ligne,esp : integer; + ligne,esp,i : integer; ok : boolean; begin ligne:=1; ok:=true; + + // vider les tableaux des détecteurs + for i:=1 to NbMaxDet do + begin + Adresse_detecteur[i]:=0; + detecteur[i].index:=0; + end; + NDetecteurs:=0; + repeat s:=AnsiUpperCase(formConfig.RichBranche.Lines[ligne-1]); if s<>'' then @@ -13609,6 +13680,7 @@ begin modif_branches:=false; end else FormConfig.labelResult.Caption:='Erreur de syntaxe'; + trier_detecteurs; end; procedure TFormConfig.ButtonValLigneClick(Sender: TObject); @@ -13642,6 +13714,7 @@ begin if j=0 then result:=0 else result:=j+1; end; + // compile une branche de réseau sous forme de texte, et la stocke dans le tableau des branches // crée les index dans la structure détecteurs et des aiguillages // i = index de la branche à stocker @@ -13756,7 +13829,7 @@ begin until ((bd=NDetecteurs+1) or trouve) or (bd>NbMaxDet) ; if not(trouve) then begin - Adresse_detecteur[bd]:=detect; + Adresse_detecteur[bd]:=detect; // stocke le détecteur de la branche dans la liste des détecteurs NDetecteurs:=bd; end; end; @@ -14428,9 +14501,17 @@ begin end; l:=Trains[index].Icone.width; h:=Trains[index].Icone.Height; - if h=0 then + if h=0 then // si pas d'icone de train dessiner un rectangle begin result:=0; + l:=image_train[index].Width; + h:=image_train[index].Height; + with Iimage.Canvas do + begin + brush.Color:=coulfond; + pen.Color:=coulfond; + rectangle(0,0,l,h); + end; exit; end; rd:=l/h; @@ -14473,12 +14554,6 @@ begin ligneclicTrain:=ListBoxTrains.ItemIndex; - //Affiche(intToSTR(lc),clyellow); - - if ligneclicTrain+1>ntrains then - begin - ligneclicTrain:=ntrains-1; - end; if ligneclicTrain<0 then exit; s:=ListBoxTrains.items[ligneclicTrain]; if s='' then exit; @@ -14665,7 +14740,7 @@ begin end; if ss='' then exit; - s:='Voulez vous supprimer '; + s:='Voulez vous supprimer'; if n=1 then s:=s+' le train ' else s:=s+' les trains '; s:=s+ss+' ?'; @@ -15443,7 +15518,7 @@ begin ListBoxSig.Items.Clear; for i:=1 to NbreSignaux do begin - s:=encode_signal(i); // encode la ligne depuis le tableau feux + s:=encode_signal(i); // encode la ligne depuis le tableau signaux if s<>'' then begin ListBoxSig.Items.Add(s); @@ -16610,7 +16685,7 @@ begin end; procedure TFormConfig.FormActivate(Sender: TObject); - var i : integer; +var i : integer; s : string; begin if affevt or (debug=1) then affiche('FormConfig activate',clLime); @@ -16835,7 +16910,8 @@ begin end; procedure TFormConfig.ListBoxOperationsDrawItem(Control: TWinControl; - Index: Integer; Rect: TRect; State: TOwnerDrawState);var + Index: Integer; Rect: TRect; State: TOwnerDrawState); +var i,erreur: Integer; ItemText: string; begin @@ -16851,7 +16927,8 @@ begin end; procedure TFormConfig.ListBoxOperationsMouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin ClicAction:=ListBoxOperations.ItemIndex; end; @@ -16916,7 +16993,6 @@ end; procedure TFormConfig.ListBoxOperationsDblClick(Sender: TObject); var s : string; op,i : integer; - begin if (clicAction<0) or (ligneclicAct<0) or clicliste then exit; Tablo_Action[ligneclicAct+1].tabloOp[clicaction+1].valide:=not(Tablo_Action[ligneclicAct+1].tabloOp[clicaction+1].valide); @@ -16935,7 +17011,10 @@ end; procedure TFormConfig.SpeedButtonOuvreClick(Sender: TObject); -var s,repini :string; i : integer;begin if ligneclicTrain<0 then exit; +var s,repini :string; + i : integer; +begin + if ligneclicTrain<0 then exit; i:=ligneclicTrain+1; s:=rep_icones; repIni:=GetCurrentDir; // si le repertoire icones n'existe pas, il passe au supérieur @@ -16960,7 +17039,8 @@ var s,repini :string; i : integer;begin if ligneclicTrain<0 then exit; end; procedure TFormConfig.EditIconeChange(Sender: TObject); -var s,Nom,repIni : string;begin +var s,Nom,repIni : string; +begin if ligneclicTrain<0 then exit; if clicliste then exit; repIni:=GetCurrentDir; @@ -16977,7 +17057,8 @@ var s,Nom,repIni : string;begin end; procedure TFormConfig.LabeledEditTempoDChange(Sender: TObject); -var erreur,i :integer;begin +var erreur,i :integer; +begin if clicliste then exit; if affevt then affiche('Evt change temps démarre train',clyellow); if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; @@ -16989,7 +17070,8 @@ var erreur,i :integer;begin end; procedure TFormConfig.CheckBoxSensClick(Sender: TObject); -begin if clicliste then exit; +begin + if clicliste then exit; if affevt then affiche('Evt inverse train',clyellow); if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; @@ -17000,7 +17082,8 @@ end; procedure TFormConfig.ButtonImRCDMClick(Sender: TObject); -var nPeriph,ia,i,j,adr : integer; ctyp : string; +var nPeriph,ia,i,j,adr : integer; + ctyp : string; begin if nSeg=0 then begin LabelInfo.caption:='Pas de structure réseau CDM trouvée';exit;end else LabelInfo.caption:=''; @@ -19979,6 +20062,43 @@ begin end; +procedure TFormConfig.SpeedButtonLayClick(Sender: TObject); +var i : integer; + s : string; +begin + if ligneclicTrain<0 then exit; + i:=ligneclicTrain+1; + s:=rep_icones; + OpenDialogSon.InitialDir:=''; + OpenDialogSon.DefaultExt:='bmp'; + OpenDialogSon.Title:='Choix du fichier LAY de CDM'; + OpenDialogSon.Filter:='Fichiers LAY (*.LAY)|*.lay|Tous fichiers (*.*)|*.*'; + if openDialogSon.execute then + begin + s:=openDialogSon.filename; + EditLAY.Text:=ExtractFileName(s); // ne pas mettre le chemin pour l'ouverture du LAY avec CDM + end; +end; + +procedure TFormConfig.MenuListesCopier2Click(Sender: TObject); +var tl: TListBox; + i : integer; + s : string; +begin + tl:=(Tpopupmenu(Tmenuitem(sender).GetParentMenu).PopupComponent) as TlistBox ; + //ClipBoard.SetTextBuf(tl.Items.GetText); + if not Clipboard.HasFormat(CF_TEXT) then Exit; + tl.Items.Text := Clipboard.AsText; + + for i:=1 to tl.items.count do + begin + s:=tl.Items[i-1]; + if not(decode_ligne_signal(s,i)) then // décode la chaine et stocke en tableau signal + Affiche('Erreur 59 : définition inccorecte du signal '+intToSTR(i),clred); + end; + +end; + end. diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index 67b2cba..fa9c5a9 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -271,7 +271,7 @@ begin //YclicCell[indexTCO]:=YclicC; xc:=xClicC;yc:=yClicC; - origine_canton(xc,yc); + origine_canton(indexTCO,xc,yc); idCanton:=index_canton(indexTCO,xC,yC); @@ -671,7 +671,7 @@ begin begin FormConfCellTCO.LabelNumC.caption:='Elément de canton'; x:=xClicC;y:=yClicC; - origine_canton(x,y); + origine_canton(indexTCO,x,y); i:=tco[indexTCO,x,y].NumCanton; if i>0 then FormConfCellTCO.EditCanton.text:=intToSTR(i); end; diff --git a/UnitConfigTCO.dfm b/UnitConfigTCO.dfm index 55bdf0d..b2ae806 100644 --- a/UnitConfigTCO.dfm +++ b/UnitConfigTCO.dfm @@ -384,9 +384,9 @@ object FormConfigTCO: TFormConfigTCO Caption = '(10 maximum)' end object Label17: TLabel - Left = 146 + Left = 144 Top = 202 - Width = 49 + Width = 51 Height = 26 Alignment = taRightJustify Caption = 'Epaisseur des voies' diff --git a/UnitInfo.pas b/UnitInfo.pas index 4f6b5f7..a98c966 100644 --- a/UnitInfo.pas +++ b/UnitInfo.pas @@ -1,6 +1,6 @@ unit UnitInfo; -// afiche une info dans le TCO +// affiche une info dans le TCO interface @@ -40,7 +40,7 @@ end; procedure TFormInfo.FormActivate(Sender: TObject); begin - TickInfo:=5; + TickInfo:=5; // temps de fermeture de la fenetre pour le timer end; procedure TFormInfo.FormCreate(Sender: TObject); diff --git a/UnitMesure.dfm b/UnitMesure.dfm index 741d48d..c5172bf 100644 --- a/UnitMesure.dfm +++ b/UnitMesure.dfm @@ -16,10 +16,13 @@ object FormMesure: TFormMesure TextHeight = 13 object Label1: TLabel Left = 56 - Top = 16 - Width = 272 - Height = 13 - Caption = 'S'#233'lection d'#39'un train plac'#233' sur le TCO pour son '#233'talonnage' + Top = 0 + Width = 289 + Height = 29 + Caption = + 'S'#233'lection d'#39'un train plac'#233' sur le TCO pour son '#233'talonnage. Le pa' + + 'rcours doit '#234'tre boucl'#233'.' + WordWrap = True end object LabelEtat: TLabel Left = 24 diff --git a/UnitMesure.pas b/UnitMesure.pas index 38fd22e..71c9126 100644 --- a/UnitMesure.pas +++ b/UnitMesure.pas @@ -1,6 +1,6 @@ unit UnitMesure; -// mesure de la vitesse des trains +// mesure de la vitesse des trains pour l'étalonnage interface @@ -112,19 +112,19 @@ begin cv.brush.color:=clWindow; cv.fillrect(rect); end; - // Affichage du texte - cv.font.style:=canvas.font.style+[fsbold]; - cv.textout(rect.left+largDest+5,rect.top,ComboBoxTrains.items[index]); - if (odSelected in state) then - begin - cv.brush.color:=clWindowFrame; - cv.fillrect(rect); - //cv.font.color:=clblue; - cv.textout(rect.left+largDest+5,rect.top,ComboBoxTrains.items[index]); - end; + // Affichage du texte + cv.font.style:=canvas.font.style+[fsbold]; + cv.textout(rect.left+largDest+5,rect.top,ComboBoxTrains.items[index]); + if (odSelected in state) then + begin + cv.brush.color:=clWindowFrame; + cv.fillrect(rect); + //cv.font.color:=clblue; + cv.textout(rect.left+largDest+5,rect.top,ComboBoxTrains.items[index]); + end; - TransparentBlt(cv.Handle,rect.Left+2,rect.Top,largDest,hautDest, - Trains[index+1].Icone.canvas.Handle,0,0,l,h,clWhite); + TransparentBlt(cv.Handle,rect.Left+2,rect.Top,largDest,hautDest, + Trains[index+1].Icone.canvas.Handle,0,0,l,h,clWhite); end; procedure TFormMesure.ComboBoxTrainsChange(Sender: TObject); diff --git a/UnitPareFeu.pas b/UnitPareFeu.pas index e26e7ec..be87d57 100644 --- a/UnitPareFeu.pas +++ b/UnitPareFeu.pas @@ -49,7 +49,7 @@ begin NewRule.Applicationname:=fichier; NewRule.Protocol:=NET_FW_IP_PROTOCOL_TCP; - NewRule.LocalPorts :=''; // sans spécif=tous ports + NewRule.LocalPorts:=''; // sans spécif=tous ports //NewRule.LocalPorts := '9999'; // '80,443,4520-4533' NewRule.Direction:=net_fw_rule_dir_in; NewRule.Enabled:=True; diff --git a/UnitPilote.pas b/UnitPilote.pas index b2132ff..9a1181c 100644 --- a/UnitPilote.pas +++ b/UnitPilote.pas @@ -132,7 +132,7 @@ var EtatSignalPilote : word; AdrPilote : integer; tableLEB : array[1..41,1..19] of - record + record // pour le décodeur LEB : offset, // offset en mode linéaire sortie, // numéro de sortie en mode linéaire code // code de pilotage en mode binaire @@ -153,13 +153,11 @@ begin i:=Index_Signal(AdrPilote); // adresse du signal d'origine if i<>0 then - //ImagePilote.Picture.Bitmap:=FormPilote.ImagePilote.picture.bitmap; EtatSignalPilote:=Signaux[0].EtatSignal; AncienEtat:=Signaux[0].ancienEtat; Vcanvas:=FormPilote.ImagePilote.picture.bitmap.Canvas; case Signaux[i].aspect of - // feux de signalisation 2 : dessine_signal2(Vcanvas,0,0,1,1,EtatSignalPilote,1,i); 3 : dessine_signal3(Vcanvas,0,0,1,1,EtatSignalPilote,1,i); 4 : dessine_signal4(VCanvas,0,0,1,1,EtatSignalPilote,1,i); @@ -426,7 +424,8 @@ if ord(Key) = VK_RETURN then end; procedure TFormPilote.FormActivate(Sender: TObject); -var n,i,d : integer; +var n,i,d,l,h : integer; + b : tBitmap; begin if fermeSC then exit; // mise à jour du champ décodeur @@ -497,12 +496,16 @@ begin Picture.Bitmap.TransparentMode:=tmAuto; Picture.Bitmap.TransparentColor:=clblue; Transparent:=true; - Picture.BitMap:=Signaux[i].Img.Picture.Bitmap; - //left:=groupBox1.width+50; + picture.Bitmap.canvas.Brush.Color:=clBtnFace; + picture.Bitmap.Canvas.Rectangle(0,0,width,height); + + b:=Select_dessin_Signal(n,l,h); + Picture.BitMap:=b; end; LabelTitrePilote.Caption:='Pilotage du signal '+intToSTR(AdrPilote); Signaux[0].EtatSignal:=Signaux[i].EtatSignal; + dessine_signal_pilote; if isDirectionnel(i) then begin @@ -578,6 +581,7 @@ end; // initialisation de l'unité begin + // tableau de pilotage du décodeur LEB // les offsets sont incrémentés tous les 2, on alterne les sorties entre droit et dévié ; // offset et sortie sont pour le mode linéaire ; code est pour le mode binaire // cible 1 vert rouge diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index ccdde5f..b6d20e0 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,11 +1,11 @@ object FormPrinc: TFormPrinc - Left = 134 - Top = 277 + Left = 104 + Top = 192 Anchors = [akLeft, akTop, akRight] BorderStyle = bsNone Caption = 'Signaux complexes' ClientHeight = 513 - ClientWidth = 847 + ClientWidth = 1019 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -22,7 +22,7 @@ object FormPrinc: TFormPrinc OnKeyDown = FormKeyDown OnResize = FormResize DesignSize = ( - 847 + 1019 513) PixelsPerInch = 96 TextHeight = 13 @@ -40,8 +40,8 @@ object FormPrinc: TFormPrinc ParentFont = False end object Image9feux: TImage - Left = 1072 - Top = 32 + Left = 848 + Top = 16 Width = 57 Height = 105 Picture.Data = { @@ -230,8 +230,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image7feux: TImage - Left = 440 - Top = 8 + Left = 72 + Top = 32 Width = 57 Height = 105 Picture.Data = { @@ -398,7 +398,7 @@ object FormPrinc: TFormPrinc Visible = False end object Image5feux: TImage - Left = 696 + Left = 416 Top = 0 Width = 41 Height = 89 @@ -498,8 +498,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image4feux: TImage - Left = 664 - Top = 8 + Left = 384 + Top = 0 Width = 41 Height = 97 Picture.Data = { @@ -590,7 +590,7 @@ object FormPrinc: TFormPrinc Visible = False end object Image3feux: TImage - Left = 200 + Left = 256 Top = 8 Width = 33 Height = 57 @@ -671,10 +671,10 @@ object FormPrinc: TFormPrinc Visible = False end object Image2feux: TImage - Left = 1072 - Top = 144 - Width = 33 - Height = 57 + Left = 288 + Top = 16 + Width = 25 + Height = 41 Picture.Data = { 07544269746D617026080000424D260800000000000036040000280000001A00 0000240000000100080000000000F0030000C40E0000C40E0000000100000001 @@ -745,8 +745,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image2Dir: TImage - Left = 624 - Top = 8 + Left = 296 + Top = 0 Width = 41 Height = 25 Picture.Data = { @@ -820,8 +820,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image3Dir: TImage - Left = 808 - Top = 32 + Left = 104 + Top = 24 Width = 49 Height = 25 Picture.Data = { @@ -898,8 +898,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image4Dir: TImage - Left = 744 - Top = 32 + Left = 24 + Top = 24 Width = 57 Height = 25 Picture.Data = { @@ -986,8 +986,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image5Dir: TImage - Left = 856 - Top = 32 + Left = 160 + Top = 24 Width = 65 Height = 25 Picture.Data = { @@ -1084,8 +1084,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image6Dir: TImage - Left = 920 - Top = 32 + Left = 744 + Top = 8 Width = 81 Height = 25 Picture.Data = { @@ -1192,8 +1192,8 @@ object FormPrinc: TFormPrinc Visible = False end object ImageSignal20: TImage - Left = 1048 - Top = 424 + Left = 984 + Top = 64 Width = 57 Height = 105 Picture.Data = { @@ -1431,7 +1431,7 @@ object FormPrinc: TFormPrinc Visible = False end object LabelClock: TLabel - Left = 755 + Left = 927 Top = 0 Width = 85 Height = 22 @@ -5040,8 +5040,8 @@ object FormPrinc: TFormPrinc Visible = False end object ImageTachro: TImage - Left = 976 - Top = 112 + Left = 904 + Top = 24 Width = 106 Height = 37 Picture.Data = { @@ -5421,7 +5421,7 @@ object FormPrinc: TFormPrinc Visible = False end object Label1: TLabel - Left = 545 + Left = 717 Top = 4 Width = 89 Height = 13 @@ -5429,7 +5429,7 @@ object FormPrinc: TFormPrinc Caption = 'Nombre de trains : ' end object LabelNbTrains: TLabel - Left = 641 + Left = 813 Top = 2 Width = 9 Height = 19 @@ -5442,10 +5442,356 @@ object FormPrinc: TFormPrinc Font.Style = [fsBold] ParentFont = False end + object Image3feux2x: TImage + Left = 552 + Top = 0 + Width = 52 + Height = 88 + Picture.Data = { + 07544269746D617016160000424D161600000000000036040000280000003400 + 0000580000000100080000000000E0110000C40E0000C40E0000000100000001 + 000000000000000080000080000000808000800000008000800080800000C0C0 + C000C0DCC000F0CAA6000020400000206000002080000020A0000020C0000020 + E00000400000004020000040400000406000004080000040A0000040C0000040 + E00000600000006020000060400000606000006080000060A0000060C0000060 + E00000800000008020000080400000806000008080000080A0000080C0000080 + E00000A0000000A0200000A0400000A0600000A0800000A0A00000A0C00000A0 + E00000C0000000C0200000C0400000C0600000C0800000C0A00000C0C00000C0 + E00000E0000000E0200000E0400000E0600000E0800000E0A00000E0C00000E0 + E00040000000400020004000400040006000400080004000A0004000C0004000 + E00040200000402020004020400040206000402080004020A0004020C0004020 + E00040400000404020004040400040406000404080004040A0004040C0004040 + E00040600000406020004060400040606000406080004060A0004060C0004060 + E00040800000408020004080400040806000408080004080A0004080C0004080 + E00040A0000040A0200040A0400040A0600040A0800040A0A00040A0C00040A0 + E00040C0000040C0200040C0400040C0600040C0800040C0A00040C0C00040C0 + E00040E0000040E0200040E0400040E0600040E0800040E0A00040E0C00040E0 + E00080000000800020008000400080006000800080008000A0008000C0008000 + E00080200000802020008020400080206000802080008020A0008020C0008020 + E00080400000804020008040400080406000804080008040A0008040C0008040 + E00080600000806020008060400080606000806080008060A0008060C0008060 + E00080800000808020008080400080806000808080008080A0008080C0008080 + E00080A0000080A0200080A0400080A0600080A0800080A0A00080A0C00080A0 + E00080C0000080C0200080C0400080C0600080C0800080C0A00080C0C00080C0 + E00080E0000080E0200080E0400080E0600080E0800080E0A00080E0C00080E0 + E000C0000000C0002000C0004000C0006000C0008000C000A000C000C000C000 + E000C0200000C0202000C0204000C0206000C0208000C020A000C020C000C020 + E000C0400000C0402000C0404000C0406000C0408000C040A000C040C000C040 + E000C0600000C0602000C0604000C0606000C0608000C060A000C060C000C060 + E000C0800000C0802000C0804000C0806000C0808000C080A000C080C000C080 + E000C0A00000C0A02000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0 + E000C0C00000C0C02000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0 + A000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF + FF00FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC000000000000000000000000 + 00000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFC00000000000000000000000000000000FCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC0000000000000000 + 00000000000000000000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFC0000000000000000000000000000000000000000 + 00000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC00000000 + 000000000000FFFFFFFFFFFFFFFFFFFFFFFF00000000000000000000FCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC00000000000000000000FFFFFFFFFFFF + FFFFFFFFFFFF00000000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + FCFC0000000000000000FFFFFFFF000000000000000000000000FFFFFFFF0000 + 000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC0000000000000000FFFF + FFFF000000000000000000000000FFFFFFFF0000000000000000FCFCFCFCFCFC + FCFCFCFCFCFCFCFC000000000000FFFFFFFF0000000000000000000000000000 + 000000000000FFFFFFFF000000000000FCFCFCFCFCFCFCFCFCFCFCFC00000000 + 0000FFFFFFFF0000000000000000000000000000000000000000FFFFFFFF0000 + 00000000FCFCFCFCFCFCFCFCFCFC000000000000FFFF00000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FCFCFCFCFCFC + FCFC000000000000FFFF00000000000000000000000000000000000000000000 + 000000000000FFFF000000000000FCFCFCFCFCFC000000000000FFFF00000000 + 00000000000000000000000000000000000000000000000000000000FFFF0000 + 00000000FCFCFCFC000000000000FFFF00000000000000000000000000000000 + 00000000000000000000000000000000FFFF000000000000FCFCFCFC00000000 + FFFF000000000000000000000000000052525252525252520000000000000000 + 000000000000FFFF00000000FCFCFCFC00000000FFFF00000000000000000000 + 0000000052525252525252520000000000000000000000000000FFFF00000000 + FCFC000000000000FFFF00000000000000000000000052525252525252525252 + 5252000000000000000000000000FFFF000000000000000000000000FFFF0000 + 0000000000000000000052525252525252525252525200000000000000000000 + 0000FFFF00000000000000000000FFFF00000000000000000000000052525252 + 525252525252525252525252000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000052525252525252525252525252525252 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000052525252525252525252525252525252000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000005252525252525252 + 5252525252525252000000000000000000000000FFFF0000000000000000FFFF + 0000000000000000000000005252525252525252525252525252525200000000 + 0000000000000000FFFF0000000000000000FFFF000000000000000000000000 + 52525252525252525252525252525252000000000000000000000000FFFF0000 + 000000000000FFFF000000000000000000000000525252525252525252525252 + 52525252000000000000000000000000FFFF0000000000000000FFFF00000000 + 0000000000000000525252525252525252525252525252520000000000000000 + 00000000FFFF0000000000000000FFFF00000000000000000000000000005252 + 525252525252525252520000000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000000005252525252525252525252520000 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000000000000525252525252525200000000000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000000000000052525252 + 5252525200000000000000000000000000000000FFFF0000000000000000FFFF + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FFFF0000000000000000FFFF000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FFFF0000 + 000000000000FFFF000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFF0000000000000000FFFF00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FFFF0000000000000000FFFF00000000000000000000000000000000 + 000000000000000000000000000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000000000000525252525252525200000000000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000000000000052525252 + 5252525200000000000000000000000000000000FFFF0000000000000000FFFF + 0000000000000000000000000000525252525252525252525252000000000000 + 0000000000000000FFFF0000000000000000FFFF000000000000000000000000 + 00005252525252525252525252520000000000000000000000000000FFFF0000 + 000000000000FFFF000000000000000000000000525252525252525252525252 + 52525252000000000000000000000000FFFF0000000000000000FFFF00000000 + 0000000000000000525252525252525252525252525252520000000000000000 + 00000000FFFF0000000000000000FFFF00000000000000000000000052525252 + 525252525252525252525252000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000052525252525252525252525252525252 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000052525252525252525252525252525252000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000005252525252525252 + 5252525252525252000000000000000000000000FFFF0000000000000000FFFF + 0000000000000000000000005252525252525252525252525252525200000000 + 0000000000000000FFFF0000000000000000FFFF000000000000000000000000 + 52525252525252525252525252525252000000000000000000000000FFFF0000 + 000000000000FFFF000000000000000000000000000052525252525252525252 + 52520000000000000000000000000000FFFF0000000000000000FFFF00000000 + 0000000000000000000052525252525252525252525200000000000000000000 + 00000000FFFF0000000000000000FFFF00000000000000000000000000000000 + 525252525252525200000000000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000000000000525252525252525200000000 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000FFFF0000000000000000FFFF + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FFFF0000000000000000FFFF000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FFFF0000 + 000000000000FFFF000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFF0000000000000000FFFF00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FFFF0000000000000000FFFF00000000000000000000000000000000 + 525252525252525200000000000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000000000000525252525252525200000000 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000000005252525252525252525252520000000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000000000525252525252 + 5252525252520000000000000000000000000000FFFF0000000000000000FFFF + 0000000000000000000000005252525252525252525252525252525200000000 + 0000000000000000FFFF0000000000000000FFFF000000000000000000000000 + 52525252525252525252525252525252000000000000000000000000FFFF0000 + 000000000000FFFF000000000000000000000000525252525252525252525252 + 52525252000000000000000000000000FFFF0000000000000000FFFF00000000 + 0000000000000000525252525252525252525252525252520000000000000000 + 00000000FFFF0000000000000000FFFF00000000000000000000000052525252 + 525252525252525252525252000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000052525252525252525252525252525252 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000052525252525252525252525252525252000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000005252525252525252 + 5252525252525252000000000000000000000000FFFF00000000000000000000 + FFFF000000000000000000000000525252525252525252525252000000000000 + 000000000000FFFF000000000000000000000000FFFF00000000000000000000 + 0000525252525252525252525252000000000000000000000000FFFF00000000 + 0000FCFC00000000FFFF00000000000000000000000000005252525252525252 + 0000000000000000000000000000FFFF00000000FCFCFCFC00000000FFFF0000 + 0000000000000000000000005252525252525252000000000000000000000000 + 0000FFFF00000000FCFCFCFC000000000000F6F6000000000000000000000000 + 0000000000000000000000000000000000000000FFFF000000000000FCFCFCFC + 000000000000F6F6000000000000000000000000000000000000000000000000 + 0000000000000000FFFF000000000000FCFCFCFCFCFC000000000000FFFF0000 + 0000000000000000000000000000000000000000000000000000FFFF00000000 + 0000FCFCFCFCFCFCFCFC000000000000FFFF0000000000000000000000000000 + 0000000000000000000000000000FFFF000000000000FCFCFCFCFCFCFCFCFCFC + 000000000000FFFFFFFF0000000000000000000000000000000000000000FFFF + FFFF000000000000FCFCFCFCFCFCFCFCFCFCFCFC000000000000FFFFFFFF0000 + 000000000000000000000000000000000000FFFFFFFF000000000000FCFCFCFC + FCFCFCFCFCFCFCFCFCFC0000000000000000FFFFFFFF00000000000000000000 + 0000FFFFFFFF0000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC0000 + 000000000000FFFFFFFF000000000000000000000000FFFFFFFF000000000000 + 0000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC00000000000000000000FFFF + FFFFFFFFFFFFFFFFFFFF00000000000000000000FCFCFCFCFCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFC00000000000000000000FFFFFFFFFFFFFFFFFFFFFFFF0000 + 0000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + 000000000000000000000000000000000000000000000000FCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC000000000000000000000000 + 000000000000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFC00000000000000000000000000000000FCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + 00000000000000000000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + FCFC} + Visible = False + end + object Image2feux2x: TImage + Left = 608 + Top = 0 + Width = 52 + Height = 72 + Picture.Data = { + 07544269746D6170D6120000424DD61200000000000036040000280000003400 + 0000480000000100080000000000A00E0000C40E0000C40E0000000100000001 + 000000000000000080000080000000808000800000008000800080800000C0C0 + C000C0DCC000F0CAA6000020400000206000002080000020A0000020C0000020 + E00000400000004020000040400000406000004080000040A0000040C0000040 + E00000600000006020000060400000606000006080000060A0000060C0000060 + E00000800000008020000080400000806000008080000080A0000080C0000080 + E00000A0000000A0200000A0400000A0600000A0800000A0A00000A0C00000A0 + E00000C0000000C0200000C0400000C0600000C0800000C0A00000C0C00000C0 + E00000E0000000E0200000E0400000E0600000E0800000E0A00000E0C00000E0 + E00040000000400020004000400040006000400080004000A0004000C0004000 + E00040200000402020004020400040206000402080004020A0004020C0004020 + E00040400000404020004040400040406000404080004040A0004040C0004040 + E00040600000406020004060400040606000406080004060A0004060C0004060 + E00040800000408020004080400040806000408080004080A0004080C0004080 + E00040A0000040A0200040A0400040A0600040A0800040A0A00040A0C00040A0 + E00040C0000040C0200040C0400040C0600040C0800040C0A00040C0C00040C0 + E00040E0000040E0200040E0400040E0600040E0800040E0A00040E0C00040E0 + E00080000000800020008000400080006000800080008000A0008000C0008000 + E00080200000802020008020400080206000802080008020A0008020C0008020 + E00080400000804020008040400080406000804080008040A0008040C0008040 + E00080600000806020008060400080606000806080008060A0008060C0008060 + E00080800000808020008080400080806000808080008080A0008080C0008080 + E00080A0000080A0200080A0400080A0600080A0800080A0A00080A0C00080A0 + E00080C0000080C0200080C0400080C0600080C0800080C0A00080C0C00080C0 + E00080E0000080E0200080E0400080E0600080E0800080E0A00080E0C00080E0 + E000C0000000C0002000C0004000C0006000C0008000C000A000C000C000C000 + E000C0200000C0202000C0204000C0206000C0208000C020A000C020C000C020 + E000C0400000C0402000C0404000C0406000C0408000C040A000C040C000C040 + E000C0600000C0602000C0604000C0606000C0608000C060A000C060C000C060 + E000C0800000C0802000C0804000C0806000C0808000C080A000C080C000C080 + E000C0A00000C0A02000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0 + E000C0C00000C0C02000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0 + A000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF + FF00FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC000000000000000000000000 + 00000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFC00000000000000000000000000000000FCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC0000000000000000 + 00000000000000000000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFC0000000000000000000000000000000000000000 + 00000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC00000000 + 000000000000FFFFFFFFFFFFFFFFFFFFFFFF00000000000000000000FCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC00000000000000000000FFFFFFFFFFFF + FFFFFFFFFFFF00000000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + FCFC0000000000000000FFFFFFFF000000000000000000000000FFFFFFFF0000 + 000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC0000000000000000FFFF + FFFF000000000000000000000000FFFFFFFF0000000000000000FCFCFCFCFCFC + FCFCFCFCFCFCFCFC000000000000FFFFFFFF0000000000000000000000000000 + 000000000000FFFFFFFF000000000000FCFCFCFCFCFCFCFCFCFCFCFC00000000 + 0000FFFFFFFF0000000000000000000000000000000000000000FFFFFFFF0000 + 00000000FCFCFCFCFCFCFCFCFCFC000000000000FFFF00000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FCFCFCFCFCFC + FCFC000000000000FFFF00000000000000000000000000000000000000000000 + 000000000000FFFF000000000000FCFCFCFCFCFC000000000000FFFF00000000 + 00000000000000000000000000000000000000000000000000000000FFFF0000 + 00000000FCFCFCFC000000000000FFFF00000000000000000000000000000000 + 00000000000000000000000000000000FFFF000000000000FCFCFCFC00000000 + FFFF000000000000000000000000000052525252525252520000000000000000 + 000000000000FFFF00000000FCFCFCFC00000000FFFF00000000000000000000 + 0000000052525252525252520000000000000000000000000000FFFF00000000 + FCFC000000000000FFFF00000000000000000000000052525252525252525252 + 5252000000000000000000000000FFFF000000000000000000000000FFFF0000 + 0000000000000000000052525252525252525252525200000000000000000000 + 0000FFFF00000000000000000000FFFF00000000000000000000000052525252 + 525252525252525252525252000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000052525252525252525252525252525252 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000052525252525252525252525252525252000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000005252525252525252 + 5252525252525252000000000000000000000000FFFF0000000000000000FFFF + 0000000000000000000000005252525252525252525252525252525200000000 + 0000000000000000FFFF0000000000000000FFFF000000000000000000000000 + 52525252525252525252525252525252000000000000000000000000FFFF0000 + 000000000000FFFF000000000000000000000000525252525252525252525252 + 52525252000000000000000000000000FFFF0000000000000000FFFF00000000 + 0000000000000000525252525252525252525252525252520000000000000000 + 00000000FFFF0000000000000000FFFF00000000000000000000000000005252 + 525252525252525252520000000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000000005252525252525252525252520000 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000000000000525252525252525200000000000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000000000000052525252 + 5252525200000000000000000000000000000000FFFF0000000000000000FFFF + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FFFF0000000000000000FFFF000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FFFF0000 + 000000000000FFFF000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFF0000000000000000FFFF00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FFFF0000000000000000FFFF00000000000000000000000000000000 + 000000000000000000000000000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000FFFF0000000000000000FFFF + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FFFF0000000000000000FFFF000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FFFF0000 + 000000000000FFFF000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFF0000000000000000FFFF00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FFFF0000000000000000FFFF00000000000000000000000000000000 + 525252525252525200000000000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000000000000525252525252525200000000 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000000005252525252525252525252520000000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000000000525252525252 + 5252525252520000000000000000000000000000FFFF0000000000000000FFFF + 0000000000000000000000005252525252525252525252525252525200000000 + 0000000000000000FFFF0000000000000000FFFF000000000000000000000000 + 52525252525252525252525252525252000000000000000000000000FFFF0000 + 000000000000FFFF000000000000000000000000525252525252525252525252 + 52525252000000000000000000000000FFFF0000000000000000FFFF00000000 + 0000000000000000525252525252525252525252525252520000000000000000 + 00000000FFFF0000000000000000FFFF00000000000000000000000052525252 + 525252525252525252525252000000000000000000000000FFFF000000000000 + 0000FFFF00000000000000000000000052525252525252525252525252525252 + 000000000000000000000000FFFF0000000000000000FFFF0000000000000000 + 0000000052525252525252525252525252525252000000000000000000000000 + FFFF0000000000000000FFFF0000000000000000000000005252525252525252 + 5252525252525252000000000000000000000000FFFF00000000000000000000 + FFFF000000000000000000000000525252525252525252525252000000000000 + 000000000000FFFF000000000000000000000000FFFF00000000000000000000 + 0000525252525252525252525252000000000000000000000000FFFF00000000 + 0000FCFC00000000FFFF00000000000000000000000000005252525252525252 + 0000000000000000000000000000FFFF00000000FCFCFCFC00000000FFFF0000 + 0000000000000000000000005252525252525252000000000000000000000000 + 0000FFFF00000000FCFCFCFC000000000000FFFF000000000000000000000000 + 0000000000000000000000000000000000000000FFFF000000000000FCFCFCFC + 000000000000FFFF000000000000000000000000000000000000000000000000 + 0000000000000000FFFF000000000000FCFCFCFCFCFC000000000000FFFF0000 + 0000000000000000000000000000000000000000000000000000FFFF00000000 + 0000FCFCFCFCFCFCFCFC000000000000FFFF0000000000000000000000000000 + 0000000000000000000000000000FFFF000000000000FCFCFCFCFCFCFCFCFCFC + 000000000000FFFFFFFF0000000000000000000000000000000000000000FFFF + FFFF000000000000FCFCFCFCFCFCFCFCFCFCFCFC000000000000FFFFFFFF0000 + 000000000000000000000000000000000000FFFFFFFF000000000000FCFCFCFC + FCFCFCFCFCFCFCFCFCFC0000000000000000FFFFFFFF00000000000000000000 + 0000FFFFFFFF0000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC0000 + 000000000000FFFFFFFF000000000000000000000000FFFFFFFF000000000000 + 0000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC00000000000000000000FFFF + FFFFFFFFFFFFF6F6FFFF00000000000000000000FCFCFCFCFCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFC00000000000000000000FFFFFFFFFFFFFFFFF6F6FFFF0000 + 0000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + 000000000000000000000000000000000000000000000000FCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC000000000000000000000000 + 000000000000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFC00000000000000000000000000000000FCFCFCFC + FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + 00000000000000000000000000000000FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC + FCFC} + Visible = False + end object StatusBar1: TStatusBar Left = 0 Top = 491 - Width = 847 + Width = 1019 Height = 22 Panels = < item @@ -5896,8 +6242,8 @@ object FormPrinc: TFormPrinc end end object GroupBoxCV: TGroupBox - Left = 617 - Top = 128 + Left = 577 + Top = 144 Width = 265 Height = 81 Anchors = [akTop, akRight] @@ -5964,7 +6310,7 @@ object FormPrinc: TFormPrinc Top = 200 Width = 393 Height = 265 - ActivePage = TabSheetComp + ActivePage = TabSheetSig Anchors = [] TabOrder = 5 OnChange = PageControlChange @@ -5987,6 +6333,24 @@ object FormPrinc: TFormPrinc ParentColor = False TabOrder = 0 end + object TrackBarSig: TTrackBar + Left = 352 + Top = 0 + Width = 37 + Height = 217 + Hint = 'Zoom signaux' + Anchors = [akTop, akRight, akBottom] + Orientation = trVertical + ParentShowHint = False + Frequency = 20 + Position = 10 + ShowHint = True + TabOrder = 1 + ThumbLength = 15 + TickMarks = tmTopLeft + TickStyle = tsManual + OnChange = TrackBarSigChange + end end object TabSheetTrains: TTabSheet Caption = 'Trains' @@ -6060,7 +6424,7 @@ object FormPrinc: TFormPrinc Top = 8 end object MainMenu1: TMainMenu - Left = 536 + Left = 464 object Afficher1: TMenuItem Caption = 'Afficher' object Affichagenormal1: TMenuItem @@ -6461,15 +6825,16 @@ object FormPrinc: TFormPrinc end end object OpenDialog: TOpenDialog - Left = 584 - Top = 16 + Left = 616 + Top = 32 end object SaveDialog: TSaveDialog - Left = 744 + Left = 464 + Top = 32 end object PopupMenuFenRich: TPopupMenu - Left = 192 - Top = 8 + Left = 528 + Top = 32 object outslectionner1: TMenuItem Caption = 'Tout s'#233'lectionner' OnClick = Toutslectionner1Click @@ -6488,7 +6853,7 @@ object FormPrinc: TFormPrinc end object PopupMenuSignal: TPopupMenu OnPopup = PopupMenuSignalPopup - Left = 504 + Left = 496 Top = 32 object Proprits1: TMenuItem Caption = 'Propri'#233't'#233's du signal' @@ -6501,7 +6866,7 @@ object FormPrinc: TFormPrinc end object PopupMenuTrains: TPopupMenu OnPopup = PopupMenuTrainsPopup - Left = 480 + Left = 528 object Propritsdutrain1: TMenuItem Caption = 'Propri'#233't'#233's du train' OnClick = Propritsdutrain1Click @@ -6516,7 +6881,7 @@ object FormPrinc: TFormPrinc end object PopupMenuCompteurs: TPopupMenu OnPopup = PopupMenuCompteursPopup - Left = 512 + Left = 496 object Propritsdescompteurs1: TMenuItem Caption = 'Propri'#233't'#233's des compteurs' OnClick = Propritsdescompteurs1Click @@ -6526,4 +6891,10 @@ object FormPrinc: TFormPrinc OnClick = Dtacherlecompteur1Click end end + object Timer2: TTimer + Interval = 50 + OnTimer = Timer2Timer + Left = 688 + Top = 16 + end end diff --git a/UnitPrinc.pas b/UnitPrinc.pas index b9fde0b..ae253af 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -1,34 +1,42 @@ unit Unitprinc; -// 18/12/2025 -(******************************************** +// 24/12/2025 +{ ******************************************** Programme signaux complexes Graphique Lenz - Composants ClientSocket et ServeurSocket pour les connexions réseau socket - -------------------------------------------------------------- Delphi 7 : - on utilise activeX Tmscomm pour les liaisons série/USB + pour les liaisons série/USB on utilise l'activeX Tmscomm -------------------------------------------------------------- Delphi 13 : - Dans Outils / Options / Interface utilisateurs / Concerpteur de fiches / Haute résolution + Dans Outils / Options / Interface utilisateurs / Concepteur de fiches / Haute résolution Sélectionner Automatique (PPI de l'écran) et cocher "taille de la grille..." - on utilise AsyncPro pour les liaisons série/USB - ce composant est compilable en 32 et en 64 bits. + pour les liaisons série/USB on utilise AsyncPro - Il existe sous forme de composant , mais dans SC, + on utilise les fichiers ci dessous, qui sont compilables en 32 ou en 64 bits. https://github.com/TurboPack/AsyncPro liste des fichiers nécessaires: - AdDispLog.inc - AdExcept.fra - AdExcept.pas - AdPort.pas - AdSelCom.dfm - AdSelCom.pas - AdStrMap.pas + AdDispLog.inc https://github.com/TurboPack/AsyncPro/blob/master/source/AdDispLog.inc + AdExcept.fra https://github.com/TurboPack/AsyncPro/blob/master/source/AdExcept.fra + AdExcept.pas https://github.com/TurboPack/AsyncPro/blob/master/source/AdExcept.pas + AdPort.pas https://github.com/TurboPack/AsyncPro/blob/master/source/AdPort.pas + AdSelCom.dfm https://github.com/TurboPack/AsyncPro/blob/master/source/AdSelCom.dfm + AdSelCom.pas https://github.com/TurboPack/AsyncPro/blob/master/source/AdSelCom.pas + AdStrMap.pas https://github.com/TurboPack/AsyncPro/blob/master/source/AdStrMap.pas + AwDefine.inc https://github.com/TurboPack/AsyncPro/blob/master/source/AwDefine.inc + AwUser.pas https://github.com/TurboPack/AsyncPro/blob/master/source/AwUser.pas + AwWin32.pas https://github.com/TurboPack/AsyncPro/blob/master/source/AwWin32.pas + LnsWin32.pas https://github.com/TurboPack/AsyncPro/blob/master/source/LNSWin32.pas + LnsQueue.pas https://github.com/TurboPack/AsyncPro/blob/master/source/LnsQueue.pas + OoMisc.pas https://github.com/TurboPack/AsyncPro/blob/master/source/OoMisc.pas AwDefine.inc - AwUser.pas - AwWin32.pas - LnsWin32.pas - LnsQueue.pas - OoMisc.pas + + Utilisation des styles: + https://github.com/RRUZ/vcl-styles-utils + nécessite les fichiers + VCL.Styles.Utils.inc https://github.com/RRUZ/vcl-styles-utils/tree/master/Common/VCL.Styles.Utils.inc + Vcl.Styles.Ext.pas https://github.com/RRUZ/vcl-styles-utils/blob/master/Common/Vcl.Styles.Ext.pas + Vcl.Styles.Utils.Misc.pas https://github.com/RRUZ/vcl-styles-utils/blob/master/Common/Vcl.Styles.Utils.Misc.pas + Vcl.Styles.Utils.Graphics.pas https://github.com/RRUZ/vcl-styles-utils/blob/master/Common/Vcl.Styles.Utils.Graphics.pas ------------------------------------------------- @@ -41,6 +49,7 @@ unit Unitprinc; Projet / Options // Application / manifeste / fichier manifeste : personnaliser à la sauvegarde, ce champ apparaitra sous "générer automatiquement" et : décocher "activer les thèmes d'exécution" + https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions ******************************************** @@ -59,34 +68,35 @@ unit Unitprinc; ligne de commande en mode administrateur pour valider le socket du pare feu: netsh advfirewall firewall add rule name="cdm rail" dir=in action=allow program="C:\Program Files (x86)\CDM-Rail\cdr.exe" enable=yes - *) -// -// En mode simulation run: -// CDM ne renvoie pas les détecteurs au départ du RUN, ou pendant le RUN -// les noms des trains sont bien renvoyés sur les actionneurs à 1 -// -// En mode RUN CDM avec train: -// CDM renvoie le nom des trains sur les actionneurs à 1, jamais à 0 -// et quelquefois (pas toujours!) sur les détecteurs à 1, jamais à 0 (il renvoie _NONE) -// Au début du RUN, CDM renvoie les états des détecteurs à 1 et en mélangé les aiguillages et on en reçoit les états. -// Puis on reçoit la position des trains qui bougent. Si un train parqué ne bouge pas, on ne reçoit rien de ce train. -// -// En mode RUN TCO CDM (sans trains) : une commande de vitesse à un train n'est pas transmise -// sur le réseau. Les aiguillages oui -// -// En simulation: -// CDM Rail ne renvoie pas les états des aiguillages en début de simu -// Les aiguillages sont renvoyés quand on clique dessus -// Les actionneurs fonctionnent. Les détecteurs ne sont pas renvoyés. -// -// En mode centrale connectée à signaux complexes (autonome) -// si on bouge un aiguillage à la raquette, SC récupère bien sa position par XpressNet. -// Une loco sur un détecteur au lancement ne renvoie pas son état statique. Seuls les changements -// d'état sont renvoyés par la centrale. Ou alors il faut demander explicitement les états des détecteurs -// à la centrale par le menu "interface / demander état détecteurs" -// -// Si SC envoie une position d'aiguillage à CDM, il ne change pas sa représentation dans CDM. - //https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions + + + En mode simulation run: + CDM ne renvoie pas les détecteurs au départ du RUN, ou pendant le RUN + les noms des trains sont bien renvoyés sur les actionneurs à 1 + + En mode RUN CDM avec train: + CDM renvoie le nom des trains sur les actionneurs à 1, jamais à 0 + et quelquefois (pas toujours!) sur les détecteurs à 1, jamais à 0 (il renvoie _NONE) + Au début du RUN, CDM renvoie les états des détecteurs à 1 et en mélangé les aiguillages et on en reçoit les états. + Puis on reçoit la position des trains qui bougent. Si un train parqué ne bouge pas, on ne reçoit rien de ce train. + + En mode RUN TCO CDM (sans trains) : une commande de vitesse à un train n'est pas transmise + sur le réseau. Les aiguillages oui + + En simulation: + CDM Rail ne renvoie pas les états des aiguillages en début de simu + Les aiguillages sont renvoyés quand on clique dessus + Les actionneurs fonctionnent. Les détecteurs ne sont pas renvoyés. + + En mode centrale connectée à signaux complexes (autonome) + si on bouge un aiguillage à la raquette, SC récupère bien sa position par XpressNet. + Une loco sur un détecteur au lancement ne renvoie pas son état statique. Seuls les changements + d'état sont renvoyés par la centrale. Ou alors il faut demander explicitement les états des détecteurs + à la centrale par le menu "interface / demander état détecteurs" + + Si SC envoie une position d'aiguillage à CDM, il ne change pas sa représentation dans CDM. + +} //{$Q-} // pas de vérification du débordement des opérations de calcul //{$R-} // pas de vérification des limites d'index du tableau et des variables @@ -298,6 +308,10 @@ type Label1: TLabel; LabelNbTrains: TLabel; SBMarcheArretLoco: TSpeedButton; + TrackBarSig: TTrackBar; + Image3feux2x: TImage; + Image2feux2x: TImage; + Timer2: TTimer; procedure FormCreate(Sender: TObject); {$IF CompilerVersion >= 28.0} procedure RecuInterface(Sender: TObject;count : word); @@ -448,6 +462,8 @@ type procedure Dtacherlecompteur1Click(Sender: TObject); procedure PopupMenuCompteursPopup(Sender: TObject); procedure Button1Click(Sender: TObject); + procedure TrackBarSigChange(Sender: TObject); + procedure Timer2Timer(Sender: TObject); private { Déclarations privées } procedure DoHint(Sender : Tobject); @@ -752,9 +768,9 @@ TSignal = record Btype_suiv2 : TEquipement ; // type de l'élément suivant voie 2 - Ne prend que les valeurs rien, det ou aig Btype_suiv3 : TEquipement ; // type de l'élément suivant voie 3 - Ne prend que les valeurs rien, det ou aig Btype_suiv4 : TEquipement ; // type de l'élément suivant voie 4 - Ne prend que les valeurs rien, det ou aig - VerrouCarre : boolean ; // si vrai, le feu se verrouille au carré si pas de train avant le signal - // EtatVerrouCarre : boolean ; // si vrai, le feu est verrouillé au carré - modifie : boolean; // feu modifié + VerrouCarre : boolean ; // si vrai, le signal se verrouille au carré si pas de train avant le signal + // EtatVerrouCarre : boolean ; // si vrai, le signal est verrouillé au carré + modifie : boolean; // signal modifié EtatSignal : word ; // état du signal AncienEtat : word ; // ancien état du signal AncienAff : word ; // état ancien affichage @@ -985,7 +1001,7 @@ var I_simule,maxTablo_act,NbreVoies,El_suivant,N_modules_dcc,NbDet1,ncrois,NbreCompteursPLigne, tempsCli,NbreSignaux,pasreponse,AdrDevie,fenetre,Tempo_Aig,Tempo_Signal,etat_init_interface, NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant, - Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM,index_couleur, + Nbre_recu_cdm,Adj1,Adj2,NbrePN,ServeurInterfaceCDM,index_couleur, ServeurRetroCDM,TailleFonte,Nb_Det_Dist,Tdoubleclic,algo_Unisemaf,fA,fB, etape,idEl,intervalle_courant,filtrageDet0,Nactionneurs,nombreStyles,idTrainUSB, TpsTimeoutSL,formatY,OsBits,NbreDecPers,NbDecodeur,NbDecodeurdeBase,HautImageC,LargImageC, @@ -1008,7 +1024,7 @@ var Modesombre,serveur_ouvert,pasChgTBV,FpBouge,debugPN,simuInterface,option_demitour, mesureTrains,AffCompteur,clicTBGB,clicTBfen,clicTBTrain,ModeTache,NoTraite : boolean; - RedFonte : single; + RedAffSig,RedFonte : single; Style : array[0..200] of Tstyle; @@ -1035,7 +1051,7 @@ var FormPrinc: TFormPrinc; Enregistrement,chaine_Envoi,Id_CDM,Af,version_Interface,entete,suffixe,Lay, - CheminProgrammesCDM,CheminProgrammes,cheminWin,fichierAide : string; + CheminProgrammesCDM,CheminProgrammes,cheminWin,fichierAide,repertoire_SC : string; Ancien_detecteur : array[0..NbMaxDet] of boolean; // anciens état des détecteurs et adresses des détecteurs et leur état @@ -1302,7 +1318,7 @@ procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string); procedure Event_act(adr,adr2,etat : integer;trainDecl : string); function verif_UniSemaf(adresse,UniSem : integer) : integer; function verif_LEB(adresse,UniSem : integer) : integer; -function Select_dessin_Signal(TypeSignal : integer) : TBitmap; +function Select_dessin_Signal(TypeSignal : integer;var l,h : integer) : TBitmap; procedure cree_image_signal(rang : integer); procedure cree_image_onglet_Train(rang : integer); procedure trouve_aiguillage(adresse : integer); @@ -1356,7 +1372,9 @@ procedure maj_couleurs; procedure AffTexteIncliBordeTexture(c : TCanvas; x,y : integer; Fonte : tFont; clBord : TColor; EpBord : integer; PenMode : TPenMode; texte : string; AngleDD : longint); +{$IF CompilerVersion >= 28.0} procedure change_style; +{$IFEND} function isDirectionnel(index : integer) : boolean; procedure stop_trains; function Aiguille_deviee(adresse : integer) : integer ; @@ -1382,7 +1400,7 @@ procedure procetape(s : string); procedure Affiche_routes_brut; procedure TJD4(adr1,pos1,adr2,pos2 : integer;var c1,c2 : char); procedure affecte_trains_config; -procedure Fonction_Loco_Operation(loco,fonction,etat : integer); +procedure Fonction_Loco_Operation_XNet(loco,fonction,etat : integer); procedure calcul_equations_coeff(indexTrain : integer); procedure connecte_interface_ethernet; function lire_cv(cv : integer) : integer; @@ -1418,6 +1436,7 @@ begin end; } +{$IF CompilerVersion >= 28.0} // lire les fichiers styles vsf - Uniquement D13 procedure lire_styles; var path,ext : string; @@ -1427,14 +1446,14 @@ var path,ext : string; chem,s : string; nombre,i,j : integer; Style1 : tStyle; - {$IF CompilerVersion >= 28.0} + ss : TArray; si : tStyleInfo; - {$IFEND} + Nbss : integer; begin // liste des fichiers chemin destination - {$IF CompilerVersion >= 28.0} + //{$IF CompilerVersion >= 28.0} ss:=TStyleManager.StyleNames; // contient les styles déja chargés en mémoire Nbss:=high(ss); @@ -1500,7 +1519,7 @@ begin end; end; end; - {$IFEND} + //{$IFEND} // renseigner clair/sombre for i:=1 to nombreStyles do @@ -1621,21 +1640,24 @@ begin if s='zircon se' then style[i].clarte:=clair; end; end; + {$IFEND} + // 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. +{$IF CompilerVersion >= 28.0} procedure change_style; var i,j,index : integer; s : string; comp : Tcomponent; te : tEdit; - {$IF CompilerVersion >= 28.0} + // {$IF CompilerVersion >= 28.0} si : tStyleInfo; - {$IFEND} + // {$IFEND} begin - {$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 après changement du nouveau style @@ -1700,8 +1722,8 @@ begin Ancien_nom_style:=nom_Style_aff; end; - {$IFEND} end; +{$IFEND} // consigne du train courant cliqué // origine=1 vient du clic bouton "envoi vitesse à loco" @@ -1812,7 +1834,7 @@ begin with ScrollBoxSig do begin Left:=0;top:=0; - width:=TabSheetSig.Width; + width:=TabSheetSig.Width-TrackBarSig.Width; Height:=TabSheetSig.Height; end; with ScrollBoxTrains do @@ -1827,6 +1849,7 @@ begin width:=TabSheetComp.Width-TrackBarZC.Width; Height:=TabSheetComp.Height; end; + positionne_elements(splitterV.left); end; @@ -2051,7 +2074,9 @@ begin n:=trains[i].routePref[0,0].adresse; if n<>0 then begin - s:=' train '+intToSTR(i)+' : '+intToSTR(n)+' routes'; + s:='Train '+intToSTR(i)+': '+intToSTR(n)+' route'; + if n>1 then s:=s+'s'; + s:=s+'. '; if mode=1 then Affiche(s,clyellow); if mode=2 then ClientInfo.Socket.SendText(s); end; @@ -2204,6 +2229,8 @@ begin end; Maj_Signaux(false); + change_clic_train(1); // sélectionne le train 1 + end; // renvoie une chaine ASCI Hexa affichable à partir d'une chaîne @@ -2306,11 +2333,9 @@ end; {$IFEND} {$IF CompilerVersion >= 28.0} -// envoi la chaîne trameIF à la centrale par USBLenz ou socket, n'attend pas l'ack +// envoi la chaîne s à la centrale par COM ou socket, n'attend pas l'ack // pour le protole XpressNet (1), on ajoute l'entete et le suffixe dans la trame. -// ici on envoie pas à CDM -// la fonction PutBlock nécessite un tableau z[] commençant à 1 et pas à 0 -// avec asyncpro +// la fonction asyncpro PutBlock nécessite un tableau z[] commençant à 1 et pas à 0 procedure envoi_ss_ack(s : string); var i,timeout,valto,l : integer; z : array[1..100] of byte; @@ -2402,9 +2427,8 @@ begin end; {$ELSE} -// envoi la chaîne trameIF à la centrale par USB ou socket, n'attend pas l'ack +// envoi la chaîne s à la centrale par USB ou socket, n'attend pas l'ack // pour le protole XpressNet (1), on ajoute l'entete et le suffixe dans la trame. -// ici on envoie pas à CDM // utilisation de TMSCOMM procedure envoi_ss_ack(s : string); var i,timeout,valto,l : integer; @@ -4030,7 +4054,7 @@ begin code_to_aspect(Etatsignal,code,combine); rayon:=round(DiamFeu*frX); - // récupérer les dimensions de l'image d'origine du feu + // récupérer les dimensions de l'image d'origine du signal with Formprinc.Image2feux.Picture.Bitmap do begin LgImage:=Width; @@ -4086,6 +4110,7 @@ begin code_to_aspect(Etatsignal,code,combine); //Affiche(intToSTR(ancienEtat),clred); + // frX : réduction pour le TCO r ; réduction pour l'afichage de la fenetre principale de droite rayon:=round(DiamFeu*frX); with Formprinc.Image3feux.Picture.Bitmap do @@ -4093,9 +4118,9 @@ begin LgImage:=Width; HtImage:=Height; end; - Xvert:=13; Yvert:=11; - xSem:=13; ySem:=22; - xJaune:=13; yJaune:=33; + Xvert:=round(13); Yvert:=round(11); + xSem:=round(13); ySem:=round(22); + xJaune:=round(13); yJaune:=round(33); if (orientation=2) then begin @@ -5085,6 +5110,7 @@ begin end; end; +// cliqué sur image signal // procédure activée quand on clique gauche sur l'image d'un signal Procedure TFormprinc.ImageOnClick(Sender : Tobject); var s : string; @@ -5092,7 +5118,7 @@ var s : string; i,erreur : integer; begin P_image_pilote:=Sender as TImage; // récupérer l'objet image du signal cliqué de la forme pilote - s:=P_Image_pilote.Hint; // récupérer son hint qui contient l'adresse du feu cliqué + s:=P_Image_pilote.Hint; // récupérer son hint qui contient l'adresse du signal cliqué //Affiche(s,clyellow); i:=pos('@',s); if i<>0 then delete(s,1,i); i:=pos('=',s); if i<>0 then delete(s,i,1); @@ -5102,37 +5128,41 @@ begin if adrPilote=0 then exit; i:=Index_Signal(AdrPilote); if i=0 then exit; - + Maj_Etat_Signal(0,Signaux[i].EtatSignal); Formpilote.show; end; -function Select_dessin_Signal(TypeSignal : integer) : TBitmap; +function Select_dessin_Signal(TypeSignal : integer;var l,h : integer) : TBitmap; var Bm : TBitMap; begin case TypeSignal of - 2 : Bm:=Formprinc.Image2feux.picture.Bitmap; - 3 : Bm:=Formprinc.Image3feux.picture.Bitmap; - 4 : Bm:=Formprinc.Image4feux.picture.Bitmap; - 5 : Bm:=Formprinc.Image5feux.picture.Bitmap; - 7 : Bm:=Formprinc.Image7feux.picture.Bitmap; - 9 : Bm:=Formprinc.Image9feux.picture.Bitmap; - 20 : Bm:=Formprinc.ImageSignal20.picture.Bitmap; // belge + 2 : begin Bm:=Formprinc.Image2feux.picture.Bitmap;l:=26;h:=36;end; + // 2 : begin Bm:=Formprinc.Image2feux.picture.Bitmap;l:=52;h:=72;end; // signaux 2 fois plus grands + 3 : begin Bm:=Formprinc.Image3feux.picture.Bitmap;l:=26;h:=44;end; +// 3 : begin Bm:=Formprinc.Image3feux2x.picture.Bitmap;l:=52;h:=88;end; + + 4 : begin Bm:=Formprinc.Image4feux.picture.Bitmap;l:=26;h:=57;end; + 5 : begin Bm:=Formprinc.Image5feux.picture.Bitmap;l:=26;h:=55;end; + 7 : begin Bm:=Formprinc.Image7feux.picture.Bitmap;l:=50;h:=77;end; + 9 : begin Bm:=Formprinc.Image9feux.picture.Bitmap;l:=50;h:=91;end; + 20 : begin Bm:=Formprinc.ImageSignal20.picture.Bitmap;l:=57;h:=105;end; // belge // signaux directionnels - 12 : Bm:=Formprinc.Image2Dir.picture.Bitmap; - 13 : Bm:=Formprinc.Image3Dir.picture.Bitmap; - 14 : Bm:=Formprinc.Image4Dir.picture.Bitmap; - 15 : Bm:=Formprinc.Image5Dir.picture.Bitmap; - 16 : Bm:=Formprinc.Image6Dir.picture.Bitmap; + 12 : begin Bm:=Formprinc.Image2Dir.picture.Bitmap;l:=37;h:=26;end; + 13 : begin Bm:=Formprinc.Image3Dir.picture.Bitmap;l:=44;h:=26;end; + 14 : begin Bm:=Formprinc.Image4Dir.picture.Bitmap;l:=55;h:=26;end; + 15 : begin Bm:=Formprinc.Image5Dir.picture.Bitmap;l:=66;h:=26;end; + 16 : begin Bm:=Formprinc.Image6Dir.picture.Bitmap;l:=77;h:=26;end; else Bm:=nil; end; Select_dessin_Signal:=bm; end; // créée une image dynamiquement dans la partie droite pour un nouveau signal déclaré dans le fichier de config +// la label d'adresse du signal et le checkbox du feu blanc // rang commence à 1 procedure cree_image_signal(rang : integer); -var adresse,TypeSignal : integer; +var adresse,TypeSignal,l,h,lIcone,hIcone : integer; s : string; T_BP : TBitMap; begin @@ -5149,10 +5179,18 @@ begin align:=alNone; Parent:=Formprinc.ScrollBoxSig; // dire que l'image est dans la scrollBox1 Name:='ImageSignal'+IntToSTR(rang); // nom de l'image - Top:=(HtImg+espY+20)*((rang-1) div NbreImagePLigne); // détermine les points d'origine - Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); - width:=LargImg; - Height:=HtImg; + + l:=round(LargImg*RedAffSig); + h:=round(HtImg*RedAffSig); + + Top:=(h+espY+20)*((rang-1) div NbreImagePLigne); // détermine les points d'origine + Left:=10+ (l+5)*((rang-1) mod (NbreImagePLigne)); + width:=l; + Height:=h; + picture.bitmap.width:=l; + picture.bitmap.height:=h; + + //Stretch:=true; // hint - sert à identifier le composant si on fait clic droit. s:='Index='+IntToSTR(rang)+' @='+inttostr(Adresse)+' Décodeur='+decodeur[Signaux[rang].Decodeur]+#13+ @@ -5161,25 +5199,33 @@ begin if Signaux[rang].Btype_suiv1=aig then s:=s+' (aig)'; Hint:=s; showHint:=true; + //proportional:=true; + //Stretch:=true; onClick:=Formprinc.Imageonclick; // affectation procédure clique G sur image onMouseDown:=Formprinc.ProcOnMouseDown; // clique G ou D PopUpMenu:=Formprinc.PopupMenuSignal; // affectation popupmenu sur clic droit // affecter le type d'image de signal dans l'image créée - T_BP:=Select_dessin_Signal(TypeSignal); + T_BP:=Select_dessin_Signal(TypeSignal,lIcone,hIcone); if T_BP=nil then begin Affiche('Erreur 418 : sélection type signal incorrecte pour signal '+intToSTR(adresse),clred); exit; end; - picture.Bitmap:=T_Bp; + + canvas.Brush.color:=clSilver; + canvas.Pen.Color:=ClSilver; + Canvas.Rectangle(0,0,l,h); picture.BitMap.TransparentMode:=tmfixed; // tmauto (la couleur transparente est déterminée par pixel le plus en haut à gauche du bitmap) // tmfixed (la couleur transparente est explicitement assignée et stockée dans le bitmap) Picture.Bitmap.TransparentColor:=clblue; // la couleur de transparence est bleue Transparent:=true; + Canvas.StretchDraw(rect(0,0,round(lIcone*RedAffSig),round(hIcone*RedAffSig)),T_bp); // copier avec agrandissement + + // mettre rouge par défaut Signaux[rang].AncienEtat:=9999; if TypeSignal=2 then Signaux[rang].EtatSignal:=violet_F; @@ -5197,7 +5243,7 @@ begin Signaux[rang].EtatSignal:=Signaux[rang].EtatSignal+clignote_F; end; end; - dessine_signal_mx(Signaux[rang].Img.Canvas,0,0,1,1,Signaux[rang].adresse,1); + dessine_signal_mx(Signaux[rang].Img.Canvas,0,0,RedAffSig,RedAffSig,Signaux[rang].adresse,1); // redAffSig affecté à redX et redY //if Signaux[rang].aspect=5 then cercle(Picture.Bitmap.Canvas,13,22,6,ClYellow); refresh; Picture.Bitmap.Modified:=True; @@ -5214,27 +5260,27 @@ begin font.color:=clBlack; font.size:=round(RedFonte*10); width:=100;height:=20; - Top:=HtImg+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne)); - Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); + Top:=h+((h+EspY+20)*((rang-1) div NbreImagePLigne)); + Left:=10+ (l+5)*((rang-1) mod (NbreImagePLigne)); BringToFront; end; - // créée le checkBox si un feu blanc est déclaré sur ce feu + // créée le checkBox si un feu blanc est déclaré sur ce signal if Signaux[rang].FeuBlanc then begin if debug=1 then affiche('Création CheckBox feu blanc '+intToSTR(rang),clLime); - Signaux[rang].checkFB:=TCheckBox.create(Formprinc.ScrollBoxSig); // ranger l'adresse de la Checkbox dans la structure du feu + Signaux[rang].checkFB:=TCheckBox.create(Formprinc.ScrollBoxSig); // ranger l'adresse de la Checkbox dans la structure du signak with Signaux[rang].CheckFB do begin onClick:=formprinc.proc_checkBoxFB; // affecter l'adresse de la procédure de traitement quand on clique dessus Hint:='Feu blanc'; - Name:='CheckBoxFB'+intToSTR(rang); // affecter l'adresse du feu pour pouvoir le retrouver dans la procédure + Name:='CheckBoxFB'+intToSTR(rang); // affecter l'adresse du signal pour pouvoir le retrouver dans la procédure caption:='dem FB'; font.color:=clBlack; Parent:=Formprinc.ScrollBoxSig; width:=100;height:=15; - Top:=HtImg+15+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne)); - Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); + Top:=h+15+((h+EspY+20)*((rang-1) div NbreImagePLigne)); + Left:=10+ (l+5)*((rang-1) mod (NbreImagePLigne)); BringToFront; end; end @@ -5243,13 +5289,30 @@ end; // change le train sélectionné ; i=nouvel index train procedure change_clic_train(i : integer); +var l,h : integer; begin if (i<1) or (i>nTrains) then exit; + // remettre l'ancien train sélectionné en non sélectionné if idTrainClic>0 then Maj_icone_train(Image_Train[IdTrainClic],IdTrainClic,clWhite); IdTrainClic:=i; - Maj_icone_train(Image_Train[IdTrainClic],IdTrainClic,$e0e0e0); + // afficher en train sélectionné + Maj_icone_train(Image_Train[IdTrainClic],IdTrainClic,$f0f0f0); + + l:=Image_Train[IdTrainClic].Width; + h:=Image_Train[IdTrainClic].height; + + with Image_Train[IdTrainClic].Canvas do + begin + pen.color:=clBlack; + moveTo(1,1);lineTo(l-1,1); + LineTo(l-1,h-1); + LineTo(1,h-1); + LineTo(1,1); + end; + + //Maj_icone_train(Image_Train[IdTrainClic],IdTrainClic,clBlue); with formprinc do begin Combotrains.ItemIndex:=IdTrainclic-1; @@ -5560,11 +5623,16 @@ end; // affiche les signaux dans la fenêtre de droite procedure Affiche_signaux; -var i : integer; +var i,l,h,lIcone,hIcone : integer; + t_bp : tBitmap; + coul : tColor; begin //Affiche('SIG='+intToSTR(Formprinc.ScrollBoxSig.Width),clYellow); //Application.ProcessMessages; - i:=(Formprinc.ScrollBoxSig.Width div (largImg+2))-1 ; + l:=round(LargImg*RedAffSig); + h:=round(HtImg*RedAffSig); + + i:=(Formprinc.ScrollBoxSig.Width div (l+2))-1 ; if (i<=0) then exit; NbreImagePLigne:=i; for i:=1 to NbreSignaux do @@ -5573,23 +5641,38 @@ begin begin with Signaux[i].img do begin - Top:=(HtImg+espY+20)*((i-1) div NbreImagePLigne); // détermine les points d'origine - Left:=10+ (LargImg+5)*((i-1) mod (NbreImagePLigne)); + Top:=(h+espY+20)*((i-1) div NbreImagePLigne); // détermine les points d'origine + Left:=10+ (l+5)*((i-1) mod (NbreImagePLigne)); + width:=l; + height:=h; + picture.Bitmap.width:=l; + picture.Bitmap.height:=h; + // mode zoom signaux + T_BP:=Select_dessin_Signal(Signaux[i].aspect,lIcone,hIcone); + // dessine un rectangle couleur de fond, pour effacer l'ancien signal + coul:=canvas.Pixels[1,1]; + canvas.Brush.Color:=coul; + canvas.Pen.color:=coul; + canvas.Rectangle(0,0,l,h); + Canvas.StretchDraw(rect(0,0,round(lIcone*redAffsig),round(hIcone*RedAffSig)),T_bp); // copier avec agrandissement + // allume les feux du signal + dessine_signal_mx(Canvas,0,0,RedAffSig,RedAffSig,Signaux[i].adresse,1); // redAffSig affecté à redX et redY + //repaint; end; with Signaux[i].lbl do begin - Top:=HtImg+((HtImg+EspY+20)*((i-1) div NbreImagePLigne)); - Left:=10+ (LargImg+5)*((i-1) mod (NbreImagePLigne)); + Top:=h+((h+EspY+20)*((i-1) div NbreImagePLigne)); + Left:=10+ (l+5)*((i-1) mod (NbreImagePLigne)); //repaint; end; if Signaux[i].FeuBlanc then with Signaux[i].checkFB do begin - Top:=HtImg+15+((HtImg+EspY+20)*((i-1) div NbreImagePLigne)); - Left:=10+ (LargImg+5)*((i-1) mod (NbreImagePLigne)); + Top:=h+15+((h+EspY+20)*((i-1) div NbreImagePLigne)); + Left:=10+ (l+5)*((i-1) mod (NbreImagePLigne)); //repaint; end; end; @@ -5837,7 +5920,7 @@ end; // envoie une fonction F à une loco via CDM ou socket ou usb // si c'est une fonction F>12 elle peut être envoyée en XpressNet -procedure envoie_fonction(fonction,etat : integer;train : string); +procedure envoie_fonction(fonction,etat : integer;train : string); var loco : integer; s : string; begin @@ -5851,7 +5934,7 @@ begin begin loco:=index_train_nom(train); loco:=trains[loco].adresse; - if protocole=1 then Fonction_Loco_operation(loco,fonction,etat); + if protocole=1 then Fonction_Loco_operation_Xnet(loco,fonction,etat); if protocole=2 then begin Affiche('Fonction F loco pas encore implantée',clred);end; end; end; @@ -5956,7 +6039,7 @@ end; // appellé par le hooker clavier function traite_code_blocUSB(code: integer) : integer; -var vitesse,f,n,i,t : integer; +var vitesse,f,n,i : integer; condValide,EtatValide,BlocSelec : boolean; s : string; begin @@ -6358,7 +6441,7 @@ end; // envoie une fonctionF à une loco en Xpressnet // loco=adresse de la loco fonction de 0 à 28 état 0/1 -procedure Fonction_Loco_Operation(loco,fonction,etat : integer); +procedure Fonction_Loco_Operation_XNet(loco,fonction,etat : integer); var s : string ; ah,al : integer; b,c : byte ; @@ -6784,7 +6867,7 @@ begin end; Signaux[i].EtatSignal:=code; //if signaux[i].img<>nil then - Dessine_signal_mx(signaux[i].Img.Canvas,0,0,1,1,adr,1); + Dessine_signal_mx(signaux[i].Img.Canvas,0,0,redaffSig,redAffSig,adr,1); end; end; @@ -8347,7 +8430,7 @@ end; envoie les données au décodeur digitalbahn équipé du logiciel "led_signal_10" adresse=adresse sur le bus codebin=motif de bits représentant l'état des feux L'allumage est fait en - adressant l'une des 14 adresses pour les 14 leds possibles du feu. + adressant l'une des 14 adresses pour les 14 leds possibles du signal. Ici on met le bit 1 à 1 (état "vert" du programme hexmanipu ===========================================================================*) procedure envoi_signalBahn(adresse : integer); @@ -8881,7 +8964,7 @@ begin Signaux[i].AncienEtat:=Signaux[i].EtatSignal; // allume les feux du signal dans la fenêtre de droite - if (Signaux[i].Img<>nil) then Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,1,1,adr,1); + if (Signaux[i].Img<>nil) then Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,redAffSig,redAffSig,adr,1); // allume les feux du signal dans le TCO for indexTCO:=1 to NbreTCO do @@ -13435,7 +13518,7 @@ begin AdrSignal:=0; if (TypeActuel=det) then // détecteur begin -// i:=Index_signal_det(AdrSuiv,voie,index2); // trouve l'index de feu affecté au détecteur "AdrSuiv" +// i:=Index_signal_det(AdrSuiv,voie,index2); // trouve l'index de signal affecté au détecteur "AdrSuiv" index_signal_det(AdrSuiv,voie1,indexSig1,voie2,indexSig2); // à compléter par signal inverse @@ -13579,9 +13662,9 @@ begin Pres_Train:=false; if debug=3 then formprinc.Caption:='Test_memoire_zones '+IntToSTR(adresse); - NSigMax:=1; // nombre de feux à trouver (nombre de cantons) + NSigMax:=1; // nombre de signaux à trouver (nombre de cantons) - ife:=1; // index feu de 1 à 4 pour explorer les 4 détecteurs d'un feu + ife:=1; // index signal de 1 à 4 pour explorer les 4 détecteurs d'un signal repeat NSignaux:=0; if NivDebug=3 then AfficheDebug('Boucle de test signal '+intToSTR(ife)+'/4',clOrange); @@ -13824,7 +13907,7 @@ begin idEl:=1; Nsignaux:=0; - ife:=1; // index feu de 1 à 4 pour explorer les 4 détecteurs d'un feu + ife:=1; // index signal de 1 à 4 pour explorer les 4 détecteurs d'un signal repeat j:=0; if NivDebug=3 then AfficheDebug('Boucle de test signal voie '+intToSTR(ife)+'/4',clOrange); @@ -13856,7 +13939,7 @@ begin TypeActuel:=det; if actuel=0 then begin - // sortie si aucun détecteur déclaré sur le feu + // sortie si aucun détecteur déclaré sur le signal Signal_precedent:=0; if nivDebug=3 then AfficheDebug('Pas de voie '+intToSTR(ife),clyellow); if debug=3 then formprinc.Caption:=''; @@ -13925,7 +14008,7 @@ begin index_signal_det(actuel,voie1,indexSig1,voie2,indexSig2); if indexSig1<>0 then begin - AdrSignal:=Signaux[indexSig1].adresse; // adresse du feu + AdrSignal:=Signaux[indexSig1].adresse; // adresse du signal if (AdrSignal=adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant begin Signal_precedent:=0; @@ -14656,11 +14739,11 @@ begin if TestBit(etat,rappel_30) then begin if (modele>=5) then Maj_Etat_Signal(AdrSignal,ral_30) else Maj_etat_signal(AdrSignal,jaune_cli); - //if affsignal then AfficheDebug('Mise du feu au ralen 30',clyellow); + //if affsignal then AfficheDebug('Mise du signal au ralen 30',clyellow); end; if TestBit(etat,rappel_60) then begin - //if AffSignal then AfficheDebug('Mise du Feu au ralen 60',clyellow); + //if AffSignal then AfficheDebug('Mise du signal au ralen 60',clyellow); if (modele>=5) then Maj_Etat_Signal(AdrSignal,ral_60) else Maj_etat_signal(AdrSignal,jaune_cli); // si signal suivant est au rappel60, il faut tester s'il est à l'avertissement aussi @@ -14669,7 +14752,7 @@ begin if TestBit(etat,jaune) then begin Maj_Etat_Signal(AdrSignal,jaune_cli); - //if affsignal then AfficheDebug('401.Mise du feu au jaune cli',clyellow); + //if affsignal then AfficheDebug('401.Mise du signal au jaune cli',clyellow); end; end; end @@ -14680,7 +14763,7 @@ begin if TestBit(etat,jaune) or TestBit(etat,ral_30) then begin Maj_Etat_Signal(AdrSignal,jaune_cli); - //if affsignal then AfficheDebug('401.Mise du feu au jaune cli',clyellow); + //if affsignal then AfficheDebug('401.Mise du signal au jaune cli',clyellow); end else begin @@ -14692,7 +14775,7 @@ begin if Signaux[index].checkFB.Checked then begin Maj_Etat_Signal(AdrSignal,blanc); - //if affsignal then AfficheDebug('Mise du feu au blanc',clyellow); + //if affsignal then AfficheDebug('Mise du signal au blanc',clyellow); end else Maj_Etat_Signal(AdrSignal,vert); end @@ -14700,7 +14783,7 @@ begin begin if Signaux[index].checkFV then Maj_Etat_Signal(AdrSignal,vert_cli) else Maj_Etat_Signal(AdrSignal,vert); - //if affsignal then AfficheDebug('Mise du feu au vert',clyellow); + //if affsignal then AfficheDebug('Mise du signal au vert',clyellow); end; end; end; @@ -16239,7 +16322,7 @@ begin end; end; - // 1 élément dans le tableau et détecteur à 1 : on pilote le train si feu sur det3--------------------------------------------- + // 1 élément dans le tableau et détecteur à 1 : on pilote le train si signal sur det3--------------------------------------------- if (nbre=1) and etat then begin if traceListe or ProcPrinc then AfficheDebug('1-1 Traitement Train n°'+intToSTR(i)+' 1 détecteur',clyellow); @@ -16583,7 +16666,7 @@ begin // activation //affiche('Efface train '+intToSTR(AdrTrainLoc),clred); //raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train - //zizi + if ModeCouleurCanton=0 then zone_TCO(ntco,det3,AdrSuiv,i,AdrTrainLoc,1,true) else zone_TCO(ntco,det3,AdrSuiv,i,AdrTrainLoc,2,true); // affichage avec la couleur de index_couleur du train end; @@ -16860,7 +16943,7 @@ begin end; if roulage then maj_route(det3); - // vérifier si le détecteur du nouveau train est associé à un feu vers un buttoir + // vérifier si le détecteur du nouveau train est associé à un signal vers un buttoir for i:=1 to NbreSignaux do begin AdrSignal:=Signaux[i].Adresse; @@ -16869,7 +16952,7 @@ begin begin AdrSuiv:=Signaux[i].Adr_el_suiv1; TypeSuiv:=Signaux[i].Btype_suiv1; - AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetSignal,det,1) ; // détecteur précédent le feu ; algo 1 + AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetSignal,det,1) ; // détecteur précédent le signal ; algo 1 if AdrPrec=0 then begin if TraceListe then Affiche('FD - Le signal '+IntToSTR(AdrSignal)+' est précédé d''un buttoir',clyellow); @@ -16940,7 +17023,7 @@ begin index_couleur:=((n_trains - 1) mod NbCouleurTrain) +1; for ntco:=1 to nbreTCO do begin - // zizi n'efface pas le train BB sur le canton 15 + // n'efface pas le train BB sur le canton 15 //raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train adrloc if ModeCouleurCanton=0 then zone_TCO(ntco,det3,suivant,AdrTrainloc,0,1,true) else zone_TCO(ntco,det3,suivant,n_trains,AdrTrainLoc,2,true); // affichage avec la couleur de index_couleur du train @@ -17359,6 +17442,8 @@ var decl,op,af,access,sortie,t,v,etat,adr : integer; Ts : TAccessoire; tr : single; begin + // tablo action n'est pas dynamique, mais Tablo_action[].TabloOp oui + if length(Tablo_Action[i].tabloOP)-1nb) or sort; + end; end; // traite l'évènement vitesse train - appelé depuis réception trame CDM ou vitesse_loco @@ -17678,7 +17765,7 @@ begin // vérifier si l'actionneur en évènement a été déclaré pour réagir // dans tableau des actions - + i:=1; repeat sDecl:=Tablo_Action[i].trainDecl; @@ -17686,7 +17773,7 @@ begin etatValide:=((etatAct=etat) and fm) or ((etatAct=0) and fd); // front montant ou descendant typ:=Tablo_Action[i].declencheur; - // fonction. Attention l'évaluation de la fonction est prise sur sur front montant. + // fonction. Attention l'évaluation de la fonction est prise sur front montant. // Or à chaque evt détecteur actionneur , elle est réévaluée. if (typ=DeclFonction) and (Adr2=0) then begin @@ -17888,18 +17975,20 @@ end; // télécommande de signaux complexes par les clients ou les périphériques function telecommande(s : string) : boolean; -var adresse,i,erreur : integer; +var adresse,i,erreur,etat : integer; sa : string; begin result:=false; sa:=s; s:=uppercase(s); // --- commandes sans paramètres + // lance cdm if pos('',s)<>0 then begin Lance_CDM(true); result:=true; end; + // affiche cdm if pos('',s)<>0 then begin if cdmHd=0 then exit; @@ -17907,6 +17996,7 @@ begin cdmDevant:=not(cdmDevant); result:=true; end; + // affiche SC if pos('',s)<>0 then begin with formprinc do @@ -17919,6 +18009,7 @@ begin end; // --- commandes avec paramètres + // Affiche TCOn if copy(s,1,4)=' begin - if Tablo_Action[i].declencheur=DeclPeriph then - begin - if Tablo_Action[i].ordrePeriph=sa then - action(i); - end; + delete(sa,1,2); + val(sa,adresse,erreur); + delete(sa,1,erreur); + val(sa,etat,erreur); + delete(sa,1,erreur); + i:=pos('>',sa); + sa:=copy(sa,1,i-1); + envoie_fonction(adresse,etat,sa); end; - //FormPrinc.AffEtatDetecteurs(formprinc); end; @@ -18151,7 +18245,7 @@ begin AdrSuiv:=Signaux[i].Adr_el_suiv1; TypeSuiv:=Signaux[i].Btype_suiv1; if AffSignal then AfficheDebug('Pour signal '+intToSTR(AdrSignal)+' detecteursuivant('+intToSTR(AdrSuiv)+','+BTypeToChaine(typeSuiv)+','+intToSTR(AdrDetSignal)+',1)',clyellow); - AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetSignal,det,1) ; // détecteur précédent le feu, algo 1 + AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetSignal,det,1) ; // détecteur précédent le signal, algo 1 if AdrPrec=0 then begin If traceListe then AfficheDebug('Le signal '+IntToSTR(AdrSignal)+' est précédé d''un buttoir',clyellow); @@ -19970,8 +20064,6 @@ function ProcessRunning(sExeName: String) : Boolean; var hSnapShot : THandle; ProcessEntry32 : TProcessEntry32; // pointeur sur la structure ProcessEntry32 processID : DWord; - n : integer; - s : string; begin Result:=false; hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); @@ -21214,7 +21306,6 @@ var n,t,i,j,index,OrgMilieu : integer; trouve : boolean; Sr : TSearchRec; tmP,tmA : tMenuItem; - compo : tcomponent; begin menu_deselec; Ancien_Nom_Style:=''; @@ -21309,7 +21400,6 @@ begin typetache:=0; end; end; - taches[1].typeTache:=0; ProcPrinc:=false; algo_Unisemaf:=1; IdTrainClic:=0; @@ -21343,6 +21433,7 @@ begin DetDepart:=0; DetAtrouve:=0; Verif_AdrXpressNet:=1; + RedAffSig:=1.0; Max_Signal_Sens:=5; portServeur:=4500; formatY:=-1; @@ -21356,8 +21447,8 @@ begin Modesombre:=false; simuInterface:=false; Stop_Maj_Sig:=false; - MaxParcours:=100; // Nombre maxi d'éléments d'une route - MaxRoutes:=1000; // nombre maxi de routes + MaxParcours:=100; // Nombre maxi d'éléments d'une route + MaxRoutes:=1000; // nombre maxi de routes Diffusion:=true; // &&&& mode diffusion publique + debug mise au point etc AffAigDet:=false; ModeTache:=true; @@ -21375,6 +21466,8 @@ begin CompteurT[i].tb:=nil; end; + GetDir(0,repertoire_SC); + {$IF CompilerVersion >= 28.0} RedFonte:=Screen.DefaultPixelsPerInch/Screen.PixelsPerInch; // pour la réduction des fontes : windows mise à l'échelle du texte FormatSettings:=tFormatSettings.Create; @@ -21388,8 +21481,6 @@ begin ButtonEssai.Visible:=not(diffusion); - - FenRich.MaxLength:=$7FFFFFF0; NbDecodeur:=12; NbDecodeurdeBase:=NbDecodeur; @@ -21709,7 +21800,9 @@ begin Application.HintPause:=400; // 400ms //visible:=true; // rend la form visible plus tot for i:=1 to MaxCdeDccpp do CdeDccpp[i]:=''; + {$IF CompilerVersion >= 28.0} lire_styles; + {$IFEND} with ParamCompteur[1] do begin @@ -21742,13 +21835,14 @@ begin procetape('Lecture de la configuration'); lit_config; - //clientInfo.Open; // &&& se connecte au serveur SC et envoie les infos + clientInfo.Open; // &&& se connecte au serveur SC et envoie les infos {$IF CompilerVersion >= 28.0} change_style; {$IFEND} init_horloge; + if (NbreSignaux=0) and (onglet=0) then onglet:=1; PageControl.ActivePageIndex:=onglet; // identifier les écrans @@ -21898,6 +21992,8 @@ begin formprinc.DoubleBuffered:=true; + + { //DoubleBuffered:=true; aiguillage[index_aig(1)].position:=const_devie; @@ -21952,6 +22048,7 @@ begin end else Affiche_fenetre_CDM.Enabled:=false; + ConfCellTCO:=false; if debug=1 then Affiche('Fini',clLime); @@ -22245,7 +22342,7 @@ end; // [].tempo procedure traite_taches; const affe=false; -var fonc,i,j,sortie,etat :integer; +var i,j,fonc,sortie,etat :integer; begin if noTraite then exit; if pointeurTaches<0 then @@ -22516,7 +22613,7 @@ begin // signal belge if TestBit(a,clignote) or Signaux[i].contrevoie then begin - Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,1,1,adresseEl,1); + Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,redAffSig,redAffSig,adresseEl,1); end; end else @@ -22526,7 +22623,7 @@ begin TestBit(a,rappel_60) or testBit(a,semaphore_cli) or testBit(a,vert_cli) or testbit(a,blanc_cli) then begin - Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,1,1,adresseEl,1); + Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,redAffSig,redAffSig,adresseEl,1); //Affiche('Clignote signal '+IntToSTR(adresse),clyellow); end; end; @@ -22572,7 +22669,7 @@ begin else ImageSignal:=Formprinc.Image3feux; end; - TailleY:=ImageSignal.picture.BitMap.Height; // taille du feu d'origine (verticale) + TailleY:=ImageSignal.picture.BitMap.Height; // taille du signal d'origine (verticale) TailleX:=ImageSignal.picture.BitMap.Width; Orientation:=TCO[indexTCO,x,y].FeuOriente; // réduction variable en fonction de la taille des cellules @@ -22665,6 +22762,8 @@ begin // if (tick mod 10)=0 then Affiche(intToSTR(trains[4].TempoArretCour),clWhite); + // gestion compteurs des trains + { for i:=1 to ntrains do begin // change l'aiguille du compteur de vitesse du train i @@ -22694,7 +22793,14 @@ begin aiguille_compteur(1,idTrainClic,formCompteur[1]); // fenetre aiguille_compteur(i,i,compteurT[i].gb); // compteurs des groupbox end; + end; + end; } + // gestion des vitesses des trains + for i:=1 to ntrains do + begin + with trains[i] do + begin // calculer la vitesse instantanée du train en fonction des accel et des décel if vitesseCons<>AVitesseCons then begin @@ -22724,8 +22830,8 @@ begin VitesseReelleR:=round(vitesseReelleR-Incrementpas); if VitesseReelleR0 then begin Affiche('Sélectionnez un train',clOrange);exit;end; - if fonction>28 then - begin - Affiche('F28 maxi',clOrange); - exit; - end; - Affiche('Train adresse '+intToStr(loco)+' F'+IntToSTR(fonction)+':'+intToSTR(etat),clyellow); - Fonction_Loco_operation(loco,fonction,etat); - end; + envoie_fonction(fonction,etat,s); + end; @@ -25199,7 +25294,7 @@ begin end; procedure TFormPrinc.EditVitesseChange(Sender: TObject); -var i,e : integer; +//var i,e : integer; begin { if pasChgTBV then exit; val(EditVitesse.Text,i,e); @@ -25427,7 +25522,7 @@ procedure TFormPrinc.PopupMenuSignalPopup(Sender: TObject); var ob : TPopupMenu; begin // AdrPilote est récupéré de l'event OnMouseDown de l'image du signal qui se produit avant - if Affevt then Affiche('PopupMenuFeu',clYellow); + if Affevt then Affiche('PopupMenuSignal',clYellow); ob:=Sender as Tpopupmenu; ob.Items[0].Caption:='Propriétés du signal '+intToSTR(AdrPilote); ob.Items[1].Caption:='Informations du signal '+intToSTR(AdrPilote); @@ -25453,11 +25548,12 @@ procedure TFormPrinc.Analyser1Click(Sender: TObject); var s1,s2 : string; i : integer; begin + FenRich.Clear; s1:=lowercase(fenRich.Lines[0]); if pos('module',s1)=0 then begin - Affiche('Pas de module réseau CDM détecté.',clyellow); - Affiche('Procédure: dans CDM RAIL ouvrez votre réseau ; Menu ... / TrackDrawing / Module Display',clLime); + //Affiche('Pas de module réseau CDM détecté.',clyellow); + Affiche('Procédure: dans CDM RAIL ouvrez votre réseau ; Menu ... / Dessin du réseau / Module Display',clLime); Affiche('Attention : nécessite la version >=23.05 de CDM',clLime); Affiche('Cela ouvre une fenêtre DEBUG dans cdm',clLime); Affiche('Dans cette fenêtre, faire Clic droit puis "sélectionner tout" et "copier"',clLime); @@ -26693,7 +26789,7 @@ end; // "actuel" est l'élément suivant à pres , pour le sens de rechercher au départ // remplit le tableau tabloroute[route,id] (route=index de la route trouvée) // on teste les aiguillages et les tjd sur toutes leurs positions -// procédure récursive +// Cette procédure est récursive // tabloroute[n,0].adresse contient le nombre d'éléments de la route n // prec,typePrec ; actuel,TypActuel : éléments contigus à explorer ; nroute : numéro de la route , id=index dans la route; ir = n° de récursivité : départ,fin : détecteurs de départ et de fin cliqués. // retourne: @@ -28207,7 +28303,8 @@ begin Affiche('La mesure de la vitesse des trains n''est disponible qu''en mode autonome sans CDM rail',clYellow); exit; end; - if (parSocketLenz or portCommOuvert) then FormMesure.showModal + if (parSocketLenz or portCommOuvert) then + FormMesure.showModal else Affiche('Interface non connectée',clYellow); end; @@ -28217,8 +28314,6 @@ begin Affiche_mesure_trains; end; - - procedure TFormPrinc.Compilerlabasededonnes1Click(Sender: TObject); begin genere_informations_BD; @@ -28255,10 +28350,20 @@ var i,d : integer; begin if (PageControl.ActivePage<>TabSheettrains) or (TempoCombo>0) or (ComboTrains.Focused) or clicComboTrain then exit; //Affiche('FormKeyDown '+intToSTR(key),clyellow); - if (key=vk_down) and (IdTrainClic1) then + if (key=vk_up) then begin - Maj_icone_train(Image_Train[IdTrainClic],IdTrainClic,clWhite); - dec(IdTrainClic); + key:=0; + if (IdTrainClic>1) then + begin + Maj_icone_train(Image_Train[IdTrainClic],IdTrainClic,clWhite); + dec(IdTrainClic); + change_clic_train(idTrainClic); + exit; + end; + exit; EditAdrTrain.Text:=intToSTR(trains[IdTrainClic].adresse); Maj_icone_train(Image_Train[IdTrainClic],IdTrainClic,$e0e0e0); Combotrains.ItemIndex:=IdTrainclic-1; @@ -28287,7 +28399,6 @@ begin d:=(IdTrainClic)*Image_Train[IdTrainClic].height; if d<=i then scrollBoxTrains.VertScrollBar.Position:=(idTrainClic-(ScrollBoxTrains.Height div Image_Train[IdTrainClic].height))*Image_Train[IdTrainClic].height; - key:=0; end; end; @@ -28298,13 +28409,36 @@ begin end; procedure TFormPrinc.ButtonEssaiClick(Sender: TObject); -var NumCanton : integer; +var l,h : integer; begin - nivdebug:=3; - Numcanton:=trouve_canton(523,det,526,det); - Affiche(intToSTR(numCanton),clyellow); - Numcanton:=trouve_canton(526,det,523,det); - Affiche(intToSTR(numCanton),clyellow); + +// telecommande(''); + telecommande('= 28.0} + redAffSig:=1+(10-TrackBarSig.position)/40; + {$ELSE} + redAffSig:=1+(10-TrackBarSig.position)/70; + {$IFEND} + // Affiche(FloatToSTRF(redAffSig,ffFixed,5,2),clLime); + Affiche_signaux; +end; + +// timer 50 ms pour aiguilles compteurs +procedure TFormPrinc.Timer2Timer(Sender: TObject); +var i,delta,a,IncrCompteur : integer; +begin + // change l'aiguille du compteur de vitesse du train i + for i:=1 to ntrains do + with trains[i] do + begin + delta:=vitesseCons-VitesseCompteur; // différence entre la vitesse à atteindre et l'actuelle + if delta<>0 then + begin + //Affiche('Delta '+intToSTR(Delta),clYellow); + a:=abs(delta); + if a>10 then + begin + IncrCompteur:=ParamCompteur[1].increment; + if IncrCompteur<=3 then IncrCompteur:=4; + IncrCompteur:=IncrCompteur div 2; + end + else IncrCompteur:=1; // grande vitesse 'increment" aiguille ou petite + if a=IncrCompteur then + if vitesseCompteur'' then begin - font.Size:=round(RedFonte*((Larg*10) div 30)+1); //((LargCell*5) div 29); + font.Size:=round(RedFonte*((Larg*10) div 30)+1); //((LargCell*5) div 29); + Brush.Color:=coul; dy:=TextWidth(s) div 2; dx:=TextHeight(s) div 2; @@ -10336,11 +10335,12 @@ begin s:=canton[i].NomTrain; l:=TextWidth(s); Brush.Color:=coul; - if l= 28.0} begin - font.orientation:=900; - Textout(xi,yi,s); + font.orientation:=-900; + Textout(xt,yt,s); end; {$ELSE} AffTexteIncliBordeTexture(PCanvasTCO[indexTCO],xt,yt, @@ -10454,6 +10454,7 @@ end; procedure dessin_canton(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer); overload; begin if PcanvasTCO[indexTCO]=nil then exit; + origine_canton(indexTCO,x,y); // revenir au point d'origine du canton if isCantonV(indexTCO,x,y) then begin dessin_cantonV(indexTCO,Canvas,x,y,mode); @@ -11363,10 +11364,11 @@ begin end; end; -procedure origine_canton(var x,y : integer); +// renvoie les coordonnées X Y d'origine du canton de la cellule x,y du TCO idt du canton +procedure origine_canton(idt : integer;var x,y : integer); var Bimage : integer; begin - Bimage:=tco[indexTCOCourant,x,y].BImage; + Bimage:=tco[idt,x,y].BImage; if isCantonH(Bimage) then begin x:=x-(Bimage-Id_cantonH); // revenir à la coordonnée X du début du canton @@ -11419,8 +11421,7 @@ begin // affiche d'abord l'icone de la cellule et colore la voie si zone ou détecteur actionnée selon valeur mode dessine_icone(indexTCO,PCanvasTCO[indexTCO],Bimage,X,Y,mode); // dessin du train sur le canton - if (Bimage=Id_CantonH) or (Bimage=Id_CantonV) then dessin_canton(indexTCO,PCanvasTCO[indexTCO],x,y,0); - + if (Bimage=Id_CantonH) or (Bimage=Id_CantonV) then dessin_canton(indexTCO,PCanvasTCO[indexTCO],x,y,0); if LargCell>24 then begin @@ -12275,7 +12276,7 @@ end; // sinon mode = couleur du train procedure affiche_trajet(indexTCO,train,AdrTrain,ir,mode : integer); var i,sx,sy,x,y,ax,ay,Bimage,adresse,IdCanton,IdTrain,AncTrain,elPrec, - DernierDet,sens : integer; + DernierDet : integer; TypePrec: tEquipement; cant : boolean; begin @@ -14616,7 +14617,7 @@ begin if isCantonH(tco[indexTCO,colonne,y].BImage) then begin yc:=y;xc:=colonne; - origine_canton(xc,yc); + origine_canton(indexTCO,xc,yc); n:=tco[indexTCO,xc,yc].NumCanton; if n<>0 then begin @@ -14714,7 +14715,7 @@ begin if isCantonV(tco[indexTCO,x,ligne].BImage) then begin xc:=x;yc:=ligne; - origine_canton(xc,yc); + origine_canton(indexTCO,xc,yc); n:=tco[indexTCO,xc,yc].NumCanton; if n<>0 then begin @@ -14845,7 +14846,7 @@ begin begin //Affiche('xy='+IntToSTR(x)+','+intToSTR(y)+' Bimage='+intToSTR(Bimage),clYellow); Xcanton:=x;Ycanton:=y; - origine_canton(Xcanton,Ycanton); + origine_canton(indexTCO,Xcanton,Ycanton); if xcanton=0 then // cas d'un canton supprimé begin // reconstituer le canton @@ -15504,7 +15505,7 @@ end; procedure end_Drag(icone,x,y : integer;Sender, Target: TObject); var s : string; -indexTCO,i,xclic,Yclic,bim,nc,maxi,libre : integer; +indexTCO,i,xclic,Yclic,bim : integer; begin if not(Target is TImage) then exit; s:=(Target as TImage).Name; @@ -18030,17 +18031,16 @@ begin AdrPilote:=adresse; i:=Index_Signal(adresse); if i=0 then begin doubleclic:=false;exit;end; + Signaux[0].EtatSignal:=Signaux[i].EtatSignal; + with formPilote do begin - show; ImagePilote.Parent:=FormPilote; ImagePilote.Picture.Bitmap.TransparentMode:=tmAuto; ImagePilote.Picture.Bitmap.TransparentColor:=clblue; ImagePilote.Transparent:=true; - ImagePilote.Picture.BitMap:=Signaux[i].Img.Picture.Bitmap; LabelTitrePilote.Caption:='Pilotage du signal '+intToSTR(Adresse); - Signaux[0].EtatSignal:=Signaux[i].EtatSignal; LabelNbFeux.Visible:=False; EditNbreFeux.Visible:=false; @@ -18064,6 +18064,7 @@ begin GroupBox1.Visible:=true; if (Signaux[i].aspect<20) then GroupBox2.Visible:=true else GroupBox2.Visible:=false; end; + show; end; end; //clicsouris:=false; @@ -18308,7 +18309,7 @@ begin begin FontDialog1.Font.Name:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].Fonte; FontDialog1.Font.Color:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].CoulFonte; - FontDialog1.Font.Size:=round(RedFonte*tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].taillefonte); + FontDialog1.Font.Size:=round(tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].taillefonte); fs:=[]; s:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].FontStyle; @@ -18659,7 +18660,7 @@ begin if isCantonV(tco[indexTCO,x,ligne_supprime].BImage) then begin xc:=x;yc:=ligne_Supprime; - origine_canton(xc,yc); + origine_canton(indexTCO,xc,yc); n:=tco[indexTCO,xc,yc].NumCanton; if n<>0 then begin @@ -18780,7 +18781,7 @@ begin if isCantonH(tco[indexTCO,colonne_supprime,y].BImage) then begin yc:=y;xc:=colonne_Supprime; - origine_canton(xc,yc); + origine_canton(indexTCO,xc,yc); n:=tco[indexTCO,xc,yc].NumCanton; if n<>0 then begin @@ -19654,7 +19655,7 @@ begin y:=YClicCell[indexTCOCourant]; if isCanton(TCO[indexTcoCourant,x,y].BImage) then begin - origine_canton(x,y); + origine_canton(indexTCOcourant,x,y); if (x<>0) and (y<>0) then begin idc:=Index_Canton_numero(tco[indexTCOcourant,x,y].NumCanton); //index canton @@ -19666,10 +19667,6 @@ begin end; procedure TFormTCO.Optiondesroutes1Click(Sender: TObject); -var GMode,l2,h2 : integer; - XFormScale,XFormRot,XFormOld,XFormXLat,xform : TXForm; - angle,Zoom : single; - recta : trect; begin formRoute.Show; { angle:=5; @@ -19810,7 +19807,7 @@ begin Affiche('Suppression du TCO '+intToSTR(Tcos),clOrange); - // supprimer les cantons + // supprimer les cantons du TCO avant de supprimer le TCO for y:=1 to NbreCellY[tcos] do for x:=1 to NbreCellX[tcos] do begin diff --git a/Vcl.Styles.Ext.pas b/Vcl.Styles.Ext.pas index 6708328..c929125 100644 --- a/Vcl.Styles.Ext.pas +++ b/Vcl.Styles.Ext.pas @@ -15,7 +15,7 @@ // The Original Code is Vcl.Styles.Ext.pas. // // The Initial Developer of the Original Code is Rodrigo Ruz V. -// Portions created by Rodrigo Ruz V. are Copyright (C) 2012-2023 Rodrigo Ruz V. +// Portions created by Rodrigo Ruz V. are Copyright (C) 2012-2025 Rodrigo Ruz V. // All Rights Reserved. // // ************************************************************************************************** @@ -97,11 +97,12 @@ type end; {$REGION 'Documentation'} - /// Helper class for the TStyleManager + /// + /// Helper class for the TStyleManager + /// Vcl.Themes.TStyleManagerHelper in RAD Studio 11 prevents activate this class helper. /// {$ENDREGION} - - TStyleManagerHelper = Class Helper for TStyleManager + TStyleManagerHelper = class Helper for TStyleManager strict private class function GetStyleSourceInfo(const StyleName: string): TSourceInfo; static; class function GetStyles: TList; diff --git a/Vcl.Styles.Utils.Graphics.pas b/Vcl.Styles.Utils.Graphics.pas index 707fd27..dabcbaf 100644 --- a/Vcl.Styles.Utils.Graphics.pas +++ b/Vcl.Styles.Utils.Graphics.pas @@ -15,7 +15,7 @@ // The Original Code is Vcl.Styles.Utils.Graphics.pas. // // The Initial Developer of the Original Code is Rodrigo Ruz V. -// Portions created by Rodrigo Ruz V. are Copyright (C) 2012-2023 Rodrigo Ruz V. +// Portions created by Rodrigo Ruz V. are Copyright (C) 2012-2025 Rodrigo Ruz V. // All Rights Reserved. // // ************************************************************************************************** diff --git a/Vcl.Styles.Utils.Misc.pas b/Vcl.Styles.Utils.Misc.pas index ac95840..7e51b4b 100644 --- a/Vcl.Styles.Utils.Misc.pas +++ b/Vcl.Styles.Utils.Misc.pas @@ -14,7 +14,7 @@ // // The Original Code is Vcl.Styles.Utils.Misc.pas. // -// Portions created by Rodrigo Ruz V. are Copyright (C) 2013-2023 Rodrigo Ruz V. +// Portions created by Rodrigo Ruz V. are Copyright (C) 2013-2025 Rodrigo Ruz V. // All Rights Reserved. // // ************************************************************************************************** diff --git a/Vcl.pas b/Vcl.pas deleted file mode 100644 index 6708328..0000000 --- a/Vcl.pas +++ /dev/null @@ -1,1902 +0,0 @@ -// ************************************************************************************************** -// -// Unit Vcl.Styles.Ext -// 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.Ext.pas. -// -// The Initial Developer of the Original Code is Rodrigo Ruz V. -// Portions created by Rodrigo Ruz V. are Copyright (C) 2012-2023 Rodrigo Ruz V. -// All Rights Reserved. -// -// ************************************************************************************************** -unit Vcl.Styles.Ext; - -interface - -{$IF RTLVersion>=24} -{$LEGACYIFEND ON} -{$IFEND} -{$DEFINE USE_VCL_STYLESAPI} - -uses - System.Classes, - System.Generics.Collections, - Winapi.Windows, - Vcl.Styles, - Vcl.Themes, - Vcl.Forms, - Vcl.Graphics, - Vcl.Controls, - Vcl.ExtCtrls; - -type - TStyleHookList = TList; - -type - /// The TVclStylesPreview class, is a control for display a preview of any Vcl style loaded - /// - /// - /// sample of use - /// - /// var - /// StyleName: string; - /// SourceInfo: TSourceInfo; - /// LStyle: TCustomStyleServices; - /// FPreview: TVclStylesPreview; - /// begin - /// FPreview := TVclStylesPreview.Create(Self); - /// FPreview.Parent := PanelPreview; - /// FPreview.BoundsRect := PanelPreview.ClientRect; - /// StyleName := 'Carbon'; - /// if (StyleName <>'') and (not SameText(StyleName, 'Windows')) then - /// begin - /// TStyleManager.StyleNames;//call DiscoverStyleResources - /// LStyle := TStyleManager.Style[StyleName]; - /// FPreview.Caption := StyleName; - /// FPreview.Style := LStyle; - /// TVclStylesPreviewClass(FPreview).Paint; - /// end; - /// .... - /// end; - /// - /// - TVclStylesPreview = class(TCustomControl) - private - FStyle: TCustomStyleServices; // TCustomStyle; - FIcon: HICON; - FCaption: TCaption; - FRegion: HRGN; - FBitmap: TBitmap; - protected - procedure Paint; override; - public - property Icon: HICON read FIcon Write FIcon; - property Style: TCustomStyleServices read FStyle Write FStyle; - property Caption: TCaption read FCaption write FCaption; - property BitMap: TBitmap read FBitmap write FBitmap; - constructor Create(AControl: TComponent); override; - destructor Destroy; override; - end; - - TStyleServicesHandle = type Pointer; - - TSourceInfo = record - Data: TStyleServicesHandle; - StyleClass: TCustomStyleServicesClass; - {$IF CompilerVersion >= 35}DesigningState: Boolean;{$IFEND} - end; - -{$REGION 'Documentation'} - /// Helper class for the TStyleManager - /// -{$ENDREGION} - - TStyleManagerHelper = Class Helper for TStyleManager - strict private - class function GetStyleSourceInfo(const StyleName: string): TSourceInfo; static; - class function GetStyles: TList; - class function _GetStyles: TList; static; - public - class function RegisteredStyles: TDictionary; -{$REGION 'Documentation'} - /// Get the TSourceInfo for a Style - /// -{$ENDREGION} - class property StyleSourceInfo[const StyleName: string]: TSourceInfo read GetStyleSourceInfo; -{$REGION 'Documentation'} - /// Send the CM_CUSTOMSTYLECHANGED message to all the forms - /// -{$ENDREGION} - class procedure RefreshCurrentTheme; -{$REGION 'Documentation'} - /// Return the loaded styles (TCustomStyleServices) in the system - /// -{$ENDREGION} - class property Styles: TList read _GetStyles; -{$REGION 'Documentation'} - /// Force to reload a modified vcl style - /// -{$ENDREGION} - class procedure ReloadStyle(const StyleName: string); -{$REGION 'Documentation'} - /// remove a vcl style - /// -{$ENDREGION} - class procedure RemoveStyle(const StyleName: string); - class function StyleLoaded(const StyleName: string): Boolean; - end; - -const - VclStyles_MaxSysColor = 23; - VclStyles_SysColors: array [0 .. VclStyles_MaxSysColor - 1] of TIdentMapEntry = ( - (Value: Vcl.Graphics.clActiveBorder;Name: 'clActiveBorder'), - (Value: Vcl.Graphics.clActiveCaption; Name: 'clActiveCaption'), - (Value: Vcl.Graphics.clBtnFace; Name: 'clBtnFace'), - (Value: Vcl.Graphics.clBtnHighlight; Name: 'clBtnHighlight'), - (Value: Vcl.Graphics.clBtnShadow; Name: 'clBtnShadow'), - (Value: Vcl.Graphics.clBtnText; Name: 'clBtnText'), - (Value: Vcl.Graphics.clCaptionText; Name: 'clCaptionText'), - (Value: Vcl.Graphics.clGrayText; Name: 'clGrayText'), - (Value: Vcl.Graphics.clHighlight; Name: 'clHighlight'), - (Value: Vcl.Graphics.clHighlightText; Name: 'clHighlightText'), - (Value: Vcl.Graphics.clInactiveBorder; Name: 'clInactiveBorder'), - (Value: Vcl.Graphics.clInactiveCaption; Name: 'clInactiveCaption'), - (Value: Vcl.Graphics.clInactiveCaptionText; Name: 'clInactiveCaptionText'), - (Value: Vcl.Graphics.clInfoBk; Name: 'clInfoBk'), - (Value: Vcl.Graphics.clInfoText; Name: 'clInfoText'), - (Value: Vcl.Graphics.clMenu; Name: 'clMenu'), - (Value: Vcl.Graphics.clMenuText; Name: 'clMenuText'), - (Value: Vcl.Graphics.clScrollBar; Name: 'clScrollBar'), - (Value: Vcl.Graphics.cl3DDkShadow; Name: 'cl3DDkShadow'), - (Value: Vcl.Graphics.cl3DLight; Name: 'cl3DLight'), - (Value: Vcl.Graphics.clWindow; Name: 'clWindow'), - (Value: Vcl.Graphics.clWindowFrame; Name: 'clWindowFrame'), - (Value: Vcl.Graphics.clWindowText; Name: 'clWindowText')); - -procedure ApplyEmptyVCLStyleHook(ControlClass: TClass); -procedure RemoveEmptyVCLStyleHook(ControlClass: TClass); -function IsStyleHookRegistered(ControlClass: TClass; StyleHookClass: TStyleHookClass): Boolean; -function GetRegisteredStylesHooks(ControlClass: TClass): TStyleHookList; -procedure DrawSampleWindow(Style: TCustomStyle; Canvas: TCanvas; ARect: TRect; const ACaption: string; - HICON: HICON = 0); overload; - -{$IFDEF USE_VCL_STYLESAPI} - -type - TCustomStyleExt = class(TCustomStyle) - strict private - FStream: TStream; - public - function GetStyleInfo: TStyleInfo; - private - function GetBitmapList: TObjectList; - procedure SetStyleInfo(const Value: TStyleInfo); - function GetSource: TObject; - public -{$REGION 'Documentation'} - /// Create a TCustomStyleExt using a vcl style stored in a file - /// -{$ENDREGION} - constructor Create(const FileName: string); reintroduce; overload; -{$REGION 'Documentation'} - /// Create a TCustomStyleExt using a vcl style stored in a stream - /// -{$ENDREGION} - constructor Create(const Stream: TStream); reintroduce; overload; - constructor Create(const Style: TCustomStyle); reintroduce; overload; - destructor Destroy; override; -{$REGION 'Documentation'} - /// Replace a internal bitmap of the Style - /// -{$ENDREGION} - procedure ReplaceBitmap(DestIndex: Integer; Src: TBitmap); -{$REGION 'Documentation'} - /// Set a returns the TStyleInfo fo the current style - /// -{$ENDREGION} - property StyleInfo: TStyleInfo read GetStyleInfo write SetStyleInfo; -{$REGION 'Documentation'} - /// Return the list of the bitmaps of the style - /// -{$ENDREGION} - property BitmapList: TObjectList read GetBitmapList; - property LocalStream: TStream read FStream; -{$REGION 'Documentation'} - /// Copy the modified style to an Stream - /// -{$ENDREGION} - procedure CopyToStream(Stream: TStream); - - property Source: TObject read GetSource; - procedure SetStyleColor(Color: TStyleColor; NewColor: TColor); - procedure SetStyleFontColor(Font: TStyleFont; NewColor: TColor); - procedure SetSystemColor(Color: TColor; NewColor: TColor); - procedure SetStyleFont(Font: TStyleFont; NewFont: TFont); - end; - - { - TCustomStyleHelper = Class Helper for TCustomStyle - private - function GetSource: TObject; - public - property Source: TObject read GetSource; - procedure SetStyleColor(Color: TStyleColor; NewColor: TColor); - procedure SetStyleFontColor(Font: TStyleFont; NewColor: TColor); - procedure SetSystemColor(Color: TColor; NewColor: TColor); - End; - } - // function DoHasElementFixedPosition(Details: TThemedElementDetails): Boolean; - -{$ENDIF} - -implementation - -uses - System.Rtti, - System.Types, - System.Sysutils, -{$IFDEF USE_VCL_STYLESAPI} - System.ZLib, - System.UITypes, - Vcl.StdCtrls, - Vcl.ImgList, - Vcl.Consts, - Vcl.GraphUtil, - Vcl.Imaging.pngimage, -{$IF CompilerVersion >= 34} - Vcl.Direct2D, - System.StrUtils, - Winapi.D2D1, -{$IFEND} -{$IF CompilerVersion >= 36} - Vcl.StyleBitmap, - Vcl.StyleAPI, -{$IFEND} - Winapi.Messages, -{$ENDIF} - Vcl.Dialogs, Vcl.Styles.Utils.Misc, - Vcl.Styles.Utils.Graphics; - -{$IF (DEFINED (USE_VCL_STYLESAPI) AND (CompilerVersion >= 23) AND (CompilerVersion <= 35))} -{$I '..\source\vcl\StyleUtils.inc'} -{$I '..\source\vcl\StyleAPI.inc'} -{$IFEND} - -type - TCustomControlClass = class(TCustomControl); - - TStyleHookDictionary = TDictionary; - - TCustomStyleEngineHelper = Class Helper for TCustomStyleEngine - public - class function GetRegisteredStyleHooks: TStyleHookDictionary; - End; - { - const - THEME_WP_CAPTION = 77; - THEME_WP_SMALLCAPTION = 78; - THEME_WP_MINCAPTION = 79; - THEME_WP_SMALLMINCAPTION = 80; - THEME_WP_MAXCAPTION = 81; - THEME_WP_SMALLMAXCAPTION = 82; - THEME_WP_FRAMELEFT = 83; - THEME_WP_FRAMERIGHT = 84; - THEME_WP_FRAMEBOTTOM = 85; - THEME_WP_SMALLFRAMELEFT = 86; - THEME_WP_SMALLFRAMERIGHT = 87; - THEME_WP_SMALLFRAMEBOTTOM = 88; - - THEME_WP_SYSBUTTON = 89; - THEME_WP_MDISYSBUTTON = 90; - THEME_WP_MINBUTTON = 91; - THEME_WP_MDIMINBUTTON = 92; - THEME_WP_MAXBUTTON = 93; - THEME_WP_CLOSEBUTTON = 94; - THEME_WP_SMALLCLOSEBUTTON = 95; - THEME_WP_MDICLOSEBUTTON = 96; - THEME_WP_RESTOREBUTTON = 97; - THEME_WP_MDIRESTOREBUTTON = 98; - THEME_WP_HELPBUTTON = 99; - THEME_WP_MDIHELPBUTTON = 100; - THEME_WP_HORZSCROLL = 101; - THEME_WP_HORZTHUMB = 102; - THEME_WP_VERTSCROLL = 103; - THEME_WP_VERTTHUMB = 104; - THEME_WP_DIALOG = 105; - THEME_WP_CAPTIONSIZINGTEMPLATE = 106; - THEME_WP_SMALLCAPTIONSIZINGTEMPLATE = 107; - THEME_WP_FRAMELEFTSIZINGTEMPLATE = 108; - THEME_WP_SMALLFRAMELEFTSIZINGTEMPLATE = 109; - THEME_WP_FRAMERIGHTSIZINGTEMPLATE = 110; - THEME_WP_SMALLFRAMERIGHTSIZINGTEMPLATE = 111; - THEME_WP_FRAMEBOTTOMSIZINGTEMPLATE = 112; - THEME_WP_SMALLFRAMEBOTTOMSIZINGTEMPLATE = 113; - THEME_WP_FRAME = 114; - - function DoHasElementFixedPosition(Details: TThemedElementDetails): Boolean; - begin - Result := False; - if Details.Element <> teWindow then Exit; - case Details.Part of - THEME_WP_SMALLCLOSEBUTTON, THEME_WP_SMALLCAPTION: - Result := TseStyle(FSource).WindowGetFixPosition(kwscToolWindow, kwbClose); - THEME_WP_CLOSEBUTTON: - Result := TseStyle(FSource).WindowGetFixPosition(kwscStandard, kwbClose); - THEME_WP_HELPBUTTON: - Result := TseStyle(FSource).WindowGetFixPosition(kwscStandard, kwbHelp); - THEME_WP_MAXBUTTON, THEME_WP_RESTOREBUTTON: - Result := TseStyle(FSource).WindowGetFixPosition(kwscStandard, kwbMax); - THEME_WP_MINBUTTON: - Result := TseStyle(FSource).WindowGetFixPosition(kwscStandard, kwbMin); - THEME_WP_SYSBUTTON, THEME_WP_CAPTION: - Result := TseStyle(FSource).WindowGetFixPosition(kwscStandard, kwbSysMenu); - end; - end; - } - -class function TCustomStyleEngineHelper.GetRegisteredStyleHooks: TStyleHookDictionary; -{$IF (CompilerVersion >= 31)} -const - Offset = SizeOf(Pointer) * 3; -var - p: Pointer; -{$IFEND} -begin -{$IF (CompilerVersion <31)} - Result := Self.FRegisteredStyleHooks; -{$ELSE} - { - TCustomStyleEngine.FRegisteredStyleHooks: - 00651030 3052AA xor [edx-$56],dl - 00651033 02F7 add dh,bh - 00651035 097623 or [esi+$23],esi - TCustomStyleEngine.$ClassInitFlag: - 00651038 FFFF db $ff $ff - 0065103A FFFF db $ff $ff - TCustomStyleEngine.FRegSysStylesList: - 0065103C D037 shl [edi],1 - } - // Use the address of the Self.FRegSysStylesList property to calculate the offset of the FRegisteredStyleHooks - p := Pointer(PByte(@Self.FRegSysStylesList) - Offset); - Result := TStyleHookDictionary(p^); -{$IFEND} -end; - -{ TStyleManagerHelper } -class function TStyleManagerHelper.RegisteredStyles: TDictionary; -{$IF (CompilerVersion >= 31)} -const - Offset = SizeOf(Pointer) * 3; -{$IFEND} -var - t: TPair; - SourceInfo: TSourceInfo; - LRegisteredStyles: TDictionary; -{$IF (CompilerVersion >= 31)} - p: Pointer; -{$IFEND} -begin - Result := TDictionary.Create; -{$IF (CompilerVersion < 31)} - LRegisteredStyles := TDictionary(Self.FRegisteredStyles); -{$ELSE} - { - TStyleManager.FFlags: - 006CD058 0100 add [eax],eax - 006CD05A 0000 add [eax],al - TStyleManager.FRegisteredStyles: - 006CD05C 7050 jo $006cd0ae - 006CD05E B702 mov bh,$02 - TStyleManager.FStyleClassDescriptors: - 006CD060 A850 test al,$50 - 006CD062 B702 mov bh,$02 - TStyleManager.FStyleEngines: - 006CD064 1851B7 sbb [ecx-$49],dl - 006CD067 02E0 add ah,al - 006CD069 50 push eax - 006CD06A B702 mov bh,$02 - TStyleManager.FSystemStyle: - 006CD06C 2077B0 and [edi-$50],dh - 006CD06F 0200 add al,[eax] - TStyleManager.FSystemHooks: - 006CD071 07 pop es 006CD076 FFFF db $ff $ff - } - // Use the address of the Self.Flags property to calculate the offset of the FRegisteredStyles -{$IFDEF CPUX64} - p := Pointer(PByte(@Self.Flags) + 8); -{$ELSE} - p := Pointer(PByte(@Self.Flags) + 4); -{$ENDIF CPUX64} - -{$IF (CompilerVersion >= 35)} //Alexandria. - with Self do - p := Pointer(@FRegisteredStyles); -{$IFEND} - - LRegisteredStyles := TDictionary(p^); -{$IFEND} - for t in LRegisteredStyles do - begin - SourceInfo.Data := t.Value.Data; - SourceInfo.StyleClass := t.Value.StyleClass; - Result.Add(t.Key, SourceInfo); - end; -end; - -class function TStyleManagerHelper.GetStyles: TList; -{$IF (CompilerVersion >= 31)} -var - p: Pointer; -{$IFEND} -begin -{$IF (CompilerVersion <31)} - Result := Self.FStyles; -{$ELSE} - { - TStyleManager.FStyles: - 0067E06C E050 loopne $0067e0be - 0067E06E AD lodsd - 0067E06F 0220 add ah,[eax] - 0067E071 77A6 jnbe $0067e019 - 0067E073 0200 add al,[eax] - .... - .... - TStyleManager.FFlags: - 0067E05C 0001 add [ecx],al - 0067E05E 0000 add [eax],al - TStyleManager.FRegisteredStyles: - 0067E060 7050 jo $0067e0b2 - 0067E062 AD lodsd - 0067E063 02A850AD0218 add ch,[eax+$1802ad50] - } -{$IFDEF CPUX64} - p := Pointer(PByte(@Self.Flags) + 32); -{$ELSE} - p := Pointer(PByte(@Self.Flags) + 16); -{$ENDIF CPUX64} - Result := TList(p^); -{$IFEND} -end; - -class function TStyleManagerHelper.GetStyleSourceInfo(const StyleName: string): TSourceInfo; -Var - LRegisteredStyles: TDictionary; -begin - Result.Data := nil; - Result.StyleClass := nil; - - LRegisteredStyles := TStyleManager.RegisteredStyles; - try - if LRegisteredStyles.ContainsKey(StyleName) then - Result := LRegisteredStyles[StyleName]; - finally - LRegisteredStyles.Free; - end; -end; - -class procedure TStyleManagerHelper.RefreshCurrentTheme; -var - I: Integer; -begin - for I := 0 to Screen.FormCount - 1 do - if Screen.Forms[I].HandleAllocated then - if IsWindowVisible(Screen.Forms[I].Handle) then - PostMessage(Screen.Forms[I].Handle, CM_CUSTOMSTYLECHANGED, 0, 0) - else - SendMessage(Screen.Forms[I].Handle, CM_CUSTOMSTYLECHANGED, 0, 0); -end; - -class procedure TStyleManagerHelper.ReloadStyle(const StyleName: string); -var - LStyle: TCustomStyleServices; - LPair: TPair; - LRegisteredStyles: TDictionary; -begin - - if SameText(StyleName, ActiveStyle.Name, loUserLocale) then - SetStyle(SystemStyle); - - for LStyle in Styles do - if SameText(StyleName, LStyle.Name, loUserLocale) then - begin - LStyle.Free; - Styles.Remove(LStyle); - end; - - LRegisteredStyles := Self.RegisteredStyles; - try - for LPair in LRegisteredStyles do - if SameText(StyleName, LPair.Key, loUserLocale) then - if (LPair.Value.Data <> nil) then - begin - TStream(LPair.Value.Data).Position := 0; - break; - end; - finally - LRegisteredStyles.Free; - end; - - SetStyle(StyleName); -end; - -class procedure TStyleManagerHelper.RemoveStyle(const StyleName: string); -var - LStyle: TCustomStyleServices; - LPair: TPair; -begin - if SameText(StyleName, ActiveStyle.Name, loUserLocale) then - SetStyle(SystemStyle); - - for LStyle in Styles do - if SameText(StyleName, LStyle.Name, loUserLocale) then - begin - LStyle.Free; - Styles.Remove(LStyle); - end; - - for LPair in Self.RegisteredStyles do - if SameText(StyleName, LPair.Key, loUserLocale) then - begin - TMemoryStream(LPair.Value.Data).Free; - Self.RegisteredStyles.Remove(LPair.Key); - end; -end; - -class function TStyleManagerHelper._GetStyles: TList; -begin - Result := TStyleManager.GetStyles; -end; - -class function TStyleManagerHelper.StyleLoaded(const StyleName: string): Boolean; -begin - Result := TStyleManager.Style[StyleName] <> nil; -end; - -function GetRegisteredStylesHooks(ControlClass: TClass): TStyleHookList; -begin - Result := nil; - if TCustomStyleEngine.GetRegisteredStyleHooks.ContainsKey(ControlClass) then - Result := TCustomStyleEngine.GetRegisteredStyleHooks[ControlClass]; -end; - -function IsStyleHookRegistered(ControlClass: TClass; StyleHookClass: TStyleHookClass): Boolean; -var - List: TStyleHookList; -begin - Result := False; - if TCustomStyleEngine.GetRegisteredStyleHooks.ContainsKey(ControlClass) then - begin - List := TCustomStyleEngine.GetRegisteredStyleHooks[ControlClass]; - Result := List.IndexOf(StyleHookClass) <> -1; - end; -end; - -procedure ApplyEmptyVCLStyleHook(ControlClass: TClass); -begin - if not IsStyleHookRegistered(ControlClass, TStyleHook) then - TStyleManager.Engine.RegisterStyleHook(ControlClass, TStyleHook); -end; - -procedure RemoveEmptyVCLStyleHook(ControlClass: TClass); -begin - if IsStyleHookRegistered(ControlClass, TStyleHook) then - TStyleManager.Engine.UnRegisterStyleHook(ControlClass, TStyleHook); -end; - -{$IFDEF USE_VCL_STYLESAPI} -type - TseStyleHelper = class Helper for TseStyle - strict private - function GetCleanCopy: TSeStyleSource; - public - property CleanCopy: TSeStyleSource read GetCleanCopy; - end; - -function TseStyleHelper.GetCleanCopy: TSeStyleSource; -begin - with Self do - Result := FCleanCopy; -end; - -{ TVCLStyleExt } - -constructor TCustomStyleExt.Create(const FileName: string); -var - LStream: TFileStream; -begin - LStream := TFileStream.Create(FileName, fmOpenRead); - try - Create(LStream); - finally - LStream.Free; - end; -end; - -procedure TCustomStyleExt.CopyToStream(Stream: TStream); -var - I: Integer; -begin - Stream.Size := 0; - Stream.Position := 0; - - TseStyle(Source).CleanCopy.Name := TseStyle(Source).StyleSource.Name; - TseStyle(Source).CleanCopy.Author := TseStyle(Source).StyleSource.Author; - TseStyle(Source).CleanCopy.AuthorEMail := TseStyle(Source).StyleSource.AuthorEMail; - TseStyle(Source).CleanCopy.AuthorURL := TseStyle(Source).StyleSource.AuthorURL; - TseStyle(Source).CleanCopy.Version := TseStyle(Source).StyleSource.Version; - - // Replace the modified bitmaps - for I := 0 to TseStyle(Source).CleanCopy.Bitmaps.Count - 1 do - TseStyle(Source).CleanCopy.Bitmaps[I].Assign(TseStyle(Source).StyleSource.Bitmaps[I]); - - // TseStyle(Source).StyleSource.SysColors.Assign(TseStyle(Source).SysColors); - - // Replace the modified colors - TseStyle(Source).CleanCopy.SysColors.Assign(TseStyle(Source).SysColors); - TseStyle(Source).CleanCopy.Colors.Assign(TseStyle(Source).Colors); - TseStyle(Source).CleanCopy.Fonts.Assign(TseStyle(Source).Fonts); - - // ShowMessage(ColorToString(TseStyle(Source).SysColors[clWindow])); - TseStyle(Source).SaveToStream(Stream); - { - TseStyle(Source).StyleSource.Fonts.Assign(TseStyle(Source).Fonts); - TseStyle(Source).StyleSource.Colors.Assign(TseStyle(Source).Colors); - TseStyle(Source).StyleSource.SysColors.Assign(TseStyle(Source).SysColors); - TseStyle(Source).StyleSource.SaveToStream(Stream); - } -end; - -constructor TCustomStyleExt.Create(const Style: TCustomStyle); -begin - // Style.Source - // inherited Create(TStream(Style.)); -end; - -constructor TCustomStyleExt.Create(const Stream: TStream); -var - LSource: TObject; -begin - inherited Create; - FStream := TMemoryStream.Create; - - Stream.Seek(0, soBeginning); // index 0 to load - FStream.CopyFrom(Stream, Stream.Size); - Stream.Seek(0, soBeginning); // restore index 0 after - LSource := Source; - FStream.Seek(0, soBeginning); // index 0 to load - TseStyle(LSource).LoadFromStream(FStream); -end; - -destructor TCustomStyleExt.Destroy; -begin - if Assigned(FStream) then - FStream.Free; - inherited Destroy; -end; - -function TCustomStyleExt.GetBitmapList: TObjectList; -var - LSource: TObject; - I: Integer; - LseBitmap: TseBitmap; -begin - LSource := Source; - Result := TObjectList.Create; - for I := 0 to TseStyle(LSource).StyleSource.Bitmaps.Count - 1 do - begin - Result.Add(TBitmap.Create); - Result[I].PixelFormat := pf32bit; - LseBitmap := TseStyle(LSource).StyleSource.Bitmaps[I]; - Result[I].Width := LseBitmap.Width; - Result[I].Height := LseBitmap.Height; - LseBitmap.Draw(Result[I].Canvas, 0, 0); - end; -end; - -procedure TCustomStyleExt.ReplaceBitmap(DestIndex: Integer; Src: TBitmap); -var - BF: TBlendFunction; - Canvas: TCanvas; - LBitMap: TseBitmap; - DstRect, SrcRect: TRect; -begin - LBitMap := TseStyle(Source).StyleSource.Bitmaps[DestIndex]; - SrcRect := Rect(0, 0, Src.Width, Src.Height); - DstRect := Rect(0, 0, Src.Width, Src.Height); - Canvas := LBitMap.Canvas; - SetStretchBltMode(Canvas.Handle, COLORONCOLOR); - if LBitMap.AlphaBlend then - begin - BF.BlendOp := AC_SRC_OVER; - BF.BlendFlags := 0; - BF.SourceConstantAlpha := 255; - BF.AlphaFormat := AC_SRC_ALPHA; - Winapi.Windows.AlphaBlend(Canvas.Handle, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, - DstRect.Bottom - DstRect.Top, Src.Canvas.Handle, SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, - SrcRect.Bottom - SrcRect.Top, BF); - end - else if LBitMap.Transparent then - begin - Winapi.Windows.TransparentBlt(Canvas.Handle, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, - DstRect.Bottom - DstRect.Top, Src.Canvas.Handle, SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, - SrcRect.Bottom - SrcRect.Top, seTransparent); - end - else - begin - Winapi.Windows.StretchBlt(Canvas.Handle, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, - DstRect.Bottom - DstRect.Top, Src.Canvas.Handle, SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, - SrcRect.Bottom - SrcRect.Top, SRCCOPY); - end; -end; - -procedure TCustomStyleExt.SetStyleColor(Color: TStyleColor; NewColor: TColor); -begin - case Color of - scBorder: - if TseStyle(Source).Colors[ktcBorder] <> NewColor then - TseStyle(Source).Colors[ktcBorder] := NewColor; - scButtonDisabled: - if TseStyle(Source).Colors[ktcButtonDisabled] <> NewColor then - TseStyle(Source).Colors[ktcButtonDisabled] := NewColor; - scButtonFocused: - if TseStyle(Source).Colors[ktcButtonFocused] <> NewColor then - TseStyle(Source).Colors[ktcButtonFocused] := NewColor; - scButtonHot: - if TseStyle(Source).Colors[ktcButtonHot] <> NewColor then - TseStyle(Source).Colors[ktcButtonHot] := NewColor; - scButtonNormal: - if TseStyle(Source).Colors[ktcButton] <> NewColor then - TseStyle(Source).Colors[ktcButton] := NewColor; - scButtonPressed: - if TseStyle(Source).Colors[ktcButtonPressed] <> NewColor then - TseStyle(Source).Colors[ktcButtonPressed] := NewColor; - scCategoryButtons: - if TseStyle(Source).Colors[ktcCategoryButtons] <> NewColor then - TseStyle(Source).Colors[ktcCategoryButtons] := NewColor; - scCategoryButtonsGradientBase: - if TseStyle(Source).Colors[ktcCategoryButtonsGradientBase] <> NewColor then - TseStyle(Source).Colors[ktcCategoryButtonsGradientBase] := NewColor; - scCategoryButtonsGradientEnd: - if TseStyle(Source).Colors[ktcCategoryButtonsGradientEnd] <> NewColor then - TseStyle(Source).Colors[ktcCategoryButtonsGradientEnd] := NewColor; - scCategoryPanelGroup: - if TseStyle(Source).Colors[ktcCategoryPanelGroup] <> NewColor then - TseStyle(Source).Colors[ktcCategoryPanelGroup] := NewColor; - scComboBox: - if TseStyle(Source).Colors[ktcComboBox] <> NewColor then - TseStyle(Source).Colors[ktcComboBox] := NewColor; - scComboBoxDisabled: - if TseStyle(Source).Colors[ktcComboBoxDisabled] <> NewColor then - TseStyle(Source).Colors[ktcComboBoxDisabled] := NewColor; - scEdit: - if TseStyle(Source).Colors[ktcEdit] <> NewColor then - TseStyle(Source).Colors[ktcEdit] := NewColor; - scEditDisabled: - if TseStyle(Source).Colors[ktcEditDisabled] <> NewColor then - TseStyle(Source).Colors[ktcEditDisabled] := NewColor; - scGrid: - if TseStyle(Source).Colors[ktcGrid] <> NewColor then - TseStyle(Source).Colors[ktcGrid] := NewColor; - scGenericBackground: - if TseStyle(Source).Colors[ktcGenericBackground] <> NewColor then - TseStyle(Source).Colors[ktcGenericBackground] := NewColor; - scGenericGradientEnd: - if TseStyle(Source).Colors[ktcGenericGradientEnd] <> NewColor then - TseStyle(Source).Colors[ktcGenericGradientEnd] := NewColor; - scGenericGradientBase: - if TseStyle(Source).Colors[ktcGenericGradientBase] <> NewColor then - TseStyle(Source).Colors[ktcGenericGradientBase] := NewColor; - scHintGradientBase: - if TseStyle(Source).Colors[ktcHintGradientBase] <> NewColor then - TseStyle(Source).Colors[ktcHintGradientBase] := NewColor; - scHintGradientEnd: - if TseStyle(Source).Colors[ktcHintGradientEnd] <> NewColor then - TseStyle(Source).Colors[ktcHintGradientEnd] := NewColor; - scListBox: - if TseStyle(Source).Colors[ktcListBox] <> NewColor then - TseStyle(Source).Colors[ktcListBox] := NewColor; - scListBoxDisabled: - if TseStyle(Source).Colors[ktcListBoxDisabled] <> NewColor then - TseStyle(Source).Colors[ktcListBoxDisabled] := NewColor; - scListView: - if TseStyle(Source).Colors[ktcListView] <> NewColor then - TseStyle(Source).Colors[ktcListView] := NewColor; - scPanel: - if TseStyle(Source).Colors[ktcPanel] <> NewColor then - TseStyle(Source).Colors[ktcPanel] := NewColor; - scPanelDisabled: - if TseStyle(Source).Colors[ktcPanelDisabled] <> NewColor then - TseStyle(Source).Colors[ktcPanelDisabled] := NewColor; - scSplitter: - if TseStyle(Source).Colors[ktcSplitter] <> NewColor then - TseStyle(Source).Colors[ktcSplitter] := NewColor; - scToolBarGradientBase: - if TseStyle(Source).Colors[ktcToolBarGradientBase] <> NewColor then - TseStyle(Source).Colors[ktcToolBarGradientBase] := NewColor; - scToolBarGradientEnd: - if TseStyle(Source).Colors[ktcToolBarGradientEnd] <> NewColor then - TseStyle(Source).Colors[ktcToolBarGradientEnd] := NewColor; - scTreeView: - if TseStyle(Source).Colors[ktcTreeView] <> NewColor then - TseStyle(Source).Colors[ktcTreeView] := NewColor; - scWindow: - if TseStyle(Source).Colors[ktcWindow] <> NewColor then - TseStyle(Source).Colors[ktcWindow] := NewColor; - end; -end; - -procedure TCustomStyleExt.SetStyleFont(Font: TStyleFont; NewFont: TFont); -begin - case Font of - sfButtonTextDisabled: - if TseStyle(Source).Fonts[ktfButtonTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfButtonTextDisabled] := NewFont; - sfButtonTextFocused: - if TseStyle(Source).Fonts[ktfButtonTextFocused] <> NewFont then - TseStyle(Source).Fonts[ktfButtonTextFocused] := NewFont; - sfButtonTextHot: - if TseStyle(Source).Fonts[ktfButtonTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfButtonTextHot] := NewFont; - sfButtonTextNormal: - if TseStyle(Source).Fonts[ktfButtonTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfButtonTextNormal] := NewFont; - sfButtonTextPressed: - if TseStyle(Source).Fonts[ktfButtonTextPressed] <> NewFont then - TseStyle(Source).Fonts[ktfButtonTextPressed] := NewFont; - sfCaptionTextInactive: - if TseStyle(Source).Fonts[ktfCaptionTextInactive] <> NewFont then - TseStyle(Source).Fonts[ktfCaptionTextInactive] := NewFont; - sfCaptionTextNormal: - if TseStyle(Source).Fonts[ktfCaptionTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfCaptionTextNormal] := NewFont; - sfCategoryPanelGroupHeaderHot: - if TseStyle(Source).Fonts[ktfCategoryPanelGroupHeaderHot] <> NewFont then - TseStyle(Source).Fonts[ktfCategoryPanelGroupHeaderHot] := NewFont; - sfCategoryPanelGroupHeaderNormal: - if TseStyle(Source).Fonts[ktfCategoryPanelGroupHeaderNormal] <> NewFont then - TseStyle(Source).Fonts[ktfCategoryPanelGroupHeaderNormal] := NewFont; - sfCatgeoryButtonsCategoryNormal: - if TseStyle(Source).Fonts[ktfCatgeoryButtonsCategoryNormal] <> NewFont then - TseStyle(Source).Fonts[ktfCatgeoryButtonsCategoryNormal] := NewFont; - sfCatgeoryButtonsCategorySelected: - if TseStyle(Source).Fonts[ktfCatgeoryButtonsCategorySelected] <> NewFont then - TseStyle(Source).Fonts[ktfCatgeoryButtonsCategorySelected] := NewFont; - sfCatgeoryButtonsHot: - if TseStyle(Source).Fonts[ktfCatgeoryButtonsHot] <> NewFont then - TseStyle(Source).Fonts[ktfCatgeoryButtonsHot] := NewFont; - sfCatgeoryButtonsNormal: - if TseStyle(Source).Fonts[ktfCatgeoryButtonsNormal] <> NewFont then - TseStyle(Source).Fonts[ktfCatgeoryButtonsNormal] := NewFont; - sfCatgeoryButtonsSelected: - if TseStyle(Source).Fonts[ktfCatgeoryButtonsSelected] <> NewFont then - TseStyle(Source).Fonts[ktfCatgeoryButtonsSelected] := NewFont; - sfCheckBoxTextDisabled: - if TseStyle(Source).Fonts[ktfCheckBoxTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfCheckBoxTextDisabled] := NewFont; - sfCheckBoxTextFocused: - if TseStyle(Source).Fonts[ktfCheckBoxTextFocused] <> NewFont then - TseStyle(Source).Fonts[ktfCheckBoxTextFocused] := NewFont; - sfCheckBoxTextHot: - if TseStyle(Source).Fonts[ktfCheckBoxTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfCheckBoxTextHot] := NewFont; - sfCheckBoxTextNormal: - if TseStyle(Source).Fonts[ktfCheckBoxTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfCheckBoxTextNormal] := NewFont; - sfCheckBoxTextPressed: - if TseStyle(Source).Fonts[ktfCheckBoxTextPressed] <> NewFont then - TseStyle(Source).Fonts[ktfCheckBoxTextPressed] := NewFont; - sfComboBoxItemDisabled: - if TseStyle(Source).Fonts[ktfComboBoxItemDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfComboBoxItemDisabled] := NewFont; - sfComboBoxItemFocused: - if TseStyle(Source).Fonts[ktfComboBoxItemFocused] <> NewFont then - TseStyle(Source).Fonts[ktfComboBoxItemFocused] := NewFont; - sfComboBoxItemHot: - if TseStyle(Source).Fonts[ktfComboBoxItemHot] <> NewFont then - TseStyle(Source).Fonts[ktfComboBoxItemHot] := NewFont; - sfComboBoxItemNormal: - if TseStyle(Source).Fonts[ktfComboBoxItemNormal] <> NewFont then - TseStyle(Source).Fonts[ktfComboBoxItemNormal] := NewFont; - sfComboBoxItemSelected: - if TseStyle(Source).Fonts[ktfComboBoxItemSelected] <> NewFont then - TseStyle(Source).Fonts[ktfComboBoxItemSelected] := NewFont; - sfEditBoxTextDisabled: - if TseStyle(Source).Fonts[ktfEditBoxTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfEditBoxTextDisabled] := NewFont; - sfEditBoxTextFocused: - if TseStyle(Source).Fonts[ktfEditBoxTextFocused] <> NewFont then - TseStyle(Source).Fonts[ktfEditBoxTextFocused] := NewFont; - sfEditBoxTextHot: - if TseStyle(Source).Fonts[ktfEditBoxTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfEditBoxTextHot] := NewFont; - sfEditBoxTextNormal: - if TseStyle(Source).Fonts[ktfEditBoxTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfEditBoxTextNormal] := NewFont; - sfEditBoxTextSelected: - if TseStyle(Source).Fonts[ktfEditBoxTextSelected] <> NewFont then - TseStyle(Source).Fonts[ktfEditBoxTextSelected] := NewFont; - sfGridItemFixedHot: - if TseStyle(Source).Fonts[ktfGridItemFixedHot] <> NewFont then - TseStyle(Source).Fonts[ktfGridItemFixedHot] := NewFont; - sfGridItemFixedNormal: - if TseStyle(Source).Fonts[ktfGridItemFixedNormal] <> NewFont then - TseStyle(Source).Fonts[ktfGridItemFixedNormal] := NewFont; - sfGridItemFixedPressed: - if TseStyle(Source).Fonts[ktfGridItemFixedPressed] <> NewFont then - TseStyle(Source).Fonts[ktfGridItemFixedPressed] := NewFont; - sfGridItemNormal: - if TseStyle(Source).Fonts[ktfGridItemNormal] <> NewFont then - TseStyle(Source).Fonts[ktfGridItemNormal] := NewFont; - sfGridItemSelected: - if TseStyle(Source).Fonts[ktfGridItemSelected] <> NewFont then - TseStyle(Source).Fonts[ktfGridItemSelected] := NewFont; - sfGroupBoxTextDisabled: - if TseStyle(Source).Fonts[ktfGroupBoxTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfGroupBoxTextDisabled] := NewFont; - sfGroupBoxTextNormal: - if TseStyle(Source).Fonts[ktfGroupBoxTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfGroupBoxTextNormal] := NewFont; - sfHeaderSectionTextDisabled: - if TseStyle(Source).Fonts[ktfHeaderSectionTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfHeaderSectionTextDisabled] := NewFont; - sfHeaderSectionTextHot: - if TseStyle(Source).Fonts[ktfHeaderSectionTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfHeaderSectionTextHot] := NewFont; - sfHeaderSectionTextNormal: - if TseStyle(Source).Fonts[ktfHeaderSectionTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfHeaderSectionTextNormal] := NewFont; - sfHeaderSectionTextPressed: - if TseStyle(Source).Fonts[ktfHeaderSectionTextPressed] <> NewFont then - TseStyle(Source).Fonts[ktfHeaderSectionTextPressed] := NewFont; - sfListItemTextDisabled: - if TseStyle(Source).Fonts[ktfListItemTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfListItemTextDisabled] := NewFont; - sfListItemTextFocused: - if TseStyle(Source).Fonts[ktfListItemTextFocused] <> NewFont then - TseStyle(Source).Fonts[ktfListItemTextFocused] := NewFont; - sfListItemTextHot: - if TseStyle(Source).Fonts[ktfListItemTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfListItemTextHot] := NewFont; - sfListItemTextNormal: - if TseStyle(Source).Fonts[ktfListItemTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfListItemTextNormal] := NewFont; - sfListItemTextSelected: - if TseStyle(Source).Fonts[ktfListItemTextSelected] <> NewFont then - TseStyle(Source).Fonts[ktfListItemTextSelected] := NewFont; - sfMenuItemTextDisabled: - if TseStyle(Source).Fonts[ktfMenuItemTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfMenuItemTextDisabled] := NewFont; - sfMenuItemTextHot: - if TseStyle(Source).Fonts[ktfMenuItemTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfMenuItemTextHot] := NewFont; - sfMenuItemTextNormal: - if TseStyle(Source).Fonts[ktfMenuItemTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfMenuItemTextNormal] := NewFont; - sfMenuItemTextSelected: - if TseStyle(Source).Fonts[ktfMenuItemTextSelected] <> NewFont then - TseStyle(Source).Fonts[ktfMenuItemTextSelected] := NewFont; - sfPanelTextDisabled: - if TseStyle(Source).Fonts[ktfPanelTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfPanelTextDisabled] := NewFont; - sfPanelTextNormal: - if TseStyle(Source).Fonts[ktfPanelTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfPanelTextNormal] := NewFont; - sfPopupMenuItemTextDisabled: - if TseStyle(Source).Fonts[ktfPopupMenuItemTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfPopupMenuItemTextDisabled] := NewFont; - sfPopupMenuItemTextHot: - if TseStyle(Source).Fonts[ktfPopupMenuItemTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfPopupMenuItemTextHot] := NewFont; - sfPopupMenuItemTextNormal: - if TseStyle(Source).Fonts[ktfPopupMenuItemTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfPopupMenuItemTextNormal] := NewFont; - sfPopupMenuItemTextSelected: - if TseStyle(Source).Fonts[ktfPopupMenuItemTextSelected] <> NewFont then - TseStyle(Source).Fonts[ktfPopupMenuItemTextSelected] := NewFont; - sfRadioButtonTextDisabled: - if TseStyle(Source).Fonts[ktfRadioButtonTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfRadioButtonTextDisabled] := NewFont; - sfRadioButtonTextFocused: - if TseStyle(Source).Fonts[ktfRadioButtonTextFocused] <> NewFont then - TseStyle(Source).Fonts[ktfRadioButtonTextFocused] := NewFont; - sfRadioButtonTextHot: - if TseStyle(Source).Fonts[ktfRadioButtonTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfRadioButtonTextHot] := NewFont; - sfRadioButtonTextNormal: - if TseStyle(Source).Fonts[ktfRadioButtonTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfRadioButtonTextNormal] := NewFont; - sfRadioButtonTextPressed: - if TseStyle(Source).Fonts[ktfRadioButtonTextPressed] <> NewFont then - TseStyle(Source).Fonts[ktfRadioButtonTextPressed] := NewFont; - sfSmCaptionTextInactive: - if TseStyle(Source).Fonts[ktfSmCaptionTextInactive] <> NewFont then - TseStyle(Source).Fonts[ktfSmCaptionTextInactive] := NewFont; - sfSmCaptionTextNormal: - if TseStyle(Source).Fonts[ktfSmCaptionTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfSmCaptionTextNormal] := NewFont; - sfStatusPanelTextDisabled: - if TseStyle(Source).Fonts[ktfStatusPanelTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfStatusPanelTextDisabled] := NewFont; - sfStatusPanelTextNormal: - if TseStyle(Source).Fonts[ktfStatusPanelTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfStatusPanelTextNormal] := NewFont; - sfTabTextActiveDisabled: - if TseStyle(Source).Fonts[ktfTabTextActiveDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfTabTextActiveDisabled] := NewFont; - sfTabTextActiveHot: - if TseStyle(Source).Fonts[ktfTabTextActiveHot] <> NewFont then - TseStyle(Source).Fonts[ktfTabTextActiveHot] := NewFont; - sfTabTextActiveNormal: - if TseStyle(Source).Fonts[ktfTabTextActiveNormal] <> NewFont then - TseStyle(Source).Fonts[ktfTabTextActiveNormal] := NewFont; - sfTabTextInactiveDisabled: - if TseStyle(Source).Fonts[ktfTabTextInactiveDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfTabTextInactiveDisabled] := NewFont; - sfTabTextInactiveHot: - if TseStyle(Source).Fonts[ktfTabTextInactiveHot] <> NewFont then - TseStyle(Source).Fonts[ktfTabTextInactiveHot] := NewFont; - sfTabTextInactiveNormal: - if TseStyle(Source).Fonts[ktfTabTextInactiveNormal] <> NewFont then - TseStyle(Source).Fonts[ktfTabTextInactiveNormal] := NewFont; - sfTextLabelDisabled: - if TseStyle(Source).Fonts[ktfStaticTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfStaticTextDisabled] := NewFont; - sfTextLabelFocused: - if TseStyle(Source).Fonts[ktfStaticTextFocused] <> NewFont then - TseStyle(Source).Fonts[ktfStaticTextFocused] := NewFont; - sfTextLabelHot: - if TseStyle(Source).Fonts[ktfStaticTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfStaticTextHot] := NewFont; - sfTextLabelNormal: - if TseStyle(Source).Fonts[ktfStaticTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfStaticTextNormal] := NewFont; - sfToolItemTextDisabled: - if TseStyle(Source).Fonts[ktfToolItemTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfToolItemTextDisabled] := NewFont; - sfToolItemTextHot: - if TseStyle(Source).Fonts[ktfToolItemTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfToolItemTextHot] := NewFont; - sfToolItemTextNormal: - if TseStyle(Source).Fonts[ktfToolItemTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfToolItemTextNormal] := NewFont; - sfToolItemTextSelected: - if TseStyle(Source).Fonts[ktfToolItemTextSelected] <> NewFont then - TseStyle(Source).Fonts[ktfToolItemTextSelected] := NewFont; - sfTreeItemTextDisabled: - if TseStyle(Source).Fonts[ktfTreeItemTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfTreeItemTextDisabled] := NewFont; - sfTreeItemTextFocused: - if TseStyle(Source).Fonts[ktfTreeItemTextFocused] <> NewFont then - TseStyle(Source).Fonts[ktfTreeItemTextFocused] := NewFont; - sfTreeItemTextHot: - if TseStyle(Source).Fonts[ktfTreeItemTextHot] <> NewFont then - TseStyle(Source).Fonts[ktfTreeItemTextHot] := NewFont; - sfTreeItemTextNormal: - if TseStyle(Source).Fonts[ktfTreeItemTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfTreeItemTextNormal] := NewFont; - sfTreeItemTextSelected: - if TseStyle(Source).Fonts[ktfTreeItemTextSelected] <> NewFont then - TseStyle(Source).Fonts[ktfTreeItemTextSelected] := NewFont; - sfWindowTextDisabled: - if TseStyle(Source).Fonts[ktfWindowTextDisabled] <> NewFont then - TseStyle(Source).Fonts[ktfWindowTextDisabled] := NewFont; - sfWindowTextNormal: - if TseStyle(Source).Fonts[ktfWindowTextNormal] <> NewFont then - TseStyle(Source).Fonts[ktfWindowTextNormal] := NewFont; - end; -end; - -procedure TCustomStyleExt.SetStyleFontColor(Font: TStyleFont; NewColor: TColor); -begin - case Font of - sfButtonTextDisabled: - if TseStyle(Source).Fonts[ktfButtonTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfButtonTextDisabled].Color := NewColor; - sfButtonTextFocused: - if TseStyle(Source).Fonts[ktfButtonTextFocused].Color <> NewColor then - TseStyle(Source).Fonts[ktfButtonTextFocused].Color := NewColor; - sfButtonTextHot: - if TseStyle(Source).Fonts[ktfButtonTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfButtonTextHot].Color := NewColor; - sfButtonTextNormal: - if TseStyle(Source).Fonts[ktfButtonTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfButtonTextNormal].Color := NewColor; - sfButtonTextPressed: - if TseStyle(Source).Fonts[ktfButtonTextPressed].Color <> NewColor then - TseStyle(Source).Fonts[ktfButtonTextPressed].Color := NewColor; - sfCaptionTextInactive: - if TseStyle(Source).Fonts[ktfCaptionTextInactive].Color <> NewColor then - TseStyle(Source).Fonts[ktfCaptionTextInactive].Color := NewColor; - sfCaptionTextNormal: - if TseStyle(Source).Fonts[ktfCaptionTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfCaptionTextNormal].Color := NewColor; - sfCategoryPanelGroupHeaderHot: - if TseStyle(Source).Fonts[ktfCategoryPanelGroupHeaderHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfCategoryPanelGroupHeaderHot].Color := NewColor; - sfCategoryPanelGroupHeaderNormal: - if TseStyle(Source).Fonts[ktfCategoryPanelGroupHeaderNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfCategoryPanelGroupHeaderNormal].Color := NewColor; - sfCatgeoryButtonsCategoryNormal: - if TseStyle(Source).Fonts[ktfCatgeoryButtonsCategoryNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfCatgeoryButtonsCategoryNormal].Color := NewColor; - sfCatgeoryButtonsCategorySelected: - if TseStyle(Source).Fonts[ktfCatgeoryButtonsCategorySelected].Color <> NewColor then - TseStyle(Source).Fonts[ktfCatgeoryButtonsCategorySelected].Color := NewColor; - sfCatgeoryButtonsHot: - if TseStyle(Source).Fonts[ktfCatgeoryButtonsHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfCatgeoryButtonsHot].Color := NewColor; - sfCatgeoryButtonsNormal: - if TseStyle(Source).Fonts[ktfCatgeoryButtonsNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfCatgeoryButtonsNormal].Color := NewColor; - sfCatgeoryButtonsSelected: - if TseStyle(Source).Fonts[ktfCatgeoryButtonsSelected].Color <> NewColor then - TseStyle(Source).Fonts[ktfCatgeoryButtonsSelected].Color := NewColor; - sfCheckBoxTextDisabled: - if TseStyle(Source).Fonts[ktfCheckBoxTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfCheckBoxTextDisabled].Color := NewColor; - sfCheckBoxTextFocused: - if TseStyle(Source).Fonts[ktfCheckBoxTextFocused].Color <> NewColor then - TseStyle(Source).Fonts[ktfCheckBoxTextFocused].Color := NewColor; - sfCheckBoxTextHot: - if TseStyle(Source).Fonts[ktfCheckBoxTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfCheckBoxTextHot].Color := NewColor; - sfCheckBoxTextNormal: - if TseStyle(Source).Fonts[ktfCheckBoxTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfCheckBoxTextNormal].Color := NewColor; - sfCheckBoxTextPressed: - if TseStyle(Source).Fonts[ktfCheckBoxTextPressed].Color <> NewColor then - TseStyle(Source).Fonts[ktfCheckBoxTextPressed].Color := NewColor; - sfComboBoxItemDisabled: - if TseStyle(Source).Fonts[ktfComboBoxItemDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfComboBoxItemDisabled].Color := NewColor; - sfComboBoxItemFocused: - if TseStyle(Source).Fonts[ktfComboBoxItemFocused].Color <> NewColor then - TseStyle(Source).Fonts[ktfComboBoxItemFocused].Color := NewColor; - sfComboBoxItemHot: - if TseStyle(Source).Fonts[ktfComboBoxItemHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfComboBoxItemHot].Color := NewColor; - sfComboBoxItemNormal: - if TseStyle(Source).Fonts[ktfComboBoxItemNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfComboBoxItemNormal].Color := NewColor; - sfComboBoxItemSelected: - if TseStyle(Source).Fonts[ktfComboBoxItemSelected].Color <> NewColor then - TseStyle(Source).Fonts[ktfComboBoxItemSelected].Color := NewColor; - sfEditBoxTextDisabled: - if TseStyle(Source).Fonts[ktfEditBoxTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfEditBoxTextDisabled].Color := NewColor; - sfEditBoxTextFocused: - if TseStyle(Source).Fonts[ktfEditBoxTextFocused].Color <> NewColor then - TseStyle(Source).Fonts[ktfEditBoxTextFocused].Color := NewColor; - sfEditBoxTextHot: - if TseStyle(Source).Fonts[ktfEditBoxTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfEditBoxTextHot].Color := NewColor; - sfEditBoxTextNormal: - if TseStyle(Source).Fonts[ktfEditBoxTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfEditBoxTextNormal].Color := NewColor; - sfEditBoxTextSelected: - if TseStyle(Source).Fonts[ktfEditBoxTextSelected].Color <> NewColor then - TseStyle(Source).Fonts[ktfEditBoxTextSelected].Color := NewColor; - sfGridItemFixedHot: - if TseStyle(Source).Fonts[ktfGridItemFixedHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfGridItemFixedHot].Color := NewColor; - sfGridItemFixedNormal: - if TseStyle(Source).Fonts[ktfGridItemFixedNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfGridItemFixedNormal].Color := NewColor; - sfGridItemFixedPressed: - if TseStyle(Source).Fonts[ktfGridItemFixedPressed].Color <> NewColor then - TseStyle(Source).Fonts[ktfGridItemFixedPressed].Color := NewColor; - sfGridItemNormal: - if TseStyle(Source).Fonts[ktfGridItemNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfGridItemNormal].Color := NewColor; - sfGridItemSelected: - if TseStyle(Source).Fonts[ktfGridItemSelected].Color <> NewColor then - TseStyle(Source).Fonts[ktfGridItemSelected].Color := NewColor; - sfGroupBoxTextDisabled: - if TseStyle(Source).Fonts[ktfGroupBoxTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfGroupBoxTextDisabled].Color := NewColor; - sfGroupBoxTextNormal: - if TseStyle(Source).Fonts[ktfGroupBoxTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfGroupBoxTextNormal].Color := NewColor; - sfHeaderSectionTextDisabled: - if TseStyle(Source).Fonts[ktfHeaderSectionTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfHeaderSectionTextDisabled].Color := NewColor; - sfHeaderSectionTextHot: - if TseStyle(Source).Fonts[ktfHeaderSectionTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfHeaderSectionTextHot].Color := NewColor; - sfHeaderSectionTextNormal: - if TseStyle(Source).Fonts[ktfHeaderSectionTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfHeaderSectionTextNormal].Color := NewColor; - sfHeaderSectionTextPressed: - if TseStyle(Source).Fonts[ktfHeaderSectionTextPressed].Color <> NewColor then - TseStyle(Source).Fonts[ktfHeaderSectionTextPressed].Color := NewColor; - sfListItemTextDisabled: - if TseStyle(Source).Fonts[ktfListItemTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfListItemTextDisabled].Color := NewColor; - sfListItemTextFocused: - if TseStyle(Source).Fonts[ktfListItemTextFocused].Color <> NewColor then - TseStyle(Source).Fonts[ktfListItemTextFocused].Color := NewColor; - sfListItemTextHot: - if TseStyle(Source).Fonts[ktfListItemTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfListItemTextHot].Color := NewColor; - sfListItemTextNormal: - if TseStyle(Source).Fonts[ktfListItemTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfListItemTextNormal].Color := NewColor; - sfListItemTextSelected: - if TseStyle(Source).Fonts[ktfListItemTextSelected].Color <> NewColor then - TseStyle(Source).Fonts[ktfListItemTextSelected].Color := NewColor; - sfMenuItemTextDisabled: - if TseStyle(Source).Fonts[ktfMenuItemTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfMenuItemTextDisabled].Color := NewColor; - sfMenuItemTextHot: - if TseStyle(Source).Fonts[ktfMenuItemTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfMenuItemTextHot].Color := NewColor; - sfMenuItemTextNormal: - if TseStyle(Source).Fonts[ktfMenuItemTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfMenuItemTextNormal].Color := NewColor; - sfMenuItemTextSelected: - if TseStyle(Source).Fonts[ktfMenuItemTextSelected].Color <> NewColor then - TseStyle(Source).Fonts[ktfMenuItemTextSelected].Color := NewColor; - sfPanelTextDisabled: - if TseStyle(Source).Fonts[ktfPanelTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfPanelTextDisabled].Color := NewColor; - sfPanelTextNormal: - if TseStyle(Source).Fonts[ktfPanelTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfPanelTextNormal].Color := NewColor; - sfPopupMenuItemTextDisabled: - if TseStyle(Source).Fonts[ktfPopupMenuItemTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfPopupMenuItemTextDisabled].Color := NewColor; - sfPopupMenuItemTextHot: - if TseStyle(Source).Fonts[ktfPopupMenuItemTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfPopupMenuItemTextHot].Color := NewColor; - sfPopupMenuItemTextNormal: - if TseStyle(Source).Fonts[ktfPopupMenuItemTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfPopupMenuItemTextNormal].Color := NewColor; - sfPopupMenuItemTextSelected: - if TseStyle(Source).Fonts[ktfPopupMenuItemTextSelected].Color <> NewColor then - TseStyle(Source).Fonts[ktfPopupMenuItemTextSelected].Color := NewColor; - sfRadioButtonTextDisabled: - if TseStyle(Source).Fonts[ktfRadioButtonTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfRadioButtonTextDisabled].Color := NewColor; - sfRadioButtonTextFocused: - if TseStyle(Source).Fonts[ktfRadioButtonTextFocused].Color <> NewColor then - TseStyle(Source).Fonts[ktfRadioButtonTextFocused].Color := NewColor; - sfRadioButtonTextHot: - if TseStyle(Source).Fonts[ktfRadioButtonTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfRadioButtonTextHot].Color := NewColor; - sfRadioButtonTextNormal: - if TseStyle(Source).Fonts[ktfRadioButtonTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfRadioButtonTextNormal].Color := NewColor; - sfRadioButtonTextPressed: - if TseStyle(Source).Fonts[ktfRadioButtonTextPressed].Color <> NewColor then - TseStyle(Source).Fonts[ktfRadioButtonTextPressed].Color := NewColor; - sfSmCaptionTextInactive: - if TseStyle(Source).Fonts[ktfSmCaptionTextInactive].Color <> NewColor then - TseStyle(Source).Fonts[ktfSmCaptionTextInactive].Color := NewColor; - sfSmCaptionTextNormal: - if TseStyle(Source).Fonts[ktfSmCaptionTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfSmCaptionTextNormal].Color := NewColor; - sfStatusPanelTextDisabled: - if TseStyle(Source).Fonts[ktfStatusPanelTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfStatusPanelTextDisabled].Color := NewColor; - sfStatusPanelTextNormal: - if TseStyle(Source).Fonts[ktfStatusPanelTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfStatusPanelTextNormal].Color := NewColor; - sfTabTextActiveDisabled: - if TseStyle(Source).Fonts[ktfTabTextActiveDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfTabTextActiveDisabled].Color := NewColor; - sfTabTextActiveHot: - if TseStyle(Source).Fonts[ktfTabTextActiveHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfTabTextActiveHot].Color := NewColor; - sfTabTextActiveNormal: - if TseStyle(Source).Fonts[ktfTabTextActiveNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfTabTextActiveNormal].Color := NewColor; - sfTabTextInactiveDisabled: - if TseStyle(Source).Fonts[ktfTabTextInactiveDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfTabTextInactiveDisabled].Color := NewColor; - sfTabTextInactiveHot: - if TseStyle(Source).Fonts[ktfTabTextInactiveHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfTabTextInactiveHot].Color := NewColor; - sfTabTextInactiveNormal: - if TseStyle(Source).Fonts[ktfTabTextInactiveNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfTabTextInactiveNormal].Color := NewColor; - sfTextLabelDisabled: - if TseStyle(Source).Fonts[ktfStaticTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfStaticTextDisabled].Color := NewColor; - sfTextLabelFocused: - if TseStyle(Source).Fonts[ktfStaticTextFocused].Color <> NewColor then - TseStyle(Source).Fonts[ktfStaticTextFocused].Color := NewColor; - sfTextLabelHot: - if TseStyle(Source).Fonts[ktfStaticTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfStaticTextHot].Color := NewColor; - sfTextLabelNormal: - if TseStyle(Source).Fonts[ktfStaticTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfStaticTextNormal].Color := NewColor; - sfToolItemTextDisabled: - if TseStyle(Source).Fonts[ktfToolItemTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfToolItemTextDisabled].Color := NewColor; - sfToolItemTextHot: - if TseStyle(Source).Fonts[ktfToolItemTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfToolItemTextHot].Color := NewColor; - sfToolItemTextNormal: - if TseStyle(Source).Fonts[ktfToolItemTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfToolItemTextNormal].Color := NewColor; - sfToolItemTextSelected: - if TseStyle(Source).Fonts[ktfToolItemTextSelected].Color <> NewColor then - TseStyle(Source).Fonts[ktfToolItemTextSelected].Color := NewColor; - sfTreeItemTextDisabled: - if TseStyle(Source).Fonts[ktfTreeItemTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfTreeItemTextDisabled].Color := NewColor; - sfTreeItemTextFocused: - if TseStyle(Source).Fonts[ktfTreeItemTextFocused].Color <> NewColor then - TseStyle(Source).Fonts[ktfTreeItemTextFocused].Color := NewColor; - sfTreeItemTextHot: - if TseStyle(Source).Fonts[ktfTreeItemTextHot].Color <> NewColor then - TseStyle(Source).Fonts[ktfTreeItemTextHot].Color := NewColor; - sfTreeItemTextNormal: - if TseStyle(Source).Fonts[ktfTreeItemTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfTreeItemTextNormal].Color := NewColor; - sfTreeItemTextSelected: - if TseStyle(Source).Fonts[ktfTreeItemTextSelected].Color <> NewColor then - TseStyle(Source).Fonts[ktfTreeItemTextSelected].Color := NewColor; - sfWindowTextDisabled: - if TseStyle(Source).Fonts[ktfWindowTextDisabled].Color <> NewColor then - TseStyle(Source).Fonts[ktfWindowTextDisabled].Color := NewColor; - sfWindowTextNormal: - if TseStyle(Source).Fonts[ktfWindowTextNormal].Color <> NewColor then - TseStyle(Source).Fonts[ktfWindowTextNormal].Color := NewColor; - end; -end; - -procedure TCustomStyleExt.SetSystemColor(Color, NewColor: TColor); -begin - if TseStyle(Source).SysColors[Color] <> NewColor then - TseStyle(Source).SysColors[Color] := NewColor; -end; - -function TCustomStyleExt.GetSource: TObject; -begin - Result := TRttiContext.Create.GetType(Self.ClassType).GetField('FSource').GetValue(Self).AsObject; -end; - -procedure TCustomStyleExt.SetStyleInfo(const Value: TStyleInfo); -begin - TseStyle(Source).StyleSource.Name := Value.Name; - TseStyle(Source).StyleSource.Author := Value.Author; - TseStyle(Source).StyleSource.AuthorEMail := Value.AuthorEMail; - TseStyle(Source).StyleSource.AuthorURL := Value.AuthorURL; - TseStyle(Source).StyleSource.Version := Value.Version; -end; - -function TCustomStyleExt.GetStyleInfo: TStyleInfo; -begin - Result.Name := TseStyle(Source).StyleSource.Name; - Result.Author := TseStyle(Source).StyleSource.Author; - Result.AuthorEMail := TseStyle(Source).StyleSource.AuthorEMail; - Result.AuthorURL := TseStyle(Source).StyleSource.AuthorURL; - Result.Version := TseStyle(Source).StyleSource.Version; -end; - -{ TCustomStyleHelper } -// function TCustomStyleHelper.GetSource: TObject; -// begin -// {$IFDEF USE_RTTI} -// Result := TRttiContext.Create.GetType(Self.ClassType).GetField('FSource').GetValue(Self).AsObject; -// {$ELSE} -// Result := Self.FSource; -// {$ENDIF} -// end; -// -{$ENDIF} - -procedure DrawSampleWindow(Style: TCustomStyle; Canvas: TCanvas; ARect: TRect; const ACaption: string; - HICON: HICON = 0); -var - LDetails, CaptionDetails, IconDetails: TThemedElementDetails; - IconRect, BorderRect, CaptionRect, ButtonRect, TextRect: TRect; - CaptionBitmap: TBitmap; - ThemeTextColor: TColor; - - function GetBorderSize: TRect; - var - Size: TSize; - Details: TThemedElementDetails; - Detail: TThemedWindow; - begin - Result := Rect(0, 0, 0, 0); - Detail := twCaptionActive; - Details := Style.GetElementDetails(Detail); - Style.GetElementSize(0, Details, esActual, Size); - Result.Top := Size.cy; - Detail := twFrameLeftActive; - Details := Style.GetElementDetails(Detail); - Style.GetElementSize(0, Details, esActual, Size); - Result.Left := Size.cx; - Detail := twFrameRightActive; - Details := Style.GetElementDetails(Detail); - Style.GetElementSize(0, Details, esActual, Size); - Result.Right := Size.cx; - Detail := twFrameBottomActive; - Details := Style.GetElementDetails(Detail); - Style.GetElementSize(0, Details, esActual, Size); - Result.Bottom := Size.cy; - end; - - function RectVCenter(var R: TRect; 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; - -begin - BorderRect := GetBorderSize; - - CaptionBitmap := TBitmap.Create; - CaptionBitmap.SetSize(ARect.Width, BorderRect.Top); - - // Draw background - LDetails.Element := teWindow; - LDetails.Part := 0; - Style.DrawElement(Canvas.Handle, LDetails, ARect); - - // Draw caption border - CaptionRect := Rect(0, 0, CaptionBitmap.Width, CaptionBitmap.Height); - LDetails := Style.GetElementDetails(twCaptionActive); - Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, CaptionRect); - TextRect := CaptionRect; - CaptionDetails := LDetails; - - // Draw icon - IconDetails := Style.GetElementDetails(twSysButtonNormal); - if not Style.GetElementContentRect(0, IconDetails, CaptionRect, ButtonRect) then - ButtonRect := Rect(0, 0, 0, 0); - IconRect := Rect(0, 0, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON)); - RectVCenter(IconRect, ButtonRect); - if ButtonRect.Width > 0 then - { - if Assigned(Application.MainForm) then - DrawIconEx(CaptionBitmap.Canvas.Handle, IconRect.Left, IconRect.Top, Application.MainForm.Icon.Handle, 0, 0, 0, 0, DI_NORMAL); - } - if (HICON <> 0) then - DrawIconEx(CaptionBitmap.Canvas.Handle, IconRect.Left, IconRect.Top, HICON, 0, 0, 0, 0, DI_NORMAL); - - Inc(TextRect.Left, ButtonRect.Width + 5); - - // Draw buttons - - // Close button - LDetails := Style.GetElementDetails(twCloseButtonNormal); - if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then - Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect); - - // Maximize button - LDetails := Style.GetElementDetails(twMaxButtonNormal); - if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then - Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect); - - // Minimize button - LDetails := Style.GetElementDetails(twMinButtonNormal); - - if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then - Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect); - - // Help button - LDetails := Style.GetElementDetails(twHelpButtonNormal); - if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then - Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect); - - if (ButtonRect.Left > 0) then - TextRect.Right := ButtonRect.Left; - - // Draw text - Style.DrawText(CaptionBitmap.Canvas.Handle, CaptionDetails, ACaption, TextRect, - [tfLeft, tfSingleLine, tfVerticalCenter]); - - // Draw caption - Canvas.Draw(0, 0, CaptionBitmap); - - CaptionBitmap.Free; - - // Draw left border - CaptionRect := Rect(0, BorderRect.Top, BorderRect.Left, ARect.Height - BorderRect.Bottom); - LDetails := Style.GetElementDetails(twFrameLeftActive); - if CaptionRect.Bottom - CaptionRect.Top > 0 then - Style.DrawElement(Canvas.Handle, LDetails, CaptionRect); - - // Draw right border - CaptionRect := Rect(ARect.Width - BorderRect.Right, BorderRect.Top, ARect.Width, ARect.Height - BorderRect.Bottom); - LDetails := Style.GetElementDetails(twFrameRightActive); - Style.DrawElement(Canvas.Handle, LDetails, CaptionRect); - - // Draw Bottom border - CaptionRect := Rect(0, ARect.Height - BorderRect.Bottom, ARect.Width, ARect.Height); - LDetails := Style.GetElementDetails(twFrameBottomActive); - Style.DrawElement(Canvas.Handle, LDetails, CaptionRect); - - // Draw Ok button - LDetails := Style.GetElementDetails(tbPushButtonNormal); - ButtonRect.Left := 30; - ButtonRect.Top := ARect.Height - 45; - ButtonRect.Width := 75; - ButtonRect.Height := 25; - Style.DrawElement(Canvas.Handle, LDetails, ButtonRect); - - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - Style.DrawText(Canvas.Handle, LDetails, 'OK', ButtonRect, TTextFormatFlags(DT_VCENTER or DT_CENTER), ThemeTextColor); - - // Draw Cancel button - ButtonRect.Left := 110; - ButtonRect.Top := ARect.Height - 45; - ButtonRect.Width := 75; - ButtonRect.Height := 25; - Style.DrawElement(Canvas.Handle, LDetails, ButtonRect); - - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - Style.DrawText(Canvas.Handle, LDetails, 'Cancel', ButtonRect, TTextFormatFlags(DT_VCENTER or DT_CENTER), - ThemeTextColor); -end; - -{ TVclStylePreview } - -constructor TVclStylesPreview.Create(AControl: TComponent); -begin - inherited; - FRegion := 0; - FStyle := nil; - FCaption := ''; - FIcon := 0; - FBitmap := TBitmap.Create; - FBitmap.PixelFormat := pf32bit; -end; - -destructor TVclStylesPreview.Destroy; -begin - if FRegion <> 0 then - begin - DeleteObject(FRegion); - FRegion := 0; - end; - FBitmap.Free; - inherited; -end; - -procedure TVclStylesPreview.Paint; -var - LDetails, CaptionDetails, IconDetails: TThemedElementDetails; - IconRect, BorderRect, CaptionRect, ButtonRect, TextRect: TRect; - CaptionBitmap: TBitmap; - ThemeTextColor: TColor; - ARect, LRect: TRect; - LRegion: HRGN; - I: Integer; - - function GetBorderSize: TRect; - var - Size: TSize; - Details: TThemedElementDetails; - Detail: TThemedWindow; - begin - Result := Rect(0, 0, 0, 0); - Detail := twCaptionActive; - Details := Style.GetElementDetails(Detail); - Style.GetElementSize(0, Details, esActual, Size); - Result.Top := Size.cy; - Detail := twFrameLeftActive; - Details := Style.GetElementDetails(Detail); - Style.GetElementSize(0, Details, esActual, Size); - Result.Left := Size.cx; - Detail := twFrameRightActive; - Details := Style.GetElementDetails(Detail); - Style.GetElementSize(0, Details, esActual, Size); - Result.Right := Size.cx; - Detail := twFrameBottomActive; - Details := Style.GetElementDetails(Detail); - Style.GetElementSize(0, Details, esActual, Size); - Result.Bottom := Size.cy; - end; - - function RectVCenter(var R: TRect; 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; - -begin - if FStyle = nil then - Exit; - - BorderRect := GetBorderSize; - ARect := ClientRect; - CaptionBitmap := TBitmap.Create; - try - CaptionBitmap.SetSize(ARect.Width, BorderRect.Top); - FBitmap.Width := ClientRect.Width; - FBitmap.Height := ClientRect.Height; - - // Draw background - LDetails.Element := teWindow; - LDetails.Part := 0; - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, ARect, True, FStyle); - - // Draw caption border - CaptionRect := Rect(0, 0, CaptionBitmap.Width, CaptionBitmap.Height); - LDetails := Style.GetElementDetails(twCaptionActive); - - LRegion := FRegion; - try - Style.GetElementRegion(LDetails, ARect, FRegion); - SetWindowRgn(Handle, FRegion, True); - finally - if LRegion <> 0 then - DeleteObject(LRegion); - end; - - { - Style.GetElementRegion(LDetails, ARect, Region); - SetWindowRgn(Handle, Region, True); - } - - DrawStyleElement(CaptionBitmap.Canvas.Handle, LDetails, CaptionRect, True, FStyle); - TextRect := CaptionRect; - CaptionDetails := LDetails; - - // Draw icon - IconDetails := Style.GetElementDetails(twSysButtonNormal); - if not Style.GetElementContentRect(0, IconDetails, CaptionRect, ButtonRect) then - ButtonRect := Rect(0, 0, 0, 0); - IconRect := Rect(0, 0, GetSysMetrics(SM_CXSMICON), GetSysMetrics(SM_CYSMICON)); - RectVCenter(IconRect, ButtonRect); - - if (ButtonRect.Width > 0) and (FIcon <> 0) then - DrawIconEx(CaptionBitmap.Canvas.Handle, IconRect.Left, IconRect.Top, FIcon, 0, 0, 0, 0, DI_NORMAL); - Inc(TextRect.Left, ButtonRect.Width + 5); - - // Draw buttons - - // Close button - LDetails := Style.GetElementDetails(twCloseButtonNormal); - if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then - DrawStyleElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect, True, FStyle); - - // Maximize button - LDetails := Style.GetElementDetails(twMaxButtonNormal); - if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then - DrawStyleElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect, True, FStyle); - - // Minimize button - LDetails := Style.GetElementDetails(twMinButtonNormal); - - if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then - DrawStyleElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect, True, FStyle); - - // Help button - LDetails := Style.GetElementDetails(twHelpButtonNormal); - if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then - DrawStyleElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect, True, FStyle); - - if ButtonRect.Left > 0 then - TextRect.Right := ButtonRect.Left; - - // Draw text - {$IF RTLVersion > 28} - if Assigned(Application.Mainform) then - CaptionBitmap.Canvas.Font.Size := Round(8*Application.MainForm.Monitor.PixelsPerInch / 96) - else - {$IFEND} - CaptionBitmap.Canvas.Font.Size := Round(8*Screen.PixelsPerInch / 96); - Style.DrawText(CaptionBitmap.Canvas.Handle, CaptionDetails, FCaption, TextRect, - [tfLeft, tfSingleLine, tfVerticalCenter]); - - // Draw caption - FBitmap.Canvas.Draw(0, 0, CaptionBitmap); - finally - CaptionBitmap.Free; - end; - - // Draw left border - CaptionRect := Rect(0, BorderRect.Top, BorderRect.Left, ARect.Height - BorderRect.Bottom); - LDetails := Style.GetElementDetails(twFrameLeftActive); - if CaptionRect.Bottom - CaptionRect.Top > 0 then - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, CaptionRect, True, FStyle); - - // Draw right border - CaptionRect := Rect(ARect.Width - BorderRect.Right, BorderRect.Top, ARect.Width, ARect.Height - BorderRect.Bottom); - LDetails := Style.GetElementDetails(twFrameRightActive); - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, CaptionRect, True, FStyle); - - // Draw Bottom border - CaptionRect := Rect(0, ARect.Height - BorderRect.Bottom, ARect.Width, ARect.Height); - LDetails := Style.GetElementDetails(twFrameBottomActive); - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, CaptionRect, True, FStyle); - - {$IF RTLVersion > 28} - if Assigned(Application.Mainform) then - FBitmap.Canvas.Font.Size := Round(8 * Application.MainForm.Monitor.PixelsPerInch / Screen.PixelsPerInch) - else - {$IFEND} - FBitmap.Canvas.Font.Size := 8; - - // Draw Main Menu - LDetails := Style.GetElementDetails(tmMenuBarBackgroundActive); - LRect := Rect(BorderRect.Left, BorderRect.Top + 1, ARect.Width - BorderRect.Left,BorderRect.Top + FBitmap.Canvas.TextHeight('Tq')+4); - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, LRect, True, FStyle); - - LDetails := Style.GetElementDetails(tmMenuBarItemNormal); - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - CaptionRect := Rect(LRect.Left+10,LRect.Top+3, LRect.Left+10+FBitmap.Canvas.TextWidth('File') + 8 ,LRect.Bottom); - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, CaptionRect, True, FStyle); - FBitmap.Canvas.Font.Color := ThemeTextColor; - DrawText(FBitmap.Canvas, 'File', CaptionRect, DT_CENTER); - CaptionRect.Left := CaptionRect.Right + 2; - - CaptionRect.Right := CaptionRect.Left + FBitmap.Canvas.TextWidth('Edit') + 8; - LDetails := Style.GetElementDetails(tmMenuBarItemHot); - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, CaptionRect, True, FStyle); - FBitmap.Canvas.Font.Color := ThemeTextColor; - DrawText(FBitmap.Canvas, 'Edit', CaptionRect, DT_CENTER); - CaptionRect.Left := CaptionRect.Right + 2; - - CaptionRect.Right := CaptionRect.Left + FBitmap.Canvas.TextWidth('View') + 8; - LDetails := Style.GetElementDetails(tmMenuBarItemNormal); - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, CaptionRect, True, FStyle); - FBitmap.Canvas.Font.Color := ThemeTextColor; - DrawText(FBitmap.Canvas, 'View', CaptionRect, DT_CENTER); - CaptionRect.Left := CaptionRect.Right + 2; - - CaptionRect.Right := CaptionRect.Left + FBitmap.Canvas.TextWidth('Help') + 8; - LDetails := Style.GetElementDetails(tmMenuBarItemDisabled); - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, CaptionRect, True, FStyle); - FBitmap.Canvas.Font.Color := ThemeTextColor; - DrawText(FBitmap.Canvas, 'Help', CaptionRect, DT_CENTER); - - // Draw ToolButtons - LDetails := Style.GetElementDetails(ttbButtonNormal); - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - ButtonRect.Left := BorderRect.Left + 2; - for i := 1 to 3 do - begin - ButtonRect.Top := LRect.Top + 30; - {$IF RTLVersion > 28} - if Assigned(Application.Mainform) then - begin - ButtonRect.Width := Round(65 * Application.MainForm.Monitor.PixelsPerInch / 96); - ButtonRect.Height := Round(25 * Application.MainForm.Monitor.PixelsPerInch / 96); - end - else - {$IFEND} - begin - ButtonRect.Width := Round(65 * Screen.PixelsPerInch / 96); - ButtonRect.Height := Round(25 * Screen.PixelsPerInch / 96); - end; - - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, ButtonRect, True, FStyle); - Style.DrawText(FBitmap.Canvas.Handle, LDetails, 'ToolButton' + IntToStr(I), ButtonRect, - TTextFormatFlags(DT_VCENTER or DT_CENTER), ThemeTextColor); - - ButtonRect.Left := ButtonRect.Right + 2; - end; - - // Draw Normal - LDetails := Style.GetElementDetails(tbPushButtonNormal); - ButtonRect.Left := BorderRect.Left + 2; - ButtonRect.Top := ARect.Height - 45; - {$IF RTLVersion > 28} - if Assigned(Application.Mainform) then - begin - ButtonRect.Width := Round(65 * Application.MainForm.Monitor.PixelsPerInch / 96); - ButtonRect.Height := Round(25 * Application.MainForm.Monitor.PixelsPerInch / 96); - end - else - {$IFEND} - begin - ButtonRect.Width := Round(65 * Screen.PixelsPerInch / 96); - ButtonRect.Height := Round(25 * Screen.PixelsPerInch / 96); - end; - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, ButtonRect, True, FStyle); - - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - Style.DrawText(FBitmap.Canvas.Handle, LDetails, 'Normal', ButtonRect, TTextFormatFlags(DT_VCENTER or DT_CENTER), - ThemeTextColor); - - // Draw Hot - LDetails := Style.GetElementDetails(tbPushButtonHot); - ButtonRect.Left := ButtonRect.Right + 2; - ButtonRect.Top := ARect.Height - 45; - {$IF RTLVersion > 28} - if Assigned(Application.Mainform) then - begin - ButtonRect.Width := Round(65 * Application.MainForm.Monitor.PixelsPerInch / 96); - ButtonRect.Height := Round(25 * Application.MainForm.Monitor.PixelsPerInch / 96); - end - else - {$IFEND} - begin - ButtonRect.Width := Round(65 * Screen.PixelsPerInch / 96); - ButtonRect.Height := Round(25 * Screen.PixelsPerInch / 96); - end; - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, ButtonRect, True, FStyle); - - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - Style.DrawText(FBitmap.Canvas.Handle, LDetails, 'Hot', ButtonRect, TTextFormatFlags(DT_VCENTER or DT_CENTER), - ThemeTextColor); - - // Draw Pressed - LDetails := Style.GetElementDetails(tbPushButtonPressed); - ButtonRect.Left := ButtonRect.Right + 2; - ButtonRect.Top := ARect.Height - 45; - {$IF RTLVersion > 28} - if Assigned(Application.Mainform) then - begin - ButtonRect.Width := Round(65 * Application.MainForm.Monitor.PixelsPerInch / 96); - ButtonRect.Height := Round(25 * Application.MainForm.Monitor.PixelsPerInch / 96); - end - else - {$IFEND} - begin - ButtonRect.Width := Round(65 * Screen.PixelsPerInch / 96); - ButtonRect.Height := Round(25 * Screen.PixelsPerInch / 96); - end; - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, ButtonRect, True, FStyle); - - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - Style.DrawText(FBitmap.Canvas.Handle, LDetails, 'Pressed', ButtonRect, TTextFormatFlags(DT_VCENTER or DT_CENTER), - ThemeTextColor); - - // Draw Disabled - LDetails := Style.GetElementDetails(tbPushButtonDisabled); - ButtonRect.Left := ButtonRect.Right + 2; - ButtonRect.Top := ARect.Height - 45; - {$IF RTLVersion > 28} - if Assigned(Application.Mainform) then - begin - ButtonRect.Width := Round(65 * Application.MainForm.Monitor.PixelsPerInch / 96); - ButtonRect.Height := Round(25 * Application.MainForm.Monitor.PixelsPerInch / 96); - end - else - {$IFEND} - begin - ButtonRect.Width := Round(65 * Screen.PixelsPerInch / 96); - ButtonRect.Height := Round(25 * Screen.PixelsPerInch / 96); - end; - DrawStyleElement(FBitmap.Canvas.Handle, LDetails, ButtonRect, True, FStyle); - - Style.GetElementColor(LDetails, ecTextColor, ThemeTextColor); - Style.DrawText(FBitmap.Canvas.Handle, LDetails, 'Disabled', ButtonRect, TTextFormatFlags(DT_VCENTER or DT_CENTER), - ThemeTextColor); - - Canvas.Draw(0, 0, FBitmap); -end; - -initialization - -{$IFDEF USE_VCL_STYLESAPI} - {$IF CompilerVersion <= 35} - InitStyleAPI; - {$IFEND} -{$ENDIF} - -finalization - -{$IFDEF USE_VCL_STYLESAPI} - {$IF CompilerVersion <= 35} - FinalizeStyleAPI; - {$IFEND} -{$ENDIF} - -end. diff --git a/selection_train.pas b/selection_train.pas index a573719..0a482fe 100644 --- a/selection_train.pas +++ b/selection_train.pas @@ -590,6 +590,7 @@ begin if IdCantonSelect=0 then IdCantonSelect:=AncienIdCantonSelect; if affevt then Affiche('FormSelTrain.StringGridTrainsSelectCell col='+intToSTR(ACol)+' lig='+intToSTR(ARow),clYellow); if (Arow>nTrains) or (IdCantonSelect<1) then exit; + faire:=false; //------------change la sélection du train if (Arow>=1) and (ACol<=5) then @@ -607,7 +608,9 @@ begin idAutrecanton:=index_canton_numero(autreCanton); if (IdAutrecanton<>0) and (IdAutreCanton<>IdCantonSelect) then begin - LabelInfo.caption:='Le train '+intToSTR(IndexTrainClic)+' '+trains[IndexTrainClic].nom_train+' est affecté au canton '+intToSTR(AutreCanton); + s:='Le train '+intToSTR(IndexTrainClic)+' '+trains[IndexTrainClic].nom_train+' est affecté au canton '+intToSTR(AutreCanton); + LabelInfo.caption:=s; + StringGridTrains.hint:='Affectation impossible,'+#13+s; exit; end; @@ -622,6 +625,7 @@ begin supprime_route_train(indextrainclic); StringGridTrains.cells[7,ARow]:=''; + end; if faire then @@ -657,7 +661,9 @@ begin if (canton[IdCantonSelect].sensCirc<>0) then sensLoco:=canton[IdCantonSelect].sensCirc ; affecte_Train_canton(trains[indexTrainClic].adresse,IdCantonSelect,sensLoco); // le train affecté contient la route du train razé - LabelInfo.caption:='Affectation du train '+intToSTR(IndexTrainClic)+' '+trains[indexTrainClic].nom_train+' au canton '+intToSTR(canton[idcantonSelect].numero); + s:='Affectation du train '+intToSTR(IndexTrainClic)+' '+trains[indexTrainClic].nom_train+' au canton '+intToSTR(canton[idcantonSelect].numero); + LabelInfo.caption:=s; + StringGridTrains.hint:=s; maj_signaux(false); end; end; diff --git a/verif_version.pas b/verif_version.pas index 09165e5..cdd9906 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -26,7 +26,7 @@ var f : textFile; Const -VersionSC = '10.8'; // sert à la comparaison de la version publiée +VersionSC = '10.82'; // 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; @@ -559,7 +559,7 @@ begin formprinc.FenRich.SelStart:=length(formprinc.FenRich.Text); formprinc.FenRich.SelAttributes.Style:=[fsUnderline]; Affiche('https://github.com/f1iwq2/Signaux_complexes_GL/releases',clAqua); - Affiche('ne comprend aucune version diffusée.',clOrange); + Affiche('ne comprend actuellement aucune version diffusée.',clOrange); end; end else diff --git a/versions.txt b/versions.txt index b1de6db..d6285f9 100644 --- a/versions.txt +++ b/versions.txt @@ -360,7 +360,11 @@ version 10.78 : Correction affichage aiguillages dans l' version 10.79 : Prise en compte du facteur réduction affichage windows pour les compteurs. version 10.8 : Amélioration de la création des compteurs de vitesse en mode CDM rail et de l'affectation des trains dans les cantons. - Corrections diverses. +version 10.81 : Prise en compte des nouveaux champs d'exportation de CDM pour l'importation du réseau. +version 10.82 : Ajout d'une barre de zoom pour la fenetre des signaux. + Ajout commande fonctions F trains pour la télécommande par serveur + Corrections diverses +