Composant grille avec nouvelles propriétés

Télécharger le projet
Commenter

Description

- Propriété About = Auteur-Concepteur.
- Propriété Aide = Aide descriptif sur les Propriétés.
- Propriété AlignText : Formatte un texte dans les Cellules
- Propriété Automatic : Ajuste automatiquement la Largeur et Hauteur de la Grille.
- Propriété FormatNumeric : Formatage à droite des cellules contenant des nombres.
- Propriété CellColor: CellCor : Couleur pour la Cellule choisie. (ou ligne ou Colonne).
- Fonction Publiée : ChangeCellColor(Acol,ARow:Integer) - Couleur de Cellule.
- Propriété Picture : Image BitMap sélectionnée pour la fonction CellBitMap.
- Utilisation de la Fonction Publiée : CellBitMap(ACol,ARow:Integer).

Source / Exemple : 


unit TGrille;     // Composant Visuel Grille Hérité TStringGrid @ Guy Bidi 2008
interface
uses Windows,SysUtils,Classes,Controls,Grids,Types,Graphics,Forms,StdCtrls,
     Dialogs,ShellApi;
 Const Mess='  Propriété About : Auteur : © Guy Bidi - paounet@free.fr'+Chr(13)+Chr(13)+
      ' 1 - La Propriété Aide à True affiche l''Aide actuelle.'+Chr(13)+Chr(13)+
      ' 2 - La Propriété AlignText :'+Chr(13)+Chr(13)+
      '      Left       :   Aligne à Gauche le texte des  Cellules.'+Chr(13)+
      '      Center  :   Aligne au Centre le texte des Cellules.'+Chr(13)+
      '      Right    :   Aligne à Droite    le texte des Cellules.'+Chr(13)+Chr(13)+
      ' 3 - La Propriété Automatic :  Ajuste la Largeur et Hauteur de la Grille (True ).'+Chr(13)+Chr(13)+
      ' 4 - La Propriété FormatNumeric : '+Chr(13)+Chr(13)+
      '      En utilisant les symbôles de formatage tels que #, 0, . les cellules contenant des'+Chr(13)+
      '      nombres seront formatés à droite comme la fonction FormatFloat (''0.##'',Valeur).'+Chr(13)+Chr(13)+
      ' 5 - La Propriété CellColor: CellCor :  Couleur pour la Cellule choisie.'+Chr(13)+Chr(13)+
      '      IndexCol   : Index de Colonne   /   IndexRow : Index de Ligne.'+Chr(13)+
      '      Si IndexRow/IndexCol est vide alors toute la colonne/Ligne sera affichée '+Chr(13)+
      '      avec la couleur issue de CellColor.'+Chr(13)+Chr(13)+
      ' 6- Utilisation de la Fonction Publiée : ChangeCellColor(Acol,ARow:Integer)'+Chr(13)+Chr(13)+
      '       - Couleur de Cellule : CellColor.Color '+Chr(13)+Chr(13)+
      ' 7 - La Propriété Picture : Image BitMap sélectionnée pour la fonction CellBitMap'+Chr(13)+Chr(13)+
      ' 8- Utilisation de la Fonction Publique : CellBitMap(ACol,ARow:Integer)'+Chr(13)+Chr(13)+
      '          Grille1.CellBitMap(-1,-1) Toute la Grille est dessinée'+Chr(13)+
      '          Grille1.CellBitMap(2,3);   La Cellule(2,3) est dessinée'+Chr(13)+
      '          Grille1.CellBitMap(-1,2);  Toute la Ligne N° 2 est dessinée'+Chr(13)+
      '          Grille1.CellBitMap(2,-1);  Toute la Colonne N° 2 est dessinée';
type
  TCellColor = class(TPersistent)                     // Propriétés rajoutées à Grille
  private             { Déclarations privées }        // Variables Utilisées
  FColor:TColor;FCol:String;FRow:String;              // Couleur, Colonne, Ligne
  Procedure SetCol(Value:String);
  Procedure SetRow(Value:String);
  protected           { Déclarations protégées }
  public              { Déclarations publiques }
    Constructor Create(Owner:Tcomponent);
  published           { Déclarations publiées }
    Property Color:TColor Read FColor Write FColor;
    Property IndexCol:String Read FCol Write SetCol;
    Property IndexRow:String Read FRow Write SEtRow;
