📄 sybmemo.pas
字号:
unit sybmemo;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,dsgnintf;
type SybObjectname = string[30];
type
TTypes = (datetime,float,int,char,bit,text);
type
Tsybobjectproperty = class(TStringProperty)
public
procedure GetValues(TheProc: TGetStrProc); override;
function getattributes:Tpropertyattributes; override;
end;
type
TSybMemo = class(TMemo)
private
fdatatype :SybObjectname;
flength :smallint;
ftablename :SybObjectname;
fdataset :SybObjectname;
fdatafield :SybObjectname;
fisprimarykey :boolean;
procedure setlength(value :smallint);
procedure Setdatatype(Value :SybObjectname);
procedure Setdataset(Value :SybObjectname);
procedure Setdatafield(Value :SybObjectname);
function getvalue:string;
procedure setvalue(value:string);
procedure Setisprimarykey(Value :boolean);
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
destructor destroy; override;
procedure setname(const NewName:Tcomponentname); override;
published
property Datatype:SybObjectname read fdatatype write setdatatype; {fdatatype;}
property Length:smallint read flength write setlength;
property DataSet :SybObjectname read Fdataset write setdataset;
property DataField :SybObjectname read fdatafield write setdatafield;
property Value:string read getvalue write setvalue;
property IsPrimaryKey:boolean read fisprimarykey write setIsPrimaryKey stored false;
end;
procedure Register;
var from_create :boolean;
implementation
uses sybase_components,sybtable,sybquery;
procedure Register;
begin
RegisterPropertyEditor(TypeInfo(SybObjectname),Tsybmemo,'',Tsybobjectproperty);
RegisterComponents('Sybase DBLIB', [tsybmemo]);
end;
constructor Tsybmemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
setdatatype('text');
from_create:=true;
fIsPrimaryKey:=false;
height:=90;
if fieldslist = nil then
begin
FieldsList:=TList.create;
end;
end;
destructor tsybmemo.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 Tsybmemo.Setisprimarykey(Value :boolean);
begin
fisprimarykey:=value;
end;
function Tsybmemo.getvalue:string;
begin
result:=text;
end;
procedure Tsybmemo.setvalue(value:string);
begin
text:=value;
end;
procedure Tsybmemo.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
fieldslist.add(self)
else
begin
fieldslist.items[fieldslist.indexof(self)]:=self;
end;
end;
procedure Tsybmemo.Setdatafield(Value :SybObjectname);
begin
fdatafield:=value;
end;
procedure Tsybmemo.Setdatatype(Value :SybObjectname);
begin
fdatatype:=value;
end;
procedure Tsybmemo.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 tsybmemo.setlength(value:smallint);
begin
flength:=value;
end;
procedure Tsybobjectproperty.GetValues(TheProc: TGetStrProc);
var i,j :integer;
thisform :tform;
teditf :tsybmemo;
nm :string;
asybtable :tsybtable;
asybquery :tsybquery;
begin
teditf:=tsybmemo(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('datetime');
theproc('float');
theproc('int');
theproc('char');
theproc('bit');
theproc('text');
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 + -