Bouton image complète

Bonjour,

Je cherche un composant "bouton" qui soit une image en fond (plusieurs états possibles), un gyph et texte comme le TBitBtn. Un peu comme les boutons dans Windev (pour ceux qui connaissent).

Hélas je ne trouve pas, et ne sais pas trop comment faire.

Partir de quoi ? Quoi modifier ?

Si quelqu'un a développé ce genre de composants, peut-il me donner des pistes d'avancement ? Je ne suis pas très pointu dans la création de composants. :aie:

Merci d'avance

JS

Bonjour,

Si Parhelie passe par ici, il pourrait te donner le code source du composant qu'il avait développé avec nous à l'époque car je ne sais pas si j'ai gardé les sources... de mémoire, il était bien avancé car j'avais spécifié (Faire un truc à la Windev dans les spéc) :P

Cordialement,

Chris

Bonjour,

Je crois que Lazarus gère nativement les 5 états d'un bouton maintenant un peu comme Windev. Comparé à ce dernier, c'est moins souple parce que il ne gère pas une image fond et une image superposée dessus mais une seule image... Donc quand on allonge le dessin du bouton, le fond s'allonge normalement mais comme il faut incruster l'icône sur le dessin du fond (Imprimante, +, corbeille...), elle se déforme aussi. Ensuite, il est impossible de débrancher -enfin je n'y suis pas arrivé- l'apparition de l'encadré automatique quand on survole le bouton.

J'utilse actuellement mes vieux boutons perso lazarus 0.28. A ce moment les 5 états n'existaient pas... où je ne les ai pas vu. J'ai commencé 2 approches : une avec un Timage et une avec un TPanel... Si j'arrive à débrancher le cadre automatique, la seconde est quasiment prête. Pour l'instant, je suis sur Windev en test et je n'ai pas trop le temps de le finir mais le test se termine la semaine prochaine et d'ici 15 jours je peux terminer le composant. Reste quand même aussi la gestion du TAB.

Cordialement. Gilles


@Chris, Bonjour, tu refais un petit tour par Lazarus ?

Merci à vous 2 pour vos réponses, même si elles ne solutionnent pas (encore) mon problème. :mrgreen:

@selzig, tu pars de TPanel ou de TCustomPanel quand tu dérives ton composant ?

JS

Du second, sinon vous ne pouvez pas enlever les propriétés "published" inutiles.
Cordialement. Gilles

OK, Merci
JS

Bonjour,
comme il est fait référence à Windev, je suppose que l'on travaille en Windows (7 ?). J'ai commencé à réaliser un composant dans ce genre là à partir de boutons 5 états Windev. Il est suffisamment fonctionnel pour moi mais bon il n'a aucune autre prétention. La première étape était celle de l'image ci-jointe. On utilise un TPanel qui se met à la taille de l'image1 (de fond). Ensuite on ajoute dans le Tpanel une deuxième image et un Tlabel. Avec les ancres, il est facile de gérer l'ensemble. Pour info, voici le lfm correspondant.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52

object Form1: TForm1 Left = 324 Height = 306 Top = 288 Width = 968 Caption = 'Form1' ClientHeight = 306 ClientWidth = 968 OnCreate = FormCreate OnShow = FormShow LCLVersion = '1.1' object Panel1: TPanel Left = 383 Height = 20 Top = 111 Width = 84 Anchors = [] AutoSize = True BevelOuter = bvNone Caption = 'Panel1' ClientHeight = 20 ClientWidth = 84 TabOrder = 0 object Image1: TImage AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Panel1 [...] AutoSize = True Picture.Data = {BBBBBBBBBBBBBBBBBB7B7AFAF.... } end object Image2: TImage AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrCenter [...] AutoSize = True BorderSpacing.Left = 4 OnClick = Image2Click Picture.Data = {0954474946496D616765...} Transparent = True end object Label1: TLabel AnchorSideLeft.Control = Panel1 AnchorSideLeft.Side = asrCenter AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrCenter [...] Caption = 'Label1' ParentColor = False end end end

---

revoir le Centrage du TLabel;

Evidemment tous les ancrages doivent être retraduits dans le composant. Le TPanel gère le TabOrder. Le TSpeedButton est encore plus facile à imiter puisque l'image2 est centrée dans image1.

Petit problème quand même, soit on part de la taille de l'image1 ou alors on gère le stretching de l'image1. Autrement dit soit le Tpanel s'adapte à la taille de l'image1 et donc c'est l'image1 qui donne la taille du Tpanel (c'est le cas des encrages ici) ou c'est l'image1 qui s'allonge à la taille désirée du Tpanel et dans ce cas là l'étape 2 est un peu plus compliquée.

La deuxième étape est de découper les images en 5 (Tpanel1.Width := Image1.width div 5) puis de gérer les actions (survol de la souris, MouseDown, MouseUp et éventuellement le focus)... Là sans faire un composant, c'est beaucoup plus difficile à gérer... Enfin je n'ai pas essayé à partir de cette étape... Par contre en étape 2 avant de commencer le composant, j'ai coupé les images... puis étape 3, traité les évènements dans un composant hérité de TCustomPanel.

Pour l'étape 2 :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106

TForm1 = class(TForm) Button1: TButton; imSrc: TImage; imPart1: TImage; imPart2: TImage; imPart3: TImage; imPart4: TImage; imPart5: TImage; OpenPictureDialog1: TOpenPictureDialog; procedure Button1Click(Sender: TObject); procedure imSepare(Sender: TObject); private { private declarations } public { public declarations } end;   var Form1: TForm1;   implementation [...]   procedure TForm1.Couper(Sender: TObject); var imSrcBmp, imDstBmp : TBitmap; aRectDstTmp, aRectSrcA, aRectSrcB, aRectSrcC, aRectSrcD, aRectSrcE : TRect; iNewWidth, iNewHeight : Integer; begin imSrc.Picture.LoadFromFile(OpenPictureDialog1.FileName); iNewWidth := imSrc.Picture.Width div 5; // 5 images à l'arrivée iNewHeight := imSrc.Picture.Height; // Hauteur constante aRectDstTmp := Rect(0, 0, iNewWidth, iNewHeight); aRectSrcA := Rect(0, 0, iNewWidth, iNewHeight); aRectSrcB := Rect(iNewWidth, 0, 2*iNewWidth, iNewHeight); aRectSrcC := Rect(2*iNewWidth, 0, 3*iNewWidth, iNewHeight); aRectSrcD := Rect(3*iNewWidth, 0, 4*iNewWidth, iNewHeight); aRectSrcE := Rect(4*iNewWidth, 0, 5*iNewWidth, iNewHeight);   try //Création de imSrcBmp imSrcBmp := TBitmap.Create; with imSrcBmp do begin Width := iNewWidth; // détermination de la taille de imSrcBmp Height := iNewHeight; Assign(imSrc.Picture.Graphic); end;   //Création de imDstBmp imDstBmp := TBitmap.Create; with imDstBmp do begin Width := iNewWidth; Height := iNewHeight; end;   //Création des 5 images with imPart1 do begin Width :=iNewWidth; // Pour visualiser à l'écran, inutile dans le composant Height :=iNewHeight; imDstBmp.Canvas.CopyRect(aRectDstTmp,imSrcBmp.Canvas,aRectSrcA); Picture.Assign(imDstBmp); end; with imPart2 do begin Width :=iNewWidth; // Idem Height :=iNewHeight; imDstBmp.Canvas.CopyRect(aRectDstTmp,imSrcBmp.Canvas,aRectSrcB); Picture.Assign(imDstBmp); end; with imPart3 do begin Width :=iNewWidth; // Idem Height :=iNewHeight; imDstBmp.Canvas.CopyRect(aRectDstTmp,imSrcBmp.Canvas,aRectSrcC); Picture.Assign(imDstBmp); end; with imPart4 do begin Width :=iNewWidth; // Idem Height :=iNewHeight; imDstBmp.Canvas.CopyRect(aRectDstTmp,imSrcBmp.Canvas,aRectSrcD); Picture.Assign(imDstBmp); end; with imPart5 do begin Width :=iNewWidth; // Idem Height :=iNewHeight; imDstBmp.Canvas.CopyRect(aRectDstTmp,imSrcBmp.Canvas,aRectSrcE); Picture.Assign(imDstBmp); end;   finally imSrcBmp.Free; imDstBmp.Free; end; end;   procedure TForm1.Button1Click(Sender: TObject); begin imSrc.Picture := nil; imPart1.Picture := nil; imPart2.Picture := nil; imPart3.Picture := nil; imPart4.Picture := nil; imPart5.Picture := nil; if OpenPictureDialog1.Execute then begin imSrc.Picture.LoadFromFile(openpicturedialog1.Filename); imSepare(Sender); end; end;

---

Ce code adapté d'une page Internet dont je ne connais plus l'adresse est seulement un début parce que cette procédure de découpe de l'image en 5 parties ne conserve pas la transparence... Pour l'image de fond, cela ne pose pas de problème... mais pour l'autre image, celle superposée, il est nécessaire de régler le problème.

Je te laisse le plaisir de le faire. Je n'ai pas testé sur un autre OS que Windows7. Il faudrait voir comment sont gérés les problèmes de transparence. Il faut que l'image2 puisse être transparente.

Maintenant, pour la surcharge des évènements, je peux éventuellement te donner des pistes si tu en as besoin et le veux... Dans ce cas, peut-être par message privé ?

A+

Merci pour ces pistes.

J'aurais effectivement surement besoin d'aide pour les évènements, pour la transparence de la 2nde image, ça devrait aller.

Je vais commencer par voir tout ça. Je ne voudrais pas faire une usine à gaz, mais je ne me suis jamais lancé dans la création de composants, alors, j'ai plein de doute...

Merci,

et à très bientôt surement... ;)

JS

Edit : Une question subsidiaire... Pour créer un nouveau composant, quel est la meilleure (la plus simple) technique ? Créer une unité, et déclarer le type composant, ou faire "Creer un nouveau composant" du menu paquet de Lazarus ?

Bonjour,
les 2 sont envisageables pour dériver un TCustomPanel.

