Ĺadny brzuch
Mam utworzony własny komponent o takim kodzie
unit TEXTLABEL; interface uses SysUtils, Classes, Controls,stdctrls,{}windows,graphics,forms,messages,dialogs; type TTEXTLABEL = class(TWinControl) private { Private declarations } flabel1:tlabel; flabel2:tlabel; protected { Protected declarations } public { Public declarations } constructor create(aowner:tcomponent);override; destructor destroy;override; published { Published declarations } end; procedure Register; implementation constructor ttextlabel.create(aowner:tcomponent); begin inherited create(aowner); flabel1.Create(self); flabel2.Create(self); flabel1.Parent:=self; flabel2.Parent:=self; end; destructor ttextlabel.destroy; begin flabel1.Free; flabel2.Free; inherited destroy; end; procedure Register; begin RegisterComponents('Standard', [TTEXTLABEL]); end; end.
Komponent kompiluje się bez problemu, i pokazuje się na zakałdce "standard". JEdnak gdy chce go wstawić na formą, wywala się jakiś błąd. Gdze jest źródło tego błędu?
Jeśli moja skromna osoba mogłaby coś tu doradzić to chciałbym zasugerować abyś podał treść błędu... nie jesteśmy jasnowidzami.
W momęcie w którym przeciągam komponent na forme, otrzymuje taki komunikat:
www.podrurznik.republika.pl/blad.jpg
Wydaje mi sie ze program probuje uzyc klasy, ktora juz jest zwolniona. Imho sprobuj tak:
destructor ttextlabel.destroy; begin inherited destroy; flabel1.Free; flabel2.Free; end;
lub w ogole usun destruktor i niech zostanie ten domyslny.
Próbowałem, nadal jest to samo.
metoda Free nie wywołuje błędu przy próbie uwolnienia wcześniej zwolnionego obiektu. Wyżej opisany problem pojawia się nawet gdy komponent jest całkowicie pozbawiony zdefiniowanego destruktora.
IMVHO jest to spowodowane tym, że labele oczekują komunikatów, podczas gdy wszystkie trafiają do Twojego komponentu (dziedziczonego bezpośrednio po TWinControl) i nie są przekazywane do etykiet. ;) BTW zamieszczam tu deklarację TWinControl (ja często korzystałem z podglądania klas, na których pracowałem). TWinControl = class(TControl) private FAlignLevel: Word; FBevelEdges: TBevelEdges; FBevelInner: TBevelCut; FBevelOuter: TBevelCut; FBevelKind: TBevelKind; FBevelWidth: TBevelWidth; FBorderWidth: TBorderWidth; FBrush: TBrush; FDefWndProc: Pointer; FDockClients: TList; FDockManager: IDockManager; FHandle: HWnd; FImeMode: TImeMode; FImeName: TImeName; FObjectInstance: Pointer; FParentWindow: HWnd; FTabList: TList; FControls: TList; FWinControls: TList; FTabOrder: Integer; FTabStop: Boolean; FCtl3D: Boolean; FShowing: Boolean; FUseDockManager: Boolean; FDockSite: Boolean; FParentCtl3D: Boolean; FOnDockDrop: TDockDropEvent; FOnDockOver: TDockOverEvent; FOnEnter: TNotifyEvent; FOnExit: TNotifyEvent; FOnGetSiteInfo: TGetSiteInfoEvent; Fonkeydown: TKeyEvent; Fonkeypress: TKeyPressEvent; Fonkeyup: TKeyEvent; FOnUnDock: TUnDockEvent; procedure AlignControl(AControl: TControl); procedure CalcConstraints(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); function GetAlignDisabled: Boolean; function GetControl(Index: Integer): TControl; function GetControlCount: Integer; function GetDockClientCount: Integer; function GetDockClients(Index: Integer): TControl; function GetHandle: HWnd; function GetParentBackground: Boolean; function GetTabOrder: TTabOrder; function GetVisibleDockClientCount: Integer; procedure Insert(AControl: TControl); procedure InvalidateFrame; procedure InvokeHelp; function IsCtl3DStored: Boolean; function PrecedingWindow(Control: TWinControl): HWnd; procedure ReadDesignSize(Reader: TReader); procedure Remove(AControl: TControl); procedure RemoveFocus(Removing: Boolean); procedure SetBevelCut(Index: Integer; const Value: TBevelCut); procedure SetBevelEdges(const Value: TBevelEdges); procedure SetBevelKind(const Value: TBevelKind); procedure SetBevelWidth(const Value: TBevelWidth); procedure SetBorderWidth(Value: TBorderWidth); procedure SetCtl3D(Value: Boolean); procedure SetDockSite(Value: Boolean); procedure SetParentCtl3D(Value: Boolean); procedure SetParentWindow(Value: HWnd); procedure SetTabOrder(Value: TTabOrder); procedure SetTabStop(Value: Boolean); procedure SetUseDockManager(Value: Boolean); procedure SetZOrderPosition(Position: Integer); procedure UpdateTabOrder(Value: TTabOrder); procedure UpdateBounds; procedure UpdateShowing; procedure WriteDesignSize(Writer: TWriter); function IsMenuKey(var Message: TWMKey): Boolean; procedure WMPaint(var Message: TWMPaint); message WM_PAINT; procedure WMCommand(var Message: TWMCommand); message WM_COMMAND; procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY; procedure WMSysColorChange(var Message: TWMSysColorChange); message WM_SYSCOLORCHANGE; procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL; procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; procedure WMCompareItem(var Message: TWMCompareItem); message WM_COMPAREITEM; procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM; procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM; procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM; procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND; procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMMove(var Message: TWMMove); message WM_MOVE; procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; procedure WMSysKeyDown(var Message: TWMKeyDown); message WM_SYSKEYDOWN; procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP; procedure WMSysKeyUp(var Message: TWMKeyUp); message WM_SYSKEYUP; procedure WMChar(var Message: TWMChar); message WM_CHAR; procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; procedure WMCharToItem(var Message: TWMCharToItem); message WM_CHARTOITEM; procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY; procedure WMVKeyToItem(var Message: TWMVKeyToItem); message WM_VKEYTOITEM; procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure WMQueryNewPalette(var Message: TMessage); message WM_QUERYNEWPALETTE; procedure WMPaletteChanged(var Message: TMessage); message WM_PALETTECHANGED; procedure WMWinIniChange(var Message: TMessage); message WM_WININICHANGE; procedure WMFontChange(var Message: TMessage); message WM_FONTCHANGE; procedure WMTimeChange(var Message: TMessage); message WM_TIMECHANGE; procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS; procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION; procedure WMIMEEndComp(var Message: TMessage); message WM_IME_ENDCOMPOSITION; procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU; procedure CMChanged(var Message: TMessage); message CM_CHANGED; procedure CMChildKey(var Message: TMessage); message CM_CHILDKEY; procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY; procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED; procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED; procedure CMCursorChanged(var Message: TMessage); message CM_CURSORCHANGED; procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED; procedure CMParentCtl3DChanged(var Message: TMessage); message CM_PARENTCTL3DCHANGED; procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED; procedure CMShowHintChanged(var Message: TMessage); message CM_SHOWHINTCHANGED; procedure CMEnter(var Message: TCMEnter); message CM_ENTER; procedure CMExit(var Message: TCMExit); message CM_EXIT; procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST; procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED; procedure CMWinIniChange(var Message: TWMWinIniChange); message CM_WININICHANGE; procedure CMFontChange(var Message: TMessage); message CM_FONTCHANGE; procedure CMTimeChange(var Message: TMessage); message CM_TIMECHANGE; procedure CMDrag(var Message: TCMDrag); message CM_DRAG; procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; procedure CNKeyUp(var Message: TWMKeyUp); message CN_KEYUP; procedure CNChar(var Message: TWMChar); message CN_CHAR; procedure CNSysKeyDown(var Message: TWMKeyDown); message CN_SYSKEYDOWN; procedure CNSysChar(var Message: TWMChar); message CN_SYSCHAR; procedure CMControlListChange(var Message: TMessage); message CM_CONTROLLISTCHANGE; procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND; procedure CMInvalidate(var Message: TMessage); message CM_INVALIDATE; procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT; procedure CMUnDockClient(var Message: TCMUnDockClient); message CM_UNDOCKCLIENT; procedure CMFloat(var Message: TCMFloat); message CM_FLOAT; procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED; procedure WMPrintClient(var Message: TWMPrintClient); message WM_PRINTCLIENT; protected FDoubleBuffered: Boolean; FInImeComposition: Boolean; FDesignSize: TPoint; procedure Actionchange(Sender: TObject; CheckDefaults: Boolean); override; procedure AddBiDiModeExStyle(var ExStyle: DWORD); procedure AssignTo(Dest: TPersistent); override; procedure AdjustClientRect(var Rect: TRect); virtual; procedure AdjustSize; override; procedure AlignControls(AControl: TControl; var Rect: TRect); virtual; function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override; function CanResize(var NewWidth, NewHeight: Integer): Boolean; override; procedure ChangeScale(M, D: Integer); override; procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); override; procedure ControlsAligned; dynamic; function CreateDockManager: IDockManager; dynamic; procedure CreateHandle; virtual; procedure CreateParams(var Params: TCreateParams); virtual; procedure CreateSubClass(var Params: TCreateParams; ControlClassName: PChar); procedure CreateWindowHandle(const Params: TCreateParams); virtual; procedure CreateWnd; virtual; function CustomAlignInsertBefore(C1, C2: TControl): Boolean; virtual; procedure CustomAlignPosition(Control: TControl; var NewLeft, NewTop, NewWidth, NewHeight: Integer; var AlignRect: TRect; AlignInfo: TAlignInfo); virtual; procedure DefineProperties(Filer: TFiler); override; procedure DestroyHandle; procedure DestroyWindowHandle; virtual; procedure DestroyWnd; virtual; procedure DoAddDockClient(Client: TControl; const ARect: TRect); dynamic; procedure DockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); dynamic; procedure DoDockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); dynamic; procedure DoEnter; dynamic; procedure DoExit; dynamic; procedure DoFlipChildren; dynamic; function DoKeyDown(var Message: TWMKey): Boolean; function DoKeyPress(var Message: TWMKey): Boolean; function DoKeyUp(var Message: TWMKey): Boolean; procedure DoRemoveDockClient(Client: TControl); dynamic; function DoUnDock(NewTarget: TWinControl; Client: TControl): Boolean; dynamic; function FindNextControl(CurControl: TWinControl; GoForward, CheckTabStop, CheckParent: Boolean): TWinControl; procedure FixupTabList; function GetActionLinkClass: TControlActionLinkClass; override; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; function GetClientOrigin: TPoint; override; function GetClientRect: TRect; override; function GetControlExtents: TRect; virtual; function GetDeviceContext(var WindowHandle: HWnd): HDC; override; function GetParentHandle: HWnd; procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); dynamic; function GetTopParentHandle: HWnd; function IsControlMouseMsg(var Message: TWMMouse): Boolean; procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic; procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic; procedure KeyPress(var Key: Char); dynamic; procedure MainWndProc(var Message: TMessage); procedure NotifyControls(Msg: Word); procedure PaintControls(DC: HDC; First: TControl); procedure PaintHandler(var Message: TWMPaint); procedure PaintWindow(DC: HDC); virtual; function PaletteChanged(Foreground: Boolean): Boolean; override; procedure ReadState(Reader: TReader); override; procedure RecreateWnd; procedure ReloadDockedControl(const AControlName: string; var AControl: TControl); dynamic; procedure ResetIme; function ResetImeComposition(Action: DWORD): Boolean; procedure ScaleControls(M, D: Integer); procedure SelectFirst; procedure SelectNext(CurControl: TWinControl; GoForward, CheckTabStop: Boolean); procedure SetChildOrder(Child: TComponent; Order: Integer); override; procedure SetIme; function SetImeCompositionWindow(Font: TFont; XPos, YPos: Integer): Boolean; procedure SetParentBackground(Value: Boolean); virtual; procedure SetZOrder(TopMost: Boolean); override; procedure ShowControl(AControl: TControl); virtual; procedure UpdateUIState(CharCode: Word); procedure WndProc(var Message: TMessage); override; property BevelEdges: TBevelEdges read FBevelEdges write SetBevelEdges default [beLeft, beTop, beRight, beBottom]; property BevelInner: TBevelCut index 0 read FBevelInner write SetBevelCut default bvRaised; property BevelOuter: TBevelCut index 1 read FBevelOuter write SetBevelCut default bvLowered; property BevelKind: TBevelKind read FBevelKind write SetBevelKind default bkNone; property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0; property Ctl3D: Boolean read FCtl3D write SetCtl3D stored IsCtl3DStored; property DefWndProc: Pointer read FDefWndProc write FDefWndProc; property DockSite: Boolean read FDockSite write SetDockSite default False; property DockManager: IDockManager read FDockManager write FDockManager; property ImeMode: TImeMode read FImeMode write FImeMode default imDontCare; property ImeName: TImeName read FImeName write FImeName; property ParentBackground: Boolean read GetParentBackground write SetParentBackground; property ParentCtl3D: Boolean read FParentCtl3D write SetParentCtl3D default True; property UseDockManager: Boolean read FUseDockManager write SetUseDockManager default False; property WindowHandle: HWnd read FHandle write FHandle; property OnDockDrop: TDockDropEvent read FOnDockDrop write FOnDockDrop; property OnDockOver: TDockOverEvent read FOnDockOver write FOnDockOver; property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; property OnExit: TNotifyEvent read FOnExit write FOnExit; property OnGetSiteInfo: TGetSiteInfoEvent read FOnGetSiteInfo write FOnGetSiteInfo; property onkeydown: TKeyEvent read Fonkeydown write Fonkeydown; property onkeypress: TKeyPressEvent read Fonkeypress write Fonkeypress; property onkeyup: TKeyEvent read Fonkeyup write Fonkeyup; property OnUnDock: TUnDockEvent read FOnUnDock write FOnUnDock; public constructor Create(AOwner: TComponent); override; constructor CreateParented(ParentWindow: HWnd); class function CreateParentedControl(ParentWindow: HWnd): TWinControl; destructor Destroy; override; procedure Broadcast(var Message); function CanFocus: Boolean; dynamic; function ContainsControl(Control: TControl): Boolean; function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean; AllowWinControls: Boolean = False): TControl; procedure DefaultHandler(var Message); override; procedure DisableAlign; property DockClientCount: Integer read GetDockClientCount; property DockClients[Index: Integer]: TControl read GetDockClients; procedure DockDrop(Source: TDragDockObject; X, Y: Integer); dynamic; property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered; procedure EnableAlign; function FindChildControl(const ControlName: string): TControl; procedure FlipChildren(AllLevels: Boolean); dynamic; function Focused: Boolean; dynamic; procedure GetTabOrderList(List: TList); dynamic; function HandleAllocated: Boolean; procedure HandleNeeded; procedure InsertControl(AControl: TControl); procedure Invalidate; override; procedure PaintTo(DC: HDC; X, Y: Integer); overload; procedure PaintTo(Canvas: TCanvas; X, Y: Integer); overload; procedure RemoveControl(AControl: TControl); procedure Realign; procedure Repaint; override; procedure ScaleBy(M, D: Integer); procedure ScrollBy(DeltaX, DeltaY: Integer); procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; procedure SetFocus; virtual; procedure Update; override; procedure UpdateControlState; property AlignDisabled: Boolean read GetAlignDisabled; property VisibleDockClientCount: Integer read GetVisibleDockClientCount; property Brush: TBrush read FBrush; property Controls[Index: Integer]: TControl read GetControl; property ControlCount: Integer read GetControlCount; property Handle: HWnd read GetHandle; property ParentWindow: HWnd read FParentWindow write SetParentWindow; property Showing: Boolean read FShowing; property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1; property TabStop: Boolean read FTabStop write SetTabStop default False; published end;
Tia, widzę błąd :>
Źle tworzysz labele :>
Powinno być constructor ttextlabel.create(aowner:tcomponent); begin inherited create(aowner); flabel1:=TLabel.Create(self); flabel2:=TLabel.Create(self); flabel1.Parent:=self; flabel2.Parent:=self; end;
I nie jestem pewny czy destruktor jest napisany OK. Imho powinno być: destructor ttextlabel.destroy; begin flabel1.Free; flabel2.Free; inherited destroy; end;
//@ KSMłody
I po co tu ten kod wkeiłeś ? Jak CI się nie chce nawet przetestować kodu to daj sobie spokój z odpowiadaniem.
Użytkownik -=PcSA=- edytował ten post 28 lipiec 2006, 15:08
zanotowane.pl doc.pisz.pl pdf.pisz.pl zsf.htw.pl
unit TEXTLABEL; interface uses SysUtils, Classes, Controls,stdctrls,{}windows,graphics,forms,messages,dialogs; type TTEXTLABEL = class(TWinControl) private { Private declarations } flabel1:tlabel; flabel2:tlabel; protected { Protected declarations } public { Public declarations } constructor create(aowner:tcomponent);override; destructor destroy;override; published { Published declarations } end; procedure Register; implementation constructor ttextlabel.create(aowner:tcomponent); begin inherited create(aowner); flabel1.Create(self); flabel2.Create(self); flabel1.Parent:=self; flabel2.Parent:=self; end; destructor ttextlabel.destroy; begin flabel1.Free; flabel2.Free; inherited destroy; end; procedure Register; begin RegisterComponents('Standard', [TTEXTLABEL]); end; end.
Komponent kompiluje się bez problemu, i pokazuje się na zakałdce "standard". JEdnak gdy chce go wstawić na formą, wywala się jakiś błąd. Gdze jest źródło tego błędu?
Jeśli moja skromna osoba mogłaby coś tu doradzić to chciałbym zasugerować abyś podał treść błędu... nie jesteśmy jasnowidzami.
W momęcie w którym przeciągam komponent na forme, otrzymuje taki komunikat:
www.podrurznik.republika.pl/blad.jpg
Wydaje mi sie ze program probuje uzyc klasy, ktora juz jest zwolniona. Imho sprobuj tak:
destructor ttextlabel.destroy; begin inherited destroy; flabel1.Free; flabel2.Free; end;
lub w ogole usun destruktor i niech zostanie ten domyslny.
Próbowałem, nadal jest to samo.
metoda Free nie wywołuje błędu przy próbie uwolnienia wcześniej zwolnionego obiektu. Wyżej opisany problem pojawia się nawet gdy komponent jest całkowicie pozbawiony zdefiniowanego destruktora.
IMVHO jest to spowodowane tym, że labele oczekują komunikatów, podczas gdy wszystkie trafiają do Twojego komponentu (dziedziczonego bezpośrednio po TWinControl) i nie są przekazywane do etykiet. ;) BTW zamieszczam tu deklarację TWinControl (ja często korzystałem z podglądania klas, na których pracowałem). TWinControl = class(TControl) private FAlignLevel: Word; FBevelEdges: TBevelEdges; FBevelInner: TBevelCut; FBevelOuter: TBevelCut; FBevelKind: TBevelKind; FBevelWidth: TBevelWidth; FBorderWidth: TBorderWidth; FBrush: TBrush; FDefWndProc: Pointer; FDockClients: TList; FDockManager: IDockManager; FHandle: HWnd; FImeMode: TImeMode; FImeName: TImeName; FObjectInstance: Pointer; FParentWindow: HWnd; FTabList: TList; FControls: TList; FWinControls: TList; FTabOrder: Integer; FTabStop: Boolean; FCtl3D: Boolean; FShowing: Boolean; FUseDockManager: Boolean; FDockSite: Boolean; FParentCtl3D: Boolean; FOnDockDrop: TDockDropEvent; FOnDockOver: TDockOverEvent; FOnEnter: TNotifyEvent; FOnExit: TNotifyEvent; FOnGetSiteInfo: TGetSiteInfoEvent; Fonkeydown: TKeyEvent; Fonkeypress: TKeyPressEvent; Fonkeyup: TKeyEvent; FOnUnDock: TUnDockEvent; procedure AlignControl(AControl: TControl); procedure CalcConstraints(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); function GetAlignDisabled: Boolean; function GetControl(Index: Integer): TControl; function GetControlCount: Integer; function GetDockClientCount: Integer; function GetDockClients(Index: Integer): TControl; function GetHandle: HWnd; function GetParentBackground: Boolean; function GetTabOrder: TTabOrder; function GetVisibleDockClientCount: Integer; procedure Insert(AControl: TControl); procedure InvalidateFrame; procedure InvokeHelp; function IsCtl3DStored: Boolean; function PrecedingWindow(Control: TWinControl): HWnd; procedure ReadDesignSize(Reader: TReader); procedure Remove(AControl: TControl); procedure RemoveFocus(Removing: Boolean); procedure SetBevelCut(Index: Integer; const Value: TBevelCut); procedure SetBevelEdges(const Value: TBevelEdges); procedure SetBevelKind(const Value: TBevelKind); procedure SetBevelWidth(const Value: TBevelWidth); procedure SetBorderWidth(Value: TBorderWidth); procedure SetCtl3D(Value: Boolean); procedure SetDockSite(Value: Boolean); procedure SetParentCtl3D(Value: Boolean); procedure SetParentWindow(Value: HWnd); procedure SetTabOrder(Value: TTabOrder); procedure SetTabStop(Value: Boolean); procedure SetUseDockManager(Value: Boolean); procedure SetZOrderPosition(Position: Integer); procedure UpdateTabOrder(Value: TTabOrder); procedure UpdateBounds; procedure UpdateShowing; procedure WriteDesignSize(Writer: TWriter); function IsMenuKey(var Message: TWMKey): Boolean; procedure WMPaint(var Message: TWMPaint); message WM_PAINT; procedure WMCommand(var Message: TWMCommand); message WM_COMMAND; procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY; procedure WMSysColorChange(var Message: TWMSysColorChange); message WM_SYSCOLORCHANGE; procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL; procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; procedure WMCompareItem(var Message: TWMCompareItem); message WM_COMPAREITEM; procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM; procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM; procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM; procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND; procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMMove(var Message: TWMMove); message WM_MOVE; procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; procedure WMSysKeyDown(var Message: TWMKeyDown); message WM_SYSKEYDOWN; procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP; procedure WMSysKeyUp(var Message: TWMKeyUp); message WM_SYSKEYUP; procedure WMChar(var Message: TWMChar); message WM_CHAR; procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; procedure WMCharToItem(var Message: TWMCharToItem); message WM_CHARTOITEM; procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY; procedure WMVKeyToItem(var Message: TWMVKeyToItem); message WM_VKEYTOITEM; procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure WMQueryNewPalette(var Message: TMessage); message WM_QUERYNEWPALETTE; procedure WMPaletteChanged(var Message: TMessage); message WM_PALETTECHANGED; procedure WMWinIniChange(var Message: TMessage); message WM_WININICHANGE; procedure WMFontChange(var Message: TMessage); message WM_FONTCHANGE; procedure WMTimeChange(var Message: TMessage); message WM_TIMECHANGE; procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS; procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION; procedure WMIMEEndComp(var Message: TMessage); message WM_IME_ENDCOMPOSITION; procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU; procedure CMChanged(var Message: TMessage); message CM_CHANGED; procedure CMChildKey(var Message: TMessage); message CM_CHILDKEY; procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY; procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED; procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED; procedure CMCursorChanged(var Message: TMessage); message CM_CURSORCHANGED; procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED; procedure CMParentCtl3DChanged(var Message: TMessage); message CM_PARENTCTL3DCHANGED; procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED; procedure CMShowHintChanged(var Message: TMessage); message CM_SHOWHINTCHANGED; procedure CMEnter(var Message: TCMEnter); message CM_ENTER; procedure CMExit(var Message: TCMExit); message CM_EXIT; procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST; procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED; procedure CMWinIniChange(var Message: TWMWinIniChange); message CM_WININICHANGE; procedure CMFontChange(var Message: TMessage); message CM_FONTCHANGE; procedure CMTimeChange(var Message: TMessage); message CM_TIMECHANGE; procedure CMDrag(var Message: TCMDrag); message CM_DRAG; procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; procedure CNKeyUp(var Message: TWMKeyUp); message CN_KEYUP; procedure CNChar(var Message: TWMChar); message CN_CHAR; procedure CNSysKeyDown(var Message: TWMKeyDown); message CN_SYSKEYDOWN; procedure CNSysChar(var Message: TWMChar); message CN_SYSCHAR; procedure CMControlListChange(var Message: TMessage); message CM_CONTROLLISTCHANGE; procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND; procedure CMInvalidate(var Message: TMessage); message CM_INVALIDATE; procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT; procedure CMUnDockClient(var Message: TCMUnDockClient); message CM_UNDOCKCLIENT; procedure CMFloat(var Message: TCMFloat); message CM_FLOAT; procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED; procedure WMPrintClient(var Message: TWMPrintClient); message WM_PRINTCLIENT; protected FDoubleBuffered: Boolean; FInImeComposition: Boolean; FDesignSize: TPoint; procedure Actionchange(Sender: TObject; CheckDefaults: Boolean); override; procedure AddBiDiModeExStyle(var ExStyle: DWORD); procedure AssignTo(Dest: TPersistent); override; procedure AdjustClientRect(var Rect: TRect); virtual; procedure AdjustSize; override; procedure AlignControls(AControl: TControl; var Rect: TRect); virtual; function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override; function CanResize(var NewWidth, NewHeight: Integer): Boolean; override; procedure ChangeScale(M, D: Integer); override; procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); override; procedure ControlsAligned; dynamic; function CreateDockManager: IDockManager; dynamic; procedure CreateHandle; virtual; procedure CreateParams(var Params: TCreateParams); virtual; procedure CreateSubClass(var Params: TCreateParams; ControlClassName: PChar); procedure CreateWindowHandle(const Params: TCreateParams); virtual; procedure CreateWnd; virtual; function CustomAlignInsertBefore(C1, C2: TControl): Boolean; virtual; procedure CustomAlignPosition(Control: TControl; var NewLeft, NewTop, NewWidth, NewHeight: Integer; var AlignRect: TRect; AlignInfo: TAlignInfo); virtual; procedure DefineProperties(Filer: TFiler); override; procedure DestroyHandle; procedure DestroyWindowHandle; virtual; procedure DestroyWnd; virtual; procedure DoAddDockClient(Client: TControl; const ARect: TRect); dynamic; procedure DockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); dynamic; procedure DoDockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); dynamic; procedure DoEnter; dynamic; procedure DoExit; dynamic; procedure DoFlipChildren; dynamic; function DoKeyDown(var Message: TWMKey): Boolean; function DoKeyPress(var Message: TWMKey): Boolean; function DoKeyUp(var Message: TWMKey): Boolean; procedure DoRemoveDockClient(Client: TControl); dynamic; function DoUnDock(NewTarget: TWinControl; Client: TControl): Boolean; dynamic; function FindNextControl(CurControl: TWinControl; GoForward, CheckTabStop, CheckParent: Boolean): TWinControl; procedure FixupTabList; function GetActionLinkClass: TControlActionLinkClass; override; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; function GetClientOrigin: TPoint; override; function GetClientRect: TRect; override; function GetControlExtents: TRect; virtual; function GetDeviceContext(var WindowHandle: HWnd): HDC; override; function GetParentHandle: HWnd; procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); dynamic; function GetTopParentHandle: HWnd; function IsControlMouseMsg(var Message: TWMMouse): Boolean; procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic; procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic; procedure KeyPress(var Key: Char); dynamic; procedure MainWndProc(var Message: TMessage); procedure NotifyControls(Msg: Word); procedure PaintControls(DC: HDC; First: TControl); procedure PaintHandler(var Message: TWMPaint); procedure PaintWindow(DC: HDC); virtual; function PaletteChanged(Foreground: Boolean): Boolean; override; procedure ReadState(Reader: TReader); override; procedure RecreateWnd; procedure ReloadDockedControl(const AControlName: string; var AControl: TControl); dynamic; procedure ResetIme; function ResetImeComposition(Action: DWORD): Boolean; procedure ScaleControls(M, D: Integer); procedure SelectFirst; procedure SelectNext(CurControl: TWinControl; GoForward, CheckTabStop: Boolean); procedure SetChildOrder(Child: TComponent; Order: Integer); override; procedure SetIme; function SetImeCompositionWindow(Font: TFont; XPos, YPos: Integer): Boolean; procedure SetParentBackground(Value: Boolean); virtual; procedure SetZOrder(TopMost: Boolean); override; procedure ShowControl(AControl: TControl); virtual; procedure UpdateUIState(CharCode: Word); procedure WndProc(var Message: TMessage); override; property BevelEdges: TBevelEdges read FBevelEdges write SetBevelEdges default [beLeft, beTop, beRight, beBottom]; property BevelInner: TBevelCut index 0 read FBevelInner write SetBevelCut default bvRaised; property BevelOuter: TBevelCut index 1 read FBevelOuter write SetBevelCut default bvLowered; property BevelKind: TBevelKind read FBevelKind write SetBevelKind default bkNone; property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0; property Ctl3D: Boolean read FCtl3D write SetCtl3D stored IsCtl3DStored; property DefWndProc: Pointer read FDefWndProc write FDefWndProc; property DockSite: Boolean read FDockSite write SetDockSite default False; property DockManager: IDockManager read FDockManager write FDockManager; property ImeMode: TImeMode read FImeMode write FImeMode default imDontCare; property ImeName: TImeName read FImeName write FImeName; property ParentBackground: Boolean read GetParentBackground write SetParentBackground; property ParentCtl3D: Boolean read FParentCtl3D write SetParentCtl3D default True; property UseDockManager: Boolean read FUseDockManager write SetUseDockManager default False; property WindowHandle: HWnd read FHandle write FHandle; property OnDockDrop: TDockDropEvent read FOnDockDrop write FOnDockDrop; property OnDockOver: TDockOverEvent read FOnDockOver write FOnDockOver; property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; property OnExit: TNotifyEvent read FOnExit write FOnExit; property OnGetSiteInfo: TGetSiteInfoEvent read FOnGetSiteInfo write FOnGetSiteInfo; property onkeydown: TKeyEvent read Fonkeydown write Fonkeydown; property onkeypress: TKeyPressEvent read Fonkeypress write Fonkeypress; property onkeyup: TKeyEvent read Fonkeyup write Fonkeyup; property OnUnDock: TUnDockEvent read FOnUnDock write FOnUnDock; public constructor Create(AOwner: TComponent); override; constructor CreateParented(ParentWindow: HWnd); class function CreateParentedControl(ParentWindow: HWnd): TWinControl; destructor Destroy; override; procedure Broadcast(var Message); function CanFocus: Boolean; dynamic; function ContainsControl(Control: TControl): Boolean; function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean; AllowWinControls: Boolean = False): TControl; procedure DefaultHandler(var Message); override; procedure DisableAlign; property DockClientCount: Integer read GetDockClientCount; property DockClients[Index: Integer]: TControl read GetDockClients; procedure DockDrop(Source: TDragDockObject; X, Y: Integer); dynamic; property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered; procedure EnableAlign; function FindChildControl(const ControlName: string): TControl; procedure FlipChildren(AllLevels: Boolean); dynamic; function Focused: Boolean; dynamic; procedure GetTabOrderList(List: TList); dynamic; function HandleAllocated: Boolean; procedure HandleNeeded; procedure InsertControl(AControl: TControl); procedure Invalidate; override; procedure PaintTo(DC: HDC; X, Y: Integer); overload; procedure PaintTo(Canvas: TCanvas; X, Y: Integer); overload; procedure RemoveControl(AControl: TControl); procedure Realign; procedure Repaint; override; procedure ScaleBy(M, D: Integer); procedure ScrollBy(DeltaX, DeltaY: Integer); procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; procedure SetFocus; virtual; procedure Update; override; procedure UpdateControlState; property AlignDisabled: Boolean read GetAlignDisabled; property VisibleDockClientCount: Integer read GetVisibleDockClientCount; property Brush: TBrush read FBrush; property Controls[Index: Integer]: TControl read GetControl; property ControlCount: Integer read GetControlCount; property Handle: HWnd read GetHandle; property ParentWindow: HWnd read FParentWindow write SetParentWindow; property Showing: Boolean read FShowing; property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1; property TabStop: Boolean read FTabStop write SetTabStop default False; published end;
Tia, widzę błąd :>
Źle tworzysz labele :>
Powinno być constructor ttextlabel.create(aowner:tcomponent); begin inherited create(aowner); flabel1:=TLabel.Create(self); flabel2:=TLabel.Create(self); flabel1.Parent:=self; flabel2.Parent:=self; end;
I nie jestem pewny czy destruktor jest napisany OK. Imho powinno być: destructor ttextlabel.destroy; begin flabel1.Free; flabel2.Free; inherited destroy; end;
//@ KSMłody
I po co tu ten kod wkeiłeś ? Jak CI się nie chce nawet przetestować kodu to daj sobie spokój z odpowiadaniem.
Użytkownik -=PcSA=- edytował ten post 28 lipiec 2006, 15:08