Panel et checkbox

Soyez le premier à donner votre avis sur cette source.

Vue 4 456 fois - Téléchargée 1 184 fois

Description

Suite de composants avec scanline.
Un panel, et un checkbox.
Checkbox pouvant être transparent, coché ou plein, et en lecture seule.
Exemple.

Source / Exemple :


unit BFCheckBox;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtDlgs, Spin, FileCtrl, ComCtrls;
Const
   PixelCountMax=32768;                                    {Nombre maxi de pixels}
TYPE
   pRGBTripleArray=^TRGBTripleArray;                       {Nom de pointeur}
   TRGBTripleArray=ARRAY[0..PixelCountMax-1]of TRGBTRIPLE; {sur l'ensemble des pixels}
type
  TBFCheckBox = class(TGraphicControl)
  private
    { Déclarations privées }
    FBROUGE:Byte;
    FBVERT:Byte;
    FBBLEU:Byte;
    FBChecked:Boolean;                                  //Case a cocher
    FBChPlein:Boolean;                                  //plein ou coché
    FBTransparent:Boolean;                              //Composant devenant transparent
    FBCaption:string;
    FBReadOnly:Boolean;                                 //Lecture seule

    Procedure SETBROUGE(Value:Byte);
    Procedure SETBVERT(Value:Byte);
    Procedure SETBBLEU(Value:Byte);
    Procedure SETBTRANSPARENT(Value:boolean);
    Procedure SETBCHECKED(Value:boolean);
    Procedure SETBCHPLEIN(Value:boolean);
    Procedure SETBCAPTION(Value:string);
    Procedure SETBReadOnly(Value:boolean);

  protected
    { Déclarations protégées }
    procedure Paint; override;
    Procedure TransformeCheckBox(Var FBRouge, FBVert, FBBleu:Byte;FBTransparent:Boolean;
                                FBChecked:boolean;FBCaption:string);

  public
    { Déclarations publiques }
    constructor Create(AOwner:TComponent); override;
    Destructor Destroy;Override;
    Procedure Click;Override;

  published
    { Déclarations publiées }
   Property ROUGE:Byte READ FBROUGE WRITE SETBROUGE;
   Property VERT:Byte READ FBVERT WRITE SETBVERT;
   Property BLEU:Byte READ FBBLEU WRITE SETBBLEU;
   Property Transparent:Boolean READ FBTransparent WRITE SETBTRANSPARENT;
   Property Checked:Boolean Read FBChecked Write SETBCHECKED;
   Property CHPlein:Boolean READ FBCHPLEIN Write SETBCHPLEIN;
   Property Caption:string READ FBCAPTION WRITE SETBCAPTION;
   Property ReadOnly:Boolean READ FBReadOnly WRITE SETBReadOnly;
   Property Action;
   Property Anchors;
   Property BidiMode;
   Property Constraints;
   Property Cursor;
   Property DragCursor;
   Property DragKind;
   Property DragMode;
   Property Enabled;
   Property Font;
   Property Height;
   Property Hint;
   Property Left;
   Property Name;
   Property ParentBiDiMode;
   Property ParentFont;
   Property ParentShowHint;
   Property PopupMenu;
   Property ShowHint;
   Property Tag;
   Property Top;
   Property Visible;
   Property Width;
   property OnClick;
   property OnDblClick;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;                                     

  end;

procedure Register;

Var
   Image : Timage;

implementation

procedure TBFCheckBox.Paint;
begin
   inherited Paint;
   with Canvas do
   begin
      TransformeCheckBox(FBrouge,FBvert,FBbleu,FBTransparent,FBChecked,FBCaption);
      Canvas.Draw(0,0,Image.Picture.Graphic);
      Image.Free;
      If FBTransparent= false then
      begin
         Brush.Style:=bsClear;                                {Spécifie le motif du pinceau}
         Pen.Width:=4;                                        {grosseur du pinceau}
         Pen.Color:=RGB(FBROUGE,FBVERT,FBBLEU);               {on récupère la couleur de bordure}
         Rectangle(0,0,Width,Height);                         {on dessine le rectangle}
      end;   
   end;
end;

Procedure TBFCheckBox.TransformeCheckBox(Var FBRouge, FBVert, FBBleu:Byte;FBTransparent:Boolean;
                                FBChecked:boolean;FBCaption:string);
VAR
   Btmap1 : TBitmap;                                {bitmaps}
   I,J,w,h:integer;
   Row:pRGBTripleARRAY;
   Dr,Ha,Hc:Integer;
   D2,D4,D8:integer;
begin
   Image:=TImage.Create(Self);      //Création et dimension de l'image
   Hc:=-Font.Height;                //Hauteur de fonte
   Height:=Hc+6;                    //Hauteur du composant calculée
   Ha:=Hc+2;
   D2:=Round(Ha/2);                //Pour le dessin de la case cochée
   D4:=Round(Ha/4);
   D8:=Round(Ha/8);
   W:=Width;
   H:=Height;
   Image.Width :=W ;
   Image.Height :=H ;
   Btmap1 := TBitmap.Create;
   TRY
      Btmap1.PixelFormat := pf24bit; //Création du bitmap aux mêmes dimentions que l'image
      Btmap1.Width := W;
      Btmap1.Height:=H;
      for J:=0 to BTMap1.Height-1 do //Avec Scanline
      begin
         Row:=BtMap1.Scanline[j];
         for i:=0 to BTMap1.Width-1 do
         begin
            With Row[i] do
            begin
               RGBTRed:=FBRouge;
               RGBTGreen:=FBVert;
               RGBTBlue:=FBBleu;
            end;
         end;
      end;
      With Image do
      begin
         Picture.Graphic := Btmap1; //Récupération de l'image
         Ha:=H-4;
         Dr:=6+Ha;
         Canvas.Brush.Style:=bsClear;
         Canvas.Draw(0,0,Btmap1);
         Canvas.Font.Size:=Font.Size;                      {la grosseur de caractère}
         Canvas.Font.Name:=Font.Name;                      {le nom de la fonte d'écriture}
         Canvas.Font.Color:=Font.Color;                    {la couleur}
         Transparent:=FBTransparent;                       {Transparence}
         if FBCaption<>'' then
         Canvas.textOut(Dr,1,FBCaption);                   {on écrit le texte}
         Canvas.Brush.Style:=bssolid;
         If FBChecked=true then                           //Case cochée
         Begin
            If FBChPlein=true then                        //Carré plein
            begin
               Canvas.Brush.color:=ClBlack;
               Canvas.Rectangle(2,2,Ha,Ha);
            end
            else
            begin
               Canvas.Pen.Width:=1;                      //Case cochée
               Canvas.Brush.color:=ClWhite;
               Canvas.Rectangle(2,2,Ha,Ha);
               Canvas.Brush.color:=ClBlack;
               if Font.size>10 then
               Canvas.Pen.Width:=3;
               Canvas.MoveTo(D4+1,D2+1);
               Canvas.LineTo(d2+1,(7*d8));
               Canvas.LineTo((3*D4),D8);
            end;
         end
         else
         begin                                         //Case non cochée
            Canvas.Pen.Width:=1;
            Canvas.Brush.color:=ClWhite;
            Canvas.Rectangle(2,2,Ha,Ha);
         end;
      END;
   FINALLY
      Btmap1.Free;
   END;
END;

Procedure TBFCheckBox.SETBROUGE(Value:Byte);
Begin
   if Value <> FBROUGE then
   begin
      FBROUGE := Value;
      Invalidate;
   end;
End;

Procedure TBFCheckBox.SETBVERT(Value:Byte);
Begin
   if Value <> FBVERT then
   begin
      FBVERT := Value;
      Invalidate;
   end;
End;

Procedure TBFCheckBox.SETBBLEU(Value:Byte);
Begin
   if Value <> FBBLEU then
   begin
      FBBLEU := Value;
      Invalidate;
   end;
End;

Procedure TBFCheckBox.SETBTRANSPARENT(Value:Boolean);
Begin
   if Value <> FBTransparent then
   begin
      FBTransparent := Value;
      Invalidate;
   end;
End;

Procedure TBFCheckBox.SETBCHECKED(Value:Boolean);
Begin
   if Value <> FBChecked then
   begin
      FBChecked := Value;
      Invalidate;
   end;
End;

Procedure TBFCheckBox.SETBCHPLEIN(Value:boolean);
Begin
   if Value <> FBChPlein then
   begin
      FBChPlein := Value;
      Invalidate;
   end;
End;

Procedure TBFCheckBox.SETBReadOnly(Value:boolean);
Begin
   if Value <> FBReadOnly then
   begin
      FBReadOnly := Value;
      Invalidate;
   end;
end;

Procedure TBFCheckBox.SETBCAPTION(Value:string);
Begin
   if Value <> FBCaption then
   begin
      FBCaption := Value;
      Invalidate;
   end;
end;

Procedure TBFCheckBox.Click;
Begin
   If FBReadOnly=true then
   exit;
   Checked:= Not Checked;
   Invalidate;
   InHerited Click;
end;

constructor TBFCheckBox.Create(AOwner:TComponent);
begin
   inherited;
   Width:=97;
   Height:=17;
   FBRouge:=180;
   FBVert:=180;
   FBBleu:=240;
   FBTransparent:=True;
   FBChecked:=False;
   Checked:=False;
   FBChPlein:=False;
   FBReadOnly:=False;
   FBCaption:='';
end;

Destructor TBFCheckBox.Destroy;
Begin
   Inherited Destroy;
end;

procedure Register;
begin
  RegisterComponents('Exemples', [TBFCheckBox]);
end;
end.

Conclusion :


Le Panel est joint.
Si vous apportez des modifs, je suis preneur.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

yacineinf24
Messages postés
2
Date d'inscription
jeudi 21 juin 2012
Statut
Membre
Dernière intervention
27 juin 2012
-
j aisselle de valider notre code mais ne donne aucun résultat tu peut l'aide moi
merci
francoisbalsan
Messages postés
3
Date d'inscription
samedi 29 décembre 2007
Statut
Membre
Dernière intervention
27 juin 2012
-
Compilé avec delphi4.
Souvent avec d'autres versions voir rect(point(x,y),point(x1,y1));
Quelle version utilises-tu?
Si non, ou est l'arret ?

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.