unit wcontrol;{Une unité écrite par denis bertin pour denis-draw son logiciel le 13.2.2013}{Pour obtenir un centre de controle du dessin dans laquelle soit affiché des états dépendant de la sélectin}{En une après midi - reste à écrire le cas d'une multi-sélection}{Et encore il faut ajuster la règle vertical en fonction, c'est fait} {Et ajouter dans le menu des réglages le centre de contrôle-Denis Bertin Stéphane}{Il fallait encore ajouter le survolle de la souris pour afficher sa couleur bien exprimée dans son cas!}{Et aussi les miniatures de la sélection sous forme de vignettes séquentielles,... le 14.2.2013--C'Denis} interface uses wbase,u_object,windows,messages,graphics,classes; Type TRectControle = class(u_object.node)public son_Rectangle:trect; libeler:string; commentaire:string; epaisseur_du_filet:integer; visible:boolean; constructor Create(left,top,right,bottom:integer; un_libeler,un_commentaire:string; une_epaisseur_du_filet:integer); procedure paint(adc:hdc); virtual; function clic(apoint:tpoint; right:boolean):boolean; virtual; function situer(apoint:tpoint):boolean; virtual; end; TFilenameControle = class(TRectControle) procedure paint(adc:hdc); override; {recouvrement en Français} procedure Paint_decalage(adc:hdc; decalage:integer); procedure Paint_hilite(adc:hdc; decalage:integer); procedure get_max_with(var maximum:integer); end; TSizeControle= class(TRectControle) procedure paint(adc:hdc); override; function clic(apoint:tpoint; right:boolean):boolean; override; end Tcommande= class(TRectControle) constructor Create(left,top,right,bottom:integer;un_libeler:string; commande:integer); procedure paint(adc:hdc); override; function clic(apoint:tpoint; right:boolean):boolean; override; private une_commande:integer; end; Tcommande_bleu= class(Tcommande) procedure paint(adc:hdc); override; end; TCloseControle = class(TRectControle) constructor Create(left,top:integer); procedure paint(adc:hdc); override; function clic(apoint:tpoint; right:boolean):boolean; override; function situer(apoint:tpoint):boolean; override; end; //Pour afficher les controle sur la sélection. TColorControle = class(TCloseControle) procedure paint(adc:hdc); override; function clic(apoint:tpoint; right:boolean):boolean; override; function situer(apoint:tpoint):boolean; override; end; TRainbowControle = class(TRectControle) constructor Create(left,top,right,bottom:integer); procedure paint(adc:hdc); override; function clic(apoint:tpoint; right:boolean):boolean; override; function situer(apoint:tpoint):boolean; override; end; THelpButtonControle = class(TRectControle) constructor Create(left,top,right,bottom:integer); procedure paint(adc:hdc); override; function clic(apoint:tpoint; right:boolean):boolean; override; function situer(apoint:tpoint):boolean; override; end; TBitmapControle = class(TRectControle) constructor Create(left,top,id,cmd:integer; un_msg:string; const droit:integer=0); procedure paint(adc:hdc); override; function clic(apoint:tpoint; right:boolean):boolean; override; function situer(apoint:tpoint):boolean; override; private son_id,sa_cmd,son_droit:integer; son_message:string; end; TReveiveControle = class(TBitmapControle) function clic(apoint:tpoint; right:boolean):boolean; override; end; TDrawControle = class(TRectControle) Constructor Create(left,top,Index:integer; Bitmap:graphics.tbitmap); procedure Paint(adc:hdc); override; function Clic(apoint:tpoint; right:boolean):boolean; override; destructor Destroy; override; private un_bitmap:graphics.tbitmap; un_index:integer; end; Tedit_filename = class(TRectControle) Constructor Create(left,top,right,bottom:integer); procedure Paint(adc:hdc); override; procedure timer; public filename:string; bool_cursor:boolean; end; TOpenAfile = class(wbase.Twindow) constructor Create(un_parent:wbase.TWinbase); destructor Destroy; override; procedure Setupwindow; override; function GetClassName: PChar; override; function Getstyle:DWORD; override; procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); override; procedure WMMouseMove(var Msg: TMessage); override; procedure WMLButtonDown(var Msg: TMessage); override; procedure WMVSCROLL(var msg:TMessage); override; procedure WMMOUSEWHEEL(var msg:TMessage); override; private list_fichier:metalist; end; TWindowControle = class(wbase.Twindow) constructor Create(un_parent:wbase.TWinbase); destructor Destroy; override; function GetClassName: PChar; override; function Getstyle:DWORD; override; procedure Actualiser; procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); override; procedure Paint_palette_neochrome(PaintDC:Hdc); procedure WMLButtonDown(var Msg: TMessage); override; procedure WMRButtonDown(var Msg: TMessage); override; procedure WMMouseMove(var Msg: TMessage); override; procedure WMCommand(var Msg: TMessage); override; procedure WMCHAR(var msg:TMessage); override; procedure WMKeyDown(var msg:TMessage); override; procedure WMTimer(var msg:TMessage); override; procedure WMVSCROLL(var Msg: TMessage); override; procedure Get_Name_of_path(pc_name_of_complet_path:pchar); procedure Open_A_File_name(Filename:pchar); public visibility:boolean; Show_les_controle:boolean; liste_rectangle:u_object.metalist; bool_aucune_element_de_selectionner:boolean; bool_forcer_l_affichage_des_couleur:boolean; bool_afficher_l_ecran_de_sauvegarde:boolean; end; implementation uses col_plan,wmain,hls_rvb,wutil,wformes1,wformebm,sysutils,relation,my_math,gdipobj, font_ob1,utile,unit_menu,wmenuk,uregedit,z_open_file,drawsym,g_base,math,haide, wregles,GDIPAPI,Registry,k_erreur,wproche,wformes2; {écrit par bertin} const id_valider_la_saisie = 1000; id_invalider_la_saisie = 1010; const k_hauteur_libeler = 24; constructor TRectControle.Create(left,top,right,bottom:integer; un_libeler,un_commentaire:string; une_epaisseur_du_filet:integer); begin setrect(self.son_Rectangle,left,top,right,bottom); self.libeler:=un_libeler; self.commentaire:=un_commentaire; self.epaisseur_du_filet:=une_epaisseur_du_filet; self.visible:=True; end; constructor Tcommande.Create(left,top,right,bottom:integer;un_libeler:string; commande:integer); begin inherited Create(left,top,right,bottom,un_libeler,'',0); self.une_commande:=commande; end; procedure TRectControle.paint(adc:hdc); var afont:hfont; begin afont:=selectObject(adc,wutil.Get_MakeDefaultFont(16)); SetBkMode(adc,Transparent); if (wmain.Wincontrole.bool_forcer_l_affichage_des_couleur or wmain.Wincontrole.bool_aucune_element_de_selectionner) and (self.son_Rectangle.top=2) then settextcolor(adc,g_base.rgb_blanc) else if wmain.Wincontrole.bool_afficher_l_ecran_de_sauvegarde then settextcolor(adc,g_base.rgb_blanc) else settextcolor(adc,g_base.rgb_bleu); with self.son_Rectangle do textout(adc,left,top,pchar(self.libeler),strlen(pchar(self.libeler))); deleteobject(SelectObject(adc,afont)); end; procedure TFilenameControle.paint(adc:hdc); var afont:hfont; begin settextcolor(adc,g_base.rgb_blanc); SetBkMode(adc,Transparent); afont:=selectObject(adc,wutil.Get_MakeDefaultFont(k_hauteur_libeler)); with self.son_Rectangle do textout(adc,left,top,pchar(self.libeler),strlen(pchar(self.libeler))); deleteobject(SelectObject(adc,afont)); end; procedure TFilenameControle.Paint_decalage(adc:hdc; decalage:integer); var afont:hfont; begin settextcolor(adc,g_base.rgb_Blanc); SetBkColor(adc,g_base.RGB_Bleu); SetBkMode(adc,Opaque); afont:=selectObject(adc,wutil.Get_MakeDefaultFont(k_hauteur_libeler)); with self.son_Rectangle do textout(adc,left,top-decalage*k_hauteur_libeler,pchar(self.libeler),strlen(pchar(self.libeler))); deleteobject(SelectObject(adc,afont)); end; {TFilenameControle.Paint_decalage} procedure TFilenameControle.Paint_hilite(adc:hdc; decalage:integer); var afont:hfont; un_rect:trect; deux_rect:trect; begin getclientrect(wmain.Wincontrole.hwindow,deux_rect); un_rect:=self.son_Rectangle; dec(un_rect.top,decalage*k_hauteur_libeler); un_rect.Left:=2; un_rect.Right:=deux_rect.Right; un_rect.Bottom:=un_rect.top+k_hauteur_libeler+6; wutil.Soft_rectangle_rectangulaire(adc,un_rect,g_base.rgb_bleu); settextcolor(adc,g_base.rgb_jaune); SetBkMode(adc,Transparent); afont:=selectObject(adc,wutil.Get_MakeDefaultFont(k_hauteur_libeler)); with self.son_Rectangle do textout(adc,left,top-decalage*k_hauteur_libeler,pchar(self.libeler),strlen(pchar(self.libeler))); deleteobject(SelectObject(adc,afont)); end; procedure TFilenameControle.get_max_with(var maximum:integer); var afont:hfont; size:tsize; adc:hdc; begin adc:=getdc(wmain.Wincontrole.hwindow); afont:=selectObject(adc,wutil.Get_MakeDefaultFont(k_hauteur_libeler)); GetTextExtentPoint(adc,pchar(self.libeler),strlen(pchar(self.libeler)),size); deleteobject(SelectObject(adc,afont)); maximum:=math.Max(maximum,size.cx); releasedc(wmain.Wincontrole.hwindow,adc); end; procedure TSizeControle.paint(adc:hdc); var afont:hfont; size:tsize; begin afont:=selectObject(adc,wutil.Get_MakeDefaultFont(16)); GetTextExtentPoint(adc,pchar(self.libeler),strlen(pchar(self.libeler)),size); with self.son_Rectangle do begin rectangle(adc,left-2,top-2,left+size.cx+2,top+size.cy+1); setbkmode(adc,Transparent); //En effet quand la première ligne était blanche ces caractères. settextcolor(adc,g_base.RGB_Noir); textout(adc,left,top,pchar(self.libeler),strlen(pchar(self.libeler))); end; deleteobject(SelectObject(adc,afont)); end; function TSizeControle.clic(apoint:tpoint; right:boolean):boolean; var un_calque_actif:col_plan.TCalque; l_element:wformes1.tforme_dessin; local_real_epaisseur:real; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; un_calque_actif:=wmain.MainWindow.wmsg.col_dessin.Get_calque_actif; if un_Calque_actif<>nil then begin l_element:=wformes1.tforme_dessin(un_Calque_actif.last_selection); if (l_element<>nil) and (l_element.ClassType=wformes1.tforme_dessin) then begin local_real_epaisseur:=strtofloat(self.libeler); local_real_epaisseur:=relation._10mm_to_log_pouce(local_real_epaisseur*10); l_element.epaisseur:=round(local_real_epaisseur); l_element.epaisseur_went:=l_element.epaisseur; l_element.calcul; postmessage(wmain.MainWindow.hwindow,wm_selection_changer,0,0); invalidaterect(wmain.MainWindow.hwindow,nil,false); end; end; end; end; {TSizeControle.clic} procedure Tcommande_bleu.paint(adc:hdc); var afont:hfont; size:tsize; begin afont:=selectObject(adc,wutil.Get_MakeDefaultFont(16)); GetTextExtentPoint(adc,pchar(self.libeler),strlen(pchar(self.libeler)),size); with self.son_Rectangle do begin rectangle(adc,left-2,top-2,left+size.cx+2,top+size.cy+1); self.son_Rectangle.Right:=left+size.cx+2; self.son_Rectangle.bottom:=top+size.cy+1; settextColor(adc,g_base.rgb_bleu); setbkmode(adc,Transparent); textout(adc,left,top,pchar(self.libeler),strlen(pchar(self.libeler))); end; deleteobject(SelectObject(adc,afont)); end; procedure Tcommande.paint(adc:hdc); var afont:hfont; size:tsize; begin afont:=selectObject(adc,wutil.Get_MakeDefaultFont(16)); GetTextExtentPoint(adc,pchar(self.libeler),strlen(pchar(self.libeler)),size); with self.son_Rectangle do begin rectangle(adc,left-2,top-2,left+size.cx+2,top+size.cy+1); self.son_Rectangle.Right:=left+size.cx+2; self.son_Rectangle.bottom:=top+size.cy+1; setbkmode(adc,Transparent); textout(adc,left,top,pchar(self.libeler),strlen(pchar(self.libeler))); end; deleteobject(SelectObject(adc,afont)); end; {Tcommande.paint} function Tcommande.clic(apoint:tpoint; right:boolean):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin postmessage(wmain.MainWindow.hwindow,wm_command,self.une_commande,0); result:=true; end; end; function TRectControle.clic(apoint:tpoint; right:boolean):boolean; begin result:=false; end; function TRectControle.situer(apoint:tpoint):boolean; begin result:=false; end; constructor TCloseControle.Create(left,top:integer); begin inherited Create(left,top,left+16,top+16,'','',0); end; procedure TCloseControle.paint(adc:hdc); begin with self.son_Rectangle do drawsym.draw_radio_on(adc,left,top); end; function TCloseControle.clic(apoint:tpoint; right:boolean):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; postmessage(wmain.MainWindow.hwindow,wm_command,unit_menu.id_menu_afficher_le_centre_de_controle,0); end; end; function TCloseControle.situer(apoint:tpoint):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; wmain.Status_window.Show_a_message_court(z_open_file.string_fermer_cette_fenetre); end; end; procedure TColorControle.paint(adc:hdc); begin with self.son_Rectangle do drawsym.draw_radioff(adc,left,top); end; function TColorControle.clic(apoint:tpoint; right:boolean):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; if wmain.Wincontrole<>nil then begin wmain.Wincontrole.Show_les_controle:=true; wmain.Wincontrole.bool_forcer_l_affichage_des_couleur:= not wmain.Wincontrole.bool_forcer_l_affichage_des_couleur; Wincontrole.Actualiser; invalidaterect(wmain.Wincontrole.hwindow,nil,true); end; end; end; function TColorControle.Situer(apoint:tpoint):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; if wmain.Status_window<>nil then wmain.Status_window.Show_a_message_court(z_open_file.string_afficher_la_palette); end; end; constructor TBitmapControle.Create(left,top,id,cmd:integer; un_msg:string; const droit:integer=0); begin inherited Create(left,top,left+40,top+40,'','',0); self.son_id:=id; self.sa_cmd:=cmd; self.son_droit:=droit; self.son_message:=un_msg; end; procedure TBitmapControle.paint(adc:hdc); var abitmap:hbitmap; memdc:hdc; begin if self.visible then begin abitmap:=loadbitmap(hinstance,pchar(son_id)); memdc:=createcompatibledc(adc); selectobject(memdc,abitmap); with self.son_Rectangle do bitblt(adc,left,top,40,40,memdc,0,0,SRCCOPY); deleteDC(memdc); DeleteObject(abitmap); end; end; {TBitmapControle.paint} function TBitmapControle.clic(apoint:tpoint; right:boolean):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin if wmain.MainWindow<>nil then begin result:=true; if right then begin if self.son_droit<>0 then postmessage(wmain.MainWindow.hwindow,wm_command,self.son_droit,0); end else postmessage(wmain.MainWindow.hwindow,wm_command,self.sa_cmd,0); end; end; end; function TReveiveControle.clic(apoint:tpoint; right:boolean):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; if wmain.MainWindow<>nil then if right then postmessage(wmain.Wincontrole.hwindow,wm_command,self.sa_cmd,1) else postmessage(wmain.Wincontrole.hwindow,wm_command,self.sa_cmd,0); end; end; function TBitmapControle.situer(apoint:tpoint):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; if wmain.Status_window<>nil then wmain.Status_window.Show_a_message_court(self.son_message); end; end; {*****************************************************************************} Constructor TDrawControle.Create(left,top,Index:integer; Bitmap:graphics.tbitmap); Begin inherited Create(left,top,left+40,top+40,'','',0); self.un_index:=Index; self.un_bitmap:=Bitmap; end; procedure TDrawControle.Paint(adc:hdc); var memdc:hdc; apc:wutil.pc100; old_bitmap:hbitmap; begin if self.un_bitmap<>nil then begin memdc:=createcompatibledc(adc); old_bitmap:=selectobject(memdc,self.un_bitmap.Handle); with self.son_Rectangle do bitblt(adc,left,top,40,40,memdc,0,0,SRCCOPY); selectobject(memdc,old_bitmap); deleteDC(memdc); end else begin with self.son_Rectangle do begin rectangle(adc,left,top,right,bottom); inttopchar(self.un_index,apc); textout(adc,left,top,apc,strlen(apc)); end; end; end; {TDrawControle.Paint} function TDrawControle.Clic(apoint:tpoint; right:boolean):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=True; if wmain.MainWindow<>nil then wmain.MainWindow.Afficher_l_index_selectionner(self.un_index); end; end; {TDrawControle.Clic} destructor TDrawControle.Destroy; begin if self.un_bitmap<>nil then self.un_bitmap.free; inherited Destroy; end; {*****************************************************************************} Constructor Tedit_filename.Create(left,top,right,bottom:integer); begin inherited Create(left,top,right,bottom,'','',0); self.filename:=''; self.bool_cursor:=false; end; procedure Tedit_filename.Paint(adc:hdc); var apen:hpen; afont:hfont; begin apen:=selectObject(adc,Createpen(ps_solid,2,g_base.RGB_Blanc)); with self.son_Rectangle do rectangle(adc,left,top,right,bottom); deleteobject(selectObject(adc,apen)); afont:=SelectObject(adc,wutil.Get_MakeDefaultFont(k_hauteur_libeler)); with self.son_Rectangle do textout(adc,left+4,top+4,pchar(filename),length(filename)); deleteobject(SelectObject(adc,afont)); end; {Tedit_filename.Paint} procedure Tedit_filename.timer; var adc:hdc; size:tsize; afont:hfont; abrush:hbrush; begin adc:=getdc(wmain.Wincontrole.hwindow); afont:=SelectObject(adc,wutil.Get_MakeDefaultFont(k_hauteur_libeler)); if self.bool_cursor then abrush:=SelectObject(adc,Createsolidbrush(g_base.RGB_Blanc)) else abrush:=SelectObject(adc,Createsolidbrush(g_base.RGB_BLeu)); if length(filename)=0 then begin GetTextExtentPoint(adc,'A',1,size); size.cx:=0; end else begin GetTextExtentPoint(adc,pchar(filename),length(filename),size); end; with self.son_Rectangle do rectangle(adc,left+4+size.cx,top+4+size.cy,left+4+size.cx+12,top+4+size.cy-4); deleteobject(SelectObject(adc,afont)); releasedc(wmain.Wincontrole.hwindow,adc); self.bool_cursor:=not self.bool_cursor; end; {*****************************************************************************} function methode_comparaison(Item1, Item2: Pointer):integer; begin result:=strcomp(pchar(TFilenameControle(Item1).libeler), pchar(TFilenameControle(Item2).libeler)); end; Constructor TOpenAfile.Create(un_parent:wbase.TWinbase); var pc_nom_du_repertoire_user:pc1024; sr: SysUtils.TSearchRec; FileAttrs:Integer; i:integer; pc_filename_found:pc1024; p:pchar; collection_a_trier:u_object.TO_COL; un_FilenameControle:TFilenameControle; begin list_fichier:=metalist.create; collection_a_trier:=u_object.TO_COL.Create; FileAttrs:=faAnyFile; //Recherche des fichiers correspondants TWindowControle(Parent).Get_Name_of_path(pc_nom_du_repertoire_user); i:=0; if SysUtils.findfirst(strpas(pc_nom_du_repertoire_user)+'\'+wmenuk.chaine_etoile_ato,FileAttrs,sr) = 0 then begin repeat if sr.Name[1]<>'.' then begin strcopy(pc_filename_found,pchar(sr.Name)); p:=strpos(pc_filename_found,wmenuk.point_ato); if p<>nil then p^:=#0; collection_a_trier.Add(TFilenameControle.Create(4,i*k_hauteur_libeler,320,succ(i)*k_hauteur_libeler,pc_filename_found,'',0)); inc(i); end; until SysUtils.FindNext(sr)<>0; end; SysUtils.findClose(sr); if true then begin collection_a_trier.Sort(methode_comparaison); for i:=0 to pred(collection_a_trier.count) do begin un_FilenameControle:=TFilenameControle(collection_a_trier.at(i)); un_FilenameControle.son_Rectangle.top:=i*k_hauteur_libeler; un_FilenameControle.son_Rectangle.bottom:=succ(i)*k_hauteur_libeler; list_fichier.Add(un_FilenameControle); end; collection_a_trier.OwnsObjects:=false; collection_a_trier.Clear; collection_a_trier.free; inherited Create(un_parent,'Ouvrir un fichier',100,100,320,500,false,false,0); end; end; destructor TOpenAfile.Destroy; begin list_fichier.free; inherited Destroy; end; Procedure TOpenAfile.Setupwindow; var une_largeur:integer; une_hauteur:integer; aTFilenameControle:TFilenameControle; i,maximum:integer; ScrollInfo_vertical:TScrollInfo; begin inherited Setupwindow; if list_fichier.count=0 then begin k_erreur.MessageBox(self.hwindow,k_erreur.Tell_Aucun_dessin_na_ete_enregistrer_dans_ce_repertoire,mb_ok or mb_iconstop); postmessage(self.hwindow,wm_close,0,0); exit; end; //Trouver la largeur la plus importante maximum:=0; for i:=0 to pred(list_fichier.count) do begin aTFilenameControle:=TFilenameControle(list_fichier.at(i)); aTFilenameControle.get_max_with(maximum); end; une_largeur:=maximum+12; if list_fichier.count>20 then inc(une_largeur,getsystemmetrics(SM_CYHSCROLL)); une_hauteur:=k_hauteur_libeler*math.min(20,list_fichier.count)+ GetSystemMetrics(SM_CYCAPTION)+ GetSystemMetrics(SM_CYBORDER)+4; Movewindow(self.hwindow, (getsystemmetrics(SM_CXFULLSCREEN)-une_largeur) div 2, (getsystemmetrics(SM_CYFULLSCREEN)-une_hauteur) div 2, une_largeur,une_hauteur,false); if list_fichier.count>20 then begin ScrollInfo_vertical.cbSize:=sizeof(TScrollInfo); ScrollInfo_vertical.fMask:=SIF_ALL; ScrollInfo_vertical.nMin:=0; ScrollInfo_vertical.nMax:=list_fichier.count-20; ScrollInfo_vertical.nPage:=0; ScrollInfo_vertical.nPos:=0; ScrollInfo_vertical.nTrackPos:=0; SetScrollInfo(self.hwindow,SB_VERT,ScrollInfo_vertical,true); end; end; function TOpenAfile.GetClassName:PChar; begin GetClassName:='WinBirdOpenAfile'; //Bertin-draw end; function TOpenAfile.Getstyle:DWORD; begin if self.list_fichier.count<=20 then Getstyle:=ws_popup or ws_border or ws_caption or ws_sysmenu else Getstyle:=ws_popup or ws_border or ws_caption or ws_vscroll or ws_sysmenu; end; procedure TOpenAfile.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); var i:integer; arect:trect; abrush:hbrush; aTFilenameControle:TFilenameControle; begin getclientrect(self.hwindow,arect); abrush:=selectobject(PaintDC,CreatesolidBrush(g_base.rgb_bleu)); with arect do rectangle(PaintDC,pred(left),pred(top),succ(right),succ(bottom)); deleteobject(selectobject(PaintDC,abrush)); for i:=0 to pred(list_fichier.count) do begin aTFilenameControle:=TFilenameControle(list_fichier.at(i)); aTFilenameControle.Paint_decalage(PaintDC,GetScrollPos(self.hwindow,SB_VERT)); end; {for i} end; procedure TOpenAfile.WMMouseMove(var Msg: TMessage); var i:integer; adc,memdc:hdc; arect:trect; abrush:hbrush; point_souris:tpoint; old_bitmap:hbitmap; aTFilenameControle:TFilenameControle; begin getclientrect(hwindow,arect); point_souris.y:=Smallint(hiword(msg.lparam)); inc(point_souris.y,Getscrollpos(self.hwindow,SB_VERT)*k_hauteur_libeler); adc:=getdc(self.hwindow); memdc:=createcompatibledc(adc); with arect do old_bitmap:=selectobject(memdc,createcompatiblebitmap(adc,right,bottom)); abrush:=selectobject(memdc,CreatesolidBrush(g_base.rgb_bleu)); with arect do rectangle(memdc,pred(left),pred(top),succ(right),succ(bottom)); deleteobject(selectobject(memdc,abrush)); for i:=0 to pred(list_fichier.count) do begin aTFilenameControle:=TFilenameControle(list_fichier.at(i)); if (aTFilenameControle.son_Rectangle.top<=point_souris.y) and (aTFilenameControle.son_Rectangle.bottom>=point_souris.y) then aTFilenameControle.Paint_hilite(memdc,GetScrollPos(self.hwindow,SB_VERT)) else aTFilenameControle.Paint_decalage(memdc,GetScrollPos(self.hwindow,SB_VERT)); end; {for i} with arect do bitblt(adc,0,0,right,bottom,memdc,0,0,SRCCOPY); deleteobject(selectobject(memdc,old_bitmap)); deleteDC(memdc); releasedc(self.hwindow,adc); end; {TOpenAfile.WMMouseMove} procedure TOpenAfile.WMLButtonDown(var Msg: TMessage); var i:integer; point_souris:tpoint; aTFilenameControle:TFilenameControle; begin point_souris.y:=Smallint(hiword(msg.lparam)); inc(point_souris.y,Getscrollpos(self.hwindow,SB_VERT)*k_hauteur_libeler); for i:=0 to pred(list_fichier.count) do begin aTFilenameControle:=TFilenameControle(list_fichier.at(i)); if (aTFilenameControle.son_Rectangle.top<=point_souris.y) and (aTFilenameControle.son_Rectangle.bottom>=point_souris.y) then begin wmain.Wincontrole.Open_A_File_name(pchar(aTFilenameControle.libeler)); end; end; end; {TOpenAfile.WMLButtonDown} procedure TOpenAfile.WMVSCROLL(var msg:TMessage); var pos,nScrollCode:integer; begin nScrollCode:=LOWORD(msg.wParam); if (nScrollCode=SB_THUMBPOSITION) or (nScrollCode=SB_THUMBTRACK) then pos:=HIWORD(msg.wParam) else pos:=GetScrollPos(self.hwindow,SB_VERT); case nScrollCode of SB_BOTTOM: begin pos:=0; end; SB_ENDSCROLL: begin invalidaterect(self.hwindow,nil,false); exit; end; SB_LINELEFT: begin pos:=math.max(0,pos-1); end; SB_LINERIGHT: begin pos:=math.min(pos+1,self.list_fichier.count-20); end; SB_PAGELEFT: begin pos:=math.max(0,pos-10); end; SB_PAGERIGHT: begin pos:=math.min(pos+10,self.list_fichier.count-20); end; SB_THUMBPOSITION: begin end; SB_THUMBTRACK: begin invalidaterect(self.hwindow,nil,false); updatewindow(self.hwindow); end; SB_TOP:pos:=self.list_fichier.count-20; end; {case} SetScrollPos(Self.hwindow,SB_VERT,Pos,true); end; {TOpenAfile.WMVSCROLL} procedure TOpenAfile.WMMOUSEWHEEL(var msg:TMessage); var zDelta:integer; begin zDelta:=smallint((msg.wParam and $ffff0000) shr 16); // wheel rotation if zDelta>0 then postmessage(self.hwindow,wm_VSCROLL,makelong(SB_LINELEFT,0),0) else postmessage(self.hwindow,wm_VSCROLL,makelong(SB_LINERIGHT,0),0); invalidaterect(self.hwindow,nil,false); end; {TOpenAfile.WMMOUSEWHEEL} {*****************************************************************************} constructor TWindowControle.create(un_parent:wbase.TWinbase); begin inherited create(un_parent,'Centre de contrôle',100,100,320,100,false,false,0,false); //-1,-1,-1,-1 self.liste_rectangle:=u_object.metalist.create; self.Show_les_controle:=True; self.visibility:=uregedit.RegGetPrivateProfileInt(wmenuk.circle,z_open_file.string_afficher_le_centre_de_controle,1)=1; self.bool_forcer_l_affichage_des_couleur:=false; self.bool_afficher_l_ecran_de_sauvegarde:=false; settimer(self.hwindow,100,220,nil); end; destructor TWindowControle.destroy; begin self.liste_rectangle.free; inherited destroy; end; function TWindowControle.GetClassName:PChar; begin GetClassName:='Denisdraw_control_center'; end; function TWindowControle.Getstyle:DWORD; begin Getstyle:=ws_child or ws_visible or ws_border; end; procedure TWindowControle.actualiser; const point_groud_zero : tpoint = (x:0;y:0); var i,j:integer; l_element:wformes1.tforme_dessin; un_calque_actif:col_plan.TCalque; pc_commentaire,apc,pc_stroke_ligne:pc255; plot:font_ob1.testnode; rayon:real; pc_une_taille:pc100; arect:trect; une_dist:real; un_angle:real; un_index:u_object.tindex; position:tpoint; un_bitmap:Graphics.tbitmap; un_contexte_d_affichage:hdc; un_rectangle_global:trect; old_bitmap:hbitmap; memory_display_context:hdc; Zoom_coefficient:real; graphics:gdipobj.TGPGraphics; resultat:integer; begin if self.bool_afficher_l_ecran_de_sauvegarde then exit; if not self.Show_les_controle then exit; liste_rectangle.freeall; getclientrect(self.hwindow,arect); bool_aucune_element_de_selectionner:=true; un_calque_actif:=wmain.MainWindow.wmsg.col_dessin.Get_calque_actif; if un_Calque_actif<>nil then begin if un_Calque_actif.col_select.count=0 then begin liste_rectangle.Add(TReveiveControle.Create(20,6,104,unit_menu.id_menu_ouvrir, z_open_file.string_Ouvrir_un_fichier)); {écrit par denis bertin} liste_rectangle.Add(TRectControle.Create(22,45,90,110,'Ouvrir','',0)); liste_rectangle.Add(TReveiveControle.Create(70,6,102,unit_menu.id_menu_file_save_as, z_open_file.string_enregistrer_le_fichier)); {écrit par denis bertin} liste_rectangle.Add(TRectControle.Create(72,45,120,110,'Sauver','',0)); liste_rectangle.Add(TBitmapControle.Create(130,6,101,unit_menu.id_menu_afficher_la_grille_de_repere, z_open_file.string_afficher_la_palette,unit_menu.id_menu_option_la_grille_de_repere)); liste_rectangle.Add(TRectControle.Create(132,45,120,110,'Grille','',0)); liste_rectangle.Add(TReveiveControle.Create(180,6,107,unit_menu.id_menu_imprimer, z_open_file.string_Imprimer_un_fichier)); {écrit par denis bertin} liste_rectangle.Add(TRectControle.Create(182,45,120,110,'Imprimer','',0)); end else if un_Calque_actif.col_select.count>1 then begin un_rectangle_global:=g_base.grand_plan; for i:=0 to pred(un_Calque_actif.count) do begin un_index:=u_object.tindex(un_Calque_actif.col_select.at(i)); if un_index<>nil then begin l_element:=wformes1.tforme_dessin(un_Calque_actif.formindex(un_index)); if l_element<>nil then begin position.x:=l_element.left; position.y:=l_element.top; with position do l_element.deplace(-x,-y,0); un_bitmap:=Tbitmap.Create; un_bitmap.Width:=40; un_bitmap.Height:=40; un_contexte_d_affichage:=getdc(self.hwindow); memory_display_context:=CreateCompatibleDc(un_contexte_d_affichage); old_bitmap:=selectobject(memory_display_context,un_bitmap.Handle); {$ifdef debug} moveto(memory_display_context,0,0); lineto(memory_display_context,40,40); {$endif debug} graphics:=gdipobj.TGPGraphics.Create(memory_display_context); graphics.SetSmoothingMode(GDIPAPI.SmoothingModeAntiAlias); //Détermination du coefficient de zoom - impect.bertin Zoom_coefficient:=1.08*(1/my_math.REAL_min(40*1/l_element.la_largeur,40*1/l_element.la_hauteur)); l_element.draw(memory_display_context,graphics,un_rectangle_global,Zoom_coefficient,false,g_base.rgb_bleu); graphics.free; selectobject(un_contexte_d_affichage,old_bitmap); deletedc(memory_display_context); releasedc(self.hwindow,un_contexte_d_affichage); with position do l_element.deplace(+x,+y,0); liste_rectangle.Add(TDrawControle.Create(10+i*50,10,pred(un_Calque_actif.count-i),un_bitmap)); {écrit par denis bertin aujourd'hui} end; end; end; end else if un_Calque_actif.col_select.count=1 then begin //Un seul élément est sélectionné. bool_aucune_element_de_selectionner:=false; l_element:=wformes1.tforme_dessin(un_Calque_actif.last_selection); if (l_element<>nil) and (l_element.ClassType=wformes2.tforme_groupe) then begin if wformes2.tforme_groupe(l_element).groupe.count=1 then liste_rectangle.Add(Tcommande.Create(6,44,200,48,' Un groupe de '+ inttostr(wformes2.tforme_groupe(l_element).groupe.count)+' élément est sélectionné ',unit_menu.id_editer_un_bitmap)) else liste_rectangle.Add(Tcommande.Create(6,44,200,48,' Un groupe '+ inttostr(wformes2.tforme_groupe(l_element).groupe.count)+' éléments est sélectionné ',unit_menu.id_editer_un_bitmap)) end else if (l_element<>nil) and (l_element.ClassType=wformebm.Tforme_TBitMap) then begin self.bool_forcer_l_affichage_des_couleur:=true; invalidaterect(self.hwindow,nil,false); liste_rectangle.Add(Tcommande.Create(6,44,200,48,' Éditeur de pixels ',unit_menu.id_editer_un_bitmap)); end else if (l_element<>nil) and (l_element.ClassType=wformes1.tforme_text) then begin //Un seul élément de texte strcopy(pc_commentaire,'Une ligne de texte est sélectionnée,'); liste_rectangle.Add(TRectControle.Create(10,2,200,32,strpas(pc_commentaire),'',0)); strcopy(pc_commentaire,'Sa typographie est '); {écrit par bertin} strcat(pc_commentaire,pchar(wformes1.tforme_text(l_element).af.nom)); strcat(pc_commentaire,pchar(' son corps est de '+inttostr(wformes1.tforme_text(l_element).af.raf.taille)+' points')); liste_rectangle.Add(TRectControle.Create(10,18,200,32,strpas(pc_commentaire),'',0)); resultat:=getsystemmetrics(SM_CXSCREEN); if resultat>=1680 then begin for i:=1 to 20 do for j:=1 to 3 do begin strcopy(pc_une_taille,pchar(floattostr((i+pred(j)*20)/10))); {Denis BERTIN} if strlen(pc_une_taille)=1 then strcat(pc_une_taille,',0'); liste_rectangle.Add(TSizeControle.Create( 340+i*32,3+pred(j)*20,340+i*32+20,3+pred(j)*20+20,pc_une_taille,'',0)); {denis Bertin} end; end else begin for i:=1 to 10 do for j:=1 to 3 do begin strcopy(pc_une_taille,pchar(floattostr(((i+pred(j)*10)/10)))); if strlen(pc_une_taille)=1 then strcat(pc_une_taille,',0'); liste_rectangle.Add(TSizeControle.Create( 340+i*32,3+pred(j)*20,340+i*32+20,3+pred(j)*20+20,pc_une_taille,'',0)); {denis Bertin} end; end; liste_rectangle.Add(Tcommande.Create(10,40,200,48,' Voulez-vous l''éditer... ',unit_menu.id_popup_edit_single_ligne)); liste_rectangle.Add(Tcommande.Create(160,40,200,48,' Voulez-vous l''éclater ',unit_menu.id_popup_eclater_un_texte_en_element_separer)); if (Getsystemmetrics(SM_CXSCREEN)>=1680) then begin liste_rectangle.Add(Tcommande.Create(1020,4,200,48,' Caractèristiques... ',unit_menu.id_menu_attributs_texte)); liste_rectangle.Add(Tcommande.Create(1020,24,200,48,' Ajouter un blob... ',unit_menu.id_effet_Ajouter_des_bubble_blog)); end else if (Getsystemmetrics(SM_CXSCREEN)>=1280) then begin liste_rectangle.Add(Tcommande.Create(720,4,200,48,' Caractèristiques... ',unit_menu.id_menu_attributs_texte)); liste_rectangle.Add(Tcommande.Create(720,24,200,48,' Ajouter un blob... ',unit_menu.id_effet_Ajouter_des_bubble_blog)); end else if (Getsystemmetrics(SM_CXSCREEN)>=1024) then begin liste_rectangle.Add(Tcommande.Create(700,4,200,48,' Typo... ',unit_menu.id_menu_attributs_texte)); liste_rectangle.Add(Tcommande.Create(700,24,200,48,' Blob... ',unit_menu.id_effet_Ajouter_des_bubble_blog)); end; end //Un seul élément de texte else if (l_element<>nil) and (l_element.ClassType=wformes1.tforme_dessin) then begin //un élément de dessin if l_element.is_un_disque then begin strcopy(pc_commentaire,'Un disque est sélectionnée,'); real_to_pchar_format(relation.log_pouce_to_10mm_real(l_element.epaisseur)/10,pc_stroke_ligne,3,1); strcat(pc_commentaire,pchar(' épaisseur = '+strpas(pc_stroke_ligne)+' mm')); liste_rectangle.Add(TRectControle.Create(10,2,200,32,strpas(pc_commentaire),'',0)); plot:=font_ob1.testnode(l_element.elements.at(1)); if plot<>nil then begin strcopy(pc_commentaire,'Son rayon est de '); rayon:=relation.log_pouce_to_10mm_real(utile.distance(0,0,plot.x,plot.y))/10; real_to_pchar_format(rayon,pc_stroke_ligne,3,2); strcat(pc_commentaire,pchar(strpas(pc_stroke_ligne)+' mm')); liste_rectangle.Add(TRectControle.Create(10,18,200,32,strpas(pc_commentaire),'',0)); strcopy(pc_commentaire,'Sa surface est de '); rayon:=round(rayon*10)/10; real_to_pchar_format(rayon*rayon*Pi,pc_stroke_ligne,3,4); strcat(pc_commentaire,pchar(strpas(pc_stroke_ligne)+' mm²')); liste_rectangle.Add(TRectControle.Create(10,34,200,32,strpas(pc_commentaire),'',0)); end; if (Getsystemmetrics(SM_CXSCREEN)>=1680) then begin liste_rectangle.Add(Tcommande.Create(1020,4,200,48,' Caractèristiques... ',unit_menu.id_menu_attributs_dessin)); liste_rectangle.Add(Tcommande.Create(1020,24,200,48,' Ajouter un blob... ',unit_menu.id_effet_Ajouter_des_bubble_blog)); if l_element.fermable then begin liste_rectangle.Add(Tcommande.Create(1180,4,300,48,' Voulez-vous la colorier ',unit_menu.id_popup_fermer)); end else if l_element.ouvrable then begin liste_rectangle.Add(Tcommande.Create(1180,4,200,48,' Voulez-vous l''ouvrir ',unit_menu.id_popup_Ouvrir)); end; end end else if l_element.is_avec_des_splines then begin strcopy(pc_commentaire,'Une Courbe de Bézier est sélectionnée,'); real_to_pchar_format(relation.log_pouce_to_10mm_real(l_element.epaisseur)/10,pc_stroke_ligne,3,1); strcat(pc_commentaire,pchar(' épaisseur = '+strpas(pc_stroke_ligne)+' mm')); liste_rectangle.Add(TRectControle.Create(10,2,200,32,strpas(pc_commentaire),'',0)); inttopchar(l_element.elements.count,pc_stroke_ligne); strcat(strcat(strcopy(pc_commentaire,'Elle est constituée de '),pc_stroke_ligne), ' points'); liste_rectangle.Add(TRectControle.Create(10,18,200,32,strpas(pc_commentaire),'',0)); if l_element.fermable and (l_element.elements.count>2) then begin liste_rectangle.Add(Tcommande.Create(10,36,200,48,' Voulez-vous la colorier ',unit_menu.id_popup_fermer)); end else if l_element.ouvrable then begin liste_rectangle.Add(Tcommande.Create(10,36,200,48,' Voulez-vous l''ouvrir ',unit_menu.id_popup_Ouvrir)); end; liste_rectangle.Add(Tcommande.Create(160,36,200,48,' Afficher les couleurs ',unit_menu.id_menu_afficher_les_couleur_du_centre_de_controle)); if getsystemmetrics(SM_CXSCREEN)>=1680 then begin liste_rectangle.Add(Tcommande.Create(1020,4,200,56,' Afficher une nébuleuse ',unit_menu.id_popup_create_nebuloide_bitmap)); liste_rectangle.Add(Tcommande.Create(1020,24,200,56,' Afficher une rubalize ',unit_menu.id_effet_spline_dessiner_un_rubalize)); end; end else if l_element.is_avec_des_ovales then begin strcopy(pc_commentaire,'Un ellipse est sélectionnée,'); real_to_pchar_format(relation.log_pouce_to_10mm_real(l_element.epaisseur)/10,pc_stroke_ligne,3,1); strcat(pc_commentaire,pchar(' épaisseur = '+strpas(pc_stroke_ligne)+' mm')); liste_rectangle.Add(TRectControle.Create(10,2,200,32,strpas(pc_commentaire),'',0)); if l_element.fermable then begin liste_rectangle.Add(Tcommande_bleu.Create(10,24,200,48,' Voulez-vous la colorier ',unit_menu.id_popup_fermer)); end else if l_element.ouvrable then begin liste_rectangle.Add(Tcommande_bleu.Create(10,24,200,48,' Voulez-vous l''ouvrir ',unit_menu.id_popup_Ouvrir)); end; liste_rectangle.Add(Tcommande_bleu.Create(150,24,200,48,' Afficher les couleurs ',unit_menu.id_menu_afficher_les_couleur_du_centre_de_controle)); if (Getsystemmetrics(SM_CXSCREEN)>=1680) then begin liste_rectangle.Add(Tcommande.Create(1020,4,200,48,' Caractèristiques... ',unit_menu.id_menu_attributs_dessin)); liste_rectangle.Add(Tcommande.Create(1020,24,200,48,' Ajouter un blob... ',unit_menu.id_effet_Ajouter_des_bubble_blog)); end else if (Getsystemmetrics(SM_CXSCREEN)>=1280) then begin liste_rectangle.Add(Tcommande.Create(720,4,200,48,' Caractèristiques... ',unit_menu.id_menu_attributs_dessin)); liste_rectangle.Add(Tcommande.Create(720,24,200,48,' Ajouter un blob... ',unit_menu.id_effet_Ajouter_des_bubble_blog)); end else if (Getsystemmetrics(SM_CXSCREEN)>=1024) then begin liste_rectangle.Add(Tcommande.Create(700,4,200,48,' Typo... ',unit_menu.id_menu_attributs_dessin)); liste_rectangle.Add(Tcommande.Create(700,24,200,48,' Blob... ',unit_menu.id_effet_Ajouter_des_bubble_blog)); end; end else if l_element.is_un_cercle then begin strcopy(pc_commentaire,'Un cercle est sélectionnée,'); real_to_pchar_format(relation.log_pouce_to_10mm_real(l_element.epaisseur)/10,pc_stroke_ligne,3,1); strcat(pc_commentaire,pchar(' épaisseur = '+strpas(pc_stroke_ligne)+' mm')); liste_rectangle.Add(TRectControle.Create(10,2,200,32,strpas(pc_commentaire),'',0)); plot:=font_ob1.testnode(l_element.elements.at(1)); if plot<>nil then begin strcopy(pc_commentaire,'Son rayon est de '); rayon:=relation.log_pouce_to_10mm_real(utile.distance(0,0,plot.x,plot.y))/10; real_to_pchar_format(rayon,pc_stroke_ligne,3,2); strcat(pc_commentaire,pchar(strpas(pc_stroke_ligne)+' mm')); liste_rectangle.Add(TRectControle.Create(10,18,200,32,strpas(pc_commentaire),'',0)); strcopy(pc_commentaire,'Sa surface est de '); rayon:=round(rayon*10)/10; real_to_pchar_format(rayon*rayon*Pi,pc_stroke_ligne,3,4); strcat(pc_commentaire,pchar(strpas(pc_stroke_ligne)+' mm²')); liste_rectangle.Add(TRectControle.Create(10,34,200,32,strpas(pc_commentaire),'',0)); end; if l_element.fermable then begin liste_rectangle.Add(Tcommande.Create(220,22,300,48,' Voulez-vous la colorier ',unit_menu.id_popup_fermer)); end; if true then begin liste_rectangle.Add(Tcommande.Create(230,43,300,72,' Convertir en Bézier ',unit_menu.id_popup_convertir_en_bezier)); end; if (Getsystemmetrics(SM_CXSCREEN)>=1680) then begin liste_rectangle.Add(Tcommande.Create(1004,4,1200,12,' Ajouter le rayon ',unit_menu.id_effets_cercle_ajouter_le_rayon)); liste_rectangle.Add(Tcommande.Create(1004,22,1200,20,' Ajouter des quartiers ',unit_menu.id_effets_cercle_ajouter_des_quartiers)); liste_rectangle.Add(Tcommande.Create(1004,22+18,1200,30,' Tracer une moire ',unit_menu.id_effets_cercle_ajouter_tracer_une_moire)); liste_rectangle.Add(Tcommande.Create(1140,4,1200,12,' Tracer les axes ',unit_menu.id_menu_boite_magique_tracer_les_axes_du_cercle)); liste_rectangle.Add(Tcommande.Create(1140,22,1200,12,' Tracé Bézier ',unit_menu.id_popup_convertir_en_bezier)); end else if (Getsystemmetrics(SM_CXSCREEN)>=1280) then begin liste_rectangle.Add(Tcommande.Create(700,4,1200,12,' Tracer les axes ',unit_menu.id_menu_boite_magique_tracer_les_axes_du_cercle)); liste_rectangle.Add(Tcommande.Create(700,22,1200,20,' Ajouter des quartiers ',unit_menu.id_effets_cercle_ajouter_des_quartiers)); liste_rectangle.Add(Tcommande.Create(700,22+18,1200,30,' Tracer une moire ',unit_menu.id_effets_cercle_ajouter_tracer_une_moire)); end else if (Getsystemmetrics(SM_CXSCREEN)>=1024) then begin liste_rectangle.Add(Tcommande.Create(700,4,1200,12,' Axes ',unit_menu.id_menu_boite_magique_tracer_les_axes_du_cercle)); liste_rectangle.Add(Tcommande.Create(700,22,1200,20,' Quartiers ',unit_menu.id_effets_cercle_ajouter_des_quartiers)); liste_rectangle.Add(Tcommande.Create(700,22+18,1200,30,' Moire ',unit_menu.id_effets_cercle_ajouter_tracer_une_moire)); end; end else if l_element.is_que_des_lignes then begin if (l_element.elements.count=2) then begin strcopy(pc_commentaire,'Une ligne est sélectionnée,'); real_to_pchar_format(relation.log_pouce_to_10mm_real(l_element.epaisseur)/10,pc_stroke_ligne,3,1); strcat(pc_commentaire,pchar(' épaisseur = '+strpas(pc_stroke_ligne)+' mm')); liste_rectangle.Add(TRectControle.Create(10,2,200,32,strpas(pc_commentaire),'',0)); strcopy(pc_commentaire,'Sa longueur est de '); plot:=font_ob1.testnode(l_element.elements.at(1)); une_dist:=relation.log_pouce_to_10mm(utile.distance(0,0,plot.x,plot.y)); //cette distanceest en twips real_to_pchar_format(une_dist/10,pc_stroke_ligne,3,4); strcat(pc_commentaire,pchar(strpas(pc_stroke_ligne)+' mm')); liste_rectangle.Add(TRectControle.Create(10,18,200,32,strpas(pc_commentaire),'',0)); un_angle:=utile.angle_degree(0,0,plot.x,plot.y); strcopy(pc_commentaire,'Cette ligne forme un angle de '); real_to_pchar_format(un_angle,pc_stroke_ligne,3,2); strcat(pc_commentaire,pchar(strpas(pc_stroke_ligne)+'°')); liste_rectangle.Add(TRectControle.Create(10,34,200,32,strpas(pc_commentaire),'',0)); if (Getsystemmetrics(SM_CXSCREEN)>1280) then begin liste_rectangle.Add(Tcommande.Create(1040,2,1200,16,' Ajouter des flèches ',unit_menu.id_menu_afficher_les_fleches)); liste_rectangle.Add(Tcommande.Create(1040,23,1200,16,' Inverser le sens ',unit_menu.id_effets_ligne_inverser_le_sens)); liste_rectangle.Add(Tcommande.Create(1040,44,1200,16,' Ajouter une cote ',unit_menu.id_menu_afficher_la_cotation)); liste_rectangle.Add(TBitmapControle.Create(1180,16,101,unit_menu.id_menu_afficher_la_grille_de_repere, z_open_file.string_afficher_la_palette,unit_menu.id_menu_option_la_grille_de_repere)); end else begin liste_rectangle.Add(Tcommande.Create(700,2,900,16,' Ajouter des flèches ',unit_menu.id_menu_afficher_les_fleches)); liste_rectangle.Add(Tcommande.Create(700,23,900,16,' Inverser le sens ',unit_menu.id_effets_ligne_inverser_le_sens)); liste_rectangle.Add(Tcommande.Create(700,44,900,16,' Ajouter une cote ',unit_menu.id_menu_afficher_la_cotation)); liste_rectangle.Add(TBitmapControle.Create(830,16,101,unit_menu.id_menu_afficher_la_grille_de_repere, z_open_file.string_afficher_la_palette,unit_menu.id_menu_option_la_grille_de_repere)); end; end else begin if l_element.is_fermer then strcopy(pc_commentaire,'Un polygone est sélectionnée,') else strcopy(pc_commentaire,'Une polyligne est sélectionnée,'); real_to_pchar_format(relation.log_pouce_to_10mm_real(l_element.epaisseur)/10,pc_stroke_ligne,3,1); strcat(pc_commentaire,pchar(' épaisseur = '+strpas(pc_stroke_ligne)+' mm')); liste_rectangle.Add(TRectControle.Create(10,2,200,32,strpas(pc_commentaire),'',0)); {---} if l_element.is_fermer then strcopy(pc_commentaire,'Ce polygone est constitué de ') else strcopy(pc_commentaire,'Cette suite est constituée de '); inttopchar(pred(l_element.elements.count),apc); strcat(strcat(pc_commentaire,apc),' segments.'); liste_rectangle.Add(TRectControle.Create(10,18,200,32,strpas(pc_commentaire),'',0)); if not l_element.is_fermer then liste_rectangle.Add(Tcommande.Create(10,40,200,48,' Voulez-vous colorier cette ensemble ',unit_menu.id_popup_fermer)); if (Getsystemmetrics(SM_CXSCREEN)>1280) then begin liste_rectangle.Add(TBitmapControle.Create(1180,16,101,unit_menu.id_menu_afficher_la_grille_de_repere, z_open_file.string_afficher_la_palette,unit_menu.id_menu_option_la_grille_de_repere)); end; end; end else if true then begin if l_element.is_fermer then strcopy(pc_commentaire,'Un polygone est sélectionnée,') else strcopy(pc_commentaire,'Une polyligne est sélectionnée,'); real_to_pchar_format(relation.log_pouce_to_10mm_real(l_element.epaisseur)/10,pc_stroke_ligne,3,1); strcat(pc_commentaire,pchar(' épaisseur = '+strpas(pc_stroke_ligne)+' mm')); liste_rectangle.Add(TRectControle.Create(10,2,200,32,strpas(pc_commentaire),'',0)); {---} if l_element.is_fermer then strcopy(pc_commentaire,'Ce polygone est constitué de ') else strcopy(pc_commentaire,'Cette suite est constituée de '); inttopchar(pred(l_element.elements.count),apc); strcat(strcat(pc_commentaire,apc),' segments.'); liste_rectangle.Add(TRectControle.Create(10,18,200,32,strpas(pc_commentaire),'',0)); if not l_element.is_fermer then liste_rectangle.Add(Tcommande.Create(10,40,200,48,' Voulez-vous colorier cette ensemble ',unit_menu.id_popup_fermer)); if (Getsystemmetrics(SM_CXSCREEN)>1280) then begin liste_rectangle.Add(TBitmapControle.Create(1180,16,101,unit_menu.id_menu_afficher_la_grille_de_repere, z_open_file.string_afficher_la_palette,unit_menu.id_menu_option_la_grille_de_repere)); end; end; resultat:=getsystemmetrics(SM_CXSCREEN); if resultat>=1680 then begin for i:=1 to 20 do for j:=1 to 3 do begin strcopy(pc_une_taille,pchar(floattostr((i+pred(j)*20)/10))); {Denis BERTIN} if strlen(pc_une_taille)=1 then strcat(pc_une_taille,',0'); liste_rectangle.Add(TSizeControle.Create( 340+i*32,3+pred(j)*20,340+i*32+20,3+pred(j)*20+20,pc_une_taille,'',0)); {denis Bertin} end; end else begin for i:=1 to 10 do for j:=1 to 3 do begin strcopy(pc_une_taille,pchar(floattostr(((i+pred(j)*10)/10)))); if strlen(pc_une_taille)=1 then strcat(pc_une_taille,',0'); liste_rectangle.Add(TSizeControle.Create( 340+i*32,3+pred(j)*20,340+i*32+20,3+pred(j)*20+20,pc_une_taille,'',0)); {denis Bertin} end; end; end; //un élément de dessin end; //Un seul élément est sélectionné. end; liste_rectangle.Add(TCloseControle.Create(arect.right-16,arect.top+2)); liste_rectangle.Add(TColorControle.Create(arect.right-16,arect.top+20)); liste_rectangle.Add(TRainbowControle.Create(arect.right-16,arect.top+36,arect.right-6,arect.top+46)); liste_rectangle.Add(THelpButtonControle.Create(arect.right-16,arect.top+50,arect.right-6,arect.top+60)); invalidaterect(self.hwindow,nil,false); end; {TWindowControle.actualiser} {------------------------------------------------------------------------------} constructor THelpButtonControle.Create(left,top,right,bottom:integer); begin inherited Create(left,top,right,bottom,'','',0); end; {THelpButtonControle.Create} procedure THelpButtonControle.paint(adc:hdc); var afont:hfont; begin wutil.Soft_interro(adc,self.son_Rectangle); end; function THelpButtonControle.clic(apoint:tpoint; right:boolean):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; haide.aide_context(haide.HELPID_Afficher_l_aide_du_panneau_de_controle); end; end; function THelpButtonControle.situer(apoint:tpoint):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; if wmain.Status_window<>nil then wmain.Status_window.Show_a_message_court(z_open_file.string_Afficher_l_aide); end; end; {------------------------------------------------------------------------------} constructor TRainbowControle.Create(left,top,right,bottom:integer); begin inherited Create(left,top,right,bottom,'','',0); end; {TRainbowControle.Create} procedure TRainbowControle.paint(adc:hdc); begin with self.son_Rectangle do wutil.Soft_circle(adc,(left+right) div 2,(top+bottom) div 2,5); end; function TRainbowControle.clic(apoint:tpoint; right:boolean):boolean; var arect:trect; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; wmain.Wincontrole.Show_les_controle:=true; if right then wmain.Wincontrole.Show_les_controle:=not wmain.Wincontrole.Show_les_controle; if wmain.Wincontrole.Show_les_controle then wmain.Wincontrole.Actualiser else begin wmain.Wincontrole.bool_forcer_l_affichage_des_couleur:=true; wmain.Wincontrole.bool_afficher_l_ecran_de_sauvegarde:=false; wmain.Wincontrole.liste_rectangle.freeall; getclientrect(wmain.Wincontrole.hwindow,arect); wmain.Wincontrole.liste_rectangle.Add(TCloseControle.Create(arect.right-16,arect.top+2)); wmain.Wincontrole.liste_rectangle.Add(TColorControle.Create(arect.right-16,arect.top+20)); wmain.Wincontrole.liste_rectangle.Add(TRainbowControle.Create(arect.right-16,arect.top+36,arect.right-6,arect.top+46)); end; invalidaterect(wmain.Wincontrole.hwindow,nil,true); {écrit par Bertin} end; end; function TRainbowControle.situer(apoint:tpoint):boolean; begin result:=false; if ptinrect(self.son_Rectangle,apoint) then begin result:=true; if wmain.Status_window<>nil then wmain.Status_window.Show_a_message_court(z_open_file.string_afficher_la_palette); end; end; {TRainbowControle.situer} procedure TWindowControle.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); var i:integer; arect:trect; memdc:hdc; abrush:hbrush; old_bitmap:hbitmap; un_controle:wcontrol.TRectControle; begin getclientrect(self.hwindow,arect); memdc:=createcompatibledc(paintdc); with arect do old_bitmap:=selectobject(memdc,createcompatiblebitmap(paintdc,right,bottom)); if bool_afficher_l_ecran_de_sauvegarde then begin abrush:=selectobject(memdc,CreatesolidBrush(g_base.rgb_bleu)); with arect do rectangle(memdc,pred(left),pred(top),succ(right),succ(bottom)); deleteobject(selectobject(memdc,abrush)); end else begin with arect do rectangle(memdc,pred(left),pred(top),succ(right),succ(bottom)); if self.bool_aucune_element_de_selectionner or self.bool_forcer_l_affichage_des_couleur then self.paint_palette_neochrome(memdc); end; if true then begin for i:=0 to pred(liste_rectangle.count) do begin un_controle:=wcontrol.TRectControle(liste_rectangle.at(i)); if un_controle<>nil then un_controle.paint(memdc); end; end; moveto(memdc,0,pred(arect.bottom)-1); lineto(memdc,succ(arect.Right),pred(arect.bottom)-1); with arect do bitblt(paintdc,0,0,right,bottom,memdc,0,0,SRCCOPY); {bertin} deleteobject(selectobject(memdc,old_bitmap)); deleteDC(memdc); end; procedure TWindowControle.WMLButtonDown(var Msg: TMessage); var i:integer; un_controle:wcontrol.TRectControle; point_souris:tpoint; arect:trect; une_couleur:tcolorref; begin if (wmain.MainWindow<>nil) and (wmain.MainWindow.Aide) then begin wmain.MainWindow.is_aide_context(HELPID_Afficher_l_aide_du_panneau_de_controle); exit; end; point_souris.x:=Smallint(loword(msg.lparam)); point_souris.y:=Smallint(hiword(msg.lparam)); for i:=0 to pred(liste_rectangle.count) do begin un_controle:=wcontrol.TRectControle(liste_rectangle.at(i)); if un_controle<>nil then if un_controle.clic(point_souris,False) then exit; end; if self.bool_aucune_element_de_selectionner or self.bool_forcer_l_affichage_des_couleur then begin getclientrect(self.hwindow,arect); une_couleur:=hls_rvb.Get_HLS_RGB((360*point_souris.x) div pred(arect.right),1*point_souris.y/pred(arect.bottom),1); u_object.brush1_actif.lbcolor:=une_couleur; sendmessage(wmain.MainWindow.hwindow,wmenuK.wm_set_couleur,ord(u_object.TQA_fond),une_couleur); if (wmain.MainWindow<>nil) and (wmain.MainWindow.window_bitmap<>nil) then invalidaterect(wmain.MainWindow.window_bitmap.hwindow,nil,false); end; end; procedure TWindowControle.WMRButtonDown(var Msg: TMessage); var i:integer; une_couleur:tcolorref; arect:trect; point_souris:tpoint; un_controle:wcontrol.TRectControle; begin if (wmain.MainWindow<>nil) and (wmain.MainWindow.Aide) then begin wmain.MainWindow.is_aide_context(haide.HELPID_Afficher_l_aide_du_panneau_de_controle); exit; end; point_souris.x:=Smallint(loword(msg.lparam)); point_souris.y:=Smallint(hiword(msg.lparam)); for i:=0 to pred(liste_rectangle.count) do begin un_controle:=wcontrol.TRectControle(liste_rectangle.at(i)); if un_controle<>nil then if un_controle.clic(point_souris,true) then exit; end; if self.bool_aucune_element_de_selectionner or self.bool_forcer_l_affichage_des_couleur then begin getclientrect(self.hwindow,arect); une_couleur:=hls_rvb.Get_HLS_RGB((360*point_souris.x) div pred(arect.right),point_souris.y/pred(arect.bottom),1); u_object.pen1_actif.lopncolor:=une_couleur; Sendmessage(MainWindow.hwindow,wmenuK.wm_set_couleur,ord(u_object.TQA_encre),une_couleur); if (wmain.MainWindow<>nil) and (wmain.MainWindow.window_bitmap<>nil) then invalidaterect(wmain.MainWindow.window_bitmap.hwindow,nil,false); end; end; procedure TWindowControle.WMMouseMove(var Msg: TMessage); var i:integer; apc:pc100; une_couleur:tcolorref; arect:trect; point_souris:tpoint; un_controle:wcontrol.TRectControle; begin if (wmain.MainWindow<>nil) and (wmain.MainWindow.Aide) then begin setcursor(haide.G_Cursor.HelpCursor); exit; end; point_souris.x:=Smallint(loword(msg.lparam)); point_souris.y:=Smallint(hiword(msg.lparam)); for i:=0 to pred(liste_rectangle.count) do begin un_controle:=wcontrol.TRectControle(liste_rectangle.at(i)); if un_controle<>nil then if un_controle.situer(point_souris) then exit; end; getclientrect(self.hwindow,arect); une_couleur:=hls_rvb.Get_HLS_RGB((360*point_souris.x) div pred(arect.right),point_souris.y/pred(arect.bottom),1); if wmain.Status_window<>nil then begin wmain.Status_window.local_TcolorRef_to_text_html(une_couleur,apc,True); invalidaterect(wmain.Status_window.hwindow,nil,false); updatewindow(wmain.Status_window.hwindow); end; end; {TWindowControle.WMMouseMove} procedure TWindowControle.WMCommand(var Msg: TMessage); var un_Tedit_filename:wcontrol.Tedit_filename; ReveiveControle:wcontrol.TReveiveControle; pc_name_of_complet_path:pc1024; lb_continuer_la_sauvegarde:boolean; Pc_absolute_private_window_name:pc1024; Edit_filename:wcontrol.Tedit_filename; begin inherited WMCommand(Msg); case msg.wparam of id_menu_imprimer: begin postmessage(wmain.MainWindow.hwindow,wm_command,unit_menu.id_menu_imprimer,0); end; id_menu_ouvrir: begin TOpenAfile.Create(self); end; {id_menu_ouvrir} id_menu_file_save_as: begin //Si cette condition est présente le fichier à déjà été enregistré mais si lParam=1 alors demander aussi le nom du fichier. if (Msg.lParam<>1) and (u_object.global_afficher_le_source_code and (strpos(pchar(u_object.global_nom_string_du_code_source),wproche.kpc_Maintain_ato)=nil)) then begin Postmessage(wmain.MainWindow.hwindow,wm_command,unit_menu.id_menu_file_save,0); exit; end; liste_rectangle.freeall; liste_rectangle.add(Tedit_filename.Create(80,20,580,54)); {Le contrôle d'édition} liste_rectangle.add(TRectControle.Create(8,2,200,16,'Donner un nom à ce document:','',0)); liste_rectangle.add(wcontrol.TReveiveControle.Create(610,16,105,id_valider_la_saisie,'Valider la saisie!')); liste_rectangle.add(wcontrol.TReveiveControle.Create(666,16,106,id_invalider_la_saisie,'Annuler l''enregistrement')); ReveiveControle:=wcontrol.TReveiveControle(self.liste_rectangle.at(2)); ReveiveControle.visible:=false; self.bool_afficher_l_ecran_de_sauvegarde:=true; invalidaterect(self.hwindow,nil,false); setfocus(self.hwindow); end; {id_menu_file_save_as} id_valider_la_saisie: begin un_Tedit_filename:=wcontrol.Tedit_filename(self.liste_rectangle.at(0)); //box(self.hwindow,pchar(un_Tedit_filename.filename)); Self.Get_Name_of_path(pc_name_of_complet_path); edit_filename:=wcontrol.Tedit_filename(self.liste_rectangle.at(0)); strcat(strcat(strcat(pc_name_of_complet_path,'\'),pchar(edit_filename.filename)),wmenuk.point_ato); lb_continuer_la_sauvegarde:=true; //Si le fichier existe déjà confirmer le remplacement. if wutil.file_existe(pc_name_of_complet_path) then begin if k_erreur.MessageBox_printf(self.hwindow, k_erreur.Err_File_exist,Mb_iconQUestion or mb_yesno,pc_name_of_complet_path)=id_Yes then begin lb_continuer_la_sauvegarde:=true; end else begin lb_continuer_la_sauvegarde:=False; end; end; if lb_continuer_la_sauvegarde then begin u_object.global_afficher_le_source_code:=true; u_object.global_nom_string_du_code_source:=strpas(pc_name_of_complet_path); wmain.MainWindow.Sauvegarder_en_ATO(u_object.global_nom_string_du_code_source); fillchar(Pc_absolute_private_window_name,pred(sizeof(Pc_absolute_private_window_name)),#0); Strcat(Strcat(Strcopy(Pc_absolute_private_window_name,k_DenisDraw),wutil.kpc_space),pchar(u_object.global_nom_string_du_code_source)); SetwindowText(wmain.Cadre_window.hwindow,Pc_absolute_private_window_name); wmain.MainWindow.Save_ce_nom_de_fichier_dans_project(pchar(u_object.global_nom_string_du_code_source)); Wmain.Cadre_window.Ajouter_le_menu; end; self.bool_afficher_l_ecran_de_sauvegarde:=false; self.Actualiser; end; id_invalider_la_saisie: postmessage(self.hwindow,WM_KeyDown,VK_ESCAPE,0); end; {case msg.wparam} end; {TWindowControle.WMCommand} procedure TWindowControle.paint_palette_neochrome(PaintDC:Hdc); var i,j:integer; arect:trect; begin getclientrect(self.hwindow,arect); for i:=0 to pred(arect.right) do for j:=0 to pred(arect.bottom) do begin setpixel(paintdc,i,j,hls_rvb.Get_HLS_RGB((360*i) div pred(arect.right),1*j/pred(arect.bottom),1)); end; end; procedure TWindowControle.WMCHAR(var msg:TMessage); var un_Tedit_filename:wcontrol.Tedit_filename; begin if self.bool_afficher_l_ecran_de_sauvegarde then begin un_Tedit_filename:=wcontrol.Tedit_filename(self.liste_rectangle.at(0)); if length(un_Tedit_filename.filename)<40 then begin case msg.wparam of 32..255:un_Tedit_filename.filename:=un_Tedit_filename.filename+chr(msg.wparam); else bip; end {case} end else bip; invalidaterect(self.hwindow,nil,false); end; end; procedure TWindowControle.WMKeyDown(var msg:TMessage); var i:integer; un_Tedit_filename:wcontrol.Tedit_filename; un_nom_de_fichier:string; begin if self.bool_afficher_l_ecran_de_sauvegarde then begin un_Tedit_filename:=wcontrol.Tedit_filename(self.liste_rectangle.at(0)); case msg.wparam of VK_ESCAPE: begin self.bool_afficher_l_ecran_de_sauvegarde:=false; self.Actualiser; end; VK_BACK: begin un_nom_de_fichier:=''; for i:=1 to pred(length(un_Tedit_filename.filename)) do un_nom_de_fichier:=un_nom_de_fichier+un_Tedit_filename.filename[i]; un_Tedit_filename.filename:=un_nom_de_fichier; end; VK_RETURN: postmessage(self.hwindow,wm_command,id_valider_la_saisie,0); end; {case} invalidaterect(self.hwindow,nil,false); end; end; {TWindowControle.WMKeyDown} procedure TWindowControle.WMTimer(var msg:TMessage); var ReveiveControle:wcontrol.TReveiveControle; edit_filename:wcontrol.Tedit_filename; begin if self.bool_afficher_l_ecran_de_sauvegarde then begin ReveiveControle:=wcontrol.TReveiveControle(self.liste_rectangle.at(2)); Edit_filename:=wcontrol.Tedit_filename(self.liste_rectangle.at(0)); Edit_filename.timer; if length(Edit_filename.filename)<>0 then begin if not ReveiveControle.visible then invalidaterect(self.hwindow,nil,false); ReveiveControle.visible:=true end else begin if ReveiveControle.visible then invalidaterect(self.hwindow,nil,false); ReveiveControle.visible:=False; end; end; end; {TWindowControle.WMTimer} procedure TWindowControle.WMVSCROLL(var Msg: TMessage); begin end; {TWindowControle.WMVSCROLL} {De ce fait chaque utilisateur inscrt dans la base de registre frait en sorte} procedure TWindowControle.Get_Name_of_path(pc_name_of_complet_path:pchar); var an_openwith_key:hkey; registre:Registry.TRegistry; nom_de_l_utilisateur,coquille:string; return_string:classes.tstrings; begin strcopy(pc_name_of_complet_path,'c:\users\'); registre:=TRegistry.Create; Registre.RootKey:=HKEY_LOCAL_MACHINE; if registre.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion',false) then begin nom_de_l_utilisateur:=Registre.ReadString('RegisteredOwner'); Strcat(pc_name_of_complet_path,pchar(nom_de_l_utilisateur)); Strcat(pc_name_of_complet_path,'\DenisDraw'); Wutil.Verif_et_creer_repertoire(pc_name_of_complet_path); {$ifdef debug} box(0,pc_name_of_complet_path); {$endif debug} end; Registre.CloseKey; Registre.Free; end; {TWindowControle.Get_Name_of_file} procedure TWindowControle.Open_A_File_name(Filename:pchar); var s_chemin_complet_plus_nom_de_fichier:string; pc_ce_chemin:pc1024; begin self.Get_Name_of_path(pc_ce_chemin); s_chemin_complet_plus_nom_de_fichier:=strpas(pc_ce_chemin)+wutil.PC_Anti_slash+strpas(Filename)+wmenuk.point_ato; if wmain.MainWindow<>nil then wmain.MainWindow.Lecture_du_fichier(s_chemin_complet_plus_nom_de_fichier); end; end. //Ecrit par denis bertin ce jour de l'an de grâce 2013 february the 13.