为什么我自定义的控件无法加入到窗口上来???点了以后没有任何反应啊??? ( 积分: 50 )

  • 主题发起人 主题发起人 龙之天涯
  • 开始时间 开始时间
龙

龙之天涯

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Lbtab;

interface

uses

SysUtils,Windows,Messages,Classes,Controls,StdCtrls;


type

EddgTabListboxError = class(Exception);
TddgTabListBox = class(TListBox)
private
FlongestString: Word;
FNumTabStops: Word;
FTabStops: PWORD;
FSizeAfterDel: Boolean;
function GetLBStringLength(S: string): Word;
procedure FindLongestString;
procedure SetScrollLength(s: String);
procedure LBAddString(var Msg: TMessage); message lb_AddString;
procedure LBInsertString(var Msg: TMessage); message lb_InsertString;
procedure LBDeleteString(var Msg: TMessage); message lb_DeleteString;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy;override;
procedure SetTabStops(A:array of Word);
published
property SizeAfterDel: Boolean read FSizeAfterDel write FSizeAfterDel default True;
end;

procedure Register;

implementation

uses PixDlg;

procedure Register;
begin
RegisterComponents('DY', [TddgTabListBox]);
end;




constructor TddgTabListBox.Create(AOwner: TComponent );
begin
inherited Create(AOwner);
FSizeAfterDel := True;
GetMem(FTabStops,SizeOf(word) * FNumTabStops);
FTabStops^ := DialogUnitsToPixelsX(32);
end;
destructor TddgTabListBox.Destroy;
begin
inherited Destroy;
end;

procedure TddgTabListBox.SetTabStops(A: array of Word);
var
i: Word;
TempTab: Word;
TempBuf: PWORD;
begin
TempTab := High(A) + 1;
GetMem(TempBuf,SizeOf(A));
Move(A,TempBuf^,SizeOf(A));
for i := 0 to TempTab - 1 do
A := PixelsToDialogUnitsX(A);

if Perform(LB_SETTABSTOPS,TempTab,LongInt(@A)) = 0 then
begin
FreeMem(TempBuf,SizeOf(Word) * TempTab);
raise EddgTabListboxError.Create('设置TAB失败');
end
else begin
FreeMem(FTabStops,SizeOf(Word) * FNumTabStops);
FNumTabStops := TempTab;
FTabStops := TempBuf;
FindLongestString ;
Invalidate;
end;
end;

procedure TddgTabListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or LBS_USETABSTOPS or WS_HSCROLL ;
end;

function TddgTabListBox.GetLBStringLength(S: String): Word;
var
Size: Integer;
begin
Canvas.Font := Font;
Result := loWord(GetTabbedTextExtent(Canvas.Handle,PChar(S),StrLen(PChar(S)),FNumTabStops,FTabStops^));
Size := Canvas.TextWidth('X');
Inc(Result,Size);
end;

procedure TddgTabListBox.SetScrollLength(S: String);
var
Extent: Word;
begin
Extent := GetLBStringLength(S);

if Extent> FlongestString then
begin
FlongestString := Extent;
Perform(LB_SETHORIZONTALEXTENT,Extent,0);
end;
end;

procedure TddgTabListBox.LBInsertString(var Msg: TMessage);
begin
inherited;
SetScrollLength(PChar(Msg.LParam));
end;

procedure TddgTabListBox.LBAddString(var Msg: TMessage);
begin
inherited;
SetScrollLength(Pchar(Msg.LParam));
end;

procedure TddgTabListBox.FindLongestString;
var
i: Word;
strg: string;
begin
FlongestString := 0;
for i := 0 to Items.Count - 1 do
begin
strg := Items;
SetScrollLength(strg);
end;
end;

procedure TddgTabListBox.LBDeleteString(var Msg: TMessage);
var
Str: string;
begin
if FSizeAfterDel then
begin
Str := Items[Msg.wParam];
inherited ;
if GetLBStringLength(Str) = FlongestString then
FindLongestString;
end
else
inherited ;
end;


end.


unit Pixdlg;

interface


function DialogUnitsToPixelsX(DlgUnits: Word): Word;
function DialogUnitsToPixelsY(DlgUnits: Word): Word;
function PixelsToDialogUnitsX(PixUnits: Word): Word;
function PixelsToDialogUnitsY(PixUnits: Word): Word;

implementation
uses WinProcs;


function DialogUnitsToPixelsX(DlgUnits: Word): Word;
begin
Result := (DlgUnits * LoWord(GetDialogBaseUnits)) div 4;
end;

function DialogUnitsToPixelsY(DlgUnits: Word): Word;
begin
Result := (DlgUnits * HiWord(GetDialogBaseUnits)) div 8;
end;

function PixelsToDialogUnitsX(PixUnits: Word): Word;
begin
Result := PixUnits * 4 div LoWord(GetDialogBaseUnits);
end;

function PixelsToDialogUnitsY(PixUnits: Word): Word;
begin
Result := PixUnits * 8 div LoWord(GetDialogBaseUnits);
end;

end.
构造函数到底什么情况使用??
 
unit Lbtab;

interface

uses

SysUtils,Windows,Messages,Classes,Controls,StdCtrls;


type

EddgTabListboxError = class(Exception);
TddgTabListBox = class(TListBox)
private
FlongestString: Word;
FNumTabStops: Word;
FTabStops: PWORD;
FSizeAfterDel: Boolean;
function GetLBStringLength(S: string): Word;
procedure FindLongestString;
procedure SetScrollLength(s: String);
procedure LBAddString(var Msg: TMessage); message lb_AddString;
procedure LBInsertString(var Msg: TMessage); message lb_InsertString;
procedure LBDeleteString(var Msg: TMessage); message lb_DeleteString;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy;override;
procedure SetTabStops(A:array of Word);
published
property SizeAfterDel: Boolean read FSizeAfterDel write FSizeAfterDel default True;
end;

