📄 sybcheckbox.pas
字号:
unit sybcheckbox;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,dsgnintf;
type SybObjectname = string[30];
type string1 = string[1];
type
Tsybobjectproperty = class(TStringProperty)
public
procedure GetValues(TheProc: TGetStrProc); override;
function getattributes:Tpropertyattributes; override;
end;
type
TSybCheckbox = class(TCheckbox)
private
{ Private declarations }
fdatatype :SybObjectname;
fdataset :SybObjectname;
fdatafield :SybObjectname;
fisprimarykey :boolean;
procedure Setdatatype(Value :SybObjectname);
procedure Setdataset(Value :SybObjectname);
procedure Setdatafield(Value :SybObjectname);
function getvalue:string1;
procedure setvalue(value:string1);
procedure Setisprimarykey(Value :boolean);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor destroy; override;
procedure setname(const NewName:Tcomponentname); override;
property Datatype:SybObjectname read fdatatype write setdatatype;
published
{ Published declarations }
property DataSet :SybObjectname read Fdataset write setdataset;
property DataField :SybObjectname read fdatafield write setdatafield;
property Value:string1 read getvalue write setvalue;
property IsPrimaryKey:boolean read fisprimarykey write setIsPrimaryKey stored false;
end;
procedure Register;
var from_create :boolean;
implementation
uses sybase_components,sybquery,sybtable;
procedure Register;
begin
RegisterPropertyEditor(TypeInfo(SybObjectname),Tsybcheckbox,'',Tsybobjectproperty);
RegisterComponents('Sybase DBLIB', [Tsybcheckbox]);
end;
constructor Tsybcheckbox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
setdatatype('bit');
from_create:=true;
fIsPrimaryKey:=false;
if fieldslist = nil then
begin
FieldsList:=TList.create;
end;
end;
destructor Tsybcheckbox.destroy;
var thisform :tform;
i,j :smallint;
asybtable :tsybtable;
asybquery :tsybquery;
begin
thisform:=tform(owner);
for i := 0 to thisform.ComponentCount - 1 do
begin
if (thisform.Components[i] is TSybTable)
and (thisform.Components[i].name=dataset) then
begin
asybtable:=tsybtable(thisform.Components[i]);
asybtable.deletefield(name);
break;
end;
if (thisform.Components[i] is TSybQuery)
and (thisform.Components[i].name=dataset) then
begin
asybquery:=tsybquery(thisform.Components[i]);
asybquery.deletefield(name);
break;
end;
end;
fieldslist.remove(self);
inherited destroy;
end;
procedure Tsybcheckbox.Setdatatype(Value :SybObjectname);
begin
fdatatype:=value;
end;
procedure Tsybcheckbox.Setisprimarykey(Value :boolean);
begin
fisprimarykey:=value;
end;
function Tsybcheckbox.getvalue:string1;
begin
if checked then
result:='1'
else
result:='0';
end;
procedure Tsybcheckbox.setvalue(value:string1);
begin
if value = '1' then
checked:=true
else
checked:=false;
end;
procedure Tsybcheckbox.setname(const NewName:Tcomponentname);
var oldname :Tcomponentname;
thisform :tform;
i :smallint;
asybtable :tsybtable;
asybquery :tsybquery;
begin
oldname:=name;
thisform:=tform(owner);
inherited setname(NewName);
for i := 0 to thisform.ComponentCount - 1 do
begin
if (thisform.Components[i] is TSybTable)
and (thisform.Components[i].name=dataset) then
begin
asybtable:=tsybtable(thisform.Components[i]);
asybtable.deletefield(oldname);
asybtable.addfield(name);
break;
end;
if (thisform.Components[i] is TSybQuery)
and (thisform.Components[i].name=dataset) then
begin
asybquery:=tsybquery(thisform.Components[i]);
asybquery.deletefield(oldname);
asybquery.addfield(name);
break;
end;
end;
if fieldslist.indexof(self) = -1 then
begin
fieldslist.add(self);
end
else
begin
fieldslist.items[fieldslist.indexof(self)]:=self;
end;
end;
procedure Tsybcheckbox.Setdatafield(Value :SybObjectname);
begin
fdatafield:=value;
end;
procedure Tsybcheckbox.Setdataset(Value :SybObjectname);
var thisform :tform;
i,j :smallint;
asybtable :tsybtable;
asybquery :tsybquery;
begin
thisform:=tform(owner);
for i := 0 to thisform.ComponentCount - 1 do
begin
if (thisform.Components[i] is TSybTable)
and (thisform.Components[i].name=value) then
begin
asybtable:=tsybtable(thisform.Components[i]);
asybtable.deletefield(name);
break;
end;
if (thisform.Components[i] is TSybQuery)
and (thisform.Components[i].name=value) then
begin
asybQuery:=tsybQuery(thisform.Components[i]);
asybQuery.deletefield(name);
break;
end;
end;
Fdataset:=value;
for i := 0 to thisform.ComponentCount - 1 do
begin
if (thisform.Components[i] is TSybTable)
and (thisform.Components[i].name=value) then
begin
asybtable:=tsybtable(thisform.Components[i]);
asybtable.addfield(name);
break;
end;
if (thisform.Components[i] is TSybquery)
and (thisform.Components[i].name=value) then
begin
asybquery:=tsybquery(thisform.Components[i]);
asybquery.addfield(name);
break;
end;
end;
end;
procedure Tsybobjectproperty.GetValues(TheProc: TGetStrProc);
var i,j :integer;
thisform :tform;
teditf :Tsybcheckbox;
nm :string;
asybtable :tsybtable;
asybquery :tsybquery;
begin
teditf:=Tsybcheckbox(getcomponent(0));
thisform:=tform(teditf.owner);
if getname = 'DataSet' then
begin
for i := 0 to thisform.ComponentCount - 1 do
begin
with thisform.Components[i] do { as TControl) do}
begin
if thisform.Components[i] is TSybTable then
theproc(thisform.Components[i].name);
if thisform.Components[i] is TSybQuery then
theproc(thisform.Components[i].name);
end;
end;
end;
if getname = 'Datatype' then
begin
theproc('binary');
theproc('bit');
theproc('char');
theproc('datetime');
theproc('decimal');
theproc('float');
theproc('int');
theproc('money');
theproc('varchar');
end;
if getname = 'DataField' then
begin
for i := 0 to thisform.ComponentCount - 1 do
begin
if (thisform.Components[i] is TSybTable)
and (thisform.Components[i].name=teditf.dataset) then
begin
asybtable:=tsybtable(thisform.Components[i]);
for j:=1 to asybtable.datafieldscount do
theproc(asybtable.datafields[j]);
end;
if (thisform.Components[i] is TSybQuery)
and (thisform.Components[i].name=teditf.dataset) then
begin
asybquery:=tsybquery(thisform.Components[i]);
for j:=1 to asybquery.datafieldscount do
theproc(asybquery.datafields[j]);
end;
end;
end;
end;
function Tsybobjectproperty.getattributes:Tpropertyattributes;
begin
Result := [paValueList,paAutoUpdate,paMultiSelect];
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -