IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Composants VCL Delphi Discussion :

Problème avec composant PicButton en création dynamique


Sujet :

Composants VCL Delphi

Mode arborescent

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé

    Homme Profil pro
    Informaticien retraité
    Inscrit en
    Mars 2010
    Messages
    364
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Informaticien retraité
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Mars 2010
    Messages : 364
    Billets dans le blog
    1
    Par défaut Problème avec composant PicButton en création dynamique
    Je suis sous W8.1 Personal Edition, avec Delphi 6 Personal Edition.

    Je voulais créer un bouton descendant de TButton, avec une image BMP sur laquelle je veux écrire le libellé. J'ai bien essayé TSpeedButton et TBitBtn, mais pour différentes raisons cela ne correspond pas.

    En cherchant sur internet, j'ai trouvé une unité PicButton qui fait exactement ce que je veux. Certes, j'au trouvé l'unité "nue", juste une page de texte, à copier dans un fichier PAS. C'est ce que j'ai fait. Je l'ai installé comme composant, ce qui n'a posé aucun problème. Le composant est reconnu dans l'IDE, je peux le placer sur une form, le configurer et l'utiliser. J'ai eu deux petits ennuis avec des bugs dans l'unité, mais je les au trouvés et corrigés, en les marquant avec un commentaire.

    Mais, j'ai un vrai problème lorsque j'essaie d'utiliser ce bouton en création dynamique. Le bouton apparaît bien dans ma form, je peux configurer certains paramètres, y compris l'évènement OnClick - ça marche. Mais les images n'apparaissent pas ! Je les charge dans un BitMap créé dynamiquement, puis j'affecte le BitMap aux propriétés Pic... (normal, pushed et hilight) pour avoir l'image comme bouton "sorti", bouton "avancé" et "en survol"). Mais rien n'apparaît, dans aucun de ces 3 états.

    J'ai fait un petit programme de démo, avec un PicButton créé dans l'IDE, et un autre créé dynamiquement en cliquant sur un bouton normal. Le projet est en pièce jointe, sous forme de fichier ZIP. Il contient le composant comme PicButton.pas. A tout hasard, voici cette unité:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    unit PicButton;
     
    interface
    uses
      Windows, Messages, Classes, Graphics, Controls, stdCtrls, Dialogs, SysUtils;
     
     
    type
    TPicButton = class(TButton)
        private
        FOver, FDoRect, FDoText: Boolean;
        FFocusColor: TColor;
        FNormalPic, FHiLightPic, FDownPic, FDisabledPic, FFocusPic: TBitmap;
        procedure setNormal(Value: TBitMap);
        procedure setHiLight(Value: TBitMap);
        procedure setDown(Value: TBitMap);
        procedure setDisabled(Value: TBitmap);
        procedure setFocusPic(Value: TBitMap);
        procedure DrawItem(const DIRec: TDrawItemStruct);
        procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
        procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
        procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
        procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
        procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
     
        protected
        property Brush;
        property Default;
        property Action;
        procedure SetButtonStyle(ADefault: Boolean); overRide;
        procedure WMPaint(var Message: TMessage); message WM_PAINT;
        procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
        procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
     
        public
        { Public declarations }
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure Loaded; override;
     
        published
        { Published declarations }
        property PicNormal: TBitMap read FNormalPic write setNormal;
        property PicHiLight: TBitMap read FHiLightPic write setHiLight;
        property PicPushed: TBitMap read FDownPic write setDown;
        property PicDisabled: TBitmap read FDisabledPic write setDisabled;
        property PicFocus: TBitmap read FFocusPic write setFocusPic;
        property FocusColor: TColor read FFocusColor write FFocusColor default clRed;
        property DoFocusText: Boolean read FDoText write FDoText default False;
        property DoFocusRect: Boolean read FDoRect write FDoRect default False;
        property Caption;
        property Enabled;
        property ParentShowHint;
        property ParentBiDiMode;
        property ShowHint;
        property TabOrder;
        property TabStop;
        property Visible;
        property OnEnter;
        property OnExit;
     
    end;
     
    procedure Register;
     
    implementation
     
    type
      TMyState = (bsUp, bsDown, bsHigh, bsDisabled);
     
    procedure Register;
    begin
      RegisterComponents('DelphiFr', [TPicButton]);
    end;
     
    constructor TPicButton.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
      ControlStyle:= ControlStyle - [csSetCaption, csOpaque];
      FOver := False;
      FNormalPic  := TBitMap.Create;
      FHiLightPic := TBitmap.Create;
      FDownPic  := TBitmap.Create;
      FDisabledPic := TBitmap.Create;
      FFocusPic := TBitmap.Create;
      FDoText := False;
      FDoRect := False;
      FFocusColor := clRed;
      Constraints.MaxHeight := Height;
      Constraints.MinHeight := 0; // Height;
      Constraints.MaxWidth := Width;
      Constraints.MinWidth := Width;     // Klaus Constraints.MinHeight corrected by Constraints.MinWidth
    end;
     
    destructor TPicButton.Destroy;
    begin
      inherited Destroy;
      FNormalPic.Free;
      FHiLightPic.Free;
      FDownPic.Free;
      FDisabledPic.Free;
      FFocusPic.Free;
    end;
     
    procedure TPicButton.Loaded;
    begin
      inherited Loaded;
      if FNormalPic.Empty then Exit;
      Constraints.MaxHeight := FNormalPic.Height;
      Constraints.MinHeight := 0; // FNormalPic.Height;
      Constraints.MaxWidth := FNormalPic.Width;
      Constraints.MinWidth := FNormalPic.Width;    // Klaus  Constraints.MinHeight corrected by Constraints.MinWidth
      Width := FNormalPic.Width;
      Height := FNormalPic.Height;
    end;
     
    procedure TPicButton.SetButtonStyle(ADefault: Boolean);
    begin
      if HandleAllocated then
        SendMessage(Handle, BM_SETSTYLE, BS_PUSHBUTTON or BS_OWNERDRAW, 1);
    end;
     
    procedure TPicButton.setNormal(Value: TBitMap);
    begin
      FNormalPic.Assign(Value);
      if not FNormalPic.Empty then
        begin
          Constraints.MaxHeight := FNormalPic.Height;
          Constraints.MinHeight := 0; // FNormalPic.Height;
          Constraints.MaxWidth := FNormalPic.Width;
          Constraints.MinWidth := FNormalPic.Width;      // Klaus  Constraints.MinHeigt corrected by Constraints.MinWidth
          Height := FNormalPic.Height;
          Width := FNormalPic.Width;
        end;
      Invalidate;
    end;
     
    procedure TPicButton.setHiLight(Value: TBitMap);
    begin
      FHiLightPic.Assign(Value);
    end;
     
    procedure TPicButton.setDown(Value: TBitMap);
    begin
      FDownPic.Assign(Value);
    end;
     
    procedure TPicButton.setDisabled(Value: TBitMap);
    begin
      FDisabledPic.Assign(Value);
    end;
     
    procedure TPicButton.setFocusPic(Value: TBitMap);
    begin
      FFocusPic.Assign(Value);
    end;
     
    procedure TPicButton.CNMeasureItem(var Message: TWMMeasureItem);
    begin
      Message.MeasureItemStruct^.itemWidth := Width;
      Message.MeasureItemStruct^.itemHeight := Height;
    end;
     
    procedure TPicButton.CNDrawItem(var Message: TWMDrawItem);
    begin
      DrawItem(Message.DrawItemStruct^);
    end;
     
    procedure TPicButton.CMTextChanged(var Message: TMessage);
    begin
      Invalidate;
    end;
     
    procedure TPicButton.CMMouseLeave(var Message: TMessage);
    begin
      FOver := False;
      if Enabled and Assigned(FHiLightPic) then
        Invalidate;
    end;
     
    procedure TPicButton.CMMouseEnter(var Message: TMessage);
    begin
      FOver := True;
      if Enabled and Assigned(FHiLightPic) then
        Invalidate;
    end;
     
    procedure TPicButton.CMFontChanged(var Message: TMessage);
    begin
      inherited;
      Invalidate;
    end;
     
    procedure TPicButton.CMEnabledChanged(var Message: TMessage);
    begin
      inherited;
      Invalidate;
    end;
     
    procedure TPicButton.WMPaint(var Message: TMessage);
    var
      BmpDC: Integer;
      PaintS: TPaintStruct;
      cRect: TRect;
      PenO: Cardinal;
    begin
      if not (csDesigning in ComponentState) then
        begin
          Inherited;
          Exit;
        end;
     
      Message.Result := 0;
      BeginPaint(Handle, PaintS);
      if FNormalPic.Empty then
        begin
          PenO := SelectObject(PaintS.hDC, CreatePen(PS_SOLID, 1, $999999));
          SetROP2(PaintS.hdc, R2_XORPEN);
          Rectangle(PaintS.hdc, 0, 0, Width, Height);
          DeleteObject(SelectObject(PaintS.hdc, PenO));
          EndPaint(Handle,PaintS);
          Exit;         // deactivated by Klaus
        end;
     
      BmpDC := CreateCompatibleDC(0);
      SelectObject(BmpDC, FNormalPic.Handle);
      BitBlt(PaintS.hdc, PaintS.rcPaint.Left, PaintS.rcPaint.Top,
               PaintS.rcPaint.Right, PaintS.rcPaint.Bottom, BmpDC,
               PaintS.rcPaint.Left, PaintS.rcPaint.Top, SRCCOPY);
      DeleteDC(BmpDC);
     
      if Length(Caption) > 0 then
        begin
          cRect := ClientRect;
     
          SelectObject(PaintS.hdc, Font.Handle);
          SetBkMode(PaintS.hdc, TRANSPARENT);
          DrawText(PaintS.hdc,PChar(Caption),-1,cRect,DT_SINGLELINE or DT_VCENTER or DT_CENTER);
        end;
      EndPaint(Handle,PaintS);
    end;
     
    procedure TPicButton.DrawItem(const DIRec: TDrawItemStruct);
    var
      Pic: TBitmap;
      IsFocus: Boolean;
      State: TMyState;
      cRect: TRect;
    begin
      if (csDesigning in ComponentState) then Exit;
     
      cRect := ClientRect;
      {I assign a State to get the correct Image}
      if not Enabled then State := bsDisabled else
      if DIRec.itemState and ODS_SELECTED <> 0 then
        State := bsDown else
      if FOver then
        State := bsHigh else
        State := bsUp;
     
      IsFocus := DIRec.itemState and ODS_FOCUS <> 0;
     
      Pic := FNormalPic;                     // added by Klaus
      SetTextColor(DIRec.hdc, Font.Color);   // added by Klaus
      case State of
      {set the Pic and cRect}
        bsUp: if IsFocus then
            if not FFocusPic.Empty then Pic := FFocusPic;
        bsDown: begin
              if not FDownPic.Empty then
                Pic := FDownPic else
                if not FHiLightPic.Empty then Pic := FHiLightPic;
              cRect := Rect(2,2,Width+2,Height+2)
              end;
        bsHigh: if not FHiLightPic.Empty then Pic := FHiLightPic;
        bsDisabled: begin
                  if not FDisabledPic.Empty then Pic := FDisabledPic;
                  SetTextColor(DIRec.hdc, clSilver);
                  end;
      end;
     
      if not Pic.Empty then
        BitBlt(DIRec.hDC, 0, 0, Width, Height, Pic.Canvas.Handle, 0, 0, SRCCOPY);
     
      if IsFocus and FDoText then
        SetTextColor(DIRec.hdc, FFocusColor);
     
      SelectObject(DIRec.hDC, Font.Handle);
      SetBkMode(DiRec.hdc, TRANSPARENT);
      if Length(Caption) > 0 then
        DrawText(DIRec.hDC,PChar(Caption),-1,cRect,DT_SINGLELINE or DT_VCENTER or DT_CENTER);
     
      if IsFocus and FDoRect then
        begin
          InflateRect(cRect, -3, -3);
          windows.DrawFocusRect(DIRec.hdc, cRect);
        end;
    end;
     
    end.
    Le problème vient, soit d'un bug dans l'unité PicButton.bas, soit d'une incompréhension de ma part. Je serais très heureux si vous pouviez jeter un regard sur ce problème. Merci d'avance.

    Cordialement
    Klaus
    Fichiers attachés Fichiers attachés

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Problème avec Excel et tableau croisé dynamique
    Par françois62 dans le forum VBScript
    Réponses: 9
    Dernier message: 19/11/2006, 22h17
  2. Problème avec la "Gestion des bibliothèques dynamiques"
    Par GoustiFruit dans le forum Delphi
    Réponses: 15
    Dernier message: 31/05/2006, 09h54
  3. Réponses: 21
    Dernier message: 09/04/2006, 23h13
  4. [VBA] Problème avec composant VB6
    Par Diablo_22 dans le forum Général VBA
    Réponses: 8
    Dernier message: 16/03/2006, 20h41
  5. Problème avec PtInRegion et un tableau dynamique
    Par mduse dans le forum Langage
    Réponses: 2
    Dernier message: 06/12/2005, 09h29

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo