【发布时间】:2019-09-20 19:08:26
【问题描述】:
我正在尝试创建一个自定义清单组件,其中包含 Orpheus 组件 (TOvcCheckList) 的一些附加功能和一些 UI 增强功能。 我需要一些帮助来创建一个如图所示的 CheckList,
为了实现这个设计,到目前为止,我们还没有设计任何自定义组件,但我们尝试通过放置一个 cxGroupBox 并在组框顶部添加 cxCheckList 并实现该功能。 但是现在我们被要求创建一个组件,以便减少在每个地方编写功能的需要。
unit DxSelectallGroupBox;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, cxContainer, cxEdit, cxCustomListBox,
cxCheckListBox, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxPC, dxDockPanel, dxDockControl,
Vcl.StdCtrls, cxGroupBox, cxCheckBox, dxBevel, System.ImageList, Vcl.ImgList,
Vcl.CheckLst,Imagelistmodule;
type
TDxSelectallGroupBox = class(TcxCustomGroupBox)
private
{ Private declarations }
fGBSelectAll: TcxGroupBox;
fGBCheckList: TcxGroupBox;
fCxCheckList: TcxCheckListBox;
fDxBevel: TdxBevel;
fCxCheckSelectAll: TcxCheckListBox;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Test Components', [TDxSelectallGroupBox]);
end;
{ TDxChecklistGroupBox }
constructor TDxSelectallGroupBox.Create(AOwner: TComponent);
begin
inherited;
SetBounds(Left, Top, 140, 120);
fGBSelectAll := TcxGroupBox.Create(self);
fGBSelectAll.Parent := Twincontrol(AOwner);
fGBSelectAll.SetBounds(10, 10, width, 185);
fGBSelectAll.Align := alNone;
fGBSelectAll.Alignment := alTopLeft;
fCxCheckSelectAll := TcxCheckListBox.Create(Self);
fCxCheckSelectAll.Parent := fGBSelectAll;
FdxBevel := Tdxbevel.Create(Self);
FdxBevel.Parent := fGBSelectAll;
FgbCheckList := TcxGroupBox.Create(Self);
FgbCheckList.Parent := fGBSelectAll;
fCxCheckList := TcxCheckListBox.Create(Self);
fCxCheckList.Parent := FgbCheckList;
with fGBSelectAll do begin
PanelStyle.Active := True;
ParentBackground := False;
ParentColor := False;
Style.BorderColor := 15065047;
Style.BorderStyle := ebsSingle;
Style.Color := clWhite;
Style.LookAndFeel.NativeStyle := False;
TabOrder := 0;
end;
with FdxBevel do begin
Left := 2;
Top := 38;
Width := 181;
Height := 1;
Align := alTop;
AutoSize := True;
LookAndFeel.NativeStyle := False;
end ;
with FgbCheckList do begin
Left := 2 ;
Top := 39;
Align := alClient;
PanelStyle.Active := True;
ParentBackground := False;
Style.BorderStyle := ebsNone;
Style.LookAndFeel.NativeStyle := False;
StyleDisabled.LookAndFeel.NativeStyle := False;
TabOrder := 0;
Height := 121;
Width := 181;
end;
with fCxCheckList do begin
Left := 2;
Top := 2;
Width := 177;
Height := 117;
Margins.Left := 5;
Margins.Top := 0;
Margins.Right := 0;
Margins.Bottom := 0;
Align := alClient;
ParentFont := False;
Style.BorderStyle := cbsNone;
Style.Color := clWhite;
Style.Font.Charset := ANSI_CHARSET;
Style.Font.Color := 7697781;
Style.Font.Height := -16;
Style.Font.Name := 'Noto Sans';
Style.Font.Style := [];
Style.HotTrack := True;
Style.LookAndFeel.NativeStyle := False;
TabOrder := 0;
additem('One');
additem('Two');
additem('Three');
showchecks:=true;
end;
with fCxCheckSelectAll do
begin
AlignWithMargins := True;
Left := 5;
Top := 5 ;
Width := 175 ;
Height := 30 ;
Align := alTop;
ParentFont := False ;
Style.BorderStyle := cbsNone;
Style.Font.Charset := ANSI_CHARSET;
Style.Font.Color := 7697781;
Style.Font.Height := -16 ;
Style.Font.Name := 'Noto Sans';
Style.Font.Style := [] ;
Style.LookAndFeel.NativeStyle := False;
StyleDisabled.BorderStyle := cbsNone;
TabOrder := 1 ;
additem('Select All');
Showchecks :=True;
end;
end;
end.
任何人都可以帮助纠正我的来源并让我朝着正确的方向前进吗? 谢谢。
更新
我找到了错误的根本原因并修复了Control '' has no parent window。当我安装并尝试将组件放在表单上时,它会给出类似的错误
Access violation at address 1D405F2E in module 'cxLibraryRS25.bpl'. Write of'地址00000090`
【问题讨论】:
-
顺便说一句,你可能想做一些教程,比如 this oldie 构建复合组件(AKA composite controls)
标签: delphi devexpress vcl delphi-10.2-tokyo checklistbox