J
jet_shen
Unregistered / Unconfirmed
GUEST, unregistred user!
自己的兴趣,写了个控件,在一般开发,直接设计界面的时候,没有任何问题,组件是能够显示在FORM上的,但用如下代码动态生成时却有问题,组件不显示,请高手指点,如发现代码有不合理的的地方也请一并指点,指点合理就有分,不够可以协商再送,谢谢。
procedure creatld(frmpaper: Tform);
var x:Tlabdbedt;
begin
x:=Tlabdbedt.create(self);
x.top:=10;
x.left:=10;
x.parent:=frmpaper;
end ;
附控件代码
unit labdbedt;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, DBTables, Menus, ComCtrls, StdCtrls, Mask, DBCtrls,ExtCtrls;
type
TFtlabel = class(Tlabel)
private
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TFDBEdit = class(TDBEdit)
private
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
Tlabdbedt=class(TCustomControl)
private
FDataBase: string;
FEnabled: Boolean;
Fcaption: string;
FlabSize: Integer;
dbedt:TFDBEdit ;
lab:TFtlabel;
function CreateDBEdit(iTop, iLeft: Integer; sName: String): TFDBEdit;
function Createlabel(iTop, iLeft: Integer; sName: String): TFtlabel;
function GetDatasource:TDataSource;
procedure SetDatasource(FValue :TDatasource);
function GetFieldName:string;
procedure SetFieldName(FValue :string);
procedure SSetEnabled(value :Boolean);
procedure SSetcaption(value:string);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure SetlabSize(value :integer);
{ procedure QueryToItems(dbSet: TDataset);
function GetParentFont: Boolean;
procedure SetParentFont(Value: Boolean); }
function GetFont: TFont;
procedure SetFont(Value: TFont);
// protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Datasource: TDataSource read GetDatasource write SetDatasource;
property FieldName: string read GetFieldName write SetFieldName;
// property caption: string read Getcaption write Setcaption;
{ property Items: Tstrings read GetItems write SetItems;
property DBAware: Boolean read FDBAware write SetDBAWare;
property Text: string read GetText write SetText; }
property DataBase: string read FDataBase write FDataBase;
{ property SQL: Tstrings read GetSQL write SetSQL;
property Params: TParams read GetParams write SetParams;
property Refresh: Boolean read FRefresh write SetRefresh; }
property TabOrder;
property TabStop;
property OnExit;
property OnEnter;
{ property OnChange: TNotifyEvent read FOnchange write FOnchange;
property OnDropdown: TNotifyEvent read FOnDropdown write FOnDropdown;}
{ property Notes: string read GetNotes write SetNotes; }
property Enabled: Boolean read FEnabled write SSetEnabled;
property caption: string read Fcaption write SSetcaption;
property labSize: Integer read FlabSize write SetlabSize;
property Visible;
// property ParentFont: Boolean read GetParentFont write SetParentFont;
property Font: TFont read GetFont write SetFont;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('SJ', [Tlabdbedt]);
end;
function Tlabdbedt.CreateDBEdit(iTop, iLeft: Integer; sName: String): TFDBEdit;
begin
Result := TFDBEdit.Create(Self);
with Result do
begin
Name := sName;
Top := iTop;
Left := iLeft ;
Height := 20;
Width := 120;
Visible := True;
charcase:=ecUpperCase;
Enabled := True;
Parent := Self;
ParentFont:=False;
TabStop := false;
end;
end;
function Tlabdbedt.Createlabel(iTop, iLeft: Integer; sName: String): TFtlabel;
begin
Result := TFtlabel.Create(Self);
with Result do
begin
Name := sName;
Top := iTop;
Left := iLeft;
Height := 20;
Width := 30;
Visible := True;
Enabled := True;
Parent := Self;
caption:='字段名';
ParentFont:=False;
end;
end;
Constructor Tlabdbedt.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
lab:= Createlabel(0, 0, 'sjlab') ;
dbedt :=CreateDBEdit(0, 30, 'sjDBEdit');
labsize:=80
end;
procedure Tlabdbedt.SSetEnabled(value :Boolean);
begin
FEnabled:= Value;
dbedt.Enabled := FEnabled;
end ;
procedure Tlabdbedt.SSetcaption(value :string);
begin
Fcaption:= Value;
lab.Caption := Fcaption;
end ;
function Tlabdbedt.GetFieldName:string;
begin
Result := dbedt.DataField;
end;
procedure Tlabdbedt.SetFieldName(FValue :string);
begin
dbedt.DataField:= FValue;
end;
function Tlabdbedt.GetDatasource:TDatasource;
begin
Result := dbedt.DataSource;
end;
procedure Tlabdbedt.SetDatasource(FValue :TDatasource);
begin
dbedt.Datasource:= FValue;
end;
function Tlabdbedt.GetFont: TFont;
begin
Result := dbedt.Font;
end;
procedure Tlabdbedt.SetFont(Value: TFont);
begin
if Assigned(Value) then
begin
dbedt.Font.Assign(Value);
lab.Font.Assign(dbedt.Font);
end;
end;
procedure Tlabdbedt.SetlabSize(Value: integer);
begin
begin
FlabSize:=Value;
lab.width:=FlabSize;
dbedt.Left:= FlabSize;
end;
end;
{ procedure Tlabdbedt.SSetEnabled(Value: Boolean);
begin
FEnabled:= Value;
end ; }
constructor TFDBEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TFDBEdit.Destroy;
begin
inherited Destroy;
end;
constructor TFtlabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TFtlabel.Destroy;
begin
inherited Destroy;
end;
destructor Tlabdbedt.Destroy;
begin
inherited Destroy;
end;
procedure Tlabdbedt.WMSize(var Message: TWMSize);
var
Offset: Integer;
begin
if Message.Width<labsize then
showmessage('设置长度太小') ;
end;
end.
procedure creatld(frmpaper: Tform);
var x:Tlabdbedt;
begin
x:=Tlabdbedt.create(self);
x.top:=10;
x.left:=10;
x.parent:=frmpaper;
end ;
附控件代码
unit labdbedt;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, DBTables, Menus, ComCtrls, StdCtrls, Mask, DBCtrls,ExtCtrls;
type
TFtlabel = class(Tlabel)
private
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TFDBEdit = class(TDBEdit)
private
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
Tlabdbedt=class(TCustomControl)
private
FDataBase: string;
FEnabled: Boolean;
Fcaption: string;
FlabSize: Integer;
dbedt:TFDBEdit ;
lab:TFtlabel;
function CreateDBEdit(iTop, iLeft: Integer; sName: String): TFDBEdit;
function Createlabel(iTop, iLeft: Integer; sName: String): TFtlabel;
function GetDatasource:TDataSource;
procedure SetDatasource(FValue :TDatasource);
function GetFieldName:string;
procedure SetFieldName(FValue :string);
procedure SSetEnabled(value :Boolean);
procedure SSetcaption(value:string);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure SetlabSize(value :integer);
{ procedure QueryToItems(dbSet: TDataset);
function GetParentFont: Boolean;
procedure SetParentFont(Value: Boolean); }
function GetFont: TFont;
procedure SetFont(Value: TFont);
// protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Datasource: TDataSource read GetDatasource write SetDatasource;
property FieldName: string read GetFieldName write SetFieldName;
// property caption: string read Getcaption write Setcaption;
{ property Items: Tstrings read GetItems write SetItems;
property DBAware: Boolean read FDBAware write SetDBAWare;
property Text: string read GetText write SetText; }
property DataBase: string read FDataBase write FDataBase;
{ property SQL: Tstrings read GetSQL write SetSQL;
property Params: TParams read GetParams write SetParams;
property Refresh: Boolean read FRefresh write SetRefresh; }
property TabOrder;
property TabStop;
property OnExit;
property OnEnter;
{ property OnChange: TNotifyEvent read FOnchange write FOnchange;
property OnDropdown: TNotifyEvent read FOnDropdown write FOnDropdown;}
{ property Notes: string read GetNotes write SetNotes; }
property Enabled: Boolean read FEnabled write SSetEnabled;
property caption: string read Fcaption write SSetcaption;
property labSize: Integer read FlabSize write SetlabSize;
property Visible;
// property ParentFont: Boolean read GetParentFont write SetParentFont;
property Font: TFont read GetFont write SetFont;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('SJ', [Tlabdbedt]);
end;
function Tlabdbedt.CreateDBEdit(iTop, iLeft: Integer; sName: String): TFDBEdit;
begin
Result := TFDBEdit.Create(Self);
with Result do
begin
Name := sName;
Top := iTop;
Left := iLeft ;
Height := 20;
Width := 120;
Visible := True;
charcase:=ecUpperCase;
Enabled := True;
Parent := Self;
ParentFont:=False;
TabStop := false;
end;
end;
function Tlabdbedt.Createlabel(iTop, iLeft: Integer; sName: String): TFtlabel;
begin
Result := TFtlabel.Create(Self);
with Result do
begin
Name := sName;
Top := iTop;
Left := iLeft;
Height := 20;
Width := 30;
Visible := True;
Enabled := True;
Parent := Self;
caption:='字段名';
ParentFont:=False;
end;
end;
Constructor Tlabdbedt.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
lab:= Createlabel(0, 0, 'sjlab') ;
dbedt :=CreateDBEdit(0, 30, 'sjDBEdit');
labsize:=80
end;
procedure Tlabdbedt.SSetEnabled(value :Boolean);
begin
FEnabled:= Value;
dbedt.Enabled := FEnabled;
end ;
procedure Tlabdbedt.SSetcaption(value :string);
begin
Fcaption:= Value;
lab.Caption := Fcaption;
end ;
function Tlabdbedt.GetFieldName:string;
begin
Result := dbedt.DataField;
end;
procedure Tlabdbedt.SetFieldName(FValue :string);
begin
dbedt.DataField:= FValue;
end;
function Tlabdbedt.GetDatasource:TDatasource;
begin
Result := dbedt.DataSource;
end;
procedure Tlabdbedt.SetDatasource(FValue :TDatasource);
begin
dbedt.Datasource:= FValue;
end;
function Tlabdbedt.GetFont: TFont;
begin
Result := dbedt.Font;
end;
procedure Tlabdbedt.SetFont(Value: TFont);
begin
if Assigned(Value) then
begin
dbedt.Font.Assign(Value);
lab.Font.Assign(dbedt.Font);
end;
end;
procedure Tlabdbedt.SetlabSize(Value: integer);
begin
begin
FlabSize:=Value;
lab.width:=FlabSize;
dbedt.Left:= FlabSize;
end;
end;
{ procedure Tlabdbedt.SSetEnabled(Value: Boolean);
begin
FEnabled:= Value;
end ; }
constructor TFDBEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TFDBEdit.Destroy;
begin
inherited Destroy;
end;
constructor TFtlabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TFtlabel.Destroy;
begin
inherited Destroy;
end;
destructor Tlabdbedt.Destroy;
begin
inherited Destroy;
end;
procedure Tlabdbedt.WMSize(var Message: TWMSize);
var
Offset: Integer;
begin
if Message.Width<labsize then
showmessage('设置长度太小') ;
end;
end.