Newsgroup: it.comp.lang.delphi
Titolo: Componente Edit

Mi sono voluto cimentare a fare il mio primo componente. Ho scelto un 
componente derivato da TEdit, a cui ho aggiunto le seguenti funzionalità:
- Di definire se accetti solo numeri.
- da formattare la stringa man mano che si immette con separatori di 
migliaia e di decimale
- di definire il max num di decimali
- di allineare a sinistra, destra o centro
- di includere inizialmente nel corpo dell'edit un testo (in genere un testo 
di aiuto che sparisce alla immissione del 1o carattere)
- di indicare un diverso colore quando si entra nell'edit
- di definire se si vuole un bottone a sinistra nel corpo dell'edit-
Naturalmente è ben poco farina del mio sacco, ma ho tratto idea e codice da 
molti esempi in giro sulla rete, nessuno dei quali faceva tutto quello che 
volevo io. Volvevo mettere quindi il componente a disposizione di tutti, ma 
l'ultima modifica che ho fatto, cioè l'aggiunta di un bottone, mi sono 
accorto che non funziona bene. I caratteri che si digitano nell'edit non 
rispettano l'area del bottone, se impostato a visibile.
Poichè non ho trovato ancora una soluzione, ho pensato di mostrarvi il 
codice qui di seguito, in modo che chi lo volesse usare lo può fare, magari 
non usando il bottone, perchè il resto mi sembra funzioni perfettamente.
Poichè l'ho fatto soprattutto per imparare, chi ha dei suggerimenti da darmi 
è il benvenuto ! Grazie
 
Ecco il codice:
unit FullEditCBtn;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Menus, Buttons;
type
  TFullEditwBtn = class(TEdit)
  private
    FButton:  TBitBtn;  // Bottone aggiunto all'edit
    FAlignment: TAlignment;
    FNumberOnly: Boolean;
    FThousendSep: Boolean;
    FMaxLength: integer;
    FMaxDecimals: integer;
    FOldBackColor : TColor;
    FColorOnEnter : TColor;
    FormatString: string;  { '#.##0.'  or  '#0.'}
    FTabOnEnter: boolean;
    FInsideHelpActive: Boolean;
    FInsideHelpText: String;
    FInsideHelpColor: TColor;
    procedure SetInsideHelpActive(const Value: Boolean);
    procedure SetInsideHelpColor(const Value: TColor);
    procedure SetInsideHelpText(const Value: String);
    procedure SetMaxDecimals(Value: integer);
    procedure SetMaxLength(Value: integer);
    function  StripThousSep(AString: string): string;
    procedure Reformat;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    property OldBackColor : TColor read FOldBackColor write 
FOldBackColor;//da adpEdit
    function  SetButtonClick: TNotifyEvent;
    procedure GetButtonClick(const Value: TNotifyEvent);
    function  GetGlyph: TBitmap;  // property Glyph dell'Edit (x il bottone)
    function  GetNumGlyphs: integer;
    procedure SetGlyph(const g: TBitmap);
    procedure SetNumGlyphs(const n: integer);
    function  GetBtnBorder: integer;    // new: x dimesionare a piacere il 
bottone
    procedure SetBtnBorder(s: integer); // new: x dimesionare a piacere il 
bottone
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: char); override; //modificato da adpEdit
    procedure SetAlignment(Value: TAlignment);
    procedure SetNumberOnly(Value: Boolean);
    procedure SetThousendSep(Value: Boolean);
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure WMPaint(var M: TMessage); message WM_Paint;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    function  GetBtnEnabled: boolean; {$IFDEF COMPILER_4_UP} reintroduce; 
{$ENDIF}
    procedure SetBtnEnabled(f: boolean); {$IFDEF COMPILER_4_UP} reintroduce; 
{$ENDIF}
    procedure DoButtonClick; virtual; abstract;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy;
  published
    property Alignment: TAlignment read FAlignment write SetAlignment 
