指点合理就有分,只要你有本事,只放三天。(120分)

  • 主题发起人 主题发起人 jet_shen
  • 开始时间 开始时间
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(frmpaper);
x.top:=10;
x.left:=10;
x.parent:=frmpaper;
x.show;
end ;
 
create(self);
改成
create(nil);
 
procedure creatld(frmpaper: Tform);
var x:Tlabdbedt;
begin
x:=Tlabdbedt.create(frmpaper);
x.top:=10;
x.left:=10;
x.parent:=frmpaper;
x.visibled := true;
end ;
 
x:=Tlabdbedt.create(self);
-------------------------------
改了没有效果
 
没有效果,我已经提供了控件的源码,那位大哥仔细看一下指点一下
 
在create里加下面的代码就可以了
Width := 121;
Height := 25;
TabStop := True;
ParentColor := False;
 
问题已经解决了,我也拿不回分了,谁帮我看看有没有什么可以要改进的东西,好的建议直接给120分了
 
靠!解决了不送分啊。
 
楼主不厚道
 
什么东西啊,你们都写的什么东西啊,问题没有说到点子上也要分,羞不羞的,分,我自己也拿不回,我当然会给了,关键你自己够不格!没动脑子也想拿分!
标题很清楚:指点合理就有分,只要你有本事
 
呵呵,惭愧
 
多人接受答案了。
 
后退
顶部