Mais pour faire un composant (notamment créer son .lpk), la méthode la plus simple est en effet
Paquet -> Nouveau Paquet -> myButtons [nom] -> Valider
Puis toujours dans la fenêtre du composant Ajouter -> Nouveau composant

• Type d'ancêtre : TPanel *
• Nouveau nom de class : TmyBitBtn
• Page de Palette myComponent
• Nom du fichier de l'unité : xxxx\mybitbtn.pas
• Nom d'unité : myBitBtn
• Image... Voir ci-après

-> Create New Component

*Je n'ai pas vu apparaître dans la liste des ancêtres proposés le TCustomPanel. J'ai choisi un TPanel puis modifier la ligne 11 de l'unit myBitBtn en TmyBitBtn = class(TCustomPanel).
Si tu mets une image, son nom sera obligatoirement : TmyBitBtn.png ou autre extension (au format 24 x 24) Elle sera transformée en myBitBtn_icon.lrs. Fais le avant de créer ton composant sinon il faudra la transformer et modifier le code de ton lpk "à la main".

Voila...

Citation:

---

Envoyé par Jon Shannow

Je ne voudrais pas faire une usine à gaz

---

Cela en est toujours une plus ou moins... mais c'est à mettre en rapport avec la puissance du concept et ce qu'il permet de faire...

PS : Ta gestion de la transparence pourrait m'intéresser. J'ai un code fonctionnel mais pas exportable sur un autre OS (avec usage de LCLintf). Donc je suppose que ma méthode est mauvaise.

Salut ,

j'ai gardé une copie des composants cités par Chris37 , je pense qu'il s'agit de lzvgraphicbutton.pas dont il parle

je peux envoyer l'ensemble complet si besoin (MP) , j'y avais mis mon grain de sel à l'époque et travaillé un peu sur les transparences

Bonjour,

Extrait de lzvgraphicbutton.pas :

Code:

---

1 2 3 4

LZVBase; type TLZVGraphicButton = class(TLZCustomControl) [...]

---

Les fonctions de transparence que tu évoques sont elles intégrées à LZVBase ? Ici, je n'en discerne pas dans le code fourni. Eventuellement, elles pourraient être intégrées dans la TLZCustomControl.Paint qui serait alors une surcharge de la méthode du même nom de TCustomControl. Il faut vraiment que je revois ce problème. Je suis complètement à la ramasse.

Je ne vois pas non plus comment sont gérés soit l'AutoSize soit le Resize. Mais bon, je n'ai pas l'habitude de partir "directement" d'un TCustomControl...

Enfin, on trouve

Code:

---

1 2 3 4 5 6

[protected] Glyphs: array[0..4] of TBitmap;   published property Glyph: TBitmap Read GlyphImg Write SetGlyph;

---

et la procedure BuildImage. Je suppose donc qu'il ne gère pas la superposition d'une Image (Corbeille, ...) sur une image de fond, comme le fait Windev. J'avais commencé comme cela... Mais j'ai trouvé cela ingérable. Si on fait un stretch sur l'image de fond, alors l'image du dessus (qui dans ce cas est intégrée à l'image de fond puisque c'est la même image) se déforme de la même façon perdant ses proportions. Or souvent on adapte la taille du bouton à son Caption donc à son width sans toucher à son height. Et donc, par exemple, une corbeille (delete) 16* 16 devient 25*16 par "élongation" de l'unique image... Cela manque d'esthétique, c'est le moins qu'on puisse dire.

Si tu veux bien fournir la partie manquante du code qua conçu l'équipe dans laquelle tu étais, cela m'intéresse d'une part pour l'utilisation de TCustomControl comme ancêtre et d'autre part pour la gestion des transparences.

Merci.
A+

La transparence n'avait rien à voir , si tu veux les paquets , je pense que la meilleure solution serait de les envoyer via MP

Merci SergioMaster,

Je regarde ces sources, quoi que je fasse au final, avoir le plus de pistes est toujours profitable.

JS

Du a des limitations de taille (+ de 2M en 7z) je propose que les personnes intéressées me MP leurs adresses mail pour leur faire parvenir les versions que je peux avoir sur mon poste .
je ne suis pas sur a 100% d'avoir les dernières sources (même SVN) disons que mon expérience LAZARUS s'est plus ou moins arrêtée en Décembre 2009

OK pour moi, SergioMaster. Je prends contact par MP pour te transmettre mon adresse mail.
Parallèlement, j'ai retravaillé sur mon composant. Je suis en train de regarder quelles différences imposait le choix d'un TCustomControl comme ancêtre à la place d'un TCustomPanel, ce dernier dérivant directement du premier. Donc ton code sera le bienvenu.

Merci.

@SergioMaster, je t'ai "MP" mon adresse mail.

Merci d'avance.

A nous tous, on va ré-écrire un WindevLazarus... :mouarf:

JS

Bonjour à toutes et tous,

Voilà, j'ai essayé de développer un bouton comme je le souhaite, mais, j'ai de gros soucis.

Voilà le code du bouton en question

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770