procedure Register;

implementation

uses PixDlg;

procedure Register;
begin
RegisterComponents('DY', [TddgTabListBox]);
end;




constructor TddgTabListBox.Create(AOwner: TComponent );
begin
inherited Create(AOwner);
FSizeAfterDel := True;
GetMem(FTabStops,SizeOf(word) * FNumTabStops);
FTabStops^ := DialogUnitsToPixelsX(32);
end;
destructor TddgTabListBox.Destroy;
begin
inherited Destroy;
end;

procedure TddgTabListBox.SetTabStops(A: array of Word);
var
i: Word;
TempTab: Word;
TempBuf: PWORD;
begin
TempTab := High(A) + 1;
GetMem(TempBuf,SizeOf(A));
Move(A,TempBuf^,SizeOf(A));
for i := 0 to TempTab - 1 do
A := PixelsToDialogUnitsX(A);

if Perform(LB_SETTABSTOPS,TempTab,LongInt(@A)) = 0 then
begin
FreeMem(TempBuf,SizeOf(Word) * TempTab);
raise EddgTabListboxError.Create('设置TAB失败');
end
else begin
FreeMem(FTabStops,SizeOf(Word) * FNumTabStops);
FNumTabStops := TempTab;
FTabStops := TempBuf;
FindLongestString ;
Invalidate;
end;
end;

procedure TddgTabListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or LBS_USETABSTOPS or WS_HSCROLL ;
end;

function TddgTabListBox.GetLBStringLength(S: String): Word;
var
Size: Integer;
begin
Canvas.Font := Font;
Result := loWord(GetTabbedTextExtent(Canvas.Handle,PChar(S),StrLen(PChar(S)),FNumTabStops,FTabStops^));
Size := Canvas.TextWidth('X');
Inc(Result,Size);
end;

procedure TddgTabListBox.SetScrollLength(S: String);
var
Extent: Word;
begin
Extent := GetLBStringLength(S);

if Extent> FlongestString then
begin
FlongestString := Extent;
Perform(LB_SETHORIZONTALEXTENT,Extent,0);
end;
end;

procedure TddgTabListBox.LBInsertString(var Msg: TMessage);
begin
inherited;
SetScrollLength(PChar(Msg.LParam));
end;

procedure TddgTabListBox.LBAddString(var Msg: TMessage);
begin
inherited;
SetScrollLength(Pchar(Msg.LParam));
end;

procedure TddgTabListBox.FindLongestString;
var
i: Word;
strg: string;
begin
FlongestString := 0;
for i := 0 to Items.Count - 1 do
begin
strg := Items;
SetScrollLength(strg);
end;
end;

procedure TddgTabListBox.LBDeleteString(var Msg: TMessage);
var
Str: string;
begin
if FSizeAfterDel then
begin
Str := Items[Msg.wParam];
inherited ;
if GetLBStringLength(Str) = FlongestString then
FindLongestString;
end
else
inherited ;
end;


end.


unit Pixdlg;

interface


function DialogUnitsToPixelsX(DlgUnits: Word): Word;
function DialogUnitsToPixelsY(DlgUnits: Word): Word;
function PixelsToDialogUnitsX(PixUnits: Word): Word;
function PixelsToDialogUnitsY(PixUnits: Word): Word;

implementation
uses WinProcs;


function DialogUnitsToPixelsX(DlgUnits: Word): Word;
begin
Result := (DlgUnits * LoWord(GetDialogBaseUnits)) div 4;
end;

function DialogUnitsToPixelsY(DlgUnits: Word): Word;
begin
Result := (DlgUnits * HiWord(GetDialogBaseUnits)) div 8;
end;

function PixelsToDialogUnitsX(PixUnits: Word): Word;
begin
Result := PixUnits * 4 div LoWord(GetDialogBaseUnits);
end;

function PixelsToDialogUnitsY(PixUnits: Word): Word;
begin
Result := PixUnits * 8 div LoWord(GetDialogBaseUnits);
end;

end.
构造函数到底什么情况使用??
 
我认为你要把TListBox的事件,属性什么的都要公布出来
不然就屏蔽掉了
你可以看看Delphi自己的代码就知道了
 
我是按照D6开发人员指南的书搞的代码

编译都能够在组件板上有控件了
但是拖动到窗口上来什么都没有

我才学这方面的东西,还请大侠指教一下.
 
因为FNumTabStops 初始化时为0，所以
GetMem(FTabStops,SizeOf(word) * FNumTabStops);
时，FTabStops = nil，故
FTabStops^ := DialogUnitsToPixelsX(32);
FTabStops^访问地址出错。创建时出异常，导致无法创建完毕。
 
看了下原书
发现在Create中少了一行
FNumTabStops:=1;
 
多人接受答案了。
 
您必须登录或注册才可回复。

Similar threads

D
学习写一个控件，但是得不到结果(100分)
回复
5
查看
260
JohnsonGuo
J
Y
写了一个控件，属性却保存不住，到底是怎么回事呢？(50分)
回复
8
查看
337
yaxich
Y
N
远程截屏的一个控件源码(来自Torry，FreeWare)(0分)
回复
18
查看
258
robot2003
R
T
计算机间文件传输源码，支持串口、MODEM、UDP方式，需要者请进! (0分)
回复
18
查看
352
cjf1009
C
J
请问下列控件的下拉框（Grid）为什么不能获得焦点？请各位帮忙！！这是我所有的分数了！！(49分)
回复
6
查看
305
jack.shi
J
后退
顶部