end;
type
  TAbout=String;                            // Propriété About rajoutée
  TAide=Boolean;                            // Propriété Aide sur le Composant
  TAlignText=(Left,Center,Right);           // Propriété Alignement du Texte
  TAuto=Boolean;                            // Ajuste la Grille Automatiquement
  TFormat=String;                           // Propriété Format pour Numérique
  Grille = class(TStringGrid)
  private             { Déclarations privées }        // Variables Utilisées
    FAbout:TAbout;FAide:TAide;FAlignText:TAlignText;Fauto:TAuto;FFormat:TFormat;
    FCellColor:TCellColor;FormAide:TForm;Memo:TMemo;FBitMap:TBitMap;
  protected           { Déclarations protégées }
   procedure DrawCell(ACol:Longint;ARow:Longint;Rectangle:TRect;State:TGridDrawState); override;
   procedure MemoDblClick(Sender:TObject);
   procedure SetBitMap(Value:TBitMap);
  public              { Déclarations publiques }
    Constructor Create(Owner:Tcomponent);override;
    destructor Destroy;Override;
  published           { Déclarations publiées }
    Property About:TAbout read FAbout;
    Property Aide:TAide read FAide Write FAide;
    Property AlignText:TAlignText read FAlignText Write FAlignText;
    Property Automatic:TAuto read FAuto Write FAuto;
    Property FormatNumeric:TFormat Read FFormat Write FFormat;
    Property CellColor:TCellColor Read FCellColor Write FCellColor;
    Property CellPicture:TBitMap Read FBitMap Write SetBitMap;
    Procedure ChangeColorCell(ACol,ARow:Integer);
    Procedure CellBitMap(ACol,ARow:Integer);
end;
procedure Register;
implementation
Procedure Grille.MemoDblClick(Sender:TObject);
Begin
  FormAide.ModalResult:=mrOk;
End;
Constructor TCellColor.Create(Owner:TComponent);
Begin
    // Rien Ici
End;
procedure Grille.SetBitMap(Value:TBitMap);
begin
  If Value<>Nil Then FBitMap.Assign(Value);
end;
Constructor Grille.Create(Owner:TComponent);
Begin
  Inherited Create(Owner);FixedCols:=0;FixedRows:=0;FAbout:='© Guy Bidi - 2008';
  Font.Name:= 'Comic Sans MS';ScrollBars:=ssNone;FAlignText:=Center;
  FAuto:=True;FAide:=False;Font.Style:=[fsBold];FFormat:='';Color:=clMoneyGreen;
  If Owner Is TForm Then With TForm(Owner)Do Position:=poScreenCenter;
  FormAide:=TForm.CreateNew(Application);With FormAide Do Begin Left:=0;Top:=0;
  AutoSize:=True;BorderIcons:=[];BorderStyle:=bsDialog;ClientHeight:=577;
  Caption:='Les Nouvelles Propriétés du Composant Grille © Guy Bidi - 2008';
  ClientWidth:=561;Color:=clBtnFace;Font.Charset:=DEFAULT_CHARSET;Font.Style:=[];
  Font.Color:=clWindowText;Font.Height:=-13;Font.Name:='Century Gothic';
  OldCreateOrder:=False;Position:=poScreenCenter;PixelsPerInch:=120;End;
  Memo:=TMemo.Create(Owner);With Memo Do Begin Parent:=FormAide;Left:=0;Top:=0;
  Width:=567;Height:=608;Hint:='Double-Cliquer pour sortir';Color:=clSkyBlue;
  Font.Charset:=DEFAULT_CHARSET;Font.Color:=clBlack;Font.Height:=-13;
  Font.Name:='Century Gothic';Font.Style:=[fsBold];ParentFont:=False;
  ParentShowHint:=False;ShowHint:=True;Lines.Text:=Mess;
  WantReturns:=True;OnDblClick:=MemoDblClick;End;
  FCellColor:=TCellColor.Create(Self);With FCellColor Do Begin
    FColor:=Color;FCol:='';FRow:='';End;
  FBitMap:=TBitMap.Create;
