Опытный
Профиль
Группа: Участник
Сообщений: 704
Регистрация: 19.1.2006
Где: Новосибирск
Репутация: 5
Всего: 20
|
конечно итак: 1. базовый класс | Код |
uses
SysUtils, Classes, TypInfo, StdCtrls, ComCtrls, Utils, RegExpr, DB;
TStructureObj = class(TComponent)
protected
function GetPropertyNameFromObject(AFromObject: TComponent): String;
public
procedure Assign(Source: TPersistent); override;
constructor Create(AOwner: TComponent); override;
function GetProperty(const APropName: String; Source: TStructureObj = nil; ARoundFloatValues: Boolean = False): Variant; overload;
function GetProperty(AFromObject: TComponent): Variant; overload;
function HasProperty(const APropName: String; Source: TStructureObj = nil): Boolean;
procedure Object2Property(AFromObject: TComponent);
procedure Property2Object(ADestObject: TComponent; ARoundFloatValues: Boolean = False);
procedure Property2Param(ADestParam: TParam);
procedure Field2Property(ASourceField: TField);
procedure Reset;
procedure SetProperty(const APropName: String; AValue: Variant);
published
end;
....
{ TStructureObj }
procedure TStructureObj.Assign(Source: TPersistent);
var PropList: PPropList;
ClassTypeInfo: PTypeInfo;
ClassTypeData: PTypeData;
I: Integer;
APropName: String;
AValue: Variant;
begin
ClassTypeInfo:=Self.ClassInfo;
ClassTypeData:=GetTypeData(ClassTypeInfo);
if ClassTypeData.PropCount <> 0 then
begin
GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
try
GetPropInfos(Self.ClassInfo, PropList);
for I:=0 to ClassTypeData.PropCount - 1 do
begin
APropName:=PropList[I]^.Name;
if HasProperty(APropName, TStructureObj(Source)) and (AnsiIndexText(APropName, SpecProperties) = -1) then
begin
AValue:=GetProperty(APropName, TStructureObj(Source));
SetProperty(APropName, AValue);
end;
end;
finally
FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
end;
end;
end;
constructor TStructureObj.Create(AOwner: TComponent);
var TS: TTimeStamp;
begin
inherited Create(AOwner);
TS:=DateTimeToTimeStamp(Now);
Name:=Self.ClassName + '_' + IntToStr(TS.Date) + '_' + IntToStr(TS.Time);
end;
function TStructureObj.GetProperty(const APropName: String; Source: TStructureObj = nil;
ARoundFloatValues: Boolean = False): Variant;
var PI: PPropInfo;
StructObj: TStructureObj;
begin
Result:=0;
if not Assigned(Source) then
StructObj:=Self
else
StructObj:=Source;
PI:=GetPropInfo(StructObj.ClassInfo, APropName);
if PI <> nil then
case PI^.PropType^.Kind of
tkInteger: Result:=GetOrdProp(StructObj, APropName);
tkFloat:
begin
Result:=GetFloatProp(StructObj, APropName);
if ARoundFloatValues then
Result:=RoundTo(Real(Result), -2);
end;
tkString, tkLString, tkWString: Result:=GetStrProp(StructObj, APropName);
end;
end;
procedure TStructureObj.Field2Property(ASourceField: TField);
var FName: String;
Val: Variant;
begin
FName:=ASourceField.FieldName;
if HasProperty(FName) then
begin
Val:=ASourceField.AsVariant;
if not VarIsNull(Val) then
SetProperty(FName, Val);
end;
end;
function TStructureObj.GetProperty(AFromObject: TComponent): Variant;
var CName: String;
begin
CName:=GetPropertyNameFromObject(AFromObject);
Result:=GetProperty(CName);
end;
function TStructureObj.GetPropertyNameFromObject(AFromObject: TComponent): String;
var RE: TRegExpr;
APropName: String;
begin
APropName:=AFromObject.Name;
RE:=TRegExpr.Create;
try
RE.Expression:='(LE|Memo|Edit|ChB|DTP|CB)';
RE.ModifierI:=False;
APropName:=RE.Replace(APropName, '');
finally
RE.Free;
end;
Result:=APropName;
end;
function TStructureObj.HasProperty(const APropName: String; Source: TStructureObj = nil): Boolean;
var PI: PPropInfo;
begin
if not Assigned(Source) then
PI:=GetPropInfo(Self.ClassInfo, APropName)
else
PI:=GetPropInfo(Source.ClassInfo, APropName);
Result:=PI <> nil;
end;
procedure TStructureObj.Object2Property(AFromObject: TComponent);
var CName, ObjClassName: String;
AValue: Variant;
PI: PPropInfo;
begin
CName:=GetPropertyNameFromObject(AFromObject);
if HasProperty(CName) then
begin
PI:=GetPropInfo(Self.ClassInfo, CName);
ObjClassName:=AFromObject.ClassName;
case AnsiIndexStr(ObjClassName, EditControls) + 1 of
1, 2: AValue:=(AFromObject as TCustomEdit).Text; // TEdit, TLabeledEdit
3: if PI^.PropType^.Kind = tkInteger then // TComboBox
AValue:=Integer((AFromObject as TComboBox).Items.Objects[(AFromObject as TComboBox).ItemIndex])
else
AValue:=(AFromObject as TComboBox).Text;
4: AValue:=(AFromObject as TMemo).Lines.Text; // TMemo
5: AValue:=Byte((AFromObject as TCheckBox).Checked); // TCheckBox
6: AValue:=(AFromObject as TDateTimePicker).DateTime; // TDateTimePicker
end;
SetProperty(CName, AValue);
end;
end;
procedure TStructureObj.Property2Object(ADestObject: TComponent; ARoundFloatValues: Boolean = False);
var APropName, ObjClassName: String;
AValue: Variant;
PI: PPropInfo;
begin
APropName:=GetPropertyNameFromObject(ADestObject);
if HasProperty(APropName) then
begin
PI:=GetPropInfo(Self.ClassInfo, APropName);
AValue:=GetProperty(APropName, nil, ARoundFloatValues);
ObjClassName:=ADestObject.ClassName;
case AnsiIndexStr(ObjClassName, EditControls) + 1 of
1, 2: (ADestObject as TCustomEdit).Text:=AValue; // TEdit, TLabeledEdit
3: if PI^.PropType^.Kind = tkInteger then // TComboBox
(ADestObject as TComboBox).ItemIndex:=GetSelected(AValue, (ADestObject as TComboBox).Items)
else
(ADestObject as TComboBox).Text:=AValue;
4: (ADestObject as TMemo).Lines.Text:=AValue; // TMemo
5: (ADestObject as TCheckBox).Checked:=AValue; // TCheckBox
6: (ADestObject as TDateTimePicker).DateTime:=AValue; // TDateTimePicker
end;
end;
end;
procedure TStructureObj.Property2Param(ADestParam: TParam);
var APropName: String;
AValue: Variant;
PI: PPropInfo;
//TimeStamp: TSQLTimeStamp;
function IsDate(AParamName: String): Boolean;
var RE: TRegExpr;
begin
RE:=TRegExpr.Create;
try
RE.Expression:='(Dat)';
RE.ModifierI:=True;
Result:=RE.Exec(AParamName);
finally
RE.Free;
end;
end;
begin
APropName:=ADestParam.Name;
if HasProperty(APropName) then
begin
PI:=GetPropInfo(Self.ClassInfo, APropName);
AValue:=GetProperty(APropName);
case PI^.PropType^.Kind of
tkInteger: ADestParam.AsInteger:=AValue;
tkFloat:
if not IsDate(APropName) then
ADestParam.AsFloat:=AValue
else
ADestParam.AsDateTime:=AValue;
{
begin
try
TimeStamp:=VarToSQLTimeStamp(AValue);
CheckSqlTimeStamp(TimeStamp);
if not VarIsSQLTimeStamp(AValue) then
raise EConvertError.Create('Convert Error');
ADestParam.AsDateTime:=AValue;
except
on E: Exception do
ADestParam.AsFloat:=AValue;
end;
end; }
tkString, tkLString, tkWString: ADestParam.AsString:=AValue;
end;
end;
end;
procedure TStructureObj.Reset;
var PropList: PPropList;
ClassTypeInfo: PTypeInfo;
ClassTypeData: PTypeData;
I: Integer;
begin
ClassTypeInfo:=Self.ClassInfo;
ClassTypeData:=GetTypeData(ClassTypeInfo);
if ClassTypeData.PropCount <> 0 then
begin
GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
try
GetPropInfos(Self.ClassInfo, PropList);
for I:=0 to ClassTypeData.PropCount - 1 do
if AnsiIndexStr(PropList[I]^.Name, SpecProperties) = -1 then
case PropList[I]^.PropType^.Kind of
tkInteger: SetOrdProp(Self, PropList[I]^.Name, 0);
tkFloat: SetFloatProp(Self, PropList[I]^.Name, 0);
tkString, tkLString, tkWString: SetStrProp(Self, PropList[I]^.Name, '');
end;
finally
FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
end;
end;
end;
procedure TStructureObj.SetProperty(const APropName: String; AValue: Variant);
var PI: PPropInfo;
begin
PI:=GetPropInfo(Self.ClassInfo, APropName);
if PI <> nil then
case PI^.PropType^.Kind of
tkInteger: SetOrdProp(Self, APropName, AValue);
tkFloat: SetFloatProp(Self, APropName, AValue);
tkString, tkLString, tkWString: SetStrProp(Self, APropName, AValue);
else
SetStrProp(Self, APropName, String(AValue));
end;
end;
|
2. class наследник | Код |
interface
uses
Classes, Structures;
type
TUserObj = class(TStructureObj)
private
FID: Integer;
FLogin: String;
FSurname: String;
FFirstname: String;
FMidname: String;
FUserCat: Byte;
published
property ID: Integer read FID write FID;
property Login: String read FLogin write FLogin;
property Surname: String read FSurname write FSurname;
property Firstname: String read FFirstname write FFirstname;
property Midname: String read FMidname write FMidname;
property UserCat: Byte read FUserCat write FUserCat;
end;
var
UserIR: TUserObj;
implementation
initialization
begin
RegisterClass(TUserObj);
UserIR:=TUserObj.Create(nil);
with UserIR do
begin
ID:=0;
Login:='annonymouse';
end;
end;
finalization
begin
UserIR.Free;
UnRegisterClass(TUserObj);
end;
end.
|
2. работа с БД | Код |
procedure TNAPDBModule.miscSetParams(AStructure: TStructureObj; AParams: TParams);
var I: Integer;
//PName: String;
AParam: TParam;
begin
for I:=0 to AParams.Count - 1 do
begin
AParam:=AParams.Items[I];
AStructure.Property2Param(AParam);
end;
end;
procedure TNAPDBModule.miscSetFields(AStructure: TStructureObj;
AFields: TFields);
var I: Integer;
begin
for I:=0 to AFields.Count - 1 do
AStructure.Field2Property(AFields.Fields[I]);
end;
procedure TNAPDBModule.miscGetObjData(AObjTab: String; AObjID: Integer;
AObj: TStructureObj; AAdvData: String = '');
begin
AObj.Reset;
with IBQDiff do
begin
SQL.Clear;
Params.Clear;
SQL.Add('select od.* ');
if AAdvData <> '' then
SQL.Add(', '+AAdvData);
SQL.Add('from ' + AObjTab + ' od where od.id = :id');
ParamByName('id').AsInteger:=AObjID;
Open;
First;
miscSetFields(AObj, Fields);
Close;
end;
end;
|
3. работа с формами ввода(сбор данных с формы, вывод данных на форму) | Код |
procedure TUserInfoForm.FormCreate(Sender: TObject);
var I: Integer;
begin
Panel.ParentBackground:=False;
if GlobalAction = gaEditUser then
for I:=0 to ComponentCount - 1 do
UserIR.Property2Object(Components[I]);
end;
procedure TUserInfoForm.OkButtonClick(Sender: TObject);
var I: Integer;
begin
for I:=0 to ComponentCount - 1 do
UserIR.Object2Property(Components[I]);
end;
|
пример формы | Код |
object UserInfoForm: TUserInfoForm
Left = 395
Top = 369
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = #1055#1086#1083#1100#1079#1086#1074#1072#1090#1077#1083#1100': '#1089#1074#1086#1081#1089#1090#1074#1072
ClientHeight = 233
ClientWidth = 481
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label3: TLabel
Left = 113
Top = 68
Width = 31
Height = 13
Alignment = taRightJustify
Caption = #1051#1086#1075#1080#1085
end
object Label4: TLabel
Left = 95
Top = 92
Width = 49
Height = 13
Alignment = taRightJustify
Caption = #1060#1072#1084#1080#1083#1080#1103
end
object Label5: TLabel
Left = 122
Top = 116
Width = 22
Height = 13
Alignment = taRightJustify
Caption = #1048#1084#1103
end
object Label6: TLabel
Left = 102
Top = 140
Width = 42
Height = 13
Alignment = taRightJustify
Caption = #1054#1095#1077#1089#1090#1074#1086
end
object BevelSec: TBevel
Left = 8
Top = 192
Width = 465
Height = 3
Shape = bsTopLine
end
object Panel: TPanel
Left = 0
Top = 0
Width = 481
Height = 49
Align = alTop
BevelOuter = bvNone
Color = clWhite
TabOrder = 0
object Bevel: TBevel
Left = 0
Top = 46
Width = 481
Height = 3
Align = alBottom
Shape = bsBottomLine
end
object Label1: TLabel
Left = 16
Top = 8
Width = 149
Height = 13
Caption = #1055#1086#1083#1100#1079#1086#1074#1072#1090#1077#1083#1100': '#1089#1074#1086#1081#1089#1090#1074#1072
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label2: TLabel
Left = 24
Top = 24
Width = 303
Height = 13
Caption = #1055#1086#1078#1072#1083#1091#1081#1089#1090#1072' '#1091#1082#1072#1078#1080#1090#1077' '#1085#1077#1086#1073#1093#1086#1076#1080#1084#1099#1077' '#1076#1072#1085#1085#1099#1077' '#1086' '#1087#1086#1083#1100#1079#1086#1074#1072#1090#1077#1083#1077
end
end
object LoginEdit: TEdit
Left = 152
Top = 64
Width = 121
Height = 21
MaxLength = 30
TabOrder = 1
OnChange = LoginEditChange
end
object SurnameEdit: TEdit
Left = 152
Top = 88
Width = 161
Height = 21
MaxLength = 50
TabOrder = 2
OnChange = LoginEditChange
end
object FirstnameEdit: TEdit
Left = 152
Top = 112
Width = 161
Height = 21
MaxLength = 50
TabOrder = 3
OnChange = LoginEditChange
end
object MidnameEdit: TEdit
Left = 152
Top = 136
Width = 161
Height = 21
MaxLength = 50
TabOrder = 4
end
object OkButton: TButton
Left = 8
Top = 200
Width = 75
Height = 25
Caption = #1054#1050
Enabled = False
ModalResult = 1
TabOrder = 5
OnClick = OkButtonClick
end
object CancelButton: TButton
Left = 88
Top = 200
Width = 75
Height = 25
Cancel = True
Caption = #1054#1090#1084#1077#1085#1072
ModalResult = 2
TabOrder = 6
end
object ChBUserCat: TCheckBox
Left = 152
Top = 160
Width = 65
Height = 17
Caption = #1043#1072#1088#1072#1078
TabOrder = 7
end
end
|
4. Пример работы с БД | Код |
procedure TNAPDBModule.userNew(AUIR: TUserObj);
begin
miscStartTransaction(False);
with IBQDiff do
begin
SQL.Clear;
Params.Clear;
SQL.Add('insert into nap_users (login, firstname, surname, midname, usercat)');
SQL.Add('values (:login, :firstname, :surname, :midname, :usercat)');
miscSetParams(AUIR, Params);
ExecSQL;
end;
miscCommitTransaction(False);
end;
procedure TNAPDBModule.userUpdate(ID: Integer; AUserIR: TUserObj);
begin
miscStartTransaction(False);
with IBQDiff do
begin
SQL.Clear;
Params.Clear;
SQL.Add('update nap_users set login = :login, surname = :surname, ');
SQL.Add('firstname = :firstname, midname = :midname, usercat = :usercat');
SQL.Add('where id = :id');
miscSetParams(AUserIR, Params);
ParamByName('id').AsInteger:=ID;
ExecSQL;
end;
miscCommitTransaction(False);
end;
procedure TNAPDBModule.userGetData(ID: Integer; AUIR: TUserObj);
begin
AUIR.Reset;
with IBQDiff do
begin
SQL.Clear;
Params.Clear;
SQL.Add('select * from nap_users where id = :id');
ParamByName('id').AsInteger:=ID;
Open;
First;
miscSetFields(AUIR, Fields);
Close;
end;
end;
|
можно конечно имено полей тоже генерить динамически - руки пока не дошли иправить Это сообщение отредактировал(а) jsa - 26.2.2009, 14:26 --------------------
Все мы, на перине с песней, строим небо на земле © Ю. Шевчук |
Большие запросы SQL 
Загрузка ...
Ты больших запросов не видел 
, наверное 