unit uImagesBouton;   {$mode objfpc}{$H+}   interface   uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LMessages;   type TEtatsBouton = (ebNormal, ebEnfonce, ebGrise, ebFocus, ebSurvol); TGlyphAlign = ( gaAGauche, gaEnHaut, gaADroite, gaEnBas); TImageTransparence = ( itAucune, itPixelHautGauche, itMagenta, itCustom);   { TImagesBouton }   TImagesBouton = class(TCustomControl) private // Fcaption : String; { Private declarations } fImgFond : TBitMap; aImages : Array[ TEtatsBouton] Of TBitMap; aGlyphs : Array[ TEtatsBouton] Of TBitmap; fImgGlyph : TBitMap; fNbImages : Byte; fNbGlyphs : Byte; fEnabled : Boolean; fImgTransparence, fGlyphTransparence : TImageTransparence; fImgColorTransparence : TColor; fGlyphColorTransparence : TColor; fGlyphAlign : TGlyphAlign; fEspacement : Integer;   Procedure SetImgFond( Image : TBitMap); Procedure SetImgGlyph( Image : TBitMap); Procedure SetCaption( Valeur : String); Procedure SetNbImages( Valeur : Byte); Procedure SetNbGlyphs( Valeur : Byte); Procedure SetEnabled( Valeur : Boolean); Procedure SetGlyphAlign( Valeur : TGlyphAlign); Procedure SetEspacement( Valeur : Integer); Procedure SetImgTransparence( Valeur : TImageTransparence); Procedure SetGlyphTransparence( Valeur : TImageTransparence); Procedure SetImgColorTransparence( Valeur : TColor); Procedure SetGlyphColorTransparence( Valeur : TColor);   protected { Protected declarations } boEnfonceEnSortie : Boolean; nGW, nGH : Integer; ColorTransImg, ColorTransGlyph : TColor; boImgFaites : Boolean; boGlyphFaites : Boolean; veb_Etat : TEtatsBouton; Procedure M_CreerImages; Procedure M_CreerGlyphs; Procedure M_ImageGrise( aSrcImg, aDstimg : TBitMap; lGereTransparance : Boolean; cTransparent : TColor); Procedure M_Prepare( aDstImg, aSrcImg : TBitMap; vSrcRect : TRect; pitTransparence : TImageTransparence; pcColorTransparence : TColor); Function M_GetTransColor( boImage : Boolean = True) : TColor;   public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Paint; override; procedure click; override; procedure KeyPress(var Key: char); override; procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: longint); override; procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: longint); override; procedure MouseEnter(); override; procedure MouseLeave(); override; procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;   published { Published declarations } Property Caption;// : String read fCaption write SetCaption; Property Fond : TBitMap read fImgFond write SetImgFond; Property Glyph : TBitMap read fImgGlyph write SetImgGlyph; Property Enabled : Boolean read fEnabled write SetEnabled default True; Property NbImages : Byte read fNbImages write SetNbImages default 1; Property NbGlyphs : Byte read fNbGlyphs write SetNbGlyphs default 1; Property GlyphAlign : TGlyphAlign read fGlyphAlign write SetGlyphAlign default gaAGauche; Property Espacement : Integer Read fEspacement write SetEspacement default 3; Property TransparenceImage : TImageTransparence read fImgTransparence write SetImgTransparence Default itAucune; Property TransparenceGlyph : TImageTransparence read fGlyphTransparence write SetGlyphTransparence default itPixelHautGauche; Property ColorTransparenceImage : TColor read fImgColorTransparence write SetImgColorTransparence default clFuchsia; Property ColorTransparenceGlyph : TColor read fGlyphColorTransparence write SetGlyphColorTransparence default clFuchsia;   property Action; property TabOrder; property TabStop; property Visible; property Anchors; property BorderSpacing; property Constraints; property Font; property OnClick; property OnEnter; property OnExit; property OnKeyDown; property OnKeyUp; property OnMouseMove; property ParentFont; property ParentShowHint; property ShowHint; // property Height; // Property Width; end;   procedure Register;   implementation   Uses LCLType, IntfGraphics, fpImage;   procedure Register; begin {$I uimagesbouton_icon.lrs} RegisterComponents('MesCompos',[TImagesBouton]); end;   { TImagesBouton }   Procedure Timagesbouton.Setimgfond( Image : Tbitmap) ; Begin fImgFond.Assign( Image); boImgFaites := False; Paint; End;   Procedure Timagesbouton.Setimgglyph( Image : Tbitmap) ; Begin fImgGlyph.Assign( Image); boGlyphFaites := False; Paint; End;   Procedure Timagesbouton.Setcaption( Valeur : String) ; Begin   End;   Procedure Timagesbouton.Setnbimages( Valeur : Byte) ; Begin If Valeur <> fNbImages Then Begin fNbImages := Valeur; boImgFaites := False; Paint; End; End;   Procedure Timagesbouton.Setnbglyphs( Valeur : Byte) ; Begin If Valeur <> fNbGlyphs Then Begin fNbGlyphs := Valeur; boGlyphFaites := False; Paint; End; End;   Procedure Timagesbouton.Setenabled( Valeur : Boolean) ; Begin If Valeur <> fEnabled Then Begin fEnabled := Valeur; Paint; End; End;   Procedure Timagesbouton.Setglyphalign( Valeur : Tglyphalign) ; Begin If Valeur <> fGlyphAlign Then Begin fGlyphAlign := Valeur; Paint; End; End;   Procedure Timagesbouton.Setespacement( Valeur : Integer) ; Begin If Valeur <> fEspacement Then Begin fEspacement := Valeur; Paint; End; End;   procedure TImagesBouton.SetImgTransparence( Valeur : TImageTransparence) ; begin If Valeur <> fImgTransparence Then Begin fImgTransparence:= Valeur; ColorTransImg := M_GetTransColor; boImgFaites:=False; Paint; end; end;   procedure TImagesBouton.SetGlyphTransparence( Valeur : TImageTransparence) ; begin If Valeur <> fGlyphTransparence Then Begin fGlyphTransparence:=Valeur; ColorTransGlyph := M_GetTransColor( False); boGlyphFaites:=False; Paint; end; end;   procedure TImagesBouton.SetImgColorTransparence( Valeur : TColor) ; begin If Valeur <> fImgColorTransparence Then Begin fImgColorTransparence:=Valeur; ColorTransImg := fImgColorTransparence; boImgFaites:=False; Paint; end; end;   procedure TImagesBouton.SetGlyphColorTransparence( Valeur : TColor) ; begin If Valeur <> fGlyphColorTransparence Then Begin fGlyphColorTransparence:=Valeur; ColorTransGlyph := fGlyphColorTransparence; boGlyphFaites:=False; Paint; end; end;   Procedure Timagesbouton.M_Creerimages; Var j : Integer; i : TEtatsBouton;   nH, nW : Integer;   vRect : TRect; vBmpTmp : TBitMap;   Begin For i := ebNormal to ebSurvol Do aImages[ i].Clear;   If fImgFond.Height > 0 Then //Si l'image de fond n'est pas définie, on dessine un rectangle Begin nH := fImgFond.Height; Case fNbImages Of 1 : Begin //Une seule image fournit, on créer l'image grisée, les autres sont toutes identiques. nW := fImgFond.Width; vRect := Rect( 0, 0, nW-1, nH-1); vBmpTmp := TBitmap.Create; M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebNormal].Assign(vBmpTmp); aImages[ ebEnfonce].Assign( vBmpTmp); aImages[ ebFocus].Assign( vBmpTmp); aImages[ ebSurvol].Assign(vBmpTmp); vBmpTmp.Free; M_ImageGrise( fImgFond, aImages[ ebGrise], fImgTransparence <> itAucune, M_GetTransColor); End; 2 : Begin //Deux images. La seconde doit représenter l'image grisée nW := fImgFond.Width div 2; vRect := Rect( 0, 0, nW-1, nH-1); vBmpTmp := TBitmap.Create; M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebNormal].Assign(vBmpTmp); aImages[ ebEnfonce].Assign( vBmpTmp); aImages[ ebFocus].Assign( vBmpTmp); aImages[ ebSurvol].Assign(vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW, 0, nW + nW -1, nH - 1); M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); vBmpTmp.Free; End; 3 : Begin //Trois images sont fournies. Normal, Enfonce et Grise. Les 2 etats suivant sont mis à Normal nw := fImgFond.Width div 3; vRect := Rect( 0, 0, nW-1, nH-1); vBmpTmp := TBitmap.Create; M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebNormal].Assign(vBmpTmp); aImages[ ebFocus].Assign( vBmpTmp); aImages[ ebSurvol].Assign( vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW, 0, nW + nW -1, nH-1); M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebEnfonce].Assign(vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW * 2, 0, nW * 3 - 1, nH-1); M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); vBmpTmp.Free; End; 4 : Begin //Quatre images sont fournies : Normal, Enfonce, Grise et Survol. Focus est mis à Normal nW := fImgFond.Width div 4; vRect := Rect( 0, 0, nW-1, nH-1); vBmpTmp := TBitmap.Create; M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebNormal].Assign(vBmpTmp); aImages[ ebFocus].Assign( vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW, 0, nW * 2 - 1, nH-1); M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebEnfonce].Assign( vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW * 2, 0, nW*3 - 1, nH-1); M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebGrise].Assign( vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW * 3, 0, nW*4-1,nH-1); M_Prepare(vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebSurvol].Assign( vBmpTmp); vBmpTmp.Free; End; 5 : Begin //L'Image de fond est composée d'une image par état. nW := fImgFond.Width div 5; vBmpTmp := TBitMap.Create; For i := ebNormal to ebSurvol Do Begin j := Ord( i); vRect := Rect( nW * j, 0, ( nW * (j+1))-1, nH-1); M_Prepare(vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ i].Assign(vBmpTmp); vBmpTmp.Clear; End; vBmpTmp.Free; End; End; End Else Begin nH := Height; nW := Width; For i := ebNormal to ebSurvol do With aImages[i] Do Begin Height := nH; Width := nW; If i <> ebGrise Then canvas.Brush.color := clbtnface Else Canvas.Brush.Color := clBtnShadow; Canvas.RoundRect(0, 0, Width - 1, Height - 1, Width div 4, Height div 4); End; End;   End;   Procedure Timagesbouton.M_creerglyphs; Var vBmpTmp : TBitMap; i : TEtatsBouton; vRect : TRect;   Begin If fImgGlyph.Height > 0 Then Begin //Si la "glyph" est définie, alors on "Colle" la glyph à l'endroit prevu. nGH := fImgGlyph.Height; For i := ebNormal To ebSurvol do Begin Case fNbGlyphs Of 1 : Begin //La glyph ne contient qu'un image ngW := fImgGlyph.Width; vBmpTmp := TBitMap.Create; If i <> ebGrise Then M_Prepare( vBmpTmp, fImgGlyph, Rect( 0, 0, nGW-1, nGH-1), fGlyphTransparence, fGlyphColorTransparence) Else M_ImageGrise( fImgGlyph, vBmpTmp, fGlyphTransparence <> itAucune, M_GetTransColor(False)); aGlyphs[ i].Assign( vBmpTmp); vBmpTmp.free; end; 2 : Begin //La glyph contient 2 images. Normal et Grisé. nGW := fImgGlyph.Width div 2; vBmpTmp := TBitmap.Create; If i = ebGrise Then vRect := Rect( nGW, 0, nGW * 2 -1, nGH -1) else vRect := Rect( 0, 0, nGW-1, nGH-1); M_Prepare( vBmpTmp, fImgGlyph, vRect, fGlyphTransparence, fGlyphColorTransparence); aGlyphs[ i].Assign( vBmpTmp); vBmpTmp.Free; End; 3 : Begin //La glyph contient 3 états : Normal, Enfonce et grise. nGW := fImgGlyph.Width Div 3; vBmpTmp := TBitmap.Create; Case i Of ebNormal, ebFocus, ebSurvol : vRect := Rect( 0, 0, nGW-1, nGH-1); ebEnfonce : vRect := Rect( nGW, 0, nGW * 2 - 1, nGH - 1); ebGrise : vRect := Rect( nGW * 2, 0, nGW * 3 - 1, nGH - 1); End; M_Prepare( vBmpTmp, fImgGlyph, vRect, fGlyphTransparence, fGlyphColorTransparence); aGlyphs[ i].assign( vBmpTmp); vBmpTmp.Free; End; 4 : Begin //La glyph contien 4 états : Normal, Enfonce, Grise et Survol. Focus est mis à Normal nGW := fImgGlyph.Width Div 4; vBmpTmp := TBitmap.Create; Case i Of ebNormal, ebFocus : vRect := Rect( 0, 0, nGW-1, nGH-1); ebEnfonce : vRect := Rect( nGW, 0, nGW * 2 - 1, nGH - 1); ebGrise : vRect := Rect( nGW * 2, 0, nGW * 3 - 1, nGH - 1); ebSurvol : vRect := Rect( nGW * 3, 0, nGW * 4 - 1, nGH - 1); End; M_Prepare( vBmpTmp, fImgGlyph, vRect, fGlyphTransparence, fGlyphColorTransparence); aGlyphs[ i].Assign( vBmpTmp); vBmpTmp.Free; End; 5 : Begin //La glyph contient une image par Etat nGW := fImgGlyph.Width Div 5; vBmpTmp := TBitmap.Create; Case i Of ebNormal : vRect := Rect( 0, 0, nGW-1, nGH-1); ebEnfonce : vRect := Rect( nGW, 0, nGW * 2 - 1, nGH - 1); ebGrise : vRect := Rect( nGW * 2, 0, nGW * 3 - 1, nGH - 1); ebFocus : vRect := Rect( nGW * 3, 0, nGW * 4 - 1, nGH - 1); ebSurvol : vRect := Rect( nGW * 4, 0, nGW * 5 - 1, nGH - 1); End; M_Prepare( vBmpTmp, fImgGlyph, vRect, fGlyphTransparence, fGlyphColorTransparence); aGlyphs[ i].Assign( vBmpTmp); vBmpTmp.Free; End; End; End; End;   End;     Procedure Timagesbouton.M_Imagegrise( Asrcimg, Adstimg : Tbitmap; lGereTransparance : Boolean; cTransparent : TColor) ; Var lii_Src : TLazIntfImage; px, py, nGris : Integer; clGrise : TColor; nlTrans : Longint; nRouge, nVert, nBleu : Byte; vCouleur : TFPColor; imgHandle, imgMaskHandle : HBitmap; oTrans, oTemp : TBitMap; cFPTrans : TFPColor;   Begin If lGereTransparance Then cFPTrans := TColorToFPColor( cTransparent); lii_Src := TLazIntfImage.Create( 0, 0); lii_Src.LoadFromBitmap( ASrcimg.Handle, aSrcimg.MaskHandle); for py := 0 To lii_Src.Height-1 Do Begin For px := 0 To lii_Src.Width-1 Do Begin vCouleur := lii_Src.Colors[ px, py]; If Not lGereTransparance Or (vCouleur <> cFPTrans) Then Begin nGris := Round( vCouleur.red * 0.3 + vCouleur.green * 0.59 + vCouleur.blue * 0.11); vCouleur.red := nGris; vCouleur.green := nGris; vCouleur.blue := nGris; End; lii_Src.Colors[ px, py] := vCouleur; End; End; oTemp := TBitmap.Create; lii_Src.CreateBitmaps( imgHandle, imgMaskHandle, False); oTemp.Handle := imgHandle; oTemp.MaskHandle := imgMaskHandle; If lGereTransparance Then Begin oTemp.Transparent := True; oTemp.TransparentColor := cTransparent; End; If Not Assigned( aDstimg) Then aDstimg := TBitmap.Create; aDstimg.Width := Asrcimg.Width; Adstimg.Height := Asrcimg.Height; { If chx_Transparence.Checked Then   Begin   nlTrans := ColorToRGB( btn_Transparence.ButtonColor);   nRouge := Round( nlTrans *0.3);   nVert := Round( ( nlTrans shr 8) * 0.59);   nBleu := Round( ( nlTrans shr 16) * 0.11);   clGrise := RGBToColor( nRouge, nVert, nBleu); // oTrans := TBitMap.Create;   P_Transparence(oTemp, Dstimage, clGrise); // Dstimage.Canvas.StretchDraw( Rect( 0, 0, Dstimage.Width, Dstimage.Height), oTrans); // oTrans.Free;   End   Else Begin} aDstimg.Canvas.Draw( 0, 0, oTemp); { End;} oTemp.Free; lii_Src.Free; End;   Procedure Timagesbouton.M_prepare( Adstimg, Asrcimg : Tbitmap; Vsrcrect : Trect; pitTransparence : TImageTransparence; pcColorTransparence : TColor) ; Var nH, nW : Integer; lii_Temp : TLazIntfImage;   Begin lii_temp := TLazIntfImage.Create( 0, 0); lii_Temp.LoadFromBitmap( aSrcimg.Handle, aSrcimg.MaskHandle); nH := Vsrcrect.Bottom - Vsrcrect.Top + 1; nW := Vsrcrect.Right - Vsrcrect.Left + 1; Adstimg.PixelFormat := pf24bit; Adstimg.Height := nH; Adstimg.Width := nW; If pitTransparence <> itAucune Then Begin Adstimg.Transparent := True; Case pitTransparence Of itPixelHautGauche : Adstimg.TransparentColor := FPColorToTColor( lii_Temp.Colors[ 0, 0]); itMagenta : Adstimg.TransparentColor := clFuchsia; itCustom : Adstimg.TransparentColor := pcColorTransparence; End;   End Else Begin Adstimg.Transparent := False; End; Adstimg.Canvas.CopyRect( Rect( 0, 0, nW-1, nH-1), Asrcimg.Canvas, Vsrcrect); lii_Temp.Free; End;   Function Timagesbouton.M_gettranscolor( Boimage : Boolean) : Tcolor; Var lii_Temp : TLazIntfImage;   Begin If Boimage Then Begin Case fImgTransparence Of itAucune : Result := clBlack; itPixelHautGauche : Begin lii_temp := TLazIntfImage.Create( 0, 0); lii_Temp.LoadFromBitmap( fImgFond.Handle, fImgFond.MaskHandle); Result := FPColorToTColor( lii_Temp.Colors[0,0]); lii_Temp.Free; End; itMagenta : Result :=clFuchsia; itCustom : Result := fImgColorTransparence; End; End Else Begin Case fGlyphTransparence Of itAucune : Result := clBlack; itPixelHautGauche : Begin lii_temp := TLazIntfImage.Create( 0, 0); lii_Temp.LoadFromBitmap( fImgGlyph.Handle, fImgGlyph.MaskHandle); Result := FPColorToTColor( lii_Temp.Colors[0,0]); lii_Temp.Free; End; itMagenta : Result := clFuchsia; itCustom : Result := fGlyphColorTransparence; End; End; End;   Constructor Timagesbouton.Create( Aowner : Tcomponent) ; Var i : TEtatsBouton;   Begin Inherited Create( Aowner) ; ControlStyle := ControlStyle + [csSetCaption]; Width := 34; Height := 18; tabstop := True; Visible := True; FEnabled := True; fImgFond := TBitMap.Create; fImgGlyph := TBitMap.Create; For i := ebNormal To ebSurvol Do Begin aImages[ i] := TBitMap.Create; aGlyphs[ i] := TBitMap.Create; End; boImgFaites := False; boGlyphFaites := False; boEnfonceEnSortie := False; veb_Etat := ebNormal; End;   Destructor Timagesbouton.Destroy; Var i : TEtatsBouton;   Begin fImgFond.Free; fImgGlyph.Free; For i := ebNormal To ebSurvol Do Begin aImages[ i].free; aGlyphs[ i].Free; End; Inherited Destroy; End;   Procedure Timagesbouton.Paint; Var veb_Index : TEtatsBouton; nGX, nGY, nTX, nTY, nTW, nTH : Integer;   Begin // Inherited Paint; If Not boImgFaites Then M_CreerImages; If Not boGlyphFaites Then M_CreerGlyphs;   If Not Enabled then veb_Index := ebGrise Else veb_Index := veb_Etat;   Canvas.Draw( 0, 0, aImages[ veb_Index]); If fImgGlyph.Height > 0 Then Begin //Si une Glyph est présente, alors on la déssine Case fGlyphAlign Of gaAGauche : Begin nGY := ( Height - nGH) Div 2; nGX := fEspacement; End; gaADroite : Begin nGY := ( Height - nGH) Div 2; nGX := Width - ( nGW + fEspacement); End; gaEnHaut : Begin nGY := fEspacement; nGX := ( Width - nGW) Div 2; End; gaEnBas : Begin nGY := Height - ( nGH + fEspacement); nGX := ( Width - nGW) Div 2; End; End; Canvas.CopyRect( Rect( nGX, nGY, nGX+nGW-1, nGY+nGH-1), aGlyphs[ veb_Index].Canvas, Rect( 0, 0, nGW-1, nGH-1)); End;   //Si un texte est précisé, on l'écrit If Trim( Caption) <> '' Then Begin Canvas.Font := Font; nTH := Canvas.TextHeight( Caption); nTW := Canvas.TextWidth( Caption); If fImgGlyph.Height > 0 Then Begin //Il y a une Glyph de déssiner case fGlyphAlign Of gaAGauche : Begin //Alors le texte est à Droite nTY := ( Height - nTH) Div 2; nTX := Width - ( nTW + fEspacement); End; gaADroite : Begin //Alors le texte est à gauche nTY := ( Height - nTH) Div 2; nTX := fEspacement; End; gaEnHaut : Begin //Alors le texte est en bas nTY := Height - ( nTH + fEspacement); nTX := ( Width - nTW) Div 2; End; gaEnBas : Begin //Alors le texte en Haut nTY := fEspacement; nTX := ( Width - nTW) Div 2; End; End; End Else Begin //Pas de glyph alors le Texte est centré dans l'image principal nTX := ( Width - nTW) Div 2; nTY := ( Height - nTH) Div 2; End; Canvas.TextRect( Rect( 0, 0, Width, Height), nTX, nTY, Caption); End; End;   Procedure Timagesbouton.Click; Begin If Enabled Then Inherited Click; End;   Procedure Timagesbouton.Keypress( Var Key : Char) ; Begin If Enabled And (Key = #13) Then Click; Inherited Keypress( Key) ; End;   Procedure Timagesbouton.Mousedown( Button : Tmousebutton; Shift : Tshiftstate; X, Y : Longint) ; Begin If Button = mbLeft Then Begin veb_Etat := ebEnfonce; Paint; End; Inherited Mousedown( Button, Shift, X, Y) ; End;   Procedure Timagesbouton.Mouseup( Button : Tmousebutton; Shift : Tshiftstate; X, Y : Longint) ; Begin If ( Button = mbLeft) Then Begin veb_Etat := ebFocus; Paint; End; Inherited Mouseup( Button, Shift, X, Y) ; End;   Procedure Timagesbouton.Mouseenter; Begin If boEnfonceEnSortie Then Begin veb_Etat := ebEnfonce; boEnfonceEnSortie := False; Paint; End Else Begin veb_Etat := ebSurvol; Paint; End; Inherited Mouseenter; End;   Procedure Timagesbouton.Mouseleave; Begin If veb_Etat = ebEnfonce Then boEnfonceEnSortie := True; If Focused Then veb_Etat := ebFocus Else veb_Etat := ebNormal; Paint; Inherited Mouseleave; End;   Procedure Timagesbouton.Wmsetfocus( Var Message : Tlmsetfocus) ; Begin veb_Etat := ebFocus; Paint; End;   Procedure Timagesbouton.Wmkillfocus( Var Message : Tlmkillfocus) ; Begin veb_Etat := ebNormal; paint; End;   end.

