diff --git a/Notice avancée pour les signaux complexes GL.pdf b/Notice avancée pour les signaux complexes GL.pdf index 02fd6d5..b21a212 100644 Binary files a/Notice avancée pour les signaux complexes GL.pdf and b/Notice avancée pour les signaux complexes GL.pdf differ diff --git a/Notice d'utilisation des signaux_complexes_GL_V10.2.pdf b/Notice d'utilisation des signaux_complexes_GL_V10.3.pdf similarity index 83% rename from Notice d'utilisation des signaux_complexes_GL_V10.2.pdf rename to Notice d'utilisation des signaux_complexes_GL_V10.3.pdf index d60bbdb..b938b73 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V10.2.pdf and b/Notice d'utilisation des signaux_complexes_GL_V10.3.pdf differ diff --git a/UnitAnalyseSegCDM.pas b/UnitAnalyseSegCDM.pas index 7964181..a90eb1d 100644 --- a/UnitAnalyseSegCDM.pas +++ b/UnitAnalyseSegCDM.pas @@ -1021,7 +1021,7 @@ begin end; // affiche le libellé de l'aiguillage du segment i -procedure coords_aff_aig(canvas : Tcanvas;i : integer); +procedure coords_aff_aig(canvas : Tcanvas;i : integer;imprime : boolean); var segType,s: string; a,x,y,x3,y3 : integer; begin @@ -1062,8 +1062,12 @@ begin end; s:='A'+intToSTR(adresse)+' '; - canvas.Font.Color:=clLime; - canvas.TextOut(x,y+YcrOffset,s); + with canvas do + begin + Font.Color:=clLime; + if imprime then Brush.color:=clWhite else Brush.color:=Fond_cdm; + TextOut(x,y+YcrOffset,s); + end; a:=adresse2; if a<>0 then @@ -1637,6 +1641,7 @@ begin begin if formAnalyseCDM.CheckSegments.checked then begin + if imprime then Brush.color:=clWhite else Brush.color:=Fond_cdm; Textout(x1,y1,s); pen.Width:=1; PolyGon([point(x1,y1),Point(x2,y2)]); @@ -1656,9 +1661,14 @@ begin if formAnalyseCDM.CheckPorts.checked then begin - if imprime then canvas.Font.Color:=ClBlack + if imprime then + begin + canvas.Brush.Color:=clwhite; + canvas.Font.Color:=ClBlack; + end else begin + canvas.Brush.Color:=fond_cdm; if coul then Canvas.font.Color:=clWhite else Canvas.font.color:=ClYellow; end; @@ -1666,6 +1676,7 @@ begin y1:=(Segment[i].port[0].y+Segment[i].port[1].y) div 2; coords(x1,y1); s:='S'+intToSTR(NumSegment); + Canvas.Font.Size:=8; Canvas.Textout(x1,y1,s); end; @@ -1681,8 +1692,9 @@ begin with canvas do begin pen.Color:=clOrange; + Brush.Color:=clOrange; pen.width:=2; - Ellipse(x1-5,y1-5,x1+5,y1+5); + Rectangle(x1-5,y1-5,x1+5,y1+5); canvas.pen.Color:=clWhite; end; end; @@ -1709,7 +1721,12 @@ begin coords(x1,y1); x1:=x1+offset; s:='P'+intToSTR(Segment[i].port[j].numero); - canvas.textout(x1,y1,s); + with canvas do + begin + if imprime then Brush.color:=clWhite else Brush.color:=Fond_cdm; + font.Size:=8; + textout(x1,y1,s); + end; end; end; //Affiche(s,ClYellow); @@ -1732,7 +1749,7 @@ begin moveto(portsSeg[1].x,portsSeg[1].y); LineTo(portsSeg[3].x,portsSeg[3].y); end; - if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i); + if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i,imprime); end else if (segtype='turnout') or (segtype='turnout_sym') then @@ -1745,7 +1762,7 @@ begin LineTo(portsSeg[1].x,portsSeg[1].y); moveTo((portsSeg[0].x+portsSeg[1].x) div 2,(portsSeg[0].y+portsSeg[1].y) div 2); LineTo(portsSeg[2].x,portsSeg[2].y); - if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i); + if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i,imprime); end else if (segtype='turnout_3way') then @@ -1759,7 +1776,7 @@ begin LineTo(portsSeg[2].x,portsSeg[2].y); moveTo((portsSeg[0].x+portsSeg[1].x) div 2,(portsSeg[0].y+portsSeg[1].y) div 2); LineTo(portsSeg[3].x,portsSeg[3].y); - if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i); + if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i,imprime); end else if (segtype='turnout_curved') or (segtype='turnout_curved_2r') @@ -1777,7 +1794,7 @@ begin LineTo(portsSeg[2].x,portsSeg[2].y); //dessine_aig_courbe(canvas,i); - if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i); + if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i,imprime); end else if (segType='arc') or (segType='curve') then @@ -1825,7 +1842,7 @@ begin font.Size:=TailleFonte; //Affiche(intToSTR(round(zoom /10)),clyellow); pen.color:=couleur; - + if imprime then Brush.color:=clWhite else Brush.color:=Fond_cdm; textout(x1+4,y1+ofs,s2); pen.Width:=2; Ellipse(x1-5,y1-5,x1+5,y1+5); @@ -1837,7 +1854,7 @@ begin font.Size:=TailleFonte; //Affiche(intToSTR(round(zoom /10)),clyellow); pen.color:=couleur; - + if imprime then Brush.color:=clWhite else Brush.color:=Fond_cdm; textout(x1+4,y1+ofs,s2); pen.Width:=2; Ellipse(x1-5,y1-5,x1+5,y1+5); @@ -4999,7 +5016,7 @@ begin Brush.Style:=bsSolid; brush.Color:=fond_cdm; end; - coords_aff_aig(canvas,indexClic); + coords_aff_aig(canvas,indexClic,false); canvas.Brush.Style:=bsClear; end; end; diff --git a/UnitCompteur.pas b/UnitCompteur.pas index 3182236..8dd2787 100644 --- a/UnitCompteur.pas +++ b/UnitCompteur.pas @@ -49,15 +49,15 @@ type end; type - typ=(fen,gb,im); + typ=(rien,fen,gb,im); // un compteur peut être de la fenetre 'formCompteur' (fen), des groupBox de la fenetre principale (gb) ou d'une image (onglet compteurs formConfig) TTcompteur=array[1..10] of record FcBitMap : Tbitmap; paramcompt : TparamCompt; end; var - formCompteur : array[1..10] of TformCompteur; - Scompteur,CompteurPP : TTCompteur; + formCompteur : array[1..10] of TformCompteur; // il y a 10 fenetres mais on utilise qu'un compteur. + Scompteur : TTCompteur; // Scompteur : associé à fen ParamCompteur : array[1..3] of record coulAig,coulGrad,CoulNum,CoulFond,CoulArc : tcolor; end; @@ -145,7 +145,7 @@ end; // change l'aiguille du compteur -// c : du compteur idTrain : index du train +// c : n° du compteur idTrain : index du train comp : composant dans lequel se trouve le compteur (form, groupbox ou image) procedure aiguille_compteur(c,idTrain : integer ; comp : Tcomponent); var ComptLoc,x1,y1,x2,y2,x3,y3,x4,y4,vitesse,vitesseFin,lim,him : integer; angleDeb,AngleFin,sinD,cosD,sinF,cosF : extended ; @@ -155,9 +155,15 @@ var ComptLoc,x1,y1,x2,y2,x3,y3,x4,y4,vitesse,vitesseFin,lim,him : integer; begin if compteur<1 then exit; + typDest:=rien; if comp is tform then typDest:=fen; if comp is tgroupBox then typDest:=gb; if comp is tImage then typDest:=im; + if TypDest=rien then + begin + Affiche('Anomalie 47',clred); + exit; + end; if idTrain<>0 then begin @@ -167,7 +173,7 @@ begin end else begin - vitesse:=0; + Vitesse:=0; VitesseFin:=0; end; @@ -200,19 +206,16 @@ begin Him:=imgH; end; - sincos(angleDeb*pisur180,sinD,cosD); - - //Affiche('Ad,Af='+floatToSTR(AngleDeb)+' '+floatToSTR(AngleFin),clred); + sincos(AngleDeb*pisur180,sinD,cosD); // arc vitesse de début + sincos(AngleFin*pisur180,sinF,cosF); // arc vitesse de fin with canvDest do begin // copie le fond du compteur - if typdest=fen then copyrect(rect(0,0,lim,him),Scompteur[c].FcBitMap.canvas,rect(0,0,lim,him)); if typdest=gb then copyrect(rect(0,0,lim,him),compteurT[c].FcBitMap.canvas,rect(0,0,lim,him)); if typdest=im then copyrect(rect(0,0,lim,him),FbmcompC.canvas,rect(0,0,lim,him)); - //moveto(0,0);lineTo(200,200); // afficher l'arc vert with param do begin @@ -226,7 +229,6 @@ begin y2:=AigCY + rav; x3:=AigCX + Round(rav*sinD); y3:=AigCY - Round(rav*cosD); - sincos(AngleFin*pisur180,sinF,cosF); // paramètres d'angleFin x4:=AigCX + Round(rav*sinF); y4:=AigCY - Round(rav*cosF); pen.color:=ParamCompteur[comptloc].coulArc; @@ -243,8 +245,8 @@ begin end; procedure compteur_2(c : integer;bm : tbitmap;param : tparamcompt); -var l,av,n,v,rayon2,rayon3,rayon4,x1,y1,x2,y2,xt,yt,lim,him,rg : integer; - angle,angleFin,incr,r,a : single; +var n,v,rayon2,rayon3,rayon4,x1,y1,x2,y2,xt,yt,lim,him,rg : integer; + angle,angleFin,incr,r : single; s : string; begin angle:=10; // angle début des graduations @@ -257,14 +259,11 @@ begin with param do begin - //AigCX:=him div 2; // centre aiguille - //AigCY:=round(200*param.redY); r:=redx; // réduction - //Raig[1]:=(Lim div 2)-round(10*r); // rayon - rg:=round(AigCX/1.05); // rayon des graduations - rayon2:=Rg-round(10*r); // rayon de fin des graduations + rg:=round(AigCX/1.05); // rayon des graduations + rayon2:=Rg-round(10*r); // rayon de fin des graduations rayon3:=Rg-round(20*r); - rayon4:=Rg-round(20*r); // chiffres + rayon4:=Rg-round(20*r); // chiffres with bm.Canvas do begin @@ -276,7 +275,6 @@ begin Brush.Color:=ParamCompteur[2].coulFond; - Cercle(bm.canvas,AigCX,AigCY,round(10*r),clBlack,clBlack); font.Name:='Arial';; @@ -341,7 +339,7 @@ end; procedure compteur_tachro(c : integer;bm : tbitmap;param : tparamcompt); var l,av,n,v,rayon2,rayon3,rayon4,x1,y1,x2,y2,xt,yt,lim,him,rg : integer; - angle,angleFin,incr,r,a : single; + angle,angleFin,incr,r,a,sinA,cosA : single; s : string; begin angle:=-40; // angle début des graduations @@ -372,7 +370,7 @@ begin FillRect(Rect(0,0,lim,him)); end; - Cercle(bm.Canvas,AigCX,AigCY,round(130*r),clGray,ParamCompteur[3].CoulFond); + Cercle(bm.Canvas,AigCX,AigCY,round(125*r),clGray,ParamCompteur[3].CoulFond); Cercle(bm.Canvas,AigCX,AigCY,round(10*r),clwhite,clWhite); with bm.Canvas do @@ -383,7 +381,7 @@ begin font.color:=ParamCompteur[3].CoulNum; font.size:=round(r*20); //Affiche(intToSTR(font.size),clred); - font.style:=[fsbold]; + font.style:=[]; end; // dessine le cadran @@ -401,7 +399,7 @@ begin xt:=round(cos((angle+180-l)*pisur180)*rayon4)+AigCX; yt:=round(sin((angle+180-l)*pisur180)*rayon4)+AigCY; - // affiche les chiffres + // affiche les chiffres avec un angle {$IF CompilerVersion >= 28.0} av:=round(90-angle)*10; bm.canvas.font.orientation:=av; @@ -414,21 +412,23 @@ begin inc(v,20); end; - x1:=round(cos((angle+180)*pisur180)*Rg)+AigCX; - y1:=round(sin((angle+180)*pisur180)*Rg)+AigCY; + cosA:=cos((angle+180)*pisur180); + sinA:=sin((angle+180)*pisur180); + x1:=round(cosA*Rg)+AigCX; + y1:=round(SinA*Rg)+AigCY; // gros traits if n mod 5 = 0 then begin bm.Canvas.pen.Width:=round(4*r); - x2:=round(cos((angle+180)*pisur180)*rayon3)+AigCX; - y2:=round(sin((angle+180)*pisur180)*rayon3)+AigCY; + x2:=round(cosA*rayon3)+AigCX; + y2:=round(sinA*rayon3)+AigCY; end else begin // traits fins bm.Canvas.pen.Width:=round(2*r); - x2:=round(cos((angle+180)*pisur180)*rayon2)+AigCX; - y2:=round(sin((angle+180)*pisur180)*rayon2)+AigCY; + x2:=round(cosA*rayon2)+AigCX; + y2:=round(sinA*rayon2)+AigCY; end; with bm.Canvas do @@ -437,17 +437,15 @@ begin lineTo(x2,y2); end; inc(n); - angle:=angle+incr; // 18 + angle:=angle+incr; until angle>AngleFin+incr; end; - //lim:=formCompteur[c].ImageTachro.width; - //him:=formCompteur[c].ImageTachro.height; lim:=param.ImgL; him:=param.ImgH; // copie l'image du texte "tachro" mise à l'échelle - StretchBlt(bm.Canvas.Handle,round(145*r),round(85*r),round(lim*r),round(him*r), + StretchBlt(bm.Canvas.Handle,round(145*r),round(90*r),round(lim*r),round(him*r), FormPrinc.ImageTachro.canvas.Handle,0,0,lim,him,srcCopy); end; @@ -464,7 +462,7 @@ begin with Im.Canvas do begin Brush.Style:=bsSolid; - Brush.Color:=$141414; //$e0e0e0; + Brush.Color:=$141414; font.name:='arial'; font.Style:=[fsBold]; @@ -530,9 +528,9 @@ begin if (i<1) or (hautComptC=0) then exit; //Affiche('Init compteur de vitesse',clYellow); - if c is tform then typDest:=fen; // si le compteur est la fenetre, sinon le groupBox de la fenetre principale - if c is tGroupBox then typDest:=gb; - if c is tImage then typDest:=im; + if c is tform then typDest:=fen; // si le compteur est la fenetre unique + if c is tGroupBox then typDest:=gb; // si le compteur est le groupBox de la fenetre principale + if c is tImage then typDest:=im; // si le compteur est l'image de l'onglet config compteurs if (typDest=fen) or (typDest=gb) then ComptLoc:=compteur; if typDest=im then ComptLoc:=formconfig.ComboBoxCompt.ItemIndex+1; @@ -568,7 +566,6 @@ begin if typDest=fen then begin Lim:=LargeurCompteurs-ofs; - //p:=Scompteur[i].paramcompt; formCompteur[i].Width:=LargeurCompteurs; Scompteur[i].paramcompt.ComptA:=(maxi-mini)/vmax; // pente de conversion vitesse en degrés compteur Scompteur[i].paramcompt.ComptB:=mini; // coordonnées origine conversion @@ -604,8 +601,6 @@ begin end; if typDest=gb then begin - //Lim:=compteurT[i].gb.Width-10-round(CompteurT[i].tb.Height/r); - //him:=round(lim*r); if l>h then begin lim:=LargComptC-10; @@ -616,7 +611,6 @@ begin him:=HautComptC-ofsGBH-CompteurT[i].tb.Height-ofsGBB; lim:=round(him/r); end; - //p:=compteurT[i].paramcompt; with CompteurT[i] do begin gb.Width:=LargComptC; @@ -637,11 +631,10 @@ begin Scompteur[i].paramcompt.redY:=Him/h; Scompteur[i].paramcompt.ImgL:=Lim; Scompteur[i].paramcompt.ImgH:=Him; - case compteur of 1 : Scompteur[i].paramcompt.rav:=round(70*Scompteur[i].paramcompt.redx); // rayon de l'arc vert 2 : Scompteur[i].paramcompt.rav:=round(100*Scompteur[i].paramcompt.redx); - 3 : Scompteur[i].paramcompt.rav:=round(122*Scompteur[i].paramcompt.redx); + 3 : Scompteur[i].paramcompt.rav:=round(115*Scompteur[i].paramcompt.redx); end; end; if typDest=gb then @@ -658,12 +651,11 @@ begin bouton.left:=(lim div 2)-6; bouton.Width:=16; end; - case compteur of 1 : compteurT[i].paramcompt.rav:=round(70*compteurT[i].paramcompt.redx); // rayon de l'arc vert 2 : compteurT[i].paramcompt.rav:=round(100*compteurT[i].paramcompt.redx); - 3 : compteurT[i].paramcompt.rav:=round(122*compteurT[i].paramcompt.redx); - end; + 3 : compteurT[i].paramcompt.rav:=round(115*compteurT[i].paramcompt.redx); + end; end; if typDest=fen then @@ -727,7 +719,6 @@ begin end; if typDest=gb then begin - //p:=compteurT[i].paramcompt; compteurT[i].FCBitMap.Free; compteurT[i].fcBitMap:=tbitmap.Create; with compteurT[i].FCBitMap do @@ -778,14 +769,12 @@ begin if typDest=fen then begin dessin_fond_compteur(Scompteur[i].paramcompt,i,Scompteur[i].FcBitmap,compteur); - //canv:=formCompteur[i].ImageCompteur.Canvas; Aiguille_compteur(i,IdTrainClic,formCompteur[i]); Affiche_train_compteur(i); end; if typDest=gb then begin dessin_fond_compteur(compteurT[i].paramcompt,i,compteurT[i].fcBitmap,compteur); - //canv:=compteurT[i].Img.Canvas; Aiguille_compteur(i,i,compteurT[i].gb); end; @@ -800,7 +789,6 @@ begin with formCompteur[1] do begin Left:=formprinc.Left+formprinc.Width-width-2; - //left:=0; end; if (formClock<>nil) and not(fermeSC) then begin @@ -875,8 +863,6 @@ begin end; procedure TFormCompteur.FormCreate(Sender: TObject); -var form : Tform; - Acanvas : tcanvas; begin //LargComptC:=150;HautCompTC:=150; // valeurs mini et maxi de la fenetre @@ -904,7 +890,7 @@ end; procedure TFormCompteur.TrackBarCChange(Sender: TObject); var s : string; - c,i,vit,larg : integer; + i,vit : integer; tt : ttrackbar; f : tform; begin diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 88ac132..de8715d 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -670,7 +670,7 @@ object FormConfig: TFormConfig Top = 8 Width = 633 Height = 505 - ActivePage = TabSheetBouton + ActivePage = TabSheetAutonome Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 @@ -1205,7 +1205,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 = 0 + ItemHeight = 13 ParentShowHint = False ShowHint = True TabOrder = 0 @@ -2412,7 +2412,7 @@ object FormConfig: TFormConfig Width = 137 Height = 21 Style = csDropDownList - ItemHeight = 0 + ItemHeight = 13 TabOrder = 1 OnChange = ComboBoxDecChange end @@ -2543,7 +2543,7 @@ object FormConfig: TFormConfig Width = 137 Height = 21 Style = csDropDownList - ItemHeight = 0 + ItemHeight = 13 TabOrder = 2 OnChange = ComboBoxAspChange end @@ -2851,7 +2851,7 @@ object FormConfig: TFormConfig Top = 56 Width = 193 Height = 21 - ItemHeight = 0 + ItemHeight = 13 TabOrder = 0 OnChange = ComboBoxDecodeurPersoChange end @@ -2870,7 +2870,7 @@ object FormConfig: TFormConfig Width = 145 Height = 21 Style = csDropDownList - ItemHeight = 0 + ItemHeight = 13 TabOrder = 2 OnChange = ComboBoxNationChange end @@ -2916,7 +2916,7 @@ object FormConfig: TFormConfig Width = 193 Height = 21 Style = csDropDownList - ItemHeight = 0 + ItemHeight = 13 TabOrder = 6 OnChange = ComboBoxDecCdeChange end @@ -3131,7 +3131,7 @@ object FormConfig: TFormConfig Top = 96 Width = 137 Height = 21 - ItemHeight = 0 + ItemHeight = 13 TabOrder = 2 OnChange = ComboBoxOperateurChange OnDrawItem = ComboBoxOperateurDrawItem @@ -3151,7 +3151,7 @@ object FormConfig: TFormConfig Top = 96 Width = 161 Height = 21 - ItemHeight = 0 + ItemHeight = 13 ParentShowHint = False ShowHint = True TabOrder = 4 @@ -3252,7 +3252,7 @@ object FormConfig: TFormConfig Width = 145 Height = 21 Style = csDropDownList - ItemHeight = 0 + ItemHeight = 13 TabOrder = 7 OnChange = ComboBoxFLChange end @@ -3802,7 +3802,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 = 0 + ItemHeight = 13 ParentShowHint = False ShowHint = True TabOrder = 10 @@ -5299,7 +5299,7 @@ object FormConfig: TFormConfig end object GroupBoxBt: TGroupBox Left = 312 - Top = 176 + Top = 200 Width = 260 Height = 121 Caption = 'Bouton' @@ -5359,7 +5359,7 @@ object FormConfig: TFormConfig object GroupBoxBloc: TGroupBox Left = 312 Top = 48 - Width = 257 + Width = 260 Height = 113 Caption = 'G'#233'n'#233'ral' TabOrder = 3 diff --git a/UnitConfig.pas b/UnitConfig.pas index 25ed5a3..5ddb72a 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -14083,7 +14083,7 @@ function Maj_icone_train(IImage : Timage;index :integer;coulfond : Tcolor) : int var h,l,HautDest,LargDest,y : integer; rd : single; begin - if (index<1) or (index>Ntrains) then + if (index<1) or (index>Ntrains) or (iImage=nil) then begin //Iimage.Picture:=nil; result:=0; @@ -14975,7 +14975,6 @@ begin EditNbreAdr.Text:=intToSTR(decodeur_pers[decCourant].NbreAdr); //Affiche('Décodeur courant = '+intToSTR(decCourant),clyellow); maj_decodeurs; - end; // renvoie vrai si chaine est dans le combobox 'combo' et renvoie son index @@ -15026,7 +15025,7 @@ begin for i:=ma to NbreDecPers-1 do begin Affiche('traitement décodeur '+inttoSTR(i),clyellow); - decodeur_pers[i]:=decodeur_pers[i+1]; + decodeur_pers[i]:=decodeur_pers[i+1]; end; dec(NbreDecPers); if NbreDecPers=0 then ComboBoxDecodeurPerso.Text:=''; @@ -15452,7 +15451,7 @@ begin if s='ListBoxAig' then ajoute_aiguillage; if s='ListBoxTrains' then ajoute_train; if s='ListBoxPeriph' then ajoute_periph; -end; +end; procedure TFormConfig.outcopierentatquetexte1Click(Sender: TObject); var tl: TListBox; @@ -15928,7 +15927,7 @@ begin index:=Index_Aig(Adresse); AncienAdresse:=aiguillage[index].AncienAdresse; if Adresse=AncienAdresse then exit; - + Affiche('Propagation de l''adresse '+intToSTR(adresse)+' en remplacement de l''ancienne adresse '+intToSTR(AncienAdresse),clOrange); // --------- aiguillages ----------- @@ -16102,7 +16101,6 @@ begin ButtonPropage.Hint:='Change les adresses dans les points de connexions'+#13+ 'des aiguillages, des branches et des signaux'+#13+ 'si on a changé l''adresse d''un aiguillage'; - clicListe:=false; end; @@ -19260,6 +19258,8 @@ begin end; end; + + end. diff --git a/UnitConfigCellTCO.dfm b/UnitConfigCellTCO.dfm index f876c76..b5ea5ad 100644 --- a/UnitConfigCellTCO.dfm +++ b/UnitConfigCellTCO.dfm @@ -4,7 +4,7 @@ object FormConfCellTCO: TFormConfCellTCO BorderStyle = bsDialog Caption = 'FormConfCellTCO' ClientHeight = 473 - ClientWidth = 571 + ClientWidth = 613 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -485,8 +485,8 @@ object FormConfCellTCO: TFormConfCellTCO OnClick = CheckPinvClick end object GroupBoxAction: TGroupBox - Left = 352 - Top = 80 + Left = 312 + Top = 152 Width = 273 Height = 145 Caption = 'Actions' @@ -561,8 +561,8 @@ object FormConfCellTCO: TFormConfCellTCO OnClick = BitBtnAnnuleClick end object GroupBoxCanton: TGroupBox - Left = 328 - Top = 280 + Left = 312 + Top = 312 Width = 281 Height = 129 Caption = 'Canton' @@ -639,8 +639,8 @@ object FormConfCellTCO: TFormConfCellTCO end end object GroupBoxDet: TGroupBox - Left = 376 - Top = 24 + Left = 320 + Top = 16 Width = 281 Height = 121 Caption = 'Visu options d'#39'arr'#234't des trains sur le d'#233'tecteur' diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index 172e5ad..7bd6a37 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -130,7 +130,7 @@ begin if bim=Id_action then begin act:=ligneclicAction+1; - tco[IndexTCOCourant,X,Y].PiedFeu:=act; + tco[IndexTCOCourant,X,Y].PiedSignal:=act; efface_cellule(indexTCOCourant,PCanvasTCO[indexTCOcourant],x,y,pmcopy); affiche_cellule(IndexTCOCourant,x,Y); actualise(indexTCOCourant); @@ -370,7 +370,7 @@ begin EditTypeImage.Enabled:=true; with GroupBoxAction do begin - act:=tco[indexTCO,XclicC,YclicC].PiedFeu; + act:=tco[indexTCO,XclicC,YclicC].PiedSignal; if (act<0) or (act-1>ListBoxAction.Count) then begin Affiche('Erreur 29 ',clred); @@ -607,7 +607,7 @@ begin end; end; - PiedFeu:=tco[indexTCO,XclicC,YclicC].PiedFeu; + PiedFeu:=tco[indexTCO,XclicC,YclicC].PiedSignal; if PiedFeu=1 then begin RadioButtonG.checked:=true; diff --git a/UnitModifAction.dfm b/UnitModifAction.dfm index bba67c9..aaefa86 100644 --- a/UnitModifAction.dfm +++ b/UnitModifAction.dfm @@ -60,7 +60,7 @@ object FormModifAction: TFormModifAction Top = 64 Width = 729 Height = 337 - ActivePage = TabSheetDecl + ActivePage = TabSheetOp MultiLine = True TabOrder = 1 object TabSheetDecl: TTabSheet diff --git a/UnitModifAction.pas b/UnitModifAction.pas index 08ab300..73fdaa9 100644 --- a/UnitModifAction.pas +++ b/UnitModifAction.pas @@ -223,9 +223,8 @@ end; procedure affecte_operation(i : integer;t : tListBox); var s : string; begin - if ligneclicAct<0 then exit; s:=operations[i].nom; - if not(Tablo_Action[ligneclicact+1].tabloOp[i].valide) then s:=s+sd; + if ligneclicAct>0 then if not(Tablo_Action[ligneclicact+1].tabloOp[i].valide) then s:=s+sd; if ivol.txt'; // /c ferme la fenetre en fin d'exec /k ne ferme pas // si on fait un runas au lieu de open, çà ouvre une fenetre de demande admin sur les postes non admin // ou dont le niveau d'utilisateur est bas dans le profil - retour:=ShellExecute(formprinc.Handle,pchar('open'),pchar('cmd.exe'),PChar(cmd),nil,SW_SHOWNORMAL); + retour:=ShellExecute(formprinc.Handle,pchar('open'),pchar('cmd.exe'),PChar(cmd),nil,SW_HIDE); s:=''; if retour<=32 then begin @@ -2229,7 +2226,7 @@ begin s:='NbreTCO='+intToSTR(nbreTCO); s:=s+' Nbrecantons='+intToSTR(ncantons); - s:=s+' NbreTrains='+intToSTR(n_trains); + s:=s+' NbreTrains='+intToSTR(ntrains); s:=s+' NbreHoraires='+intToSTR(Nombre_horaires); s:=s+' NbreAig='+intToSTR(maxaiguillage); s:=s+' NbreSignaux='+intToSTR(NbreSignaux); @@ -2240,6 +2237,15 @@ begin if mode=1 then Affiche(s,clyellow); if mode=2 then ClientInfo.Socket.SendText(s); + + for i:=1 to ntrains do + begin + n:=trains[i].routePref[0,0].adresse; + if n<>0 then s:='train '+intToSTR(i)+' : '+intToSTR(n)+' routes'; + end; + if mode=1 then Affiche(s,clyellow); + if mode=2 then ClientInfo.Socket.SendText(s); + end; procedure menu_selec; @@ -2321,10 +2327,19 @@ begin interface_ou_cdm; // démarrer l'interface , génère les evts détecteurs ; ou cdm - formprinc.SetFocus; + // créer les compteurs après avoir téléchargé la liste des trains de CDM + s:='Création des compteurs GB'; + procetape(s); + + for i:=1 to ntrains do + begin + cree_GB_compteur(i); + end; + s:='Fin du préliminaire'; procetape(s); + formprinc.SetFocus; menu_selec; end; @@ -4560,30 +4575,30 @@ begin begin //rotation 90° vers la gauche des feux : échange des coordonnées X et Y et translation sur HtImage ech:=frY;frY:=frX;FrX:=ech; - Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp; - Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp; - Temp:=HtImage-yRal1;YRal1:=XRal1;XRal1:=Temp; - Temp:=HtImage-yRal2;YRal2:=XRal2;XRal2:=Temp; - Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp; - Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp; - Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp; - Temp:=HtImage-yRap1;YRap1:=XRap1;XRap1:=Temp; - Temp:=HtImage-yRap2;YRap2:=XRap2;XRap2:=Temp; + Temp:=HtImage-yjaune;YJaune:=XJaune-1;Xjaune:=Temp; + Temp:=HtImage-yBlanc;YBlanc:=XBlanc-1;XBlanc:=Temp; + Temp:=HtImage-yRal1;YRal1:=XRal1-1;XRal1:=Temp; + Temp:=HtImage-yRal2;YRal2:=XRal2-1;XRal2:=Temp; + Temp:=HtImage-ycarre;Ycarre:=Xcarre-1;Xcarre:=Temp; + Temp:=HtImage-ySem;YSem:=XSem-1;XSem:=Temp; + Temp:=HtImage-yvert;Yvert:=Xvert-1;Xvert:=Temp; + Temp:=HtImage-yRap1;YRap1:=XRap1-1;XRap1:=Temp; + Temp:=HtImage-yRap2;YRap2:=XRap2-1;XRap2:=Temp; end; if (orientation=3) then begin //rotation 90° vers la droite des feux : échange des coordonnées X et Y et translation sur LgImage ech:=frY;frY:=frX;FrX:=ech; - Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; - Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; - Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; - Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp; - Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp; - Temp:=LgImage-Xral1;Xral1:=Yral1;Yral1:=Temp; - Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp; - Temp:=LgImage-Xrap1;Xrap1:=Yrap1;Yrap1:=Temp; - Temp:=LgImage-Xrap2;Xrap2:=Yrap2;Yrap2:=Temp; + Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp-1; + Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp-1; + Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp-1; + Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp-1; + Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp-1; + Temp:=LgImage-Xral1;Xral1:=Yral1;Yral1:=Temp-1; + Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp-1; + Temp:=LgImage-Xrap1;Xrap1:=Yrap1;Yrap1:=Temp-1; + Temp:=LgImage-Xrap2;Xrap2:=Yrap2;Yrap2:=Temp-1; end; if (orientation=4) then @@ -4661,7 +4676,6 @@ var xblanc,xvert,xrouge,Yblanc,xjauneBas,xJauneHaut,yJauneBas,yJauneHaut,YVert,Y inverse,etatChevron,EtatChiffre,codeClignote : boolean; r : Trect; begin - code:=etatSignal and $3f; combine:=etatSignal and $1c0; // LDT-DEC-NMBS ou b-model @@ -5417,6 +5431,7 @@ const HautTb=10; // hauteur trackbar ofsGBB=8; // marge bas du groupbox var Imh,Iml : integer; begin + iml:=0;imh:=0; //Affiche('Création compteur GroupBox'+intToSTR(rang),clYellow); CompteurT[rang].gb:=TGroupBox.Create(Formprinc.ScrollBoxC); // groupBox @@ -5536,6 +5551,21 @@ begin change_clic_train(i); end; +procedure tformprinc.ImageTrainDoubleClic(Sender : tObject); +var P_component : tComponent; + i : integer; +begin + P_component:=sender as Tcomponent; + + i:=extract_int(P_Component.name); // récupérer le nom du composant cliqué (image, label) qui contient l'index du train + if (i<1) or (i>nTrains) then exit; + + IdTrainClic:=i; + AffCompteur:=true; + formCompteur[1].Show; +end; + + // renseigne les composants image train, label et vitesse procedure renseigne_comp_trains(i : integer); begin @@ -5618,9 +5648,11 @@ begin begin onClick:=Formprinc.ImageTrainonclick; // affectation procédure clique G sur image + OnDblClick:=formPrinc.ImageTrainDoubleClic; //onMouseDown:=Formprinc.ProcOnMouseDown; // clique G ou D PopUpMenu:=Formprinc.PopupMenuTrains; // affectation popupmenu sur clic droit + if debug=1 then affiche('Image '+intToSTR(rang)+' créée',clLime); Maj_icone_train(Image_Train[rang],rang,clWhite); // copie le bitmap à l'échelle depuis trains[].icone @@ -5899,7 +5931,7 @@ begin end; // prépare une tache pour le timer -// ttache=1 : pilote accessoire +// ttache=1 : pilote accessoire... // temporisation pour le timer avant action // destinataire (1=CDM 2=XpressNet 3=Dccpp) // commande : chaine de pilotage pour le destinataire @@ -5912,6 +5944,8 @@ begin Affiche('Nombre de taches dépassé',clred); exit; end; + + NoTraite:=true; // interdire le traitement pour éviter interférence with taches[pointeurTaches+1] do begin traite:=false; @@ -5921,6 +5955,7 @@ begin chaine:=commande; end; inc(pointeurTaches); + NoTraite:=false; end; @@ -5933,18 +5968,19 @@ begin if CDM_connecte and (fonction<=12) then begin s:=chaine_CDM_Func(fonction,etat,train); - //envoi_cdm(s); - tache(ttacheFF,0,ttDestCDM,s); + if modeTache then tache(ttacheFF,0,ttDestCDM,s) else envoi_cdm(s); end; if (portCommOuvert or parSocketLenz) then begin loco:=index_train_nom(train); loco:=trains[loco].adresse; - Fonction_Loco_operation(loco,fonction,etat); + if protocole=1 then Fonction_Loco_operation(loco,fonction,etat); + if protocole=2 then begin Affiche('Fonction F loco pas encore implantée',clred);end; end; end; +// teste la condition d'une action function teste_condition(action : integer) : boolean; var condValide : boolean; vit,vit1,vit2,it,pa,m1,m2,hc,n,ncond,cond,etat : integer; @@ -6041,7 +6077,7 @@ begin end; -// appelé par le hooker clavier +// appellé par le hooker clavier function traite_code_blocUSB(code: integer) : integer; var vitesse,f,n,i : integer; condValide,EtatValide,BlocSelec : boolean; @@ -6309,7 +6345,7 @@ end; // cette fonction intercepte tous les évènements clavier windows quelque soit la fenetre ou le prog activé. // https://learn.microsoft.com/en-us/previous-versions/windows/desktop/legacy/ms644984(v=vs.85)?redirectedfrom=MSDN // https://learn.microsoft.com/fr-fr/windows/win32/api/winuser/ns-winuser-kbdllhookstruct -function ClavierHookLLProc(Code : integer; WordParam : wparam; LongParam: lparam) : longint;//; cdecl; +function ClavierHookLLProc(Code : integer; WordParam : wparam; LongParam: lparam) : longint; const LLKHF_UP=$0080; var KeyState : TKeyboardState; @@ -6435,6 +6471,7 @@ begin end; 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); var s : string ; @@ -8283,10 +8320,8 @@ begin end; procedure envoi_virtuel(adresse : integer); -var - combine,aspect,code : integer; - i : integer; - s : string; +var i,combine,aspect,code : integer; + s : string; begin i:=Index_Signal(adresse); if (Signaux[i].AncienEtat<>Signaux[i].EtatSignal) then //; && (stop_cmd==FALSE)) @@ -13978,7 +14013,11 @@ begin if Pres_Train and (AdrTr=0) then begin - if roulage then AdrTr:=MemZone[actuel,dernierdet].AdrTrain; // adresse + if roulage then + begin + AdrTr:=MemZone[actuel,dernierdet].AdrTrain; // adresse + if AdrTr=0 then AdrTr:=detecteur[actuel].AdrTrain; + end; if (nivDebug=3) then begin s:='3.Présence train '; @@ -14320,6 +14359,7 @@ begin // détecteurs précédent le signal , pour déterminer si leurs mémoires de zones sont à 1 pour libérer le carré //if (Signaux[index].VerrouCarre) and (modele>=4) then presTrain:=PresTrainPrec(AdrSignal,Nb_cantons_Sig,detect,AdrTrainLoc,voie); //etape A // présence train par adresse train ; renvoie l'adresse du train dans AdrTrainLoc + if AffSignal and roulage then AfficheDebug('L''@ du train avant le signal est '+intToSTR(AdrTrainLoc),clYellow); // si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou aig réservé ou que pas présence train avant signal et signal // verrouillable au carré, afficher un carré @@ -16008,7 +16048,7 @@ begin begin if det_suiv=9996 then affiche_evt('Erreur 1-1 position inconnue aiguillage ',clred) else Affiche_evt('Erreur 1-1 '+intToSTR(Det_Suiv)+' : pas de suivant detecteur_suivant_el '+intToSTR(det1)+' '+intToSTR(det3),clred); - exit; + //exit; end; s:='1-1 route ok de '+intToSTR(det1)+' à '+IntToSTR(det3)+' pour train '+intToSTR(i); Affiche_Evt(s,clWhite); @@ -17883,7 +17923,7 @@ var s: string; faire_event,inv,bjd,rf : boolean; prov,index,i,id,etatact,typ,adr : integer; begin - //if AffAigDet then Affiche('Tick='+IntToSTR(tick)+' Event Aig '+intToSTR(adresse)+'='+intToSTR(pos),clorange); + if AffAigDet then Affiche('Tick='+IntToSTR(tick)+' Event Aig '+intToSTR(adresse)+'='+intToSTR(pos),clorange); index:=index_aig(adresse); if index<>0 then begin @@ -18082,10 +18122,10 @@ begin exit; end; pilotage:=octet; + indexAig:=index_aig(adresse); // test si pilotage aiguillage inversé if (acc=aigP) then begin - indexAig:=index_aig(adresse); if indexAig<>0 then begin AdrTrainLoc:=aiguillage[indexAig].AdrTrain; @@ -18112,30 +18152,27 @@ begin if pilotage=2 then pilotageCDM:=2; s:=chaine_CDM_Acc(adresse,pilotageCDM); - //envoi_CDM(s); + // pilotage actif de l'accessoire---------------- tache(ttacheAcc,0,ttDestCDM,s); // TypeTache,tempo,destinataire,chaine - if Acc<>Signal then event_aig(adresse,pilotage); - // si l'accessoire est un signal et sans raz des signaux, sortir if (acc=signal) and not(Raz_Acc_signaux) then exit; if Acc=AigP then begin temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4; // mini pour pilotage en signaux LEB - //if portCommOuvert or parSocketLenz then tempo2(temp); end; - // remise à 0 + // remise à 0 -------------- s:=chaine_CDM_Acc(adresse,0); - //envoi_CDM(s); tache(ttacheAcc,temp,ttDestCDM,s); // TypeTache,tempo,destinataire,chaine + // si l'accessoire est un aiguillage, temporiser suivant variable de séquenceent + if indexaig<>0 then tache(ttacheTempo,tempo_Aig div 100,0,''); result:=true; - //exit; end; - if (pilotage=0) or (pilotage>2) then begin result:=true;exit;end; + // if (pilotage=0) or (pilotage>2) then begin result:=true;exit;end; // pilotage par USB ou par éthernet de la centrale ------------ if (portCommOuvert or parSocketLenz) and not CDM_connecte then @@ -18159,8 +18196,6 @@ begin tache(ttacheAcc,0,ttDestXpressNet,s); // TypeTache,tempo,destinataire,chaine - if acc<>signal then event_aig(adresse,pilotage); - // si l'accessoire est un signal et sans raz des signaux, sortir if (acc=signal) and not(Raz_Acc_signaux) then exit; @@ -18168,7 +18203,6 @@ begin if Acc=AigP then begin temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4; - // if portCommOuvert or parSocketLenz then tempo2(temp); end; // pilotage à 0 pour éteindre le pilotage de la bobine du relais @@ -18176,8 +18210,9 @@ begin s:=checksum(s); if debug_dec_sig and (acc=signal) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange); //if avecAck then envoi(s) else envoi_ss_ack(s); // envoi de la trame avec ou sans Ack + tache(ttacheAcc,temp,ttDestXpressNet,s); - tache(ttacheAcc,temp,ttDestXpressNet,s); // TypeTache,tempo,destinataire,chaine + if indexAig<>0 then tache(ttacheTempo,tempo_Aig div 100,0,''); //affiche('5.'+intToSTR(tick),clyellow); result:=true; @@ -18198,15 +18233,13 @@ begin tache(ttacheAcc,0,ttDestDccpp,s); // TypeTache,tempo,destinataire,chaine result:=true; - //exit; end; end; - // pas de centrale et pas CDM connecté: on change la position de l'aiguillage - if acc=aigP then event_aig(adresse,octet) + if indexAig<>0 then event_aig(adresse,octet) else - // Serveur envoi au clients - Envoi_serveur('T'+intToSTR(adresse)+','+intToSTR(octet)); + // Serveur envoi au clients + Envoi_serveur('T'+intToSTR(adresse)+','+intToSTR(octet)); result:=true; @@ -20153,7 +20186,7 @@ begin if (pos=const_devie) or (pos=const_droit) then begin pilote_acc(aiguillage[i].Adresse,pos,aigP); - if portCommOuvert or parSocketLenz or CDM_connecte then sleep(Tempo_Aig); + if (portCommOuvert or parSocketLenz or CDM_connecte) and not modeTache then sleep(Tempo_Aig); end; end; end; @@ -21205,7 +21238,7 @@ begin onConnect:=ClientInfoConnect; OnDisconnect:=ClientInfoDisconnect; OnError:=ClientInfoError; - Open; // se connecte au serveur SC et envoie les infos + Open; //zizi se connecte au serveur SC et envoie les infos end; //s:=GetCurrentDir; @@ -21328,7 +21361,6 @@ begin procetape('Lecture de la configuration'); lit_config; - {$IF CompilerVersion >= 28.0} //https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions change_style; @@ -21357,6 +21389,8 @@ begin if (Ecran_sc<1) or (Ecran_sc>Screen.MonitorCount) then ecran_SC:=1; + if nTrains>30 then TrackBarZC.Visible:=false; + serveur_ouvert:=true; serverSocket.Port:=PortServeur; try @@ -21414,12 +21448,6 @@ begin cree_image_signal(i); // et initialisation tableaux signaux end; - // les compteurs - for i:=1 to ntrains do - begin - cree_GB_compteur(i); - end; - Tempo_init:=5; // démarre les initialisations des signaux et des aiguillages dans 0,5 s OrgMilieu:=formprinc.width div 2; @@ -21807,6 +21835,7 @@ begin end; // calcule les 2 équations de droite des coefficients +// pour les étalonnages des trains procedure calcul_equations_coeff(indexTrain : integer); begin with trains[indexTrain] do @@ -21824,34 +21853,50 @@ procedure traite_taches; const affe=false; var fonc,i,j,sortie,etat :integer; begin + if noTraite then exit; if pointeurTaches<0 then begin pointeurTaches:=0; exit; end; - - if affe then Affiche('Tick='+intToSTR(tick)+' Pointeur de taches='+intToSTR(pointeurTaches),clYellow); + //if affe then Affiche('Tick='+intToSTR(tick)+' Pointeur de taches='+intToSTR(pointeurTaches),clYellow); // pilote accessoire i:=1; - repeat + //repeat with taches[i] do begin + //if affe then Affiche('Traite adr '+intToSTR(Typetache),clLime); if traite then begin if affe then Affiche('Traite 1 en cours',clblue); exit; end; - // si tempo non nulle d'accessoire + // si tempo non nulle de fin d'accessoire if (typeTache=ttacheAcc) and (tempo<>0) then begin if affe then Affiche('dec tempo ',clLime); dec(tempo); - //tester tache suivante exit; // ne rien faire d'autre dans ce tour timer end else + if (TypeTache=ttacheTempo) then begin - // envoyer au destinataire + if affe then Affiche('Dec tempo fin aig',clLime); + if tempo<>0 then dec(tempo); + if tempo=0 then + begin + if affe then Affiche('dec tempo fin aig',clLime); + for j:=i to pointeurTaches do + begin + taches[j]:=taches[j+1]; + end; + dec(pointeurtaches); + end; + exit; + end + else + begin + // ------------ envoyer au destinataire ------------- // pilotage accessoire if typetache=ttacheACC then begin @@ -21877,7 +21922,7 @@ begin end; if dest=ttDestDccpp then envoi_ss_ack(chaine); - // lorsque l'action i est traitée, la supprimer, et décaler la liste d'un cran + // lorsque l'action i est traitée, la supprimer, et décaler la liste des taches d'un cran for j:=i to pointeurTaches do begin taches[j]:=taches[j+1]; @@ -21911,11 +21956,15 @@ begin dec(pointeurtaches); exit; end; + end; //affiche('Pointeur='+intToSTR(pointeurtaches),clred); end; + Affiche('Erreur tache typ='+intTOSTR(taches[1].typeTache)+' t='+intToSTR(taches[1].tempo),clred); + exit; inc(i); - until (i>pointeurtaches); + Affiche('INC',clwhite); + //until (i>pointeurtaches); end; // timer à 100 ms @@ -21947,7 +21996,6 @@ begin end; end; tempoblocUSB:=0; - //if tempoBlocUSB=0 then consigne_train(2); // la consigne vient de bloc USB end; // séquencement des actions après tempo @@ -22295,6 +22343,7 @@ begin // gestion ralenti : on doit arreter le train sur le détecteur if trains[i].arret_det then // le train est sur un détecteur d'arrêt begin + //Affiche('Ralenti train '+intToSTR(i),clYellow); adresseEl:=dernierDet; // identifie le détecteur if adresseEl<>0 then case phase_arret of // !! voir si phase arret est multitrains!!! @@ -22316,12 +22365,13 @@ begin else d:=9999; // si la vitesse du train est nulle, mettre une condition qui arrete le train en fin de parcours sur le détecteur if not detecteur[adresseEl].Etat then d:=9999; // si on passe le détecteur arrêter le train. if DebugRoulage then Affiche('D='+intToSTR(d)+' train '+intToSTR(i),clOrange); + // arrêt //if debugRoulage then Affiche('Timer Dist='+intToSTR(d)+' Vit='+intToSTR(trains[i].vitesseReelle),clYellow); longDet:=detecteur[adresseEl].longueur; LongLoco:=trains[i].longueur; longueur:=longDet-longLoco; - + CompteurT[i].lbl.Caption:=trains[i].nom_train+' '+intToSTR(d); // calculer quelle distance il faudra pour s'arrêter avec la décélération TempsArret:=abs(0.896*cv4*VitesseCons/128); // convertir la vitesse en cran en cm/s @@ -22345,7 +22395,7 @@ begin trains[i].arret_det:=false; trains[i].phase_arret:=0; if debugRoulage then Affiche('Timer '+trains[i].nom_train+' Arrêté',ClWhite); - + CompteurT[i].lbl.Caption:=trains[i].nom_train; trains[i].vitesseCons:=0; vitesse_loco(trains[i].nom_train,i,trains[i].adresse,0,0,0); // arrêt du train train_sarrete(i); // vérifie si fin de route, et copie tempo_demarre si détecteur arrêt optionnel+ tempo de redémarrage @@ -22381,7 +22431,7 @@ begin vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitcons,0,0); end; - // démarrage sur consigne + // démarrage sur consigne ou répétition de la consigne a:=trains[i].compteur_consigne; if a<>0 then begin @@ -23075,6 +23125,7 @@ begin Trains[ntrains].vitmax:=Trains_cdm[i].vitmax; FormPrinc.ComboTrains.Items.Add(trains_cdm[i].nom_train); cree_image_Train(ntrains); + cree_GB_compteur(ntrains); end; end; @@ -23189,6 +23240,9 @@ begin //s:='AD='+IntToSTR(adr)f; Delete(commandeCDM,i,l-i+1); end; + + //Affiche('TrainCDM='+trains_cdm[ntrains_cdm].nom_train,clYellow); + end; // évènement aiguillage. Le champ AD2 n'est pas forcément présent @@ -28096,4 +28150,8 @@ begin onglet:=PageControl.ActivePageIndex; end; + + + + end. diff --git a/UnitRouteTrains.pas b/UnitRouteTrains.pas index 96f8ebb..c60e570 100644 --- a/UnitRouteTrains.pas +++ b/UnitRouteTrains.pas @@ -361,6 +361,8 @@ procedure TFormRouteTrain.FormClose(Sender: TObject; var Action: TCloseAction); begin efface_route_tco(false); + maj_signaux(true); + maj_signaux(true); end; procedure TFormRouteTrain.ButtonSupprimeClick(Sender: TObject); @@ -626,8 +628,6 @@ begin if (indexTrainFR<1) then exit; hide; efface_route_tco(false); - maj_signaux(true); - maj_signaux(true); // positionner les aiguillages de la route // si le train est doté d'une route @@ -637,6 +637,7 @@ begin aig_canton(indexTrainFR,trains[indexTrainFR].route[1].adresse); // positionne aiguillage et fait les réservations demarre:=demarre_index_train(indexTrainFR); // met la mémoire de roulage du train à 1 end; + maj_signaux(true); close; // efface la route du TCO end; diff --git a/UnitTCO.dfm b/UnitTCO.dfm index 8aaac0a..1f8c4f9 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -24,8 +24,8 @@ object FormTCO: TFormTCO OnKeyPress = FormKeyPress OnMouseWheel = FormMouseWheel DesignSize = ( - 1005 - 556) + 997 + 548) PixelsPerInch = 96 TextHeight = 13 object LabelZoom: TLabel @@ -1138,7 +1138,7 @@ object FormTCO: TFormTCO Top = 104 Width = 33 Height = 33 - Hint = 'Action' + Hint = 'Bouton action' ParentShowHint = False ShowHint = True OnDragOver = ImagePalette52DragOver @@ -1401,9 +1401,9 @@ object FormTCO: TFormTCO end end object buttonRaz: TButton - Left = 889 + Left = 888 Top = 88 - Width = 97 + Width = 96 Height = 33 Anchors = [akTop, akRight] Caption = 'Raz des occupations' @@ -1470,23 +1470,6 @@ object FormTCO: TFormTCO TabOrder = 8 OnClick = RadioGroupSelClick end - object Button1: TButton - Left = 800 - Top = 88 - Width = 75 - Height = 25 - Caption = 'Button1' - TabOrder = 9 - Visible = False - end - object Button2: TButton - Left = 848 - Top = 96 - Width = 75 - Height = 25 - Caption = 'Button2' - TabOrder = 10 - end end object PopupMenu1: TPopupMenu OnPopup = PopupMenu1Popup diff --git a/UnitTCO.pas b/UnitTCO.pas index abbcfe4..2e37c06 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -1,4 +1,5 @@ unit UnitTCO; + // ne pas utiliser les éléments 30 et 31 qui sont les anciens signaux et quais interface uses @@ -160,13 +161,11 @@ type AffRoutes: TMenuItem; ImageDrapVert: TImage; ImageDrapRouge: TImage; - Button1: TButton; Optiondesroutes1: TMenuItem; Trouverunlment1: TMenuItem; ImageBt0Bistable: TImage; ImageBt1Bistable: TImage; Mmoiredezone1: TMenuItem; - Button2: TButton; //TimerTCO: TTimer; procedure FormCreate(Sender: TObject); procedure FormActivate(Sender: TObject); @@ -346,47 +345,47 @@ type procedure ButtonCalibrageClick(Sender: TObject); procedure ButtonCoulFondClick(Sender: TObject); procedure ColorDialog1Show(Sender: TObject); - procedure ImagePalette24DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette24EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette24MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette25DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette25EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette25MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette24DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette24EndDrag(Sender, Target: TObject; X, Y: Integer); + procedure ImagePalette24MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette25DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette25EndDrag(Sender, Target: TObject; X,Y: Integer); + procedure ImagePalette25MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormKeyPress(Sender: TObject; var Key: Char); - procedure ImagePalette1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette4DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); + procedure ImagePalette4DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean); + procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean); procedure EditTypeImageChange(Sender: TObject); procedure Toutslectionner1Click(Sender: TObject); procedure ButtonDessinerClick(Sender: TObject); - procedure ImagePalette26DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette26EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette26MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette23EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette23DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette23MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette27DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette27MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette27EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette28DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette28EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette28MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette29DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette29EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette29MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette32DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette32EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette32MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette33DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette33EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette33MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette34DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette34EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette34MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette26DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette26EndDrag(Sender, Target: TObject; X,Y: Integer); + procedure ImagePalette26MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette23EndDrag(Sender, Target: TObject; X,Y: Integer); + procedure ImagePalette23DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette23MouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette27DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette27MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette27EndDrag(Sender, Target: TObject; X,Y: Integer); + procedure ImagePalette28DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette28EndDrag(Sender, Target: TObject; X,Y: Integer); + procedure ImagePalette28MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette29DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette29EndDrag(Sender, Target: TObject; X,Y: Integer); + procedure ImagePalette29MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette32DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette32EndDrag(Sender, Target: TObject; X,Y: Integer); + procedure ImagePalette32MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette33DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette33EndDrag(Sender, Target: TObject; X,Y: Integer); + procedure ImagePalette33MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette34DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette34EndDrag(Sender, Target: TObject; X,Y: Integer); + procedure ImagePalette34MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure EditAdrElementClick(Sender: TObject); procedure ImagePalette53DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette52EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette53MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette53MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ButtonAffSCClick(Sender: TObject); procedure RadioGroupSelClick(Sender: TObject); procedure SauvegarderleTCO1Click(Sender: TObject); @@ -401,9 +400,9 @@ type procedure RechargerleTCOdepuislefichier1Click(Sender: TObject); procedure Supprimercanton1Click(Sender: TObject); procedure Affecterlocomotiveaucanton1Click(Sender: TObject); - procedure ImagePalette52MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette52DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette53EndDrag(Sender, Target: TObject; X, Y: Integer); + procedure ImagePalette52MouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette52DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette53EndDrag(Sender, Target: TObject; X,Y: Integer); procedure ImageTCOEndDrag(Sender, Target: TObject; X, Y: Integer); procedure AffRoutesClick(Sender: TObject); procedure Optiondesroutes1Click(Sender: TObject); @@ -477,9 +476,8 @@ const Id_cantonH=60; // codifications de l'icone dans le TCO Id_cantonV=70; // " - // liaisons des voies pour chaque icone par N° de bit (0=NO 1=Nord 2=NE 3=Est 4=SE 5=S 6=SO 7=Ouest) 7 - // un bit à 1 indique une liaison + // un bit à 1 indique une liaison de l'élément Liaisons : array[0..53] of integer= // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 (0,$88,$c8,$8c,$98,$89,$9,$84,$90,$48,$44,$11,$19,$c4,$91,$4c,$21,$24,$42,$12,$22,$cc,$99,$66,$23,$33,$26,$62,$32,$31,0,0, @@ -503,7 +501,7 @@ type TailleFonte : integer; CouleurFond : Tcolor; // couleur de fond // pour les signaux seulement ou action - PiedFeu : integer; // type de pied au signal : signal à gauche=1 ou à droite=2 de la voie OU si action: type d'action + PiedSignal : integer; // type de pied au signal : signal à gauche=1 ou à droite=2 de la voie OU si action: type d'action NumCanton : integer; // numéro de canton, pas son index x,y : integer; // coordonnées pixels relativés du coin sup gauche du signal pour le décalage par rapport au 0,0 cellule Xundo,Yundo : integer; // coordonnées x,y de la cellule pour le undo @@ -1860,7 +1858,7 @@ begin Texte:=''; fonte:='Arial'; fontSTyle:=''; - piedFeu:=0; + PiedSignal:=0; NumCanton:=0; x:=0; y:=0; @@ -2341,13 +2339,13 @@ begin if PiedFeu<1 then PiedFeu:=1; if PiedFeu>2 then PiedFeu:=2; - tco[indexTCO,x,y].PiedFeu:=PiedFeu; + tco[indexTCO,x,y].PiedSignal:=PiedFeu; end; end; // si c'est une action, remplir les paramètres de l'action if tco[indexTCO,x,y].Bimage=Id_action then begin - tco[indexTCO,x,y].PiedFeu:=PiedFeu; // quelle action + tco[indexTCO,x,y].PiedSignal:=PiedFeu; // quelle action tco[indexTCO,x,y].FeuOriente:=FeuOriente; // paramètre de l'action if (PiedFeu=AcBouton_bistable) then begin @@ -2564,7 +2562,7 @@ begin // piedFeu ou index canton if (Bimage=Id_CantonH) or (Bimage=Id_cantonV) then s:=s+intToSTR(tco[i,x,y].NumCanton) - else s:=s+IntToSTR(tco[i,x,y].PiedFeu); + else s:=s+IntToSTR(tco[i,x,y].PiedSignal); s:=s+','; // texte ou nom du canton @@ -2982,7 +2980,7 @@ begin s:=format('%d',[TCO[indexTCO,x,y].Numcanton]); end else - if (b=id_action) and (tco[indexTCO,x,y].PiedFeu=AcBouton_bistable) then + if (b=id_action) and (tco[indexTCO,x,y].PiedSignal=AcBouton_bistable) then begin exit; end; @@ -5275,7 +5273,7 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; moveto(x0,yc);lineto(xc,yc); // partie droite end; end; - + begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine @@ -6772,7 +6770,7 @@ begin //s:=tco[indexTCO,x,y].texte; s:=''; if s='' then tco[indexTCO,x,y].repr:=5; // centré en X et Y - act:=tco[indexTCO,x,y].PiedFeu; + act:=tco[indexTCO,x,y].PiedSignal; case act of AcChangeTCO : begin @@ -6883,13 +6881,9 @@ begin //PImageTCO[indexTCO].Picture.Bitmap.Canvas.textOut(x0+3,y0+3,s); //exit; end; - end; - //affiche_texte(indextco,x,y); end; - - end; @@ -7405,7 +7399,6 @@ begin PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,s,-900); {$IFEND} - Canton[i].Xicone:=x0+round(8*frx); Canton[i].Yicone:=yi; Canton[i].Licone:=LargDest; @@ -9073,7 +9066,7 @@ begin pen.color:=fond; Brush.Color:=fond; pen.width:=epaisseur div 2; - moveTo(xc,y0);LineTo(xc,yc);LineTo(xf,yf); + moveTo(xc,y0);LineTo(xc,yc);LineTo(xf,yf); end; end; @@ -10412,14 +10405,12 @@ end; // calcul des facteurs de réductions X et Y pour l'adapter à l'image de destination procedure calcul_reduction(Var frx,fry : single;DimDestX,DimDestY : integer); begin - //frX:=DimDestX/DimOrgX; - //frY:=DimDestY/DimOrgY; frx:=DimDestX/ZoomMax; fry:=DimDestY/ZoomMax; //Affiche(formatfloat('0.000000',frY),clyellow); end; -procedure Feu_180(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean); +procedure Signal_180(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean); var p : array[0..2] of TPoint; TailleY,TailleX : integer; begin @@ -10461,7 +10452,7 @@ end; // Affiche dans le TCO en x,y un signal à 90° d'après l'image transmise // x y en coordonnées pixels -procedure Feu_90G(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean); +procedure Signal_90G(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean); var p : array[0..2] of TPoint; TailleY,TailleX : integer; begin @@ -10493,7 +10484,7 @@ begin end; // copie de l'image du signal à 90° dans le canvas source et le tourne de 90° et le met dans l'image temporaire -procedure Feu_90D(index : integer;ImageSource : TImage;x,y : integer ; FrX,FrY : real;inverse : boolean); +procedure Signal_90D(index : integer;ImageSource : TImage;x,y : integer ; FrX,FrY : real;inverse : boolean); var p : array[0..2] of TPoint; TailleY,TailleX : integer; begin @@ -10587,7 +10578,7 @@ begin end; end; -procedure affiche_pied7_180(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied7_180(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do @@ -10598,12 +10589,12 @@ begin moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); - if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else + if piedSignal=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else LineTo( x+round((x1+40)*frX),y+round(y1*frY) ); end; end; -procedure affiche_pied9_180(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied9_180(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do @@ -10614,12 +10605,12 @@ begin moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); - if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else + if piedSignal=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else LineTo( x+round((x1+40)*frX),y+round(y1*frY) ); end; end; -procedure affiche_pied20_90G(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); +procedure affiche_pied20_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer;contrevoie : boolean); var x1,y1 : integer; begin with PcanvasTCO[index] do @@ -10633,7 +10624,7 @@ begin moveTo( x+round(x1*frX),y+round(y1*frY) ); x1:=x1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); - if pied=1 then LineTo( x+round(x1*frX),y+round((y1+40)*frY) ) else // a gauche + if piedSignal=1 then LineTo( x+round(x1*frX),y+round((y1+40)*frY) ) else // a gauche LineTo( x+round(x1*frX),y+round((y1-65)*frY) ); // a droite end else @@ -10642,13 +10633,13 @@ begin moveTo( x+round(x1*frX),y+round(y1*frY) ); x1:=x1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); - if pied=1 then LineTo( x+round(x1*frX),y+round((y1+60)*frY) ) else + if piedSignal=1 then LineTo( x+round(x1*frX),y+round((y1+60)*frY) ) else LineTo( x+round(x1*frX),y+round((y1-45)*frY) ); end; end; end; -procedure affiche_pied20_90D(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); +procedure affiche_pied20_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer;contrevoie : boolean); var x1,y1 : integer; begin with PcanvasTCO[index] do @@ -10662,7 +10653,7 @@ begin moveTo( x+round(x1*frX),y+round(y1*frY) ); x1:=x1+6; LineTo( x+round(x1*frX),y+round(y1*frY) ); - if pied=1 then LineTo( x+round(x1*frX),y+round((y1+65)*frY) ) else // a gauche + if piedSignal=1 then LineTo( x+round(x1*frX),y+round((y1+65)*frY) ) else // a gauche LineTo( x+round(x1*frX),y+round((y1-40)*frY) ); // a droite end else @@ -10671,13 +10662,13 @@ begin moveTo( x+round(x1*frX),y+round(y1*frY) ); x1:=x1+6; LineTo( x+round(x1*frX),y+round(y1*frY) ); - if pied=1 then LineTo( x+round(x1*frX),y+round((y1-57)*frY) ) else + if piedSignal=1 then LineTo( x+round(x1*frX),y+round((y1-57)*frY) ) else LineTo( x+round(x1*frX),y+round((y1+45)*frY) ); end; end; end; -procedure affiche_pied20_180(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); +procedure affiche_pied20_180(index,x,y : integer;FrX,frY : real;piedSignal : integer;contrevoie : boolean); var x1,y1 : integer; begin with PcanvasTCO[index] do @@ -10691,7 +10682,7 @@ begin moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); - if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else // a gauche + if piedSignal=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else // a gauche LineTo( x+round((x1+55)*frX),y+round(y1*frY) ); // a droite end else @@ -10700,13 +10691,13 @@ begin moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); - if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else + if piedSignal=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else LineTo( x+round((x1+40)*frX),y+round(y1*frY) ); end; end; end; -procedure affiche_pied20_vertical(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); +procedure affiche_pied20_vertical(index,x,y : integer;FrX,frY : real;piedSignal : integer;contrevoie : boolean); var x1,y1 : integer; begin with PcanvasTCO[index] do @@ -10720,7 +10711,7 @@ begin moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1+6; LineTo( x+round(x1*frX),y+round(y1*frY) ); - if pied=1 then LineTo( x+round((x1+40)*frX),y+round(y1*frY) ) else + if piedSignal=1 then LineTo( x+round((x1+40)*frX),y+round(y1*frY) ) else LineTo( x+round((x1-65)*frX),y+round(y1*frY) ); end else @@ -10729,14 +10720,14 @@ begin moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1+6; LineTo( x+round(x1*frX),y+round(y1*frY) ); - if pied=1 then LineTo( x+round((x1+62)*frX),y+round(y1*frY) ) else + if piedSignal=1 then LineTo( x+round((x1+62)*frX),y+round(y1*frY) ) else LineTo( x+round((x1-40)*frX),y+round(y1*frY) ); end; end; end; -procedure affiche_pied2G_90G(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied2G_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; ech,frYR : real; begin @@ -10749,12 +10740,12 @@ begin x1:=0;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frYR) ); LineTo( x+round((x1-6)*frX),y+round((y1+0)*frYR) ); - if pied=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else + if piedSignal=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else LineTo( x+round((x1-6)*frX),y+round((y1-50)*frYR) ); end; end; -procedure affiche_pied2G_90D(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied2G_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; ech,frYR: real; begin @@ -10767,12 +10758,12 @@ begin x1:=35;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frYR) ); LineTo( x+round((x1+6)*frX),y+round((y1+0)*frYR) ); - if pied=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else + if piedSignal=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) ) ; end; end; -procedure affiche_pied_Vertical2G(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied_Vertical2G(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do @@ -10782,12 +10773,12 @@ begin x1:=12;y1:=35; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+6)*frY) ); - if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) ) else + if piedSignal=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+6)*frY) ); end; end; -procedure affiche_pied3G_90D(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied3G_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; ech,fryR : real; begin @@ -10800,12 +10791,12 @@ begin x1:=45;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+6)*frX),y+round((y1+0)*frY) ); - if pied=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else + if piedSignal=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) ); end; end; -procedure affiche_pied3G_90G(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied3G_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; ech,frYR : real; begin @@ -10818,12 +10809,12 @@ begin x1:=0;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1-4)*frX),y+round((y1+0)*frY) ); - if pied=1 then LineTo( x+round((x1-4)*frX),y+round((y1+50)*frYR) ) else + if piedSignal=1 then LineTo( x+round((x1-4)*frX),y+round((y1+50)*frYR) ) else LineTo( x+round((x1-4)*frX),y+round((y1-50)*fryR) ); end; end; -procedure affiche_pied_Vertical3G(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied_Vertical3G(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do @@ -10833,12 +10824,12 @@ begin x1:=12;y1:=42; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+6)*frY) ); - if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) ) + if piedSignal=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+6)*frY) ) ; end; end; -procedure affiche_pied4G_90G(index,x,y : integer;FrX,frY : real;piedFeu : integer); +procedure affiche_pied4G_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; fryR,ech : real; begin @@ -10851,12 +10842,12 @@ begin x1:=0;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1-6)*frX),y+round((y1+0)*frY) ); - if piedFeu=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else + if piedSignal=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else LineTo( x+round((x1-6)*frX),y+round((y1-50)*frYR) ) ; end; end; -procedure affiche_pied4G_90D(index,x,y : integer;FrX,frY : real;piedfeu: integer); +procedure affiche_pied4G_90D(index,x,y : integer;FrX,frY : real;piedSignal: integer); var x1,y1 : integer; ech,frYR : real; begin @@ -10869,12 +10860,12 @@ begin x1:=55;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+6)*frX),y+round((y1+0)*frY) ); - if piedFeu=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) + if piedSignal=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) ); end; end; -procedure affiche_pied_Vertical4G(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied_Vertical4G(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do @@ -10884,12 +10875,12 @@ begin x1:=12;y1:=55; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) ); - if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else + if piedSignal=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+7)*frY) ); end; end; -procedure affiche_pied9G_90D(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied9G_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; var ech,frYR : real; begin @@ -10902,12 +10893,12 @@ begin x1:=90;y1:=38; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) ); - if pied=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fryR)) else + if piedSignal=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fryR)) else LineTo( x+round((x1+7)*frX),y+round((y1+40)*fryR)); end; end; -procedure affiche_pied5G_90D(index,x,y : integer;FrX,frY : real;piedFeu : integer); +procedure affiche_pied5G_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; ech,frYR : real; begin @@ -10920,12 +10911,12 @@ begin x1:=66;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+6)*frX),y+round((y1+0)*frY) ); - if piedFeu=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else + if piedSignal=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) ); end; end; -procedure affiche_pied5G_90G(index,x,y : integer;FrX,frY : real;piedFeu : integer); +procedure affiche_pied5G_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; ech,fryR : real; begin @@ -10938,12 +10929,12 @@ begin x1:=0;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1-6)*frX),y+round((y1+0)*frY) ); - if piedFeu=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else + if piedSignal=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else LineTo( x+round((x1-6)*frX),y+round((y1-50)*fryR) ); end; end; -procedure affiche_pied_Vertical5G(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied_Vertical5G(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do @@ -10954,12 +10945,12 @@ begin moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) ); - if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else + if piedSignal=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+7)*frY) ); end; end; -procedure affiche_pied7G_90D(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied7G_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; ech,frYR : real; begin @@ -10972,7 +10963,7 @@ begin x1:=75;y1:=38; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) ); - if pied=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fryR) ) else + if piedSignal=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fryR) ) else LineTo( x+round((x1+7)*frX),y+round((y1+38)*fryR) ) ; end; end; @@ -11010,7 +11001,7 @@ begin end; end; -procedure affiche_pied9G_90G(index,x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied9G_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer); var x1,y1 : integer; frYR,ech : real; begin @@ -11025,7 +11016,7 @@ begin moveTo( x+round(x1*frX),y+round(y1*frYR) ); LineTo( x+round((x1-6)*frX),y+round((y1+0)*frYR) ); - if pied=1 then LineTo( x+round((x1-6)*frX),y+round((y1+58)*frYR) ) else + if piedSignal=1 then LineTo( x+round((x1-6)*frX),y+round((y1+58)*frYR) ) else LineTo( x+round((x1-6)*frX),y+round((y1-40)*frYR) ) ; end; end; @@ -11053,7 +11044,7 @@ begin { if y>1 then begin - // si la cellule au dessus contient un feu vertical, ne pas effacer la cellule + // si la cellule au dessus contient un signal vertical, ne pas effacer la cellule // if (tco[indextco,x,y-1].BImage=12) and (tco[indextco,x,y-1].FeuOriente=1) then exit; end; if x10) and (aspect<20) and(oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]);end; + if (aspect>10) and (aspect<20) and (oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]);end; if (aspect>10) and (aspect<20) and (oriente=2) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end; if (aspect>10) and (aspect<20) and (oriente=3) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end; @@ -14467,7 +14458,7 @@ begin tco[indextco,x,y].FontStyle:=''; tco[indextco,x,y].CoulFonte:=0; // tco[indextco,x,y].CouleurFond:=0; - tco[indextco,x,y].PiedFeu:=0; + tco[indextco,x,y].PiedSignal:=0; tco[indexTCO,x,y].NumCanton:=0; tco[indextco,x,y].x:=0; tco[indextco,x,y].y:=0; @@ -16486,7 +16477,7 @@ begin // action if (Bimage=id_action) and not(ConfCellTCO) then begin - i:=tco[indextco,xclic,yclic].piedfeu; // type d'action + i:=tco[indextco,xclic,yclic].PiedSignal; // type d'action n:=tco[indextco,xclic,yclic].feuoriente; //Affiche('Clic bouton action i='+intToSTR(i)+' n='+intToSTR(n),clYellow); case i of @@ -16540,7 +16531,7 @@ begin begin if tco[i,x,y].BImage=Id_Action then begin - if tco[i,x,y].PiedFeu=acBouton_bistable then + if tco[i,x,y].PiedSignal=acBouton_bistable then begin j:=tco[indextco,xclic,yclic].Adresse; if j=adresse then @@ -17310,7 +17301,7 @@ begin raz_cellule(indextco,xClic,yClic); tco[indextco,XClic,YClic].BImage:=Id_signal; tco[indextco,XClic,YClic].FeuOriente:=1; - tco[indextco,XClic,YClic].PiedFeu:=1; + tco[indextco,XClic,YClic].PiedSignal:=1; tco[indextco,XClic,YClic].coulFonte:=clWhite; clicTCO:=true; editAdrElement.Text:=''; @@ -18057,7 +18048,7 @@ begin if actualize then exit; if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage=Id_signal then begin - tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedFeu:=2; + tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedSignal:=2; Affiche_TCO(indexTCO); TCO_modifie:=true; actualise(indexTCO); // met à jour la fenetre de config de la cellule @@ -18078,7 +18069,7 @@ begin if actualize then exit; if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage=Id_signal then begin - tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedFeu:=1; + tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedSignal:=1; Affiche_TCO(indexTCO); TCO_modifie:=true; actualise(indexTCO); // met à jour la fenetre de config de la cellule @@ -18149,7 +18140,7 @@ begin PopUpMenu1.Items[6][3].checked:=true; end; // coche sur l'orientation du pied - PiedFeu:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedFeu; + PiedFeu:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedSignal; if PiedFeu=1 then begin PopUpMenu1.Items[6][5].checked:=true; @@ -19326,6 +19317,9 @@ begin defocusControl(EditAdrElement,true); end; + + + end. diff --git a/Vcl.pas b/Vcl.pas new file mode 100644 index 0000000..6708328 --- /dev/null +++ b/Vcl.pas @@ -0,0 +1,1902 @@ +// ************************************************************************************************** +// +// 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/verif_version.pas b/verif_version.pas index ac075ef..8c3cf33 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -23,7 +23,7 @@ var Lance_verif : integer; DebugVV,verifVersion,notificationVersion,essai : boolean; chemin_Dest,chemin_src,date_creation,nombre_tel : string; - f : text; + f : textFile; Const VersionSC = '10.2'; // sert à la comparaison de la version publiée @@ -237,7 +237,7 @@ begin i:=pos('.zip',s); if i=0 then begin - log('nom du zip invalide',clred); + Affiche('Nom du zip invalide',clred); exit; end; @@ -267,7 +267,6 @@ begin chdir(chemin_src); //s:='"'+chemin_dest+'" "'+chemin_src+'"'; //log('exécution de copie_sc.exe '+s,clyellow); - close(f); Affiche('Installation de la nouvelle version',clyellow); Sleep(2000); i:=ShellExecute(Formprinc.Handle,pchar('runas'), // mode admin @@ -283,11 +282,11 @@ begin end else begin - Affiche('Erreur '+intToSTR(i)+' au lancement de installeur.exe ',clred); Affiche(SysErrorMessage(GetLastError),clred); - Affiche('Exécutez le manuellement',clred); + log('Erreur '+intToSTR(i)+' au lancement de installeur.exe ',clred); + log('Exécutez le manuellement',clred); end; - + close(f); end; // renvoie le numéro de version depuis le site github, et télécharge... etc