default taLeftJustify;
    property NumberOnly: Boolean read FNumberOnly write SetNumberOnly;
    property ThousendSep: Boolean read FThousendSep write SetThousendSep;
    property MaxLength: integer read FMaxLength write SetMaxLength;
    property MaxDecimals: integer read FMaxDecimals write SetMaxDecimals;
    property ColorOnEnter :TColor read FColorOnEnter write FColorOnEnter; 
//da adpEdit
    property TabOnEnter : boolean read FTabOnEnter write FTabOnEnter; 
//da adpEdit
    property OnButtonClick: TNotifyEvent read SetButtonClick write 
GetButtonClick;
    property  Button: TBitBtn read FButton write FButton;
    property  Glyph: TBitmap read GetGlyph write SetGlyph;
    property  NumGlyphs: integer read GetNumGlyphs write SetNumGlyphs;
    property  BtnEnabled: boolean read GetBtnEnabled write SetBtnEnabled;
    property  BtnBorder: integer read GetBtnBorder write SetBtnBorder;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property CharCase;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property OEMConvert;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;
procedure Register;
 
implementation
var
  nDecimals: integer;
  nBorder: integer; // da EditwBtn.pas
const
  Alignments: array[TAlignment] of Word = (ES_LEFT, ES_RIGHT, ES_CENTER);
 
constructor TFullEditwBtn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csSetCaption]; // necessaria ??
  // default
  FAlignment := taLeftJustify;
  FNumberOnly := False;
  ThousendSep := False;
  FMaxLength := 16;
  MaxDecimals := CurrencyDecimals;
  FColorOnEnter := Color;
  FTabOnEnter := false;
  Height := 24;
  Width := 120;
  Self.FInsideHelpActive:= False;
  Self.FInsideHelpText  := Self.FInsideHelpText;
  Self.FInsideHelpColor := Self.FInsideHelpColor;
  FButton := TBitBtn.Create(self);  // crea il BitBtn FButton
  with FButton do begin
     Parent := self;
     TabStop := false;
     Visible := true;
     OnClick := OnButtonClick;
  end;
end;
 
procedure TFullEditwBtn.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
   Params.Style := Params.Style or Alignments[FAlignment] or 
WS_CLIPCHILDREN;
  // WS_CLIPCHILDREN credevo potesse proteggere l'area del bottone, ma non è 
così ...
end;
 
destructor TFullEditwBtn.Destroy;
begin
  inherited Destroy;
end;
 
procedure TFullEditwBtn.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value; // taLeftJustify, taRightJustify, taCenter
    RecreateWnd;
  end;
end;
 
procedure TFullEditwBtn.SetNumberOnly(Value: Boolean);
begin
  if FNumberOnly <> Value then
    FNumberOnly := Value;
end;
 
procedure TFullEditwBtn.SetThousendSep(Value: Boolean);
begin
  if FThousendSep <> Value then
    FThousendSep := Value;
end;
 
procedure TFullEditwBtn.SetMaxDecimals(Value: integer);
begin
  if ( Value > 0 ) and ( Value < FMaxLength-1 ) then
    FMaxDecimals := Value;
end;
 
procedure TFullEditwBtn.SetMaxLength(Value: integer);
begin
if ( Value < 20 ) and ( Value > FMaxDecimals+1 ) then
   FMaxLength := Value;
end;
 