---

Bon, ce n'est surement pas le plus beau des codes, mais ce n'est pas mon problème. Le problème c'est que ça ne marche pas :cry:

En conception (car j'ai mis le compo dans un paquet), si je précise un fond (1 etat) et une glyph (1 Etat), j'ai la glyph qui est agrandie à la taille du bouton et qui masque le fond.

A l'execution, j'ai carrément rien à part le "caption". En débuguant, j'ai finalement trouvé que c'est parce fNbImages et fNbGlyphs sont à 0 ! Alors qu'en conception, je les ai bien mis à 1.

Autre problème, les valeurs "default" des propriétés ne semblent pas être prises en compte ? Pourquoi ?

Bref, je ne comprends rien.
J'ai déjà réaliser des composants sous Delphi 5 et je n'ai jamais rencontré ce genre de problème.

Si quelqu'un peut m'éclairer sur les erreurs que j'ai commises, merci d'avance

JS

Bon, j'ai quasiment terminé.
Il ne me reste qu'un soucis sur le Caption (Cf ici) et ça devrait marcher.

Je copierais le source une fois terminé.

Ah ! Si j'ai un petit soucis. L'image du composant dans la palette. J'ai bien créé le fichier ressource, mais Lazarus n'en veut pas dans la palette, il met un icone par défaut. :? C'est un détail, mais bon.

A+
JS

Bon, je vous livre mon travail, fortement inspiré du source que SergioMaster (encore merci à toi).

Ce n'est surement pas parfait, mais ça semble vouloir fonctionner comme prévu, donc, la phase utilisation/debugging va réellement commencer pour moi.

Si vous avez le temps, l'envie, etc... vous pouvez l'utiliser et me renvoyer vos impressions, remarques et corrections.

JS

PS : Et si quelqu'un sait comment solutionner le problème de l'icone de la palette... :?

Voici la dernière mouture du composant.
Merci à ApproxDev...

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320

unit uImagesBouton;   {$mode objfpc}{$H+}   interface   uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LMessages;   type TEtatsBouton = (ebNormal, ebEnfonce, ebGrise, ebFocus, ebSurvol); TGlyphAlign = ( gaAGauche, gaEnHaut, gaADroite, gaEnBas); TTexteAlign = ( taGauche, taCentre, taDroite); TImageTransparence = ( itAucune, itPixelHautGauche, itMagenta, itCustom); TStyleImage = ( siEtirer, siRepeter);   { TMode9Images }   TMode9Images = Class( TPersistent) Private FControl : TControl; fActif : Boolean; fMHaute, fMGauche, fMBasse, fMDroite : Integer; fCentre, fTraitGauche, fTraitHaut, fTraitDroit, fTraitBas : TStyleImage; fOnChange : TNotifyEvent;   Procedure SetActif( Valeur : Boolean); Procedure SetMHaute( Valeur : Integer); Procedure SetMGauche( Valeur : Integer); Procedure SetMBasse( Valeur : Integer); Procedure SetMDroite( Valeur : Integer); Procedure SetCentre( Valeur : TStyleImage); Procedure SetTraitGauche( Valeur : TStyleImage); Procedure SetTraitHaut( Valeur : TStyleImage); Procedure SetTraitDroit( Valeur : TStyleImage); Procedure SetTraitBas( Valeur : TStyleImage);   Protected Procedure Change; Virtual;   Public Constructor Create( AControl : TControl); virtual; Procedure AssignTo( Dest : TPersistent); override;   Procedure CreerImageMode9( ASrcImage, ADstImage : TBitMap; AWidth, AHeight : Integer);   Published property OnChange : TNotifyEvent read FOnChange Write FOnChange; Property Actif : Boolean read fActif Write SetActif default False; Property MargeHaute : Integer read fMHaute Write SetMHaute default 10; Property MargeGauche : Integer read fMGauche Write SetMGauche default 10; Property MargeBasse : Integer read fMBasse Write SetMBasse default 10; Property MargeDroite : Integer read fMDroite write SetMDroite default 10; Property StyleCentre : TStyleImage read fCentre Write SetCentre default siEtirer; Property StyleGauche : TStyleImage read fTraitGauche write SetTraitGauche default siEtirer; Property StyleHaut : TStyleImage read fTraitHaut write SetTraitHaut default siEtirer; Property StyleBas : TStyleImage read fTraitBas write SetTraitBas default siEtirer; Property StyleDroit : TStyleImage read fTraitDroit write SetTraitDroit default siEtirer; End;   { TImagesBouton }   TImagesBouton = class(TCustomControl) private fTailleAuto : Boolean; fImgFond : TBitMap; aImages : Array[ TEtatsBouton] Of TBitMap; aGlyphs : Array[ TEtatsBouton] Of TBitmap; fFontSurvol : TFont; fImgGlyph : TBitMap; fNbImages : Byte; fNbGlyphs : Byte; fEnabled : Boolean; fImgTransparence, fGlyphTransparence : TImageTransparence; fImgColorTransparence : TColor; fGlyphColorTransparence : TColor; fGlyphAlign : TGlyphAlign; fEspacement : Integer; fMarge : Integer; fTexteAlign : TTexteAlign; fMode9Images : TMode9Images;   Procedure GlyphChanged( Sender : TObject); Procedure FondChanged( Sender : TObject); Procedure SetImgFond( Image : TBitMap); Procedure SetImgGlyph( Image : TBitMap); Procedure SetNbImages( Valeur : Byte); Procedure SetNbGlyphs( Valeur : Byte); Procedure SetEnabled( Valeur : Boolean); Procedure SetGlyphAlign( Valeur : TGlyphAlign); Procedure SetEspacement( Valeur : Integer); Procedure SetMarge( Valeur : Integer); Procedure SetImgTransparence( Valeur : TImageTransparence); Procedure SetGlyphTransparence( Valeur : TImageTransparence); Procedure SetImgColorTransparence( Valeur : TColor); Procedure SetGlyphColorTransparence( Valeur : TColor); Procedure SetTailleAuto( Valeur : Boolean); Procedure SetFontSurvol( Valeur : TFont); Procedure SetTexteAlign( Valeur : TTexteAlign) ; Procedure Mode9ImagesChanged( Sender : TObject); Procedure SetMode9Images( Valeur : TMode9Images);   protected { Protected declarations } boForcePaint, boEnfonceEnSortie : Boolean; nGW, nGH : Integer; ColorTransImg, ColorTransGlyph : TColor; boImgFaites : Boolean; boGlyphFaites : Boolean; veb_Index : TEtatsBouton; veb_Etat : TEtatsBouton; Procedure M_CreerImages; Procedure M_CreerGlyphs; Procedure M_ImageGrise( aSrcImg, aDstimg : TBitMap; lGereTransparance : Boolean; cTransparent : TColor); Procedure M_Prepare( aDstImg, aSrcImg : TBitMap; vSrcRect : TRect; pitTransparence : TImageTransparence; pcColorTransparence : TColor); Function M_GetTransColor( boImage : Boolean = True) : TColor; Procedure CMTextChanged( var Message: TLMessage); message CM_TEXTCHANGED;   public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Paint; override; procedure click; override; procedure KeyPress(var Key: char); override; procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: longint); override; procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: longint); override; procedure MouseEnter(); override; procedure MouseLeave(); override; procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;   published { Published declarations } Property TexteAlign : TTexteAlign read FTexteAlign Write SetTexteAlign default taCentre; Property TailleAuto : Boolean Read fTailleAuto Write SetTailleAuto default False; Property Fond : TBitMap read fImgFond write SetImgFond; Property Glyph : TBitMap read fImgGlyph write SetImgGlyph; Property Enabled : Boolean read fEnabled write SetEnabled default True; Property NbImages : Byte read fNbImages write SetNbImages default 1; Property NbGlyphs : Byte read fNbGlyphs write SetNbGlyphs default 1; Property GlyphAlign : TGlyphAlign read fGlyphAlign write SetGlyphAlign default gaAGauche; Property Espacement : Integer Read fEspacement write SetEspacement default 3; Property FondTransparent : TImageTransparence read fImgTransparence write SetImgTransparence Default itAucune; Property GlyphTransparent : TImageTransparence read fGlyphTransparence write SetGlyphTransparence default itPixelHautGauche; Property TransCouleurFond : TColor read fImgColorTransparence write SetImgColorTransparence default clFuchsia; Property TransCouleurGlyph : TColor read fGlyphColorTransparence write SetGlyphColorTransparence default clFuchsia; Property Marge : Integer Read fMarge Write SetMarge default 3; Property FontEnSurvol : TFont read fFontSurvol write SetFontSurvol; Property Mode9Images : TMode9Images read fMode9Images write SetMode9Images;   property Action; Property Caption; property TabOrder; property TabStop; property Visible; property Anchors; property BorderSpacing; property Constraints; property Font; property OnClick; property OnEnter; property OnExit; property OnKeyDown; property OnKeyUp; property OnMouseMove; property ParentFont; property ParentShowHint; property ShowHint; end;   procedure Register;   implementation   Uses LCLType, IntfGraphics, fpImage, math;   procedure Register; begin RegisterComponents('MesCompos',[TImagesBouton]); end;   { TMode9Images }   Procedure Tmode9images.Setactif( Valeur : Boolean) ; Begin If Valeur <> fActif Then Begin fActif := Valeur; Change; End; End;   Procedure Tmode9images.Setmhaute( Valeur : Integer) ; Begin If Valeur <> fMHaute Then Begin fMHaute := Valeur; Change; End; End;   Procedure Tmode9images.Setmgauche( Valeur : Integer) ; Begin If Valeur <> fMGauche Then Begin fMGauche := Valeur; Change; End; End;   Procedure Tmode9images.Setmbasse( Valeur : Integer) ; Begin If Valeur <> fMBasse Then Begin fMBasse := Valeur; Change; End; End;   Procedure Tmode9images.Setmdroite( Valeur : Integer) ; Begin If Valeur <> fMDroite Then Begin fMDroite := Valeur; Change; End; End;   Procedure Tmode9images.Setcentre( Valeur : Tstyleimage) ; Begin If Valeur <> fCentre Then Begin fCentre := Valeur; Change; End; End;   Procedure Tmode9images.Settraitgauche( Valeur : Tstyleimage) ; Begin If Valeur <> fTraitGauche Then Begin fTraitGauche := Valeur; Change; End; End;   Procedure Tmode9images.Settraithaut( Valeur : Tstyleimage) ; Begin If Valeur <> fTraitHaut Then Begin fTraitHaut := Valeur; Change; End; End;   Procedure Tmode9images.Settraitdroit( Valeur : Tstyleimage) ; Begin If Valeur <> fTraitDroit then Begin fTraitDroit := Valeur; Change; End; End;   Procedure Tmode9images.Settraitbas( Valeur : Tstyleimage) ; Begin If Valeur <> fTraitBas Then Begin fTraitBas := Valeur; Change; End; End;   Procedure Tmode9images.Change; Begin FControl.Invalidate; If Assigned( fOnChange) Then fOnChange(Self); End;   Constructor Tmode9images.Create( AControl : TControl); Begin Inherited Create; FControl := AControl;   fActif := False; fMGauche := 10; fMHaute := 10; fMDroite := 10; fMBasse := 10; fCentre := siEtirer; fTraitGauche := siEtirer; fTraitHaut := siEtirer; fTraitDroit := siEtirer; fTraitBas := siEtirer; End;   Procedure Tmode9images.Assignto( Dest : Tpersistent) ; Begin If Dest is TMode9Images Then Begin With TMode9Images(Dest) Do Begin fActif := self.fActif; fMGauche := self.fMGauche; fMHaute := Self.fMHaute; fMDroite := self.fMDroite; fMBasse := Self.fMBasse; fCentre := self.fCentre; fTraitGauche := self.fTraitGauche; fTraitHaut := self.fTraitHaut; fTraitDroit := self.fTraitDroit; fTraitBas := self.fTraitBas; Change; End; End Else Inherited Assignto( Dest) ; End;   Procedure Tmode9images.Creerimagemode9( Asrcimage, Adstimage : Tbitmap; Awidth, Aheight : Integer); Var vBmpTemp : TBitMap;   //Sources cRect : TRect; //Etirer ou Répeter en Hauteur et en Largeur ghRect, dhRect, dbRect, gbRect : TRect; //Copier tels quels mhRect, mBRect : TRect; //Etirer ou Répéter en Largeur mgRect, mdRect : TRect; //Etirer ou Répéter en Hauteur mW, mH : Integer; //Largeur et Hauteur du centre   //Destination dRect : TRect; //Pour dessiner sur la destination   X, Y : Integer;   Begin Try vBmpTemp := TBitmap.Create; vBmpTemp.PixelFormat := pf24bit; vBmpTemp.Width := Awidth; vBmpTemp.Height := Aheight; vBmpTemp.Transparent := Asrcimage.Transparent; vBmpTemp.TransparentColor := Asrcimage.TransparentColor;   //On définit les Rectangles d'origine ghRect := Rect( 0, 0, fMGauche, fMHaute); //Coin Haut-Gauche dhRect := Rect( Asrcimage.Width - fMDroite, 0, Asrcimage.Width, fMHaute); //Coin Haut-Droit dbRect := Rect( Asrcimage.Width - fMDroite, Asrcimage.Height - fMBasse, Asrcimage.Width, Asrcimage.Height); //Coin Bas-Droit gbRect := Rect( 0, Asrcimage.Height - fMBasse, fMGauche, Asrcimage.Height);   //On définit les Milieux mhRect := Rect( fMGauche, 0, Asrcimage.Width - fMDroite, fMHaute); //Mileu Haut mdRect := Rect( Asrcimage.Width - fMDroite, fMHaute, Asrcimage.Width, Asrcimage.Height - fMBasse); //Milieu Droit mbRect := Rect( fMGauche, Asrcimage.Height - fMBasse, Asrcimage.Width - fMDroite, Asrcimage.Height); //Mileu Bas mgRect := Rect( 0, fMHaute, fMGauche, Asrcimage.Height - fMBasse);   //On définit le rectangle du milieu cRect := Rect( fMGauche, fMHaute, Asrcimage.Width - fMDroite, Asrcimage.Height - fMBasse);   //On calcul la Largeur et la Hauteur du centre mW := Asrcimage.Width - fMGauche - fMDroite; mH := Asrcimage.Height - fMHaute - fMBasse;   //Une fois les rectangles d'origines calculés, on peut dessiner l'image finale.   //On commence par le coin Haut-Gauche dRect := ghRect; vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, ghRect); //Le coin Haut gauche est similaire   //On dessine le Mileu Haut If fTraitHaut = siEtirer Then //Etirement Begin dRect := Rect( fMGauche, 0, Awidth - fMDroite, fMHaute); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, mhRect); End Else Begin //Répétition X := fMGauche; While X <= ( Awidth - fMDroite) do Begin dRect := Rect( X, 0, Min( X + mW, AWidth - fMDroite), fMHaute); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, mhRect); X := X + mW; End; End;   //On Dessine le Milieu Gauche If fTraitGauche = siEtirer Then Begin dRect := Rect( 0, fMHaute, fMGauche, Aheight - fMBasse); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, mgRect); End Else Begin Y := fMHaute; While Y <= ( Aheight - fMBasse) Do Begin dRect := Rect( 0, Y, fMGauche, Min( Y + mH, Aheight - fMBasse)); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, mgRect); Y := Y + mH; End; End;   //On dessine le centre If fCentre = siEtirer Then Begin dRect := Rect( fMGauche, fMHaute, Awidth - fMDroite, Aheight - fMBasse); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, cRect); End Else Begin Y := fMHaute; While Y <= ( Aheight - fMBasse) Do Begin X := fMGauche; While X <= ( Awidth - fMDroite) Do Begin dRect := Rect( X, Y, Min( X + mW, Awidth - fMDroite), Min( Y + mH, Aheight - fMBasse)); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, cRect); X := X + mW; End; Y := Y + mH; End; End;   //On dessine le coin Gauche-Bas dRect := Rect( 0, Aheight - fMBasse, fMGauche, Aheight); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, gbRect);   //On dessine le coin Droit-Haut dRect := Rect( Awidth - fMDroite, 0, Awidth, fMHaute); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, dhRect);   //On dessine le milieu bas If fTraitBas = siEtirer Then Begin dRect := Rect( fMGauche, Aheight - fMBasse, Awidth - fMDroite, Aheight); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, mBRect); End Else Begin X := fMGauche; While X <= ( Awidth - fMDroite) Do Begin dRect := Rect( X, Aheight - fMBasse, Min( X + mW, Awidth - fMDroite), Aheight); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, mBRect); X := X + mW; End; End;   //On dessine le Milieu Droit If fTraitDroit = siEtirer Then Begin dRect := Rect( AWidth - fMDroite, fMHaute, Awidth, Aheight - fMBasse); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, mdRect); End Else Begin Y := fMHaute; While Y <= ( Aheight - fMBasse) Do Begin dRect := Rect( Awidth - fMDroite, Y, Awidth, Min( Y + mH, Aheight - fMBasse)); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, mdRect); Y := Y + mH; End; End;   //On dessine le coin Bas-Droit dRect := Rect( Awidth - fMDroite, Aheight - fMBasse, Awidth, Aheight); vBmpTemp.Canvas.CopyRect( dRect, Asrcimage.Canvas, dbRect);   //On assign le résultat à la Bitmap de sortie Adstimage.Assign( vBmpTemp);   Finally vBmpTemp.Free; End; End;   { TImagesBouton }   Procedure Timagesbouton.Glyphchanged( Sender : Tobject) ; Begin boGlyphFaites := False; boForcePaint := True; Invalidate; End;   Procedure Timagesbouton.Fondchanged( Sender : Tobject) ; Var nW : Integer;   Begin nW := fImgFond.Width Div fNbImages; If fTailleAuto Then Begin Width := nW; Height := fImgFond.Height; End; boImgFaites := False; boForcePaint := True; Invalidate; End;   Procedure Timagesbouton.Setimgfond( Image : Tbitmap) ; Begin fImgFond.Assign( Image); End;   Procedure Timagesbouton.Setimgglyph( Image : Tbitmap) ; Begin fImgGlyph.Assign( Image); End;   Procedure Timagesbouton.Setnbimages( Valeur : Byte) ; Begin If Valeur <> fNbImages Then Begin fNbImages := Valeur; boImgFaites := False; boForcePaint := True; Invalidate; End; End;   Procedure Timagesbouton.Setnbglyphs( Valeur : Byte) ; Begin If Valeur <> fNbGlyphs Then Begin fNbGlyphs := Valeur; boGlyphFaites := False; boForcePaint := True; Invalidate; End; End;   Procedure Timagesbouton.Setenabled( Valeur : Boolean) ; Begin If Valeur <> fEnabled Then Begin fEnabled := Valeur; boForcePaint := True; Invalidate; End; End;   Procedure Timagesbouton.Setglyphalign( Valeur : Tglyphalign) ; Begin If Valeur <> fGlyphAlign Then Begin fGlyphAlign := Valeur; boForcePaint := True; Invalidate; End; End;   Procedure Timagesbouton.Setespacement( Valeur : Integer) ; Begin If Valeur <> fEspacement Then Begin fEspacement := Valeur; boForcePaint := True; Invalidate; End; End;   Procedure Timagesbouton.Setmarge( Valeur : Integer) ; Begin If Valeur <> fMarge Then Begin fMarge := Valeur; boForcePaint := True; Invalidate; End; End;   procedure TImagesBouton.SetImgTransparence( Valeur : TImageTransparence) ; begin If Valeur <> fImgTransparence Then Begin fImgTransparence:= Valeur; ColorTransImg := M_GetTransColor; boImgFaites:=False; boForcePaint := True; Invalidate; end; end;   procedure TImagesBouton.SetGlyphTransparence( Valeur : TImageTransparence) ; begin If Valeur <> fGlyphTransparence Then Begin fGlyphTransparence:=Valeur; ColorTransGlyph := M_GetTransColor( False); boGlyphFaites:=False; boForcePaint := True; Invalidate; end; end;   procedure TImagesBouton.SetImgColorTransparence( Valeur : TColor) ; begin If Valeur <> fImgColorTransparence Then Begin fImgColorTransparence:=Valeur; ColorTransImg := fImgColorTransparence; boImgFaites:=False; boForcePaint := True; Invalidate; end; end;   procedure TImagesBouton.SetGlyphColorTransparence( Valeur : TColor) ; begin If Valeur <> fGlyphColorTransparence Then Begin fGlyphColorTransparence:=Valeur; ColorTransGlyph := fGlyphColorTransparence; boGlyphFaites:=False; boForcePaint := True; Invalidate; end; end;   Procedure Timagesbouton.Settailleauto( Valeur : Boolean) ; Begin If Valeur <> fTailleAuto Then Begin fTailleAuto := Valeur; If fTailleAuto Then If fImgFond.Height > 0 Then Begin Height := fImgFond.Height; If fNbImages> 0 Then Width := fImgFond.Width Div fNbImages Else Width := fImgFond.Width; End; Invalidate; End; End;   Procedure Timagesbouton.Setfontsurvol( Valeur : Tfont) ; Begin If Valeur <> fFontSurvol Then Begin fFontSurvol.Assign( Valeur); End; End;     Procedure Timagesbouton.Settextealign( Valeur : Ttextealign) ; Begin If Ftextealign <> Valeur Then Begin Ftextealign := Valeur; Invalidate; End; End;   Procedure Timagesbouton.Mode9imageschanged( Sender : Tobject) ; Begin boForcePaint := True; Invalidate; End;   Procedure Timagesbouton.Setmode9images( Valeur : Tmode9images) ; Begin fMode9Images.Assign(Valeur); End;   Procedure Timagesbouton.M_Creerimages; Var j : Integer; i : TEtatsBouton;   nH, nW : Integer;   vRect : TRect; vBmpTmp : TBitMap;   Begin For i := ebNormal to ebSurvol Do aImages[ i].Clear;   If fImgFond.Height > 0 Then //Si l'image de fond n'est pas définie, on dessine un rectangle Begin nH := fImgFond.Height; Case fNbImages Of 1 : Begin //Une seule image fournit, on créer l'image grisée, les autres sont toutes identiques. nW := fImgFond.Width; vRect := Rect( 0, 0, nW, nH); vBmpTmp := TBitmap.Create; M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebNormal].Assign(vBmpTmp); aImages[ ebEnfonce].Assign( vBmpTmp); aImages[ ebFocus].Assign( vBmpTmp); aImages[ ebSurvol].Assign(vBmpTmp); vBmpTmp.Free; M_ImageGrise( fImgFond, aImages[ ebGrise], fImgTransparence <> itAucune, M_GetTransColor); End; 2 : Begin //Deux images. La seconde doit représenter l'image grisée nW := fImgFond.Width div 2; vRect := Rect( 0, 0, nW, nH); vBmpTmp := TBitmap.Create; M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebNormal].Assign(vBmpTmp); aImages[ ebEnfonce].Assign( vBmpTmp); aImages[ ebFocus].Assign( vBmpTmp); aImages[ ebSurvol].Assign(vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW, 0, nW + nW , nH ); M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); vBmpTmp.Free; End; 3 : Begin //Trois images sont fournies. Normal, Enfonce et Grise. Les 2 etats suivant sont mis à Normal nw := fImgFond.Width div 3; vRect := Rect( 0, 0, nW, nH); vBmpTmp := TBitmap.Create; M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebNormal].Assign(vBmpTmp); aImages[ ebFocus].Assign( vBmpTmp); aImages[ ebSurvol].Assign( vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW, 0, nW + nW , nH); M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebEnfonce].Assign(vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW * 2, 0, nW * 3 , nH); M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); vBmpTmp.Free; End; 4 : Begin //Quatre images sont fournies : Normal, Enfonce, Grise et Survol. Focus est mis à Normal nW := fImgFond.Width div 4; vRect := Rect( 0, 0, nW, nH); vBmpTmp := TBitmap.Create; M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebNormal].Assign(vBmpTmp); aImages[ ebFocus].Assign( vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW, 0, nW * 2 , nH); M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebEnfonce].Assign( vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW * 2, 0, nW*3 , nH); M_Prepare( vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebGrise].Assign( vBmpTmp); vBmpTmp.Clear; vRect := Rect( nW * 3, 0, nW*4,nH); M_Prepare(vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ ebSurvol].Assign( vBmpTmp); vBmpTmp.Free; End; 5 : Begin //L'Image de fond est composée d'une image par état. nW := fImgFond.Width div 5; vBmpTmp := TBitMap.Create; For i := ebNormal to ebSurvol Do Begin j := Ord( i); vRect := Rect( nW * j, 0, ( nW * (j+1)), nH); M_Prepare(vBmpTmp, fImgFond, vRect, fImgTransparence, fImgColorTransparence); aImages[ i].Assign(vBmpTmp); vBmpTmp.Clear; End; vBmpTmp.Free; End; End; If fTailleAuto Then Begin Height := nH; Width := nW; End; End Else Begin nH := Height; nW := Width; For i := ebNormal to ebSurvol do With aImages[i] Do Begin { Height := nH;   Width := nW;} If i <> ebGrise Then canvas.Brush.color := clbtnface Else Canvas.Brush.Color := clBtnShadow; Canvas.RoundRect(0, 0, Width , Height , Width div 4, Height div 4); End; End;   End;   Procedure Timagesbouton.M_creerglyphs; Var vBmpTmp : TBitMap; i : TEtatsBouton; vRect : TRect;   Begin If fImgGlyph.Height > 0 Then Begin //Si la "glyph" est définie, alors on "Colle" la glyph à l'endroit prevu. nGH := fImgGlyph.Height; For i := ebNormal To ebSurvol do Begin Case fNbGlyphs Of 1 : Begin //La glyph ne contient qu'un image ngW := fImgGlyph.Width; vBmpTmp := TBitMap.Create; If i <> ebGrise Then M_Prepare( vBmpTmp, fImgGlyph, Rect( 0, 0, nGW, nGH), fGlyphTransparence, fGlyphColorTransparence) Else M_ImageGrise( fImgGlyph, vBmpTmp, fGlyphTransparence <> itAucune, M_GetTransColor(False)); aGlyphs[ i].Assign( vBmpTmp); vBmpTmp.free; end; 2 : Begin //La glyph contient 2 images. Normal et Grisé. nGW := fImgGlyph.Width div 2; vBmpTmp := TBitmap.Create; If i = ebGrise Then vRect := Rect( nGW, 0, nGW * 2 , nGH ) else vRect := Rect( 0, 0, nGW, nGH); M_Prepare( vBmpTmp, fImgGlyph, vRect, fGlyphTransparence, fGlyphColorTransparence); aGlyphs[ i].Assign( vBmpTmp); vBmpTmp.Free; End; 3 : Begin //La glyph contient 3 états : Normal, Enfonce et grise. nGW := fImgGlyph.Width Div 3; vBmpTmp := TBitmap.Create; Case i Of ebNormal, ebFocus, ebSurvol : vRect := Rect( 0, 0, nGW, nGH); ebEnfonce : vRect := Rect( nGW, 0, nGW * 2 , nGH ); ebGrise : vRect := Rect( nGW * 2, 0, nGW * 3 , nGH ); End; M_Prepare( vBmpTmp, fImgGlyph, vRect, fGlyphTransparence, fGlyphColorTransparence); aGlyphs[ i].assign( vBmpTmp); vBmpTmp.Free; End; 4 : Begin //La glyph contien 4 états : Normal, Enfonce, Grise et Survol. Focus est mis à Normal nGW := fImgGlyph.Width Div 4; vBmpTmp := TBitmap.Create; Case i Of ebNormal, ebFocus : vRect := Rect( 0, 0, nGW, nGH); ebEnfonce : vRect := Rect( nGW, 0, nGW * 2 , nGH ); ebGrise : vRect := Rect( nGW * 2, 0, nGW * 3 , nGH ); ebSurvol : vRect := Rect( nGW * 3, 0, nGW * 4 , nGH ); End; M_Prepare( vBmpTmp, fImgGlyph, vRect, fGlyphTransparence, fGlyphColorTransparence); aGlyphs[ i].Assign( vBmpTmp); vBmpTmp.Free; End; 5 : Begin //La glyph contient une image par Etat nGW := fImgGlyph.Width Div 5; vBmpTmp := TBitmap.Create; Case i Of ebNormal : vRect := Rect( 0, 0, nGW, nGH); ebEnfonce : vRect := Rect( nGW, 0, nGW * 2 , nGH ); ebGrise : vRect := Rect( nGW * 2, 0, nGW * 3 , nGH ); ebFocus : vRect := Rect( nGW * 3, 0, nGW * 4 , nGH ); ebSurvol : vRect := Rect( nGW * 4, 0, nGW * 5 , nGH ); End; M_Prepare( vBmpTmp, fImgGlyph, vRect, fGlyphTransparence, fGlyphColorTransparence); aGlyphs[ i].Assign( vBmpTmp); vBmpTmp.Free; End; End; End; End;   End;     Procedure Timagesbouton.M_Imagegrise( Asrcimg, Adstimg : Tbitmap; lGereTransparance : Boolean; cTransparent : TColor) ; Var lii_Src : TLazIntfImage; px, py, nGris : Integer; clGrise : TColor; nlTrans : Longint; nRouge, nVert, nBleu : Byte; vCouleur : TFPColor; imgHandle, imgMaskHandle : HBitmap; oTrans, oTemp : TBitMap; cFPTrans : TFPColor;   Begin If lGereTransparance Then cFPTrans := TColorToFPColor( cTransparent); lii_Src := TLazIntfImage.Create( 0, 0); lii_Src.LoadFromBitmap( ASrcimg.Handle, aSrcimg.MaskHandle); for py := 0 To lii_Src.Height-1 Do Begin For px := 0 To lii_Src.Width-1 Do Begin vCouleur := lii_Src.Colors[ px, py]; If Not lGereTransparance Or (vCouleur <> cFPTrans) Then Begin nGris := Round( vCouleur.red * 0.3 + vCouleur.green * 0.59 + vCouleur.blue * 0.11); vCouleur.red := nGris; vCouleur.green := nGris; vCouleur.blue := nGris; End; lii_Src.Colors[ px, py] := vCouleur; End; End; oTemp := TBitmap.Create; lii_Src.CreateBitmaps( imgHandle, imgMaskHandle, False); oTemp.Handle := imgHandle; oTemp.MaskHandle := imgMaskHandle; If Not Assigned( aDstimg) Then aDstimg := TBitmap.Create Else Adstimg.Clear; Adstimg.PixelFormat := pf24bit; aDstimg.Width := Asrcimg.Width; Adstimg.Height := Asrcimg.Height; aDstimg.Canvas.Draw( 0, 0, oTemp); If lGereTransparance Then Begin Adstimg.Transparent := True; Adstimg.TransparentColor := cTransparent; End;   { If chx_Transparence.Checked Then   Begin   nlTrans := ColorToRGB( btn_Transparence.ButtonColor);   nRouge := Round( nlTrans *0.3);   nVert := Round( ( nlTrans shr 8) * 0.59);   nBleu := Round( ( nlTrans shr 16) * 0.11);   clGrise := RGBToColor( nRouge, nVert, nBleu); // oTrans := TBitMap.Create;   P_Transparence(oTemp, Dstimage, clGrise); // Dstimage.Canvas.StretchDraw( Rect( 0, 0, Dstimage.Width, Dstimage.Height), oTrans); // oTrans.Free;   End   Else Begin   End;} oTemp.Free; lii_Src.Free; End;   Procedure Timagesbouton.M_prepare( Adstimg, Asrcimg : Tbitmap; Vsrcrect : Trect; pitTransparence : TImageTransparence; pcColorTransparence : TColor) ; Var nH, nW : Integer; lii_Temp : TLazIntfImage;   Begin lii_temp := TLazIntfImage.Create( 0, 0); lii_Temp.LoadFromBitmap( aSrcimg.Handle, aSrcimg.MaskHandle); nH := ( Vsrcrect.Bottom - Vsrcrect.Top);// + 1; nW := Vsrcrect.Right - Vsrcrect.Left;// + 1; Adstimg.PixelFormat := pf24bit; Adstimg.Height := nH; Adstimg.Width := nW; If pitTransparence <> itAucune Then Begin Adstimg.Transparent := True; Case pitTransparence Of itPixelHautGauche : Adstimg.TransparentColor := FPColorToTColor( lii_Temp.Colors[ 0, 0]); itMagenta : Adstimg.TransparentColor := clFuchsia; itCustom : Adstimg.TransparentColor := pcColorTransparence; End; Adstimg.Canvas.Brush.Color := Adstimg.TransparentColor; Adstimg.Canvas.FillRect( 0, 0, nW, nH); End Else Begin Adstimg.Transparent := False; End; Adstimg.Canvas.CopyRect( Rect( 0, 0, nW, nH), Asrcimg.Canvas, Vsrcrect); lii_Temp.Free; End;   Function Timagesbouton.M_gettranscolor( Boimage : Boolean) : Tcolor; Var lii_Temp : TLazIntfImage;   Begin If Boimage Then Begin Case fImgTransparence Of itAucune : Result := clBlack; itPixelHautGauche : Begin lii_temp := TLazIntfImage.Create( 0, 0); lii_Temp.LoadFromBitmap( fImgFond.Handle, fImgFond.MaskHandle); Result := FPColorToTColor( lii_Temp.Colors[0,0]); lii_Temp.Free; End; itMagenta : Result :=clFuchsia; itCustom : Result := fImgColorTransparence; End; End Else Begin Case fGlyphTransparence Of itAucune : Result := clBlack; itPixelHautGauche : Begin lii_temp := TLazIntfImage.Create( 0, 0); lii_Temp.LoadFromBitmap( fImgGlyph.Handle, fImgGlyph.MaskHandle); Result := FPColorToTColor( lii_Temp.Colors[0,0]); lii_Temp.Free; End; itMagenta : Result := clFuchsia; itCustom : Result := fGlyphColorTransparence; End; End; End;   Procedure Timagesbouton.Cmtextchanged( Var Message : Tlmessage) ; Begin { Try   Paint;} Invalidate; { Finally End;} End;   Constructor Timagesbouton.Create( Aowner : Tcomponent) ; Var i : TEtatsBouton; Onchange : Pointer;   Begin Inherited Create( Aowner) ; ControlStyle := ControlStyle + [csSetCaption]; fNbGlyphs := 1; fNbImages := 1; fImgTransparence := itAucune; fGlyphTransparence := itPixelHautGauche; fImgColorTransparence := clFuchsia; fGlyphColorTransparence := clFuchsia; fEspacement := 3; fMarge := 3; fTailleAuto := False; Width := 110; Height := 24; tabstop := True; Visible := True; FEnabled := True; fImgFond := TBitMap.Create; fImgFond.OnChange := @FondChanged; fImgGlyph := TBitMap.Create; fImgGlyph.OnChange := @GlyphChanged; fMode9Images := TMode9Images.Create( Self); fMode9Images.OnChange := @Mode9ImagesChanged; For i := ebNormal To ebSurvol Do Begin aImages[ i] := TBitMap.Create; aGlyphs[ i] := TBitMap.Create; End; fFontSurvol := TFont.Create; fFontSurvol.Assign( Font); fTexteAlign := taCentre; fGlyphAlign := gaAGauche; boImgFaites := False; boGlyphFaites := False; boEnfonceEnSortie := False; boForcePaint := True; veb_Etat := ebNormal; End;   Destructor Timagesbouton.Destroy; Var i : TEtatsBouton;   Begin fFontSurvol.Free; fImgFond.Free; fImgGlyph.Free; For i := ebNormal To ebSurvol Do Begin aImages[ i].free; aGlyphs[ i].Free; End; Inherited Destroy; End;   Procedure Timagesbouton.Paint; Var vBmp9Etat : TBitMap; veb_NewEtat : TEtatsBouton; nGX, nGY, nTX, nTY, nTW, nTH : Integer; boPaint : Boolean;   Begin // Inherited Paint; boPaint := False; If Not boImgFaites Then Begin M_CreerImages; boImgFaites := True; boPaint := True; End; If Not boGlyphFaites Then Begin M_CreerGlyphs; boGlyphFaites := True; boPaint := True; End;   If Not Enabled then veb_NewEtat := ebGrise Else veb_NewEtat := veb_Etat;   If veb_NewEtat <> veb_Index Then Begin boPaint := True; veb_Index := veb_NewEtat; End;   If boPaint Or boForcePaint Then Begin // boForcePaint := False; If fTailleAuto Then Begin Height := aImages[ ebNormal].Height; Width := aImages[ ebNormal].Width; Canvas.StretchDraw( Rect( 0, 0, Width, Height), aImages[ veb_NewEtat]); End Else If fMode9Images.Actif Then Begin Try vBmp9Etat := TBitmap.Create; fMode9Images.CreerImageMode9( aImages[ veb_NewEtat], vBmp9Etat, Width, Height); Canvas.Draw( 0, 0, vBmp9Etat); Finally vBmp9Etat.Free; End; End Else Canvas.StretchDraw( Rect( 0, 0, Width, Height), aImages[ veb_NewEtat]);   If fImgGlyph.Height > 0 Then Begin //Si une Glyph est présente, alors on la déssine Case fGlyphAlign Of gaAGauche : Begin nGY := ( Height - nGH) Div 2; nGX := fMarge; End; gaADroite : Begin nGY := ( Height - nGH) Div 2; nGX := Width - ( nGW + fMarge); End; gaEnHaut : Begin nGY := fMarge; nGX := ( Width - nGW) Div 2; End; gaEnBas : Begin nGY := Height - ( nGH + fMarge); nGX := ( Width - nGW) Div 2; End; End; Canvas.Draw( nGX, nGY, aGlyphs[ veb_NewEtat]); End;   //Si un texte est précisé, on l'écrit If Trim( Caption) <> '' Then Begin If veb_NewEtat = ebSurvol Then Canvas.Font := fFontSurvol Else Canvas.Font := Font; nTH := Canvas.TextHeight( Caption); nTW := Canvas.TextWidth( Caption); If fImgGlyph.Height > 0 Then Begin //Il y a une Glyph de déssiner case fGlyphAlign Of gaAGauche : Begin nTY := ( Height - nTH) Div 2; //nTX := nGX + nGW + fEspacement; Case fTexteAlign Of taGauche : nTX := fMarge + nGW + fEspacement; taCentre : nTX := fMarge + nGW + ( ( Width - fMarge - nGW - nTW) div 2); taDroite : nTX := Width - nTW - fMarge; End; End; gaADroite : Begin nTY := ( Height - nTH) Div 2; //nTX := nGX - fEspacement - nTW; Case fTexteAlign Of taGauche : nTX := fMarge; taCentre : nTX := ( Width - fMarge - nGW - nTW) div 2; taDroite : nTX := Width - nTW - fMarge - nGW - fEspacement; End; End; gaEnHaut : Begin nTY := nGY + nGH + fEspacement; //nTX := ( Width - nTW) Div 2; Case fTexteAlign Of taGauche : nTX := fMarge; taCentre : nTX := ( Width - nTW) div 2; taDroite : nTX := Width - nTW - fMarge; End; End; gaEnBas : Begin nTY := nGY - fEspacement - nTH; //nTX := ( Width - nTW) Div 2; Case fTexteAlign Of taGauche : nTX := fMarge; taCentre : nTX := ( Width - nTW) div 2; taDroite : nTX := Width - nTW - fMarge; End; End; End; End Else Begin //Pas de glyph alors le Texte est centré dans l'image principal Case fTexteAlign Of taGauche : nTX := fMarge; taCentre : nTX := ( Width - nTW) div 2; taDroite : nTX := Width - nTW - fMarge; End; // nTX := ( Width - nTW) Div 2; nTY := ( Height - nTH) Div 2; End; Canvas.TextRect( Rect( 0, 0, Width, Height), nTX, nTY, Caption); End; End; End;   Procedure Timagesbouton.Click; Begin If Enabled Then Inherited Click; End;   Procedure Timagesbouton.Keypress( Var Key : Char) ; Begin If Enabled And (Key = #13) Then Click; Inherited Keypress( Key) ; End;   Procedure Timagesbouton.Mousedown( Button : Tmousebutton; Shift : Tshiftstate; X, Y : Longint) ; Begin If Button = mbLeft Then Begin veb_Etat := ebEnfonce; Paint; End; Inherited Mousedown( Button, Shift, X, Y) ; End;   Procedure Timagesbouton.Mouseup( Button : Tmousebutton; Shift : Tshiftstate; X, Y : Longint) ; Begin If ( Button = mbLeft) Then Begin veb_Etat := ebFocus; Paint; End; Inherited Mouseup( Button, Shift, X, Y) ; End;   Procedure Timagesbouton.Mouseenter; Begin If boEnfonceEnSortie Then Begin veb_Etat := ebEnfonce; boEnfonceEnSortie := False; Paint; End Else Begin veb_Etat := ebSurvol; Paint; End; Inherited Mouseenter; End;   Procedure Timagesbouton.Mouseleave; Begin If veb_Etat = ebEnfonce Then boEnfonceEnSortie := True; If Focused Then veb_Etat := ebFocus Else veb_Etat := ebNormal; Paint; Inherited Mouseleave; End;   Procedure Timagesbouton.Wmsetfocus( Var Message : Tlmsetfocus) ; Begin veb_Etat := ebFocus; Paint; End;   Procedure Timagesbouton.Wmkillfocus( Var Message : Tlmkillfocus) ; Begin veb_Etat := ebNormal; paint; End;   Initialization {$I uimagesbouton_icon.lrs}   end.

---

A+
JS