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
[-]
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; 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
OnDataChange := DataChange;
OnUpdateData := UpdateData;
OnEditingChange := EditingChange;
OnActiveChange := ActiveChange;
end;
FIncr:=0.01;
FMaxLenghTab:=True;
FBorderThick:=1;
FEnterTab:=False;
OnResize := FOnResized;
end;
procedure TDBNewEditJL.AutoDestroy;
begin
FDataLink.Free;
end;
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;
end;
procedure TDBNewEditJL.DataChange(Sender : TObject);
begin
if FDataLink.Field = nil then
begin
end
else
begin
Text:=FDataLink.Field.AsString;
end
end;
procedure TDBNewEditJL.UpdateData(Sender : TObject);
begin
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
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); 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); if (Key=VK_DOWN) then Text:=DateToStr(StrToDate(Self.Text)+1); 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); 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;
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; 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; 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