procedure TFullEditwBtn.KeyDown(var Key: Word; Shift: TShiftState);
{gestisce la cancellazione dall'edit di 1 o + caratteri }
var
  CursorPos: integer;
  Buffer: string;
begin
  inherited KeyDown(Key,Shift);
 
  if Key = VK_DELETE then
  begin
     Buffer := Text;
     if SelLength > 0 then begin
        CursorPos := Length(Buffer)-SelStart-SelLength;
        Delete( Buffer, SelStart+1, SelLength);
        SelLength:= 0;
        Key := 0;
        Text := Buffer;
     end else begin
        //Se la cancellazione coinvolge 1 solo carattere
        CursorPos := Length(Buffer)-SelStart;
        Delete( Buffer, Length(Buffer)-CursorPos+1, 1 );
        Dec(CursorPos);
        Text := Buffer; //RESETTA text al valore rimasto dopo la 
cancellazione
     end;
     Key := 0;
     if length(Text) = 0 then exit;
     if NumberOnly then
        Reformat;
     SelStart := Length(Text)-CursorPos;
  end;
end;
 
procedure TFullEditwBtn.KeyPress( var Key: char );
var
  Buffer: string;
  CursorPos,i: integer;
begin
  inherited KeyPress(Key);
  if TabOnEnter AND (Owner is TWinControl) then
  begin
    if Key = Char(VK_RETURN) then
    begin
     if HiWord(GetKeyState(VK_SHIFT)) <> 0 then
        PostMessage((Owner as TWinControl).Handle, WM_NEXTDLGCTL, 1, 0)
     else
        PostMessage((Owner as TWinControl).Handle, WM_NEXTDLGCTL, 0, 0);
    end;
  end;
 
  if FNumberOnly then
  begin
     Buffer := Text; //la 1a key digitata ancora non è in Text (ma è in Key)
     if (Key <> #0) and (SelLength > 0) then begin
         Delete( Buffer, SelStart+1, SelLength);  //cancella parte 
selezionata
         SelLength:= 0;
     end;
     CursorPos := Length(Buffer)-SelStart;
     if (length(Buffer) > 0) and (Buffer[1] = '-') then
        if CursorPos = length(Buffer) then
        begin
           Key := #0;
           exit;
        end;
     if key = DecimalSeparator then
     begin
       if Length(StripThousSep(Buffer)) < FMaxLength-1 then
          if pos(DecimalSeparator,Text) = 0 then
          begin
             if CursorPos <= MaxDecimals then
                Insert( Key, Buffer, SelStart+1);
          end;
     end else
     if key = '-' then
     {2-DIGITATO NELL'EDIT UN CAR + o -}
     begin
        if (length(Buffer) = 0) or
           ((SelStart=0) and (pos('-',Buffer)=0)) or
           ((SelStart=0) and (pos('+',Buffer)=0))
        then
          Insert( Key, Buffer, Length(Buffer)-CursorPos+1 );
     end else
     if key in ['0'..'9'] then
     {2-DIGITATO NELL'EDIT UN CAR TRA 0 E 9}
     begin
        nDecimals:= 0;
        if pos(DecimalSeparator,Buffer) > 0 then
           for i:= pos(DecimalSeparator,Buffer) to length(Buffer)-1 do
             inc(nDecimals);
        if Length(StripThousSep(Buffer)) < FMaxLength then
        begin
          if pos(DecimalSeparator,Text) = 0 then
            Insert( Key, Buffer, Length(Buffer)-CursorPos+1 )
          else
            if SelStart > length(buffer)-nDecimals then
               if nDecimals+1 <= MaxDecimals then
                  Insert( Key, Buffer, Length(Buffer)-CursorPos+1 )
               else
            else
               Insert( Key, Buffer, Length(Buffer)-CursorPos+1 )
        end; //if Length(StripThousSep(Buffer))
     end else
     if key = #8 then
     {3-DIGITATO NELL'EDIT BACKSPACE}
        Delete( Buffer, Length(Buffer)-CursorPos, 1 );
 
     Key := #0;
     Text := Buffer;
     if length(Text) > 0 then
        if (length(Text) = 1) and (Text='-') then
           else
        if pos(DecimalSeparator,Text[length(Text)]) = 0 then
           Reformat;
     SelStart := Length(Text)-CursorPos; //CursorPos=Len(buffer)-SelStart
  end; //if NumberOnly
end;
 
function TFullEditwBtn.StripThousSep(AString: string): string;
begin
  while (Pos(ThousandSeparator, AString) > 0 ) do
    delete(AString, Pos(ThousandSeparator, AString), 1);
  Result := AString;
end;
 
procedure TFullEditwBtn.Reformat;
{ Questa funzione formatta 'text' (cioè il contenuto numerico dell'edit)
  secondo quanto indicato dalle proprietà ThousendSep
}
var
  i: integer;
begin
  if FThousendSep then
     FormatString := '#,##0.'
  else
     FormatString := '#0.';
  Text:= StripThousSep(Text);  // azzera SelStart !!!
  nDecimals := 0;
  if pos(DecimalSeparator,Text) > 0 then
  begin
     if pos(DecimalSeparator,Text) > 0 then
        for i:= pos(DecimalSeparator,Text) to length(text)-1 do
          inc(nDecimals)
     else
        nDecimals:= 0;
     for i := 1 to nDecimals do FormatString := FormatString + '0';
     Text := FormatFloat(FormatString, StrToFloat(StripThousSep(Text)));
  end else
     Text := FormatFloat(FormatString, StrToFloat(StripThousSep(Text)));
end;
 
procedure TFullEditwBtn.CMEnter(var Message: TCMGotFocus);
begin
  SelStart := Length(Text);
  inherited;
end; // va a WMPaint
 
procedure TFullEditwBtn.DoEnter;
begin
  SelectAll;
  OldBackColor := Color;
  Color := ColorOnEnter;
  inherited DoEnter;
end;
 
procedure TFullEditwBtn.DoExit;
begin
  Color := OldBackColor;
  inherited DoExit;
end;
 
procedure TFullEditwBtn.WMPaint(var M: TMessage);
var
  MCanvas: TControlCanvas;
  DrawBounds: TRect;
begin
  if (Self.Text <> '') or (not Self.FInsideHelpActive) then begin
    inherited;
    Exit;
  end;
  inherited;
  MCanvas := TControlCanvas.Create;
  DrawBounds := ClientRect;
  try
    MCanvas.Control := Self;
    MCanvas.Brush.Color := Self.Color;
    MCanvas.Font.Color := Self.FInsideHelpColor;
 
MCanvas.Font.Name
 := 'Arial';
    MCanvas.Font.Style := MCanvas.Font.Style + [fsBold];
    MCanvas.TextOut(2,2, Self.FInsideHelpText);
  finally
    MCanvas.Free;
  end;
end;
 
procedure TFullEditwBtn.CMExit(var Message: TCMExit);
begin
  Color := OldBackColor;
  Self.Repaint;
end;
 
procedure TFullEditwBtn.SetInsideHelpActive(const Value: Boolean);
begin
  Self.FInsideHelpActive := Value;
  Self.Repaint;
end;
 
procedure TFullEditwBtn.SetInsideHelpColor(const Value: TColor);
begin
  Self.FInsideHelpColor := Value;
  Repaint;
end;
 
procedure TFullEditwBtn.SetInsideHelpText(const Value: String);
begin
  Self.FInsideHelpText := Value;
  Repaint;
end;
 
procedure TFullEditwBtn.SetBtnEnabled(f: boolean);
begin
   FButton.Enabled := f;
end;
 
function TFullEditwBtn.GetBtnEnabled: boolean;
begin
   result := FButton.Enabled;
end;
 
function TFullEditwBtn.GetGlyph: TBitmap;
begin
   result := FButton.Glyph;
end;
 
procedure TFullEditwBtn.SetGlyph(const g: TBitmap);
begin
   FButton.Glyph := g;
end;
 
function TFullEditwBtn.GetNumGlyphs: integer;
begin
   result := FButton.NumGlyphs;
end;
 
procedure TFullEditwBtn.SetNumGlyphs(const n: integer);
begin
   FButton.NumGlyphs := n;
end;
 
procedure TFullEditwBtn.SetBtnBorder(s: integer);
begin
   nBorder := s;  // valore del bordo esterno bottone
end;
 
function TFullEditwBtn.GetBtnBorder: integer;
begin
   result := nBorder;
end;
 
procedure TFullEditwBtn.WMSize(var Message: TWMSize);
var
  b: integer;
begin
  if (not FButton.Enabled) or (not Enabled) then
  begin
    FButton.Width := 0;
    FButton.Left := ClientWidth;
    exit;
  end;
  if (BorderStyle = bsSingle) and not Ctl3d then
     b := nBorder+1
  else
     b := nBorder;
  FButton.Top := b;
  FButton.Height := ClientHeight - b * 2;
  FButton.Width := FButton.Height;
  FButton.Left := ClientWidth - FButton.Width - b;
end;
 
function TFullEditwBtn.SetButtonClick: TNotifyEvent;
begin
  result:= FButton.OnClick;
end;
 
procedure TFullEditwBtn.GetButtonClick(const value: TNotifyEvent);
begin
  FButton.OnClick:= value;
end;
 
procedure Register;
begin
  RegisterComponents('InProva', [TFullEditwBtn]);
end;
 
end. 
 
 
---
Questa e-mail è priva di virus e malware perché è attiva la protezione avast! Antivirus.
http://www.avast.com
 
 

 componente derivato da TEdit, a cui ho aggiunto le seguenti funzionalità [...]
 
In generale, conviene derivare la classe superiore nella gerarchia, ossia *TCustomEdit*: in questo modo, puoi decidere tu quali membri della classe del controllo rendere disponibili all'utente, cosa che non puoi fare se erediti direttamente da *TEdit* poiché quest'ultima non fa altro che esporre pubblicamente tutto ciò che è presente in *TCustomEdit*.
 
Ad esempio, potrebbe tornarti utile nascondere certe proprietà (es. mi è capitato di dover precludere l'accesso a /Color/ per gestire internamente il colore della casella, senza possibilità di valorizzazione diretta da parte dell'utente, che potrebbe aggirare la mia logica, oppure nascondere certi eventi).
 
Per il resto, se trovo il tempo (sempre tiranno) di analizzare il codice che hai scritto, magari mi viene in mente qualche altro suggerimento. :)
 
Per uno spunto, visto che si tratta di un esercizio, puoi leggere il codice sorgente del componente *TButtonedEdit* (
http://docwiki.embarcadero.com/Libraries/XE7/en/Vcl.ExtCtrls.TButtonedEdit
), che è già incluso in Delphi.
 
Ciao,
  Marco.
 
-- 
MARCO BREVEGLIERI (Software and Web Developer)
#Home: 
http://bit.ly/marcobreveglieri
 
#Blog: 
http://bit.ly/compilaquindiva
 

"Marco Breveglieri"  ha scritto nel messaggio 
news:d2a2d138-f4b1-43c7...@googlegroups.com...
Per il resto, se trovo il tempo (sempre tiranno) di analizzare il codice che 
hai scritto, magari mi viene in mente qualche altro suggerimento. :)
 
Per uno spunto, visto che si tratta di un esercizio, puoi leggere il codice 
sorgente del componente *TButtonedEdit* 
(
http://docwiki.embarcadero.com/Libraries/XE7/en/Vcl.ExtCtrls.TButtonedEdit
), 
che è già incluso in Delphi.
Ciao,
  Marco.
Grazie davvero Marco. In che versione di Delphi è incluso TButtonedEdit ? Io 
ho Delphi 2007 e magari ho fatto un lavoro inutile, ma il mio obiettivo era 
di mettere insieme tutte le possibili opzioni che desideravo e nello stesso 
tempo imparare un pò. Per esempio, già il tuo commento sull'uso di TEdit 
piuttosto che TCustomEdit mi è utile. Sono andatro a vedere sul link che mi 
hai dato, ma il source dov'è. Anche in Delphi 2007 non ho trovato source 
delle classi. E' forse una delle opzioni in fase di installazione ? 


Nessuno lo ha provato ? Immagino voglia dire che è inutile e non se ne 
avverte l'esigenza. C'è qualcosa di analogo nelle versioni Delphi successive 
al 2007 ?
 
"Stark"  ha scritto nel messaggio news:m8jfrn$u1e$1...@speranza.aioe.org...

---
Questa e-mail è stata controllata per individuare virus con Avast antivirus.
http://www.avast.com