End;
Procedure TCellColor.SetCol(Value:String);
Begin
  If Not(Ord(Copy(Value,1,1))) In [49..59] Then Value:='';FCol:=Value;
End;
Procedure TCellColor.SetRow(Value:String);
Begin
  If Not(Ord(Copy(Value,1,1))) In [49..59] Then Value:='';FRow:=Value;
End;
Procedure Grille.DrawCell(ACol,ARow:Integer;Rectangle:TRect;State:TGridDrawState);
Var Valeur:Real;Code,i,j:Integer;
Begin                            // Surchage OnDrawCell de la Grille
  Val(Trim(Cells[ACol,ARow]),Valeur,Code);
  If (FFormat<>'') And (Code=0) And (Trim(Cells[ACol,ARow])<>'') Then
      DrawText(Canvas.Handle,PWideChar(FormatFloat(FFormat,Valeur)),
      -1,Rectangle,DT_RIGHT or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE)
   Else
      If FAlignText=Center then DrawText(Canvas.Handle,PWideChar(Cells[ACol,ARow]),
      -1,Rectangle,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE)
      Else If FAlignText=Right then DrawText(Canvas.Handle,PWideChar(Cells[ACol,ARow]),
      -1,Rectangle,DT_RIGHT or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE)
      Else DrawText(Canvas.Handle,PWideChar(Cells[ACol,ARow]),
      -1,Rectangle,DT_LEFT or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE);
  If FAuto=True then Begin
    Width:=ColCount*DefaultColWidth+(ColCount+1)*GridLineWidth;
    Height:=RowCount*DefaultRowHeight+(RowCount+1)*GridLineWidth;End;
  If FAide then Begin FAide:=False;FormAide.ShowModal;End;
  If (FCellColor.FCol='') And (FCellColor.FRow='') Then Exit;
  If (FCellColor.FCol<>'') And (FCellColor.FRow<>'') And
    (StrToInt(FCellColor.FRow)<RowCount) And
    (StrToInt(FCellColor.FCol)<ColCount) Then Begin
    ChangeColorCell(StrToInt(FCellColor.Fcol),StrToInt(FCellColor.FRow));Exit;End;
  If FCellColor.FCol='' Then Begin
    If StrToInt(FCellColor.FRow)<RowCount Then Begin
      For i := 0 to ColCount - 1 do For j := 0 to RowCount-1 do Begin
        ChangeColorCell(i,StrToInt(FCellColor.FRow));End;Exit;End
    Else Begin MessageDlg('Valeur de Ligne trop grande',mtInformation,[mbOk],0,mbOk);
      FCellColor.FRow:='';Exit;End;End
  Else If FCellColor.FRow='' Then Begin
      If StrToInt(FCellColor.FCol)<ColCount Then Begin
        For i := 0 to ColCount - 1 do For j := 0 to RowCount-1 do Begin
          ChangeColorCell(StrToInt(FCellColor.FCol),j);End;Exit; End
      Else Begin MessageDlg('Valeur de Colonne trop grande',mtInformation,[mbOk],0,mbOk);
        FCellColor.FCol:='';Exit;End;End;
  FBitMap:=TBitMap.Create;FBitMap:=Nil;
End;
Procedure Grille.CellBitMap(ACol,ARow:Integer); // Procedure Publique CellBitMap
Var Rect,Rect1:TRect;
Begin
  If ACol<0 Then                            // Pas de Colonne
    If ARow<0 Then Begin                    // Toute la Grille est dessinée...
      Rect:=BoundsRect;Rect.Right:=Rect.Right-Rect.Left;
      Rect.Bottom:=Rect.Bottom-Rect.Top;Rect.Left:=0;Rect.Top:=0;End
    Else                                   // Toute une Colonne est dessinée
      If ARow>RowCount-1 Then Begin MessageDlg('Valeur de Ligne trop grande',
        mtInformation,[mbOk],0,mbOk);Exit;End
      Else Begin                           // Toute une Ligne est dessinée
        Rect:=CellRect(0,ARow);Rect1:=CellRect(ColCount-1,ARow);
        Rect.Right:=Rect1.Right;Rect.Bottom:=Rect1.Bottom;End
  Else If ARow<0 then
    If ACol>ColCount-1 Then Begin MessageDlg('Valeur de Ligne erronée',
      mtInformation,[mbOk],0,mbOk);Exit;End
    Else Begin                             // Toute une Colonne est dessinée
      Rect:=CellRect(ACol,0);Rect1:=CellRect(ACol,RowCount-1);
      Rect.Right:=Rect1.Right;Rect.Bottom:=Rect1.Bottom;End
  Else If (ACol>ColCount-1) Or (ARow>RowCount-1) Then Begin
    MessageDlg('Valeur de Colonne/Ligne erronée',mtInformation,[mbOk],0,mbOk);
  Exit;End Else Rect:=CellRect(ACol,ARow); // Une seule Cellule est dessinée
  Canvas.StretchDraw(Rect,CellPicture);    // Affiche le dessin dans Cellule(s)
