Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > OOP
Actualizar esta página Problema al agrandar este nuevo componente
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 30-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 22
José Luis Garcí Va camino a la fama
Problema al agrandar este nuevo componente
Hola compañeros, como siempre haber si podéis echarme una mano con este componente, que por culpa de el (llevo cuatro días intentando buscar una solución y por un error en un archivo DFM, no he podido seguir con el tema de programa de gestión desde 0.

El problema es el siguiente, pongo el componente y bien, en cuanto lo alargamos en tamaño, se ve la parte que estaba visible pero la nueva parte no, lo ejecuto y se ve completamente, pero por si algún motivo lo alargamos en ejecución pasa lo mismo.

Os pongo el código

Código Delphi [-]
{ ****************************************************************** }
{                                                                    }
{   VCL component TDBNewEditJL                                         }
{                                                                    }
{   Code generated by Component Create for Delphi                    }
{                                                                    }
{   Generated from untitled component definition                     }
{   on 25 May 2013 at 11:52                                          }
{                                                                    }
{   Copyright © 201 by J.L.G.T.3                                     }
{                                                                    }
{ ****************************************************************** }

unit DBneweditjl;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
     Forms, Graphics, Stdctrls, Dialogs, Windows, DbTables, DB, DBCtrls;

type
  TBorderStyle = (bsNone, bsSingle, bsRound);

  TDBNewEditJL = class(TEdit)
    private
        FColorFocused : TColor;
        FOnlyNumbersDouble : Boolean;
        FOnlyDate  : Boolean;
        FFillToEnterDate: Boolean;
        FTextDefault : String;
        FAlignment: TAlignment;
        FBorderStyle: TBorderStyle;
        FBorderColor: TColor;
        FBorderRadio: Integer;
        FDataLink : TFieldDataLink;
        FBorderThick: Integer;
        FIncrouble;
        FEnterTab:Boolean;
        FMaxLenghTab:Boolean;
        procedure SetEnterTab(Value: boolean);
        function GetDataSource : TDataSource;
        function GetDataField : String;
        procedure SetDataField(Value : String);
        procedure SetBorderThick(Value:Integer);
        procedure SetIncr(Value: Double);
        procedure SetMaxLenghTab(Value: boolean);
        procedure SetDataSource(Value : TDataSource);
        procedure ActiveChange(Sender : TObject);
        procedure DataChange(Sender : TObject);
        procedure EditingChange(Sender : TObject);
        procedure UpdateData(Sender : TObject);
        procedure SetBorderColor(Color: TColor);
        procedure SetBorderRadio(Radio: integer);
        procedure SetBorderStyle(Value: TBorderStyle);
        procedure SetRound(Value: boolean);
        procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
        procedure WMSize(var Message: TWMSize); message WM_SIZE;
        procedure SetOnlyDate (Value : Boolean);
        procedure SetFillToEnterDate(Value : Boolean);
        procedure SetAlignment(Value: TAlignment);
        procedure AutoInitialize;
        procedure AutoDestroy;
        procedure SetColorFocused(Value : TColor);
        procedure SetOnlyNumbersDouble(Value : Boolean);
        procedure SetTextDefault(Value : String);
        procedure FOnResized(Sender: TObject);
        var VarCColor:Tcolor;
    protected
        procedure CreateWnd; override;
        procedure Change; override;
        procedure Click; override;
        procedure KeyPress(var Key : Char); override;
        procedure Loaded; override;
        procedure CreateParams(var Params: TCreateParams); override;
        procedure DoExit; override;
        procedure DoEnter; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
    published
        property OnChange;
        property OnClick;
        property OnDblClick;
        property OnDragDrop;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnResize;
        property ColorFocused : TColor read FColorFocused write SetColorFocused default clSkyBlue;
        property OnlyNumbersDouble : Boolean read FOnlyNumbersDouble write SetOnlyNumbersDouble default False;
        property TextDefault : String read FTextDefault write SetTextDefault;
        property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
        property FillToEnterDate: Boolean read FFillToEnterDate write SetFillToEnterDate default False;
        property OnlyDate: Boolean read FOnlyDate write SetOnlyDate default False;
        property BorderColor: TColor  read FBorderColor write SetBorderColor default clNavy;
        property BorderRadio: Integer read FBorderRadio write SetBorderRadio default 5;
        property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; //default bsRound;
        property DataField : String read GetDataField write SetDataField;
        property DataSource : TDataSource read GetDataSource write SetDataSource;
        property Incr: Double read FIncr write SetIncr;
        property MaxLenghTab: Boolean read FMaxLenghTab write SetMaxLenghTab default False;
        property BorderThick: Integer read FBorderThick write SetBorderThick default 1;
        property EnterTab: Boolean read FEnterTab write SetEnterTab default False;
end;

procedure Register;

implementation

procedure Register;
begin
     RegisterComponents('Data Controls', [TDBNewEditJL]);
end;

procedure TDBNewEditJL.AutoInitialize;
begin
     FColorFocused := clSkyBlue;
     FOnlyNumbersDouble := False;
     FAlignment:=taLeftJustify;
     FBorderColor:= clNavy;
     FBorderRadio:= 5;
     FBorderStyle:= bsRound;
     FOnlyDate  :=false;
     FFillToEnterDate:=True;
     FTextDefault :='';
     FDataLink := TFieldDataLink.Create;
     with FDataLink do
     begin
          { Assign handlers }
          OnDataChange := DataChange;
          OnUpdateData := UpdateData;
          OnEditingChange := EditingChange;
          OnActiveChange := ActiveChange;
     end;
     FIncr:=0.01;
     FMaxLenghTab:=True;
     FBorderThick:=1;
     FEnterTab:=False;
     OnResize := FOnResized;
end; { of AutoInitialize }

procedure TDBNewEditJL.AutoDestroy;
begin
     FDataLink.Free;
end; { of AutoDestroy }

function TDBNewEditJL.GetDataField : String;
begin
     Result := FDataLink.FieldName;
end;

procedure TDBNewEditJL.SetDataField(Value : String);
begin
     FDataLink.FieldName := Value;
end;

function TDBNewEditJL.GetDataSource : TDataSource;
begin
     Result := FDataLink.DataSource;
end;

procedure TDBNewEditJL.SetDataSource(Value : TDataSource);
begin
     FDataLink.DataSource := Value;
end;


procedure TDBNewEditJL.SetEnterTab(Value: boolean);
begin
  if FEnterTab<>value then FEnterTab:=Value;
end;

procedure TDBNewEditJL.ActiveChange(Sender : TObject);
const IntFieldTypes = [ftSmallInt, ftInteger, ftWord];
begin
     if DataField = '' then  Exit;
     if FDataLink <> nil then
        if FDataLink.Dataset <> nil then
           if FDataLink.Dataset.Active then    Text:=FDataLink.Field.AsString;
   //   raise EDatabaseError.Create('Wrong field type');
end;

procedure TDBNewEditJL.DataChange(Sender : TObject);
begin
     if FDataLink.Field = nil then
        begin

        end
     else
        begin
           Text:=FDataLink.Field.AsString;
        { Update component using properties of FDataLink.Field }
        end
end;

procedure TDBNewEditJL.UpdateData(Sender : TObject);
begin
     { Respond to OnUpdateData events of FDataLink }
      Text:=FDataLink.Field.AsString;
end;

procedure TDBNewEditJL.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    RecreateWnd;
  end;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetColorFocused(Value : TColor);
begin
     FColorFocused := Value;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetFillToEnterDate(Value: Boolean);
begin
    if FFillToEnterDate<>value then FFillToEnterDate:=Value;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetIncr(Value: Double);
begin
    if FIncr<>Value then FIncr:=Value;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetMaxLenghTab(Value: boolean);
begin
   if FMaxLenghTab<>Value then FMaxLenghTab:=value;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetOnlyDate(Value: Boolean);
begin
   if FOnlyDate<>value then
   begin
     if (FOnlyNumbersDouble) and (Value=true) then FOnlyNumbersDouble:=False;
     FOnlyDate:=Value;
   end;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetOnlyNumbersDouble(Value: Boolean);
begin
   if FOnlyNumbersDouble<>value then
   begin
     if (FOnlyDate) and (Value=true) then FOnlyDate:=False;
     if Value=true then Alignment:=taRightJustify else Alignment:=taLeftJustify;
     FOnlyNumbersDouble:=Value;
   end;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.EditingChange(Sender : TObject);
begin
     { Respond to OnEditingChange events of FDataLink }
     { The data source has gone from editing to non-editing,
       or the reverse; update the component's properties
       based on the value of FDataLink.Editing. }
     { ReadOnly := not FDataLink.Editing; }
     { . . . if the component has a ReadOnly property, or . . . }
     { Enabled := not FDataLink.Editing; }
     if FDataLink.DataSet.State in [dsEdit, dsInsert]  then
     begin
         if OnlyDate then FDataLink.Field.Value:=StrToDate(Text)
                     else if OnlyNumbersDouble then FDataLink.Field.Value:=StrToFloat(text)
                                               else FDataLink.Field.Value:=Text;
     end;
end;

procedure TDBNewEditJL.FOnResized(Sender: TObject);
begin
   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetTextDefault(Value : String);
begin
     if FTextDefault<>Value then FTextDefault := Value;
       RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.Change;
begin
     inherited Change;
     if FMaxLenghTab then
     begin
       if (Length(Text)>=MaxLength) and (MaxLength<>0) and (Self.Focused) then keybd_event(VK_TAB ,0,0,0); //Pulsa el tab por código
     end;
end;

procedure TDBNewEditJL.Click;
begin
     inherited Click;
       RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.KeyDown(var Key: Word; Shift: TShiftState);
var Numerouble;
begin
  if FOnlyDate then
  begin
     if (Key=VK_UP) then text:=DateToStr(StrToDate(Self.Text)+1);  //Añadimos  díaa
     if (Key=VK_DOWN) then Text:=DateToStr(StrToDate(Self.Text)+1);//Disminuimos  días
     Key := 0;
  end;
  if FOnlyNumbersDouble then
  begin
     Numer:=StrToFloat(Text);
     if (Key=VK_UP) then Numer:=numer+FIncr;
     if (Key=VK_DOWN) then Numer:=Numer-FIncr;
     if Numer>=0 then Text:=FloatToStr(Numer)
                 else text:='-'+FloatToStr(Numer);
     Key := 0;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TDBNewEditJL.KeyPress(var Key : Char);
const TabKey = Char(VK_TAB);
      EnterKey = Char(VK_RETURN);
begin
   if FOnlyNumbersDouble then
   begin
     if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
     begin
        ShowMessage('Tecla no valida: ' + Key);
        Key := #0;
     end else if ((Key = DecimalSeparator) or (Key = '-') or (Key=',')) and (Pos(Key, Self.Text) > 0) then
     begin
        ShowMessage('Tecla no valida: (por repetida) ' + Key);
        Key := #0;
     end else if (Key = '-') and (Self.SelStart <> 0) then
     begin
        ShowMessage('Sólo se permite numeros: ' + Key);
        Key := #0;
     end;
   end;
   If Key = #13 Then
   Begin
      if FEnterTab then
      begin
        keybd_event(VK_TAB ,0,0,0); //Pulsa el Tab por código
        Key := #0
      end;
   end;
   inherited KeyPress(Key);
end;

constructor TDBNewEditJL.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     AutoInitialize;
end;

procedure TDBNewEditJL.CreateParams(var Params: TCreateParams);
const
  Alignments : array[TAlignment] of LongWord= (ES_Left,ES_Right, ES_Center);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or Alignments[FAlignment];
end;

destructor TDBNewEditJL.Destroy;
begin
     AutoDestroy;
     inherited Destroy;
end;

procedure TDBNewEditJL.Loaded;
begin
     inherited Loaded;
end;

procedure TDBNewEditJL.DoEnter;
begin
  inherited;
  VarCColor:=Self.Color;
  SElf.Color:=fcolorFocused;
  if (FOnlyDate) and (FillToEnterDate) then Self.Text:=DateToStr(Now);
end;

procedure TDBNewEditJL.DoExit;
begin
  self.Color:=VarCColor;
  if (self.text='') and (FOnlyNumbersDouble=False) and (FOnlyDate=false) then self.text:=ftextDefault;
  if (FOnlyNumbersDouble) and (Self.Text='') then Self.Text:='0';
  if (FOnlyDate) and (Self.Text='') then Self.Text:=DateToStr(Now);
  inherited;
end;

//todo esto es cogido del compañero Escafandra de su componente RoundEdit

procedure TDBNewEditJL.CreateWnd;
begin
  inherited CreateWnd;
  SetRound(FBorderStyle = bsRound);
end;


procedure TDBNewEditJL.SetRound(Value: boolean);
var
  Rgn: HRGN;
begin
  Rgn:= 0;
  if Value then
    Rgn := CreateRoundRectRgn(0, 0, Width+1, Height+1, FBorderRadio-2, FBorderRadio-2) ;
  SetWindowRgn(Handle, Rgn, true);
  DeleteObject(Rgn);
end;

procedure TDBNewEditJL.SetBorderColor(Color: TColor);
begin
  FBorderColor:= Color;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  Invalidate;
end;


procedure TDBNewEditJL.SetBorderRadio(Radio: integer);
begin
  if Radio <= 10 then
  begin
    FBorderRadio:= Radio;
    SetRound(true);
    RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  end;
end;

procedure TDBNewEditJL.SetBorderStyle(Value: TBorderStyle);
begin
  if Value <> FBorderStyle then
  begin
    FBorderStyle:= Value;
    SetRound(false);
    inherited Ctl3D:= Ctl3D;
    case Value of
      bsNone:   inherited BorderStyle := Forms.TBorderStyle(bsNone);
      bsSingle: inherited BorderStyle := Forms.TBorderStyle(bsSingle);
      bsRound:
      begin
        inherited BorderStyle := Forms.TBorderStyle(bsSingle);
        inherited Ctl3D:= true;
        SetRound(true);
      end;
    end;
    RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  end;
end;


procedure TDBNewEditJL.SetBorderThick(Value: Integer);
begin
    if FBorderThick<>value then FBorderThick:=Value;       //añadido por mi
end;

procedure TDBNewEditJL.WMNCPaint(var Message: TMessage);
var
  Brush: TBrush;
  Pen: TPen;
  DC: HDC;
  Clip: integer;
begin
  if (BorderStyle <> bsRound) or not inherited Ctl3D then
  begin
    inherited;
    exit;
  end;

  DC:= GetWindowDC(Handle);
  Brush:= TBrush.Create;
  Pen:= TPen.Create;
  Pen.Color:= BorderColor;
  Pen.Width:=FBorderThick;  //añadido por mi
  Brush.Color:= Color;

  ExcludeClipRect(DC, 4, 4, Width-4, Height-4);
  Windows.SelectObject(DC, Brush.Handle);
  Windows.SelectObject(DC, Pen.Handle);

  Windows.Rectangle(DC, 0, 0, Width, Height);
  Brush.Style:= bsClear;
  Windows.RoundRect(DC, 0, 0, Width, Height,  FBorderRadio, FBorderRadio);

  Windows.ReleaseDC(Handle, DC);
  Brush.Destroy;
  Pen.Destroy;
end;

procedure TDBNewEditJL.WMSize(var Message: TWMSize);
var r : TRect;
begin
   inherited;
   r := ClientRect;
   InvalidateRect(handle,@r,false);
   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

end.

LA imagen




he marcado en rojo para que veais el fallo.
y por el último el archivo
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #2  
Antiguo 30-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 22
José Luis Garcí Va camino a la fama
El archivo, donde tendre la cabeza
Archivos Adjuntos
Tipo de Archivo: zip DBneweditjl.zip (3,6 KB, 18 visitas)
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #3  
Antiguo 30-05-2013
beginner01 beginner01 is offline
Miembro
NULL
  
Registrado: mar 2011
Ubicación: República Dominicana
Posts: 181
Poder: 14
beginner01 Va por buen camino
Hola.

Por lo que pude leer aquí, el problema se presenta por el uso de SetWindowRgn, ya que este impide que se vea o dibuje la ventana
mas allá de el área designada por la misma.

Cita:
This function sets the window region of a window. The window region determines the area within the window where the system permits drawing.
The system does not display any portion of a window that lies outside of the window region.
Para solucionar este problema debes de cambiar el tamaño de la región acorde con el nuevo tamaño del componente.

realicé una prueba con el componente cambiando: 

Código Delphi [-]
procedure TDBNewEditJL.WMSize(var Message: TWMSize);
var r : TRect;
begin
   inherited;
   r := ClientRect;
   SetRound(True);
   InvalidateRect(handle,@r,false);
   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

Lo cual evita que se produzca el efecto que comentas.
Responder Con Cita
  #4  
Antiguo 30-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 22
José Luis Garcí Va camino a la fama
Muchas gracias beginner01, funciono perfectamente. Pasate poor la taberna que te he dejado una ronda paga.
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #5  
Antiguo 30-05-2013
beginner01 beginner01 is offline
Miembro
NULL
  
Registrado: mar 2011
Ubicación: República Dominicana
Posts: 181
Poder: 14
beginner01 Va por buen camino
Cita:
Empezado por José Luis Garcí Ver Mensaje
Muchas gracias beginner01, funciono perfectamente. Pasate poor la taberna que te he dejado una ronda paga.
Me parece bien.
Responder Con Cita
  #6  
Antiguo 01-06-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 22
José Luis Garcí Va camino a la fama
Hola compañeros, al final he tenido que hacer algunos cambio y aquí os pongo el código definitivo, del componente

Código Delphi [-]
{ ****************************************************************** }
{                                                                    }
{   VCL component TDBNewEditJL                                         }
{                                                                    }
{   Code generated by Component Create for Delphi                    }
{                                                                    }
{   Generated from untitled component definition                     }
{   on 25 May 2013 at 11:52                                          }
{                                                                    }
{   Copyright © 201 by J.L.G.T.3                                     }
{                                                                    }
{ ****************************************************************** }

unit DBneweditjl;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
     Forms, Graphics, Stdctrls, Dialogs, Windows, DbTables, DB, DBCtrls;

type
  TBorderStyle = (bsNone, bsSingle, bsRound);

  TDBNewEditJL = class(TDBEdit)
    private
        FColorFocused : TColor;
        FOnlyNumbersDouble : Boolean;
        FOnlyDate  : Boolean;
        FFillToEnterDate: Boolean;
        FTextDefault : String;
        FAlignment: TAlignment;
        FBorderStyle: TBorderStyle;
        FBorderColor: TColor;
        FBorderRadio: Integer;
        FDataLink : TFieldDataLink;
        FBorderThick: Integer;
        FIncrouble;
        FEnterTab:Boolean;
        FMaxLenghTab:Boolean;
        FMatchHintAndDefault: Boolean;
        procedure SetMatchHintAndDefault(Value:Boolean);
        procedure SetEnterTab(Value: boolean);
        procedure SetBorderThick(Value:Integer);
        procedure SetIncr(Value: Double);
        procedure SetMaxLenghTab(Value: boolean);
        procedure SetBorderColor(Color: TColor);
        procedure SetBorderRadio(Radio: integer);
        procedure SetBorderStyle(Value: TBorderStyle);
        procedure SetRound(Value: boolean);
        procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
        procedure WMSize(var Message: TWMSize); message WM_SIZE;
        procedure SetOnlyDate (Value : Boolean);
        procedure SetFillToEnterDate(Value : Boolean);
        procedure SetAlignment(Value: TAlignment);
        procedure AutoInitialize;
        procedure AutoDestroy;
        procedure SetColorFocused(Value : TColor);
        procedure SetOnlyNumbersDouble(Value : Boolean);
        procedure SetTextDefault(Value : String);
        procedure FOnResized(Sender: TObject);
        var VarCColor:Tcolor;
    protected
        procedure CreateWnd; override;
        procedure Change; override;
        procedure Click; override;
        procedure KeyPress(var Key : Char); override;
        procedure Loaded; override;
        procedure CreateParams(var Params: TCreateParams); override;
        procedure DoExit; override;
        procedure DoEnter; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
    published
        property Text;
        property TextHint;
        property OnChange;
        property OnClick;
        property OnDblClick;
        property OnDragDrop;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnResize;
        property ColorFocused : TColor read FColorFocused write SetColorFocused default clSkyBlue;
        property OnlyNumbersDouble : Boolean read FOnlyNumbersDouble write SetOnlyNumbersDouble default False;
        property TextDefault : String read FTextDefault write SetTextDefault;
        property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
        property FillToEnterDate: Boolean read FFillToEnterDate write SetFillToEnterDate default False;
        property OnlyDate: Boolean read FOnlyDate write SetOnlyDate default False;
        property BorderColor: TColor  read FBorderColor write SetBorderColor default clNavy;
        property BorderRadio: Integer read FBorderRadio write SetBorderRadio default 5;
        property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; //default bsRound;
        property Incr: Double read FIncr write SetIncr;
        property MaxLenghTab: Boolean read FMaxLenghTab write SetMaxLenghTab default False;
        property BorderThick: Integer read FBorderThick write SetBorderThick default 1;
        property EnterTab: Boolean read FEnterTab write SetEnterTab default False;
        property MatchHintAndDefault: Boolean read FMatchHintAndDefault write setMatchHintAndDefault default True;
end;

procedure Register;

implementation

procedure Register;
begin
     RegisterComponents('Data Controls', [TDBNewEditJL]);
end;

procedure TDBNewEditJL.AutoInitialize;
begin
     FColorFocused := clSkyBlue;
     FOnlyNumbersDouble := False;
     FAlignment:=taLeftJustify;
     FBorderColor:= clNavy;
     FBorderRadio:= 5;
     FBorderStyle:= bsRound;
     FOnlyDate  :=false;
     FFillToEnterDate:=True;
     FTextDefault :='';
     FMatchHintAndDefault:=True;
     FIncr:=0.01;
     FMaxLenghTab:=True;
     FBorderThick:=1;
     FEnterTab:=False;
     OnResize := FOnResized;
end; { of AutoInitialize }

procedure TDBNewEditJL.AutoDestroy;
begin
   {...}
end; { of AutoDestroy }


procedure TDBNewEditJL.SetEnterTab(Value: boolean);
begin
  if FEnterTab<>value then FEnterTab:=Value;
end;

procedure TDBNewEditJL.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    RecreateWnd;
  end;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetColorFocused(Value : TColor);
begin
     FColorFocused := Value;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetFillToEnterDate(Value: Boolean);
begin
    if FFillToEnterDate<>value then FFillToEnterDate:=Value;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetIncr(Value: Double);
begin
    if FIncr<>Value then FIncr:=Value;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetMatchHintAndDefault(Value: Boolean);
begin
 if fMatchHintAndDefault<>value then FMatchHintAndDefault:=Value;
end;

procedure TDBNewEditJL.SetMaxLenghTab(Value: boolean);
begin
   if FMaxLenghTab<>Value then FMaxLenghTab:=value;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetOnlyDate(Value: Boolean);
begin
   if FOnlyDate<>value then
   begin
     if (FOnlyNumbersDouble) and (Value=true) then FOnlyNumbersDouble:=False;
     FOnlyDate:=Value;
   end;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetOnlyNumbersDouble(Value: Boolean);
begin
   if FOnlyNumbersDouble<>value then
   begin
     if (FOnlyDate) and (Value=true) then FOnlyDate:=False;
     if Value=true then Alignment:=taRightJustify else Alignment:=taLeftJustify;
     FOnlyNumbersDouble:=Value;
   end;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;


procedure TDBNewEditJL.FOnResized(Sender: TObject);
begin
   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.SetTextDefault(Value : String);
begin
     if FTextDefault<>Value then FTextDefault := Value;
     if fMatchHintAndDefault then Self.TextHint:=Value;
       RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.Change;
begin
     inherited Change;
     if FMaxLenghTab then
     begin
       if (Length(Text)>=MaxLength) and (MaxLength<>0) and (Self.Focused) then keybd_event(VK_TAB ,0,0,0); //Pulsa el tab por código
     end;
end;

procedure TDBNewEditJL.Click;
begin
     inherited Click;
       RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

procedure TDBNewEditJL.KeyDown(var Key: Word; Shift: TShiftState);
var Numerouble;
begin
  if FOnlyDate then
  begin
     if (Key=VK_UP) then text:=DateToStr(StrToDate(Self.Text)+1);  //Añadimos  díaa
     if (Key=VK_DOWN) then Text:=DateToStr(StrToDate(Self.Text)+1);//Disminuimos  días
     Key := 0;
  end;
  if FOnlyNumbersDouble then
  begin
     Numer:=StrToFloat(Text);
     if (Key=VK_UP) then Numer:=numer+FIncr;
     if (Key=VK_DOWN) then Numer:=Numer-FIncr;
     if Numer>=0 then Text:=FloatToStr(Numer)
                 else text:='-'+FloatToStr(Numer);
     Key := 0;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TDBNewEditJL.KeyPress(var Key : Char);
const TabKey = Char(VK_TAB);
      EnterKey = Char(VK_RETURN);
begin
   if FOnlyNumbersDouble then
   begin
     if Key='.' then Key:=',';  //Para los Decimales
     if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
     begin
        ShowMessage('Tecla no valida: ' + Key);
        Key := #0;
     end else if ((Key = DecimalSeparator) or (Key = '-') or (Key=',') or (Key = #8 )) and (Pos(Key, Self.Text) > 0) then
     begin
         //#8= backSpace, #13= Enter, #25= LeftArrow, #274= RightArrow
        ShowMessage('Tecla no valida: (por repetida) ' + Key);
        Key := #0;
     end else if (Key = '-') and (Self.SelStart <> 0) then
     begin
        ShowMessage('Sólo se permite numeros: ' + Key);
        Key := #0;
     end;
   end;
   If Key = #13 Then
   Begin
      if FEnterTab then
      begin
        keybd_event(VK_TAB ,0,0,0); //Pulsa el Tab por código
        Key := #0
      end;
   end;
   inherited KeyPress(Key);
end;

constructor TDBNewEditJL.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     AutoInitialize;
end;

procedure TDBNewEditJL.CreateParams(var Params: TCreateParams);
const
  Alignments : array[TAlignment] of LongWord= (ES_Left,ES_Right, ES_Center);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or Alignments[FAlignment];
end;

destructor TDBNewEditJL.Destroy;
begin
     AutoDestroy;
     inherited Destroy;
end;

procedure TDBNewEditJL.Loaded;
begin
     inherited Loaded;
end;

procedure TDBNewEditJL.DoEnter;
begin
  inherited;
  VarCColor:=Self.Color;
  SElf.Color:=fcolorFocused;
  if (FOnlyDate) and (FillToEnterDate) then Self.Text:=DateToStr(Now);
end;

procedure TDBNewEditJL.DoExit;
begin
  self.Color:=VarCColor;
  if (self.text='') and (FOnlyNumbersDouble=False) and (FOnlyDate=false) then self.text:=ftextDefault;
  if (FOnlyNumbersDouble) and (Self.Text='') then Self.Text:='0';
  if (FOnlyDate) and (Self.Text='') then Self.Text:=DateToStr(Now);
  inherited;
end;

//todo esto es cogido del compañero Escafandra de su componente RoundEdit

procedure TDBNewEditJL.CreateWnd;
begin
  inherited CreateWnd;
  SetRound(FBorderStyle = bsRound);
end;


procedure TDBNewEditJL.SetRound(Value: boolean);
var
  Rgn: HRGN;
begin
  Rgn:= 0;
  if Value then
    Rgn := CreateRoundRectRgn(0, 0, Width+1, Height+1, FBorderRadio-2, FBorderRadio-2) ;
  SetWindowRgn(Handle, Rgn, true);
  DeleteObject(Rgn);
end;

procedure TDBNewEditJL.SetBorderColor(Color: TColor);
begin
  FBorderColor:= Color;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  Invalidate;
end;


procedure TDBNewEditJL.SetBorderRadio(Radio: integer);
begin
  if Radio <= 10 then
  begin
    FBorderRadio:= Radio;
    SetRound(true);
    RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  end;
end;

procedure TDBNewEditJL.SetBorderStyle(Value: TBorderStyle);
begin
  if Value <> FBorderStyle then
  begin
    FBorderStyle:= Value;
    SetRound(false);
    inherited Ctl3D:= Ctl3D;
    case Value of
      bsNone:   inherited BorderStyle := Forms.TBorderStyle(bsNone);
      bsSingle: inherited BorderStyle := Forms.TBorderStyle(bsSingle);
      bsRound:
      begin
        inherited BorderStyle := Forms.TBorderStyle(bsSingle);
        inherited Ctl3D:= true;
        SetRound(true);
      end;
    end;
    RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  end;
end;

procedure TDBNewEditJL.SetBorderThick(Value: Integer);
begin
    if FBorderThick<>value then FBorderThick:=Value;       //añadido por mi
end;

procedure TDBNewEditJL.WMNCPaint(var Message: TMessage);
var
  Brush: TBrush;
  Pen: TPen;
  DC: HDC;
  Clip: integer;
begin
  if (BorderStyle <> bsRound) or not inherited Ctl3D then
  begin
    inherited;
    exit;
  end;

  DC:= GetWindowDC(Handle);
  Brush:= TBrush.Create;
  Pen:= TPen.Create;
  Pen.Color:= BorderColor;
  Pen.Width:=FBorderThick;  //añadido por mi
  Brush.Color:= Color;

  ExcludeClipRect(DC, 4, 4, Width-4, Height-4);
  Windows.SelectObject(DC, Brush.Handle);
  Windows.SelectObject(DC, Pen.Handle);

  Windows.Rectangle(DC, 0, 0, Width, Height);
  Brush.Style:= bsClear;
  Windows.RoundRect(DC, 0, 0, Width, Height,  FBorderRadio, FBorderRadio);

  Windows.ReleaseDC(Handle, DC);
  Brush.Destroy;
  Pen.Destroy;
end;

procedure TDBNewEditJL.WMSize(var Message: TWMSize);
var r : TRect;
begin
   inherited;
   r := ClientRect;
   SetRound(True);
   InvalidateRect(handle,@r,false);
   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

end.
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #7  
Antiguo 01-06-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 22
José Luis Garcí Va camino a la fama
Y su equivalente sin bases de datos

Código Delphi [-]
{ ****************************************************************** }
{                                                                    }
{   VCL component TMyNewEditJL                                         }
{                                                                    }
{   Code generated by Component Create for Delphi                    }
{                                                                    }
{   Generated from untitled component definition                     }
{   on 25 May 2013 at 11:52                                          }
{                                                                    }
{   Copyright © 201 by J.L.G.T.3                                     }
{                                                                    }
{ ****************************************************************** }

unit Mneweditjl;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
     Forms, Graphics, Stdctrls, Dialogs, Windows;

type
  TBorderStyle = (bsNone, bsSingle, bsRound);

  TMyNewEditJL = class(TEdit)
    private
        FColorFocused : TColor;
        FOnlyNumbersDouble : Boolean;
        FOnlyDate  : Boolean;
        FFillToEnterDate: Boolean;
        FTextDefault : String;
        FAlignment: TAlignment;
        FBorderStyle: TBorderStyle;
        FBorderColor: TColor;
        FBorderRadio: Integer;
        FBorderThick: Integer;
        FIncrouble;
        FEnterTab:Boolean;
        FMaxLenghTab:Boolean;
        FMatchHintAndDefault: Boolean;
        procedure SetMatchHintAndDefault(Value:Boolean);
        procedure SetBorderThick(Value:Integer);
        procedure SetIncr(Value: Double);
        procedure SetEnterTab(Value: boolean);
        procedure SetMaxLenghTab(Value: boolean);
        procedure SetBorderColor(Color: TColor);
        procedure SetBorderRadio(Radio: integer);
        procedure SetBorderStyle(Value: TBorderStyle);
        procedure SetRound(Value: boolean);
        procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
        procedure SetOnlyDate (Value : Boolean);
        procedure SetFillToEnterDate(Value : Boolean);
        procedure SetAlignment(Value: TAlignment);
        procedure AutoInitialize;
        procedure AutoDestroy;
        procedure SetColorFocused(Value : TColor);
        procedure SetOnlyNumbersDouble(Value : Boolean);
        procedure SetTextDefault(Value : String);
        procedure WMSize(var Message: TWMSize); message WM_SIZE;
        var VarCColor:Tcolor;
    protected
        procedure CreateWnd; override;
        procedure Change; override;
        procedure Click; override;
        procedure KeyPress(var Key : Char); override;
        procedure Loaded; override;
        procedure CreateParams(var Params: TCreateParams); override;
        procedure DoExit; override;
        procedure DoEnter; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
    published
        property Text;
        property TextHint;
        property OnChange;
        property OnDblClick;
        property OnDragDrop;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property ColorFocused : TColor read FColorFocused write SetColorFocused default clSkyBlue;
        property OnlyNumbersDouble : Boolean read FOnlyNumbersDouble write SetOnlyNumbersDouble default False;
        property TextDefault : String read FTextDefault write SetTextDefault;
        property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
        property FillToEnterDate: Boolean read FFillToEnterDate write SetFillToEnterDate default False;
        property OnlyDate: Boolean read FOnlyDate write SetOnlyDate default False;
        property BorderColor: TColor  read FBorderColor write SetBorderColor default clNavy;
        property BorderRadio: Integer read FBorderRadio write SetBorderRadio default 5;
        property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; //default bsRound;
        property Incr: Double read FIncr write SetIncr;
        property EnterTab: Boolean read FEnterTab write SetEnterTab default False;
        property MaxLenghTab: Boolean read FMaxLenghTab write SetMaxLenghTab default False;
        property BorderThick: Integer read FBorderThick write SetBorderThick default 1;
        property MatchHintAndDefault: Boolean read FMatchHintAndDefault write setMatchHintAndDefault default True;
end;

procedure Register;

implementation


procedure Register;
begin
     RegisterComponents('Standard', [TMyNewEditJL]);
end;

procedure TMyNewEditJL.AutoInitialize;
begin
     FColorFocused := clSkyBlue;
     FOnlyNumbersDouble := False;
     FAlignment:=taLeftJustify;
     FBorderColor:= clNavy;
     FBorderRadio:= 5;
     FBorderStyle:= bsRound;
     FOnlyDate  :=false;
     FFillToEnterDate:=True;
     FTextDefault :='';
     FIncr:=0.01;
     FMaxLenghTab:=True;
     FEnterTab:=False;
     FBorderThick:=1;
     FMatchHintAndDefault:=True;
end; { of AutoInitialize }

procedure TMyNewEditJL.AutoDestroy;
begin
   {}
end; { of AutoDestroy }

procedure TMyNewEditJL.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    RecreateWnd;
  end;
end;

procedure TMyNewEditJL.SetColorFocused(Value : TColor);
begin
     FColorFocused := Value;
end;

procedure TMyNewEditJL.SetEnterTab(Value: boolean);
begin
  if FEnterTab<>value then FEnterTab:=Value;
end;

procedure TMyNewEditJL.SetFillToEnterDate(Value: Boolean);
begin
    if FFillToEnterDate<>value then FFillToEnterDate:=Value;
end;

procedure TMyNewEditJL.SetIncr(Value: Double);
begin
   if FIncr<>Value then FIncr:=Value;
end;

procedure TMyNewEditJL.SetMatchHintAndDefault(Value: Boolean);
begin
    if fMatchHintAndDefault<>value then FMatchHintAndDefault:=Value;
end;

procedure TMyNewEditJL.SetMaxLenghTab(Value: boolean);
begin
   if FMaxLenghTab<>Value then FMaxLenghTab:=value;
end;

procedure TMyNewEditJL.SetOnlyDate(Value: Boolean);
begin
   if FOnlyDate<>value then
   begin
     if (FOnlyNumbersDouble) and (Value=true) then FOnlyNumbersDouble:=False;
     FOnlyDate:=Value;
   end;
end;

procedure TMyNewEditJL.SetOnlyNumbersDouble(Value : Boolean);
begin
   if FOnlyNumbersDouble<>value then
   begin
     if (FOnlyDate) and (Value=true) then FOnlyDate:=False;
     if Value=true then Alignment:=taRightJustify else Alignment:=taLeftJustify;
     FOnlyNumbersDouble:=Value;
   end;
end;

procedure TMyNewEditJL.SetTextDefault(Value : String);
begin
     FTextDefault := Value;
end;

procedure TMyNewEditJL.Change;
begin
     inherited Change;
     if FMaxLenghTab then
     begin
       if (Length(Text)>=MaxLength) and (MaxLength<>0) and (Self.Focused) then keybd_event(VK_TAB ,0,0,0); //Pulsa el tab por código
     end;
end;

procedure TMyNewEditJL.Click;
begin
     inherited Click;
end;

procedure TMyNewEditJL.KeyDown(var Key: Word; Shift: TShiftState);
var Numerouble;
begin
  if FOnlyDate then
  begin
     if (Key=VK_UP) then text:=DateToStr(StrToDate(Self.Text)+1);  //Añadimos  díaa
     if (Key=VK_DOWN) then Text:=DateToStr(StrToDate(Self.Text)+1);//Disminuimos  días
     Key := 0;
  end;
  if FOnlyNumbersDouble then
  begin
     Numer:=StrToFloat(Text);
     if (Key=VK_UP) then Numer:=numer+FIncr;
     if (Key=VK_DOWN) then Numer:=Numer-FIncr;
     if Numer>=0 then Text:=FloatToStr(Numer)
                 else text:='-'+FloatToStr(Numer);
     Key := 0;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TMyNewEditJL.KeyPress(var Key : Char);
const TabKey = Char(VK_TAB);
      EnterKey = Char(VK_RETURN);
begin
   if FOnlyNumbersDouble then
   begin
     if Key='.' then Key:=',';  //Para los Decimales
     if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
     begin
        ShowMessage('Tecla no valida: ' + Key);
        Key := #0;
     end else if ((Key = DecimalSeparator) or (Key = '-') or (Key=',') or (Key = #8 )) and (Pos(Key, Self.Text) > 0) then
     begin
        ShowMessage('Tecla no valida: (por repetida) ' + Key);
        Key := #0;
     end else if (Key = '-') and (Self.SelStart <> 0) then
     begin
        ShowMessage('Sólo se permite numeros: ' + Key);
        Key := #0;
     end;
   end;
   If Key = #13 Then
   Begin
      if FEnterTab then
      begin
        keybd_event(VK_TAB ,0,0,0); //Pulsa el Tab por código
        Key := #0
      end;
   end;
   inherited KeyPress(Key);
end;

constructor TMyNewEditJL.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     AutoInitialize;
end;

procedure TMyNewEditJL.CreateParams(var Params: TCreateParams);
const
  Alignments : array[TAlignment] of LongWord= (ES_Left,ES_Right, ES_Center);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or Alignments[FAlignment];
end;

destructor TMyNewEditJL.Destroy;
begin
     AutoDestroy;
     inherited Destroy;
end;

procedure TMyNewEditJL.Loaded;
begin
     inherited Loaded;
end;

procedure TMyNewEditJL.DoEnter;
begin
  inherited;
  VarCColor:=Self.Color;
  SElf.Color:=fcolorFocused;
  if (FOnlyDate) and (FillToEnterDate) then Self.Text:=DateToStr(Now);
end;

procedure TMyNewEditJL.DoExit;
begin
  self.Color:=VarCColor;
  if (self.text='') and (FOnlyNumbersDouble=False) and (FOnlyDate=false) then self.text:=ftextDefault;
  if (FOnlyNumbersDouble) and (Self.Text='') then Self.Text:='0';
  if (FOnlyDate) and (Self.Text='') then Self.Text:=DateToStr(Now);
  inherited;
end;

//todo esto es cogido del compañero Escafandra de su componente RoundEdit--------------------------

procedure TMyNewEditJL.CreateWnd;
begin
  inherited CreateWnd;
  SetRound(FBorderStyle = bsRound);
end;


procedure TMyNewEditJL.SetRound(Value: boolean);
var
  Rgn: HRGN;
begin
  Rgn:= 0;
  if Value then
    Rgn := CreateRoundRectRgn(0, 0, Width+1, Height+1, FBorderRadio-2, FBorderRadio-2) ;
  SetWindowRgn(Handle, Rgn, true);
  DeleteObject(Rgn);
end;

procedure TMyNewEditJL.SetBorderColor(Color: TColor);
begin
  FBorderColor:= Color;
  RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  Invalidate;
end;


procedure TMyNewEditJL.SetBorderRadio(Radio: integer);
begin
  if Radio <= 10 then
  begin
    FBorderRadio:= Radio;
    SetRound(true);
    RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  end;
end;

procedure TMyNewEditJL.SetBorderStyle(Value: TBorderStyle);
begin
  if Value <> FBorderStyle then
  begin
    FBorderStyle:= Value;
    SetRound(false);
    inherited Ctl3D:= Ctl3D;
    case Value of
      bsNone:   inherited BorderStyle := Forms.TBorderStyle(bsNone);
      bsSingle: inherited BorderStyle := Forms.TBorderStyle(bsSingle);
      bsRound:
      begin
        inherited BorderStyle := Forms.TBorderStyle(bsSingle);
        inherited Ctl3D:= true;
        SetRound(true);
      end;
    end;
    RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
  end;
end;


procedure TMyNewEditJL.SetBorderThick(Value: Integer);
begin
   if FBorderThick<>value then FBorderThick:=Value;       //añadido por mi
end;

procedure TMyNewEditJL.WMNCPaint(var Message: TMessage);
var
  Brush: TBrush;
  Pen: TPen;
  DC: HDC;
  Clip: integer;
begin
  if (BorderStyle <> bsRound) or not inherited Ctl3D then
  begin
    inherited;
      exit;
  end;

  DC:= GetWindowDC(Handle);
  Brush:= TBrush.Create;
  Pen:= TPen.Create;
  Pen.Color:= BorderColor;
  Pen.Width:=FBorderThick;  //añadido por mi
  Brush.Color:= Color;

  ExcludeClipRect(DC, 4, 4, Width-4, Height-4);
  Windows.SelectObject(DC, Brush.Handle);
  Windows.SelectObject(DC, Pen.Handle);

  Windows.Rectangle(DC, 0, 0, Width, Height);
  Brush.Style:= bsClear;
  Windows.RoundRect(DC, 0, 0, Width, Height,  FBorderRadio, FBorderRadio);

  Windows.ReleaseDC(Handle, DC);
  Brush.Destroy;
  Pen.Destroy;
end;

procedure TMyNewEditJL.WMSize(var Message: TWMSize);
var r : TRect;
begin
   inherited;
   r := ClientRect;
   SetRound(True);
   InvalidateRect(handle,@r,false);
   RedrawWindow(Handle,nil,0,RDW_FRAME + RDW_INVALIDATE);
end;

end.
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
Respuesta

« Tema Anterior | Próximo Tema »


Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes
El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Agrandar botones al pasar el cursor LuisAlf:: HTML, Javascript y otros 4 07-10-2010 03:06:22
Problema creando un nuevo componente y un editor de propiedades Koder OOP 8 21-08-2005 10:59:08
Fuentes para negrillas y agrandar las letras Jorge Taveras Impresión 2 16-04-2005 22:47:31
agrandar fuente en ticket perico Impresión 8 04-02-2005 02:55:29


La franja horaria es GMT +2. Ahora son las 21:17:09.

Club Delphi - Archivo - Top

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi