Panel et checkbox
Description
Suite de composants avec scanline.
Un panel, et un checkbox.
Checkbox pouvant être transparent, coché ou plein, et en lecture seule.
Exemple.
Le Panel est joint.
Si vous apportez des modifs, je suis preneur.
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.
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.