End;
Procedure Grille.ChangeColorCell(ACol,ARow:Integer); // Changement de Couleur/Cellule
Var Valeur:Real;Code:Integer;Rectangle:TRect;
Begin
  Canvas.Brush.Color:=FCellColor.FColor;
  Rectangle:=CellRect(ACol,ARow);
  Canvas.TextRect(Rectangle,Rectangle.Left,Rectangle.Top,'');
  If Cells[ACol,ARow]<>'' then Begin
    Val(Trim(Cells[ACol,ARow]),Valeur,Code);
  If (FFormat<>'') And (Code=0) And (Trim(Cells[ACol,ARow])<>'') Then
      DrawText(Canvas.Handle,PWideChar(FormatFloat(FFormat,Valeur)),
      -1,Rectangle,DT_RIGHT or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE)
   Else
      If FAlignText=Center then DrawText(Canvas.Handle,PWideChar(Cells[ACol,ARow]),
      -1,Rectangle,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE)
      Else If FAlignText=Right then DrawText(Canvas.Handle,PWideChar(Cells[ACol,ARow]),
      -1,Rectangle,DT_RIGHT or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE)
      Else DrawText(Canvas.Handle,PWideChar(Cells[ACol,ARow]),
      -1,Rectangle,DT_LEFT or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE);
  End;
end;
destructor Grille.Destroy;             // Destruction du Composant
begin
  inherited Destroy;
end;
procedure Register;                   // Enregistre le Composant Grille
begin
  RegisterComponents('Guy Bidi',[Grille]);
end;
end.

Test du Composant Grille = Fichier TTest.pas (Test.dproj)
unit TTest;
interface
uses Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
     Dialogs,Grids,TGrille,StdCtrls,Buttons,Types;
type
  TFormGrille = class(TForm)Cellules:TSpeedButton;
    CellBitMapT: TSpeedButton;          
    CellBitMapC: TSpeedButton;
    CellBitMapCol: TSpeedButton;
    CellBitMapRow: TSpeedButton;
    Grille1: Grille;
    procedure FormShow(Sender:TObject);
    procedure CellulesClick(Sender:TObject);
    procedure CellBitMapClick(Sender:TObject);
  end;
var FormGrille:TFormGrille;Flag:Boolean;Ori:TColor;
implementation
{$R *.dfm}
procedure TFormGrille.CellBitMapClick(Sender:TObject);
begin
  case TSpeedButton(Sender).Tag of
    0:Grille1.CellBitMap(-1,-1);
    1:Grille1.CellBitMap(2,3);     // Cellule 2,3
    2:Grille1.CellBitMap(3,-1);    // Colonne N° 3
    3:Grille1.CellBitMap(-1,2);    // Ligne N° 2
  end;
end;
procedure TFormGrille.CellulesClick(Sender:TObject);
Var i:Integer;
begin
  With Grille1 Do Begin If Flag then CellColor.Color:=Color Else
    CellColor.Color:=Ori;Flag:=Not(Flag);
  For i:= 0 to 4 do ChangeColorCell(i,i);End;
end;
procedure TFormGrille.FormShow(Sender:TObject);
begin
    Flag:=False;With Grille1 Do Begin Ori:=Grille1.CellColor.Color;
    Cells[0,0]:='12345.34';Cells[1,1]:='12.55';Cells[2,2]:='0.75';
    Cells[3,3]:='Guy Bidi';End;
end;
end.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_Paounet)