fields.inc 42 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
  5. Free Pascal development team
  6. TFields and related components implementations.
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. Procedure DumpMem (P : Pointer;Size : Longint);
  14. Var i : longint;
  15. begin
  16. Write ('Memory dump : ');
  17. For I:=0 to Size-1 do
  18. Write (Pbyte(P)[i],' ');
  19. Writeln;
  20. end;
  21. { ---------------------------------------------------------------------
  22. TFieldDef
  23. ---------------------------------------------------------------------}
  24. Constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string;
  25. ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
  26. begin
  27. Inherited Create(AOwner);
  28. {$ifdef dsdebug }
  29. Writeln('TFieldDef.Create : ',Aname,'(',AFieldNo,')');
  30. {$endif}
  31. FName:=Aname;
  32. FDisplayName := '';
  33. FDatatype:=ADatatype;
  34. FSize:=ASize;
  35. FRequired:=ARequired;
  36. FPrecision:=-1;
  37. // Correct sizes.
  38. If FDataType=ftFloat then
  39. begin
  40. If Not (FSize in [4,8,10]) then FSize:=10
  41. end
  42. else If FDataType in [ftWord,ftsmallint,ftinteger] Then
  43. If Not (FSize in [1,2,4]) then FSize:=4;
  44. FFieldNo:=AFieldNo;
  45. AOwner.FItems.Add(Self);
  46. end;
  47. Destructor TFieldDef.Destroy;
  48. Var I : longint;
  49. begin
  50. Inherited destroy;
  51. end;
  52. Function TFieldDef.CreateField(AOwner: TComponent): TField;
  53. Var TheField : TFieldClass;
  54. begin
  55. {$ifdef dsdebug}
  56. Writeln ('Creating field '+FNAME);
  57. {$endif dsdebug}
  58. TheField:=GetFieldClass;
  59. if TheField=Nil then
  60. DatabaseErrorFmt(SUnknownFieldType,[FName]);
  61. Result:=Thefield.Create(AOwner);
  62. Try
  63. Result.Size:=FSize;
  64. Result.Required:=FRequired;
  65. Result.FFieldName:=FName;
  66. Result.FDisplayLabel:=FDisplayName;
  67. Result.FFieldNo:=Self.FieldNo;
  68. Result.SetFieldType(DataType);
  69. Result.FReadOnly:= (faReadOnly in Attributes);
  70. {$ifdef dsdebug}
  71. Writeln ('TFieldDef.CReateField : Trying to set dataset');
  72. {$endif dsdebug}
  73. {$ifdef dsdebug}
  74. Writeln ('TFieldDef.CReateField : Result Fieldno : ',Result.FieldNo,' Self : ',FieldNo);
  75. {$endif dsdebug}
  76. Result.Dataset:=TFieldDefs(Owner).FDataset;
  77. If Result is TFloatField then
  78. TFloatField(Result).Precision:=FPrecision;
  79. except
  80. Result.Free;
  81. Raise;
  82. end;
  83. end;
  84. Function TFieldDef.GetFieldClass : TFieldClass;
  85. begin
  86. //!! Should be owner as tdataset but that doesn't work ??
  87. If Assigned(Owner) then
  88. Result:=TFieldDefs(Owner).FDataSet.GetFieldClass(FDataType)
  89. else
  90. Result:=Nil;
  91. end;
  92. { ---------------------------------------------------------------------
  93. TFieldDefs
  94. ---------------------------------------------------------------------}
  95. destructor TFieldDefs.Destroy;
  96. begin
  97. FItems.Free;
  98. // This will destroy all fielddefs since we own them...
  99. Inherited Destroy;
  100. end;
  101. procedure TFieldDefs.Add(const AName: string; ADataType: TFieldType);
  102. begin
  103. Add(AName,ADatatype,0,False);
  104. end;
  105. procedure TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize : Word);
  106. begin
  107. Add(AName,ADatatype,ASize,False);
  108. end;
  109. procedure TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize: Word;
  110. ARequired: Boolean);
  111. begin
  112. If Length(AName)=0 Then
  113. DatabaseError(SNeedFieldName);
  114. // the fielddef will register itself here as a owned component.
  115. // fieldno is 1 based !
  116. TFieldDef.Create(Self,AName,ADataType,ASize,Arequired,FItems.Count+1);
  117. end;
  118. function TFieldDefs.GetCount: Longint;
  119. begin
  120. Result:=FItems.Count;
  121. end;
  122. function TFieldDefs.GetItem(Index: Longint): TFieldDef;
  123. begin
  124. Result:=TFieldDef(FItems[Index]);
  125. end;
  126. constructor TFieldDefs.Create(ADataSet: TDataSet);
  127. begin
  128. Inherited Create(ADataSet);
  129. FItems:=TList.Create;
  130. FDataset:=ADataset;
  131. end;
  132. procedure TFieldDefs.Assign(FieldDefs: TFieldDefs);
  133. Var I : longint;
  134. begin
  135. Clear;
  136. For i:=0 to FieldDefs.Count-1 do
  137. With FieldDefs[i] do
  138. Add(Name,DataType,Size,Required);
  139. end;
  140. procedure TFieldDefs.Clear;
  141. Var I : longint;
  142. begin
  143. For I:=FItems.Count-1 downto 0 do
  144. TFieldDef(Fitems[i]).Free;
  145. FItems.Clear;
  146. end;
  147. function TFieldDefs.Find(const AName: string): TFieldDef;
  148. Var I : longint;
  149. begin
  150. I:=IndexOf(AName);
  151. If I=-1 Then
  152. DataBaseErrorFmt(SUnknownField,[AName,FDataSet.Name]);
  153. Result:=TFieldDef(Fitems[i]);
  154. end;
  155. function TFieldDefs.IndexOf(const AName: string): Longint;
  156. Var I : longint;
  157. begin
  158. For I:=0 to Fitems.Count-1 do
  159. If AnsiCompareText(TFieldDef(FItems[I]).Name,AName)=0 then
  160. begin
  161. Result:=I;
  162. Exit;
  163. end;
  164. Result:=-1;
  165. end;
  166. procedure TFieldDefs.Update;
  167. begin
  168. FDataSet.UpdateFieldDefs;
  169. end;
  170. Function TFieldDefs.AddFieldDef : TFieldDef;
  171. begin
  172. Result:=TFieldDef.Create(Self,'',ftUnknown,0,False,FItems.Count+1);
  173. end;
  174. { ---------------------------------------------------------------------
  175. TField
  176. ---------------------------------------------------------------------}
  177. Const
  178. SBoolean = 'Boolean';
  179. SDateTime = 'TDateTime';
  180. SFloat = 'Float';
  181. SInteger = 'Integer';
  182. SVariant = 'Variant';
  183. SString = 'String';
  184. constructor TField.Create(AOwner: TComponent);
  185. begin
  186. Inherited Create(AOwner);
  187. FVisible:=True;
  188. FValidChars:=[#0..#255];
  189. FProviderFlags := [pfInUpdate,pfInWhere];
  190. end;
  191. destructor TField.Destroy;
  192. begin
  193. IF Assigned(FDataSet) then
  194. begin
  195. FDataSet.Active:=False;
  196. FDataSet.RemoveField(Self);
  197. end;
  198. Inherited Destroy;
  199. end;
  200. function TField.AccessError(const TypeName: string): EDatabaseError;
  201. begin
  202. Result:=EDatabaseError.CreateFmt(SinvalidTypeConversion,[TypeName,FFieldName]);
  203. end;
  204. procedure TField.Assign(Source: TPersistent);
  205. begin
  206. if Source = nil then Clear
  207. else if Source is TField then begin
  208. Value := TField(Source).Value;
  209. end else
  210. inherited Assign(Source);
  211. end;
  212. procedure TField.AssignValue(const Value: TVarRec);
  213. procedure Error;
  214. begin
  215. DatabaseErrorFmt(SFieldValueError, [DisplayName]);
  216. end;
  217. begin
  218. with Value do
  219. case VType of
  220. vtInteger:
  221. AsInteger := VInteger;
  222. vtBoolean:
  223. AsBoolean := VBoolean;
  224. vtChar:
  225. AsString := VChar;
  226. vtExtended:
  227. AsFloat := VExtended^;
  228. vtString:
  229. AsString := VString^;
  230. vtPointer:
  231. if VPointer <> nil then Error;
  232. vtPChar:
  233. AsString := VPChar;
  234. vtObject:
  235. if (VObject = nil) or (VObject is TPersistent) then
  236. Assign(TPersistent(VObject))
  237. else
  238. Error;
  239. vtAnsiString:
  240. AsString := string(VAnsiString);
  241. // vtCurrency:
  242. // AsCurrency := VCurrency^;
  243. vtVariant:
  244. if not VarIsClear(VVariant^) then Self.Value := VVariant^;
  245. vtWideString:
  246. AsString := WideString(VWideString);
  247. vtInt64:
  248. Self.Value := VInt64^;
  249. else
  250. Error;
  251. end;
  252. end;
  253. procedure TField.Change;
  254. begin
  255. If Assigned(FOnChange) Then
  256. FOnChange(Self);
  257. end;
  258. procedure TField.CheckInactive;
  259. begin
  260. If Assigned(FDataSet) then
  261. FDataset.CheckInactive;
  262. end;
  263. procedure TField.Clear;
  264. begin
  265. if FieldKind in [fkData, fkInternalCalc] then
  266. SetData(Nil);
  267. end;
  268. procedure TField.DataChanged;
  269. begin
  270. FDataset.DataEvent(deFieldChange,ptrint(Self));
  271. end;
  272. procedure TField.FocusControl;
  273. begin
  274. FDataSet.DataEvent(deFocusControl,ptrint(Self));
  275. end;
  276. procedure TField.FreeBuffers;
  277. begin
  278. // Empty. Provided for backward compatibiliy;
  279. // TDataset manages the buffers.
  280. end;
  281. function TField.GetAsBoolean: Boolean;
  282. begin
  283. AccessError(SBoolean);
  284. end;
  285. function TField.GetAsDateTime: TDateTime;
  286. begin
  287. AccessError(SdateTime);
  288. end;
  289. function TField.GetAsFloat: Double;
  290. begin
  291. AccessError(SDateTime);
  292. end;
  293. function TField.GetAsLongint: Longint;
  294. begin
  295. AccessError(SInteger);
  296. end;
  297. function TField.GetAsVariant: Variant;
  298. begin
  299. AccessError(SVariant);
  300. end;
  301. function TField.GetAsInteger: Integer;
  302. begin
  303. Result:=GetAsLongint;
  304. end;
  305. function TField.GetAsString: string;
  306. begin
  307. AccessError(SString);
  308. end;
  309. function TField.GetOldValue: Variant;
  310. var SaveState : tDatasetState;
  311. begin
  312. with FDataset do
  313. begin
  314. SaveState := State;
  315. SetTempState(dsOldValue);
  316. Result := GetAsVariant;
  317. RestoreState(SaveState);
  318. end;
  319. end;
  320. function TField.GetCanModify: Boolean;
  321. begin
  322. Result:=Not ReadOnly;
  323. If Result then
  324. begin
  325. Result:=Assigned(DataSet);
  326. If Result then
  327. Result:= DataSet.CanModify;
  328. end;
  329. end;
  330. function TField.GetData(Buffer: Pointer): Boolean;
  331. begin
  332. IF FDataset=Nil then
  333. DatabaseErrorFmt(SNoDataset,[FieldName]);
  334. If FVAlidating then
  335. begin
  336. result:=Not(FValueBuffer=Nil);
  337. If Result then
  338. Move (FValueBuffer^,Buffer^ ,DataSize);
  339. end
  340. else
  341. Result:=FDataset.GetFieldData(Self,Buffer);
  342. end;
  343. function TField.GetDataSize: Word;
  344. begin
  345. Result:=0;
  346. end;
  347. function TField.GetDefaultWidth: Longint;
  348. begin
  349. Result:=10;
  350. end;
  351. function TField.GetDisplayName : String;
  352. begin
  353. If FDisplayLabel<>'' then
  354. result:=FDisplayLabel
  355. else
  356. Result:=FFieldName;
  357. end;
  358. Function TField.IsDisplayStored : Boolean;
  359. begin
  360. Result:=(DisplayLabel<>FieldName);
  361. end;
  362. function TField.getIndex : longint;
  363. begin
  364. If Assigned(FDataset) then
  365. Result:=FDataset.FFieldList.IndexOf(Self)
  366. else
  367. Result:=-1;
  368. end;
  369. function TField.GetAsCurrency: Currency;
  370. begin
  371. Result := GetAsFloat;
  372. end;
  373. procedure TField.SetAlignment(const AValue: TAlignMent);
  374. begin
  375. if FAlignment <> AValue then
  376. begin
  377. FAlignment := Avalue;
  378. PropertyChanged(false);
  379. end;
  380. end;
  381. procedure TField.SetAsCurrency(AValue: Currency);
  382. begin
  383. SetAsFloat(AValue);
  384. end;
  385. function TField.GetIsNull: Boolean;
  386. begin
  387. Result:=Not(GetData (Nil));
  388. end;
  389. function TField.GetParentComponent: TComponent;
  390. begin
  391. //!! To be implemented
  392. end;
  393. procedure TField.GetText(var AText: string; ADisplayText: Boolean);
  394. begin
  395. AText:=GetAsString;
  396. end;
  397. function TField.HasParent: Boolean;
  398. begin
  399. HasParent:=True;
  400. end;
  401. function TField.IsValidChar(InputChar: Char): Boolean;
  402. begin
  403. // FValidChars must be set in Create.
  404. Result:=InputChar in FValidChars;
  405. end;
  406. procedure TField.Notification(AComponent: TComponent; Operation: TOperation);
  407. begin
  408. Inherited Notification(AComponent,Operation);
  409. end;
  410. procedure TField.PropertyChanged(LayoutAffected: Boolean);
  411. begin
  412. If (FDataset<>Nil) and (FDataset.Active) then
  413. If LayoutAffected then
  414. FDataset.DataEvent(deLayoutChange,0)
  415. else
  416. FDataset.DataEvent(deDatasetchange,0);
  417. end;
  418. procedure TField.ReadState(Reader: TReader);
  419. begin
  420. //!! To be implemented
  421. end;
  422. procedure TField.SetAsBoolean(AValue: Boolean);
  423. begin
  424. AccessError(SBoolean);
  425. end;
  426. procedure TField.SetAsDateTime(AValue: TDateTime);
  427. begin
  428. AccessError(SDateTime);
  429. end;
  430. procedure TField.SetAsFloat(AValue: Double);
  431. begin
  432. AccessError(SFloat);
  433. end;
  434. procedure TField.SetAsVariant(AValue: Variant);
  435. begin
  436. if VarIsNull(AValue) then
  437. Clear
  438. else
  439. try
  440. SetVarValue(AValue);
  441. except
  442. on EVariantError do DatabaseErrorFmt(SFieldValueError, [DisplayName]);
  443. end;
  444. end;
  445. procedure TField.SetAsLongint(AValue: Longint);
  446. begin
  447. AccessError(SInteger);
  448. end;
  449. procedure TField.SetAsInteger(AValue: Integer);
  450. begin
  451. SetAsLongint(AValue);
  452. end;
  453. procedure TField.SetAsString(const AValue: string);
  454. begin
  455. AccessError(SString);
  456. end;
  457. procedure TField.SetData(Buffer: Pointer);
  458. begin
  459. If Not Assigned(FDataset) then
  460. EDatabaseError.CreateFmt(SNoDataset,[FieldName]);
  461. FDataSet.SetFieldData(Self,Buffer);
  462. end;
  463. Procedure TField.SetDataset (Value : TDataset);
  464. begin
  465. {$ifdef dsdebug}
  466. Writeln ('Setting dataset');
  467. {$endif}
  468. If Value=FDataset then exit;
  469. If Assigned(FDataset) Then
  470. begin
  471. FDataset.CheckInactive;
  472. FDataset.FFieldList.Remove(Self);
  473. end;
  474. If Assigned(Value) then
  475. begin
  476. Value.CheckInactive;
  477. Value.FFieldList.Add(Self);
  478. end;
  479. FDataset:=Value;
  480. end;
  481. procedure TField.SetDataType(AValue: TFieldType);
  482. begin
  483. FDataType := AValue;
  484. end;
  485. procedure TField.SetFieldType(AValue: TFieldType);
  486. begin
  487. //!! To be implemented
  488. end;
  489. procedure TField.SetParentComponent(AParent: TComponent);
  490. begin
  491. //!! To be implemented
  492. end;
  493. procedure TField.SetSize(AValue: Word);
  494. begin
  495. CheckInactive;
  496. CheckTypeSize(AValue);
  497. FSize:=AValue;
  498. end;
  499. procedure TField.SetText(const AValue: string);
  500. begin
  501. AsString:=AValue;
  502. end;
  503. procedure TField.SetVarValue(const AValue: Variant);
  504. begin
  505. AccessError(SVariant);
  506. end;
  507. procedure TField.Validate(Buffer: Pointer);
  508. begin
  509. If assigned(OnValidate) Then
  510. begin
  511. FValueBuffer:=Buffer;
  512. FValidating:=True;
  513. Try
  514. OnValidate(Self);
  515. finally
  516. FValidating:=False;
  517. end;
  518. end;
  519. end;
  520. class function Tfield.IsBlob: Boolean;
  521. begin
  522. Result:=False;
  523. end;
  524. class procedure TField.CheckTypeSize(AValue: Longint);
  525. begin
  526. If (AValue<>0) and Not IsBlob Then
  527. DatabaseErrorFmt(SInvalidFieldSize,[AValue]);
  528. end;
  529. // TField private methods
  530. function TField.GetDisplayText: String;
  531. begin
  532. SetLength(Result, 0);
  533. if Assigned(OnGetText) then
  534. OnGetText(Self, Result, True)
  535. else
  536. GetText(Result, True);
  537. end;
  538. procedure TField.SetDisplayLabel(const AValue: string);
  539. begin
  540. if FDisplayLabel<>Avalue then
  541. begin
  542. FDisplayLabel:=Avalue;
  543. PropertyChanged(true);
  544. end;
  545. end;
  546. procedure TField.SetDisplayWidth(const AValue: Longint);
  547. begin
  548. if FDisplayWidth<>AValue then
  549. begin
  550. FDisplayWidth:=AValue;
  551. PropertyChanged(True);
  552. end;
  553. end;
  554. function TField.GetDisplayWidth: integer;
  555. begin
  556. if FDisplayWidth=0 then
  557. result:=GetDefaultWidth
  558. else
  559. result:=FDisplayWidth;
  560. end;
  561. procedure TField.SetReadOnly(const AValue: Boolean);
  562. begin
  563. if (FReadOnly<>Avalue) then
  564. begin
  565. FReadOnly:=AValue;
  566. PropertyChanged(True);
  567. end;
  568. end;
  569. procedure TField.SetVisible(const AValue: Boolean);
  570. begin
  571. if FVisible<>Avalue then
  572. begin
  573. FVisible:=AValue;
  574. PropertyChanged(True);
  575. end;
  576. end;
  577. { ---------------------------------------------------------------------
  578. TStringField
  579. ---------------------------------------------------------------------}
  580. constructor TStringField.Create(AOwner: TComponent);
  581. begin
  582. Inherited Create(AOwner);
  583. SetDataType(ftString);
  584. Size:=20;
  585. end;
  586. class procedure TStringField.CheckTypeSize(AValue: Longint);
  587. begin
  588. If (AValue<1) or (AValue>dsMaxStringSize) Then
  589. databaseErrorFmt(SInvalidFieldSize,[AValue])
  590. end;
  591. function TStringField.GetAsBoolean: Boolean;
  592. Var S : String;
  593. begin
  594. S:=GetAsString;
  595. result := (Length(S)>0) and (Upcase(S[1]) in ['T',YesNoChars[True]]);
  596. end;
  597. function TStringField.GetAsDateTime: TDateTime;
  598. begin
  599. Result:=StrToDateTime(GetAsString);
  600. end;
  601. function TStringField.GetAsFloat: Double;
  602. begin
  603. Result:=StrToFloat(GetAsString);
  604. end;
  605. function TStringField.GetAsLongint: Longint;
  606. begin
  607. Result:=StrToInt(GetAsString);
  608. end;
  609. function TStringField.GetAsString: string;
  610. begin
  611. If Not GetValue(Result) then
  612. Result:='';
  613. end;
  614. function TStringField.GetAsVariant: Variant;
  615. Var s : string;
  616. begin
  617. If GetValue(s) then
  618. Result:=s
  619. else
  620. Result:=Null;
  621. end;
  622. function TStringField.GetDataSize: Word;
  623. begin
  624. Result:=Size+1;
  625. end;
  626. function TStringField.GetDefaultWidth: Longint;
  627. begin
  628. result:=Size;
  629. end;
  630. Procedure TStringField.GetText(var AText: string; ADisplayText: Boolean);
  631. begin
  632. AText:=GetAsString;
  633. end;
  634. function TStringField.GetValue(var AValue: string): Boolean;
  635. Var Buf : TStringFieldBuffer;
  636. begin
  637. Result:=GetData(@Buf);
  638. If Result then
  639. AValue:=Buf;
  640. end;
  641. procedure TStringField.SetAsBoolean(AValue: Boolean);
  642. begin
  643. If AValue Then
  644. SetAsString('T')
  645. else
  646. SetAsString('F');
  647. end;
  648. procedure TStringField.SetAsDateTime(AValue: TDateTime);
  649. begin
  650. SetAsString(DateTimeToStr(AValue));
  651. end;
  652. procedure TStringField.SetAsFloat(AValue: Double);
  653. begin
  654. SetAsString(FloatToStr(AValue));
  655. end;
  656. procedure TStringField.SetAsLongint(AValue: Longint);
  657. begin
  658. SetAsString(intToStr(AValue));
  659. end;
  660. procedure TStringField.SetAsString(const AValue: string);
  661. Const NullByte : char = #0;
  662. begin
  663. IF Length(AValue)=0 then
  664. SetData(@NullByte)
  665. else
  666. SetData(@AValue[1]);
  667. end;
  668. procedure TStringField.SetVarValue(const AValue: Variant);
  669. begin
  670. SetAsString(AValue);
  671. end;
  672. { ---------------------------------------------------------------------
  673. TNumericField
  674. ---------------------------------------------------------------------}
  675. constructor TNumericField.Create(AOwner: TComponent);
  676. begin
  677. Inherited Create(AOwner);
  678. AlignMent:=taRightJustify;
  679. end;
  680. procedure TNumericField.RangeError(AValue, Min, Max: Double);
  681. begin
  682. DatabaseErrorFMT(SRangeError,[AValue,Min,Max,FieldName]);
  683. end;
  684. procedure TNumericField.SetDisplayFormat(const AValue: string);
  685. begin
  686. If FDisplayFormat<>AValue then
  687. begin
  688. FDisplayFormat:=AValue;
  689. PropertyChanged(True);
  690. end;
  691. end;
  692. procedure TNumericField.SetEditFormat(const AValue: string);
  693. begin
  694. If FEDitFormat<>AValue then
  695. begin
  696. FEDitFormat:=AVAlue;
  697. PropertyChanged(True);
  698. end;
  699. end;
  700. { ---------------------------------------------------------------------
  701. TLongintField
  702. ---------------------------------------------------------------------}
  703. constructor TLongintField.Create(AOwner: TComponent);
  704. begin
  705. Inherited Create(AOwner);
  706. SetDatatype(ftinteger);
  707. FMinRange:=Low(LongInt);
  708. FMaxRange:=High(LongInt);
  709. FValidchars:=['+','-','0'..'9'];
  710. end;
  711. function TLongintField.GetAsFloat: Double;
  712. begin
  713. Result:=GetAsLongint;
  714. end;
  715. function TLongintField.GetAsLongint: Longint;
  716. begin
  717. If Not GetValue(Result) then
  718. Result:=0;
  719. end;
  720. function TLongintField.GetAsVariant: Variant;
  721. Var L : Longint;
  722. begin
  723. If GetValue(L) then
  724. Result:=L
  725. else
  726. Result:=Null;
  727. end;
  728. function TLongintField.GetAsString: string;
  729. Var L : Longint;
  730. begin
  731. If GetValue(L) then
  732. Result:=IntTostr(L)
  733. else
  734. Result:='';
  735. end;
  736. function TLongintField.GetDataSize: Word;
  737. begin
  738. Result:=SizeOf(Longint);
  739. end;
  740. procedure TLongintField.GetText(var AText: string; ADisplayText: Boolean);
  741. var l : longint;
  742. fmt : string;
  743. begin
  744. Atext:='';
  745. If Not GetValue(l) then exit;
  746. If ADisplayText or (FEditFormat='') then
  747. fmt:=FDisplayFormat
  748. else
  749. fmt:=FEditFormat;
  750. If length(fmt)<>0 then
  751. AText:=FormatFloat(fmt,L)
  752. else
  753. Str(L,AText);
  754. end;
  755. function TLongintField.GetValue(var AValue: Longint): Boolean;
  756. Var L : Longint;
  757. P : PLongint;
  758. begin
  759. P:=@L;
  760. Result:=GetData(P);
  761. If Result then
  762. Case Datatype of
  763. ftInteger,ftautoinc : AValue:=Plongint(P)^;
  764. ftword : Avalue:=Pword(P)^;
  765. ftsmallint : AValue:=PSmallint(P)^;
  766. end;
  767. end;
  768. procedure TLongintField.SetAsFloat(AValue: Double);
  769. begin
  770. SetAsLongint(Round(Avalue));
  771. end;
  772. procedure TLongintField.SetAsLongint(AValue: Longint);
  773. begin
  774. If CheckRange(AValue) then
  775. SetData(@AValue)
  776. else
  777. RangeError(Avalue,FMinrange,FMaxRange);
  778. end;
  779. procedure TLongintField.SetVarValue(const AValue: Variant);
  780. begin
  781. SetAsLongint(AValue);
  782. end;
  783. procedure TLongintField.SetAsString(const AValue: string);
  784. Var L,Code : longint;
  785. begin
  786. If length(AValue)=0 then
  787. Clear
  788. else
  789. begin
  790. Val(AVAlue,L,Code);
  791. If Code=0 then
  792. SetAsLongint(L)
  793. else
  794. DatabaseErrorFMT(SNotAnInteger,[Avalue]);
  795. end;
  796. end;
  797. Function TLongintField.CheckRange(AValue : longint) : Boolean;
  798. begin
  799. result := true;
  800. if (FMaxValue=0) then
  801. begin
  802. if (AValue>FMaxRange) Then result := false;
  803. end
  804. else
  805. if AValue>FMaxValue then result := false;
  806. if (FMinValue=0) then
  807. begin
  808. if (AValue<FMinRange) Then result := false;
  809. end
  810. else
  811. if AValue<FMinValue then result := false;
  812. end;
  813. Procedure TLongintField.SetMaxValue (AValue : longint);
  814. begin
  815. If (AValue>=FMinRange) and (AValue<=FMaxRange) then
  816. FMaxValue:=AValue
  817. else
  818. RangeError(AValue,FMinRange,FMaxRange);
  819. end;
  820. Procedure TLongintField.SetMinValue (AValue : longint);
  821. begin
  822. If (AValue>=FMinRange) and (AValue<=FMaxRange) then
  823. FMinValue:=AValue
  824. else
  825. RangeError(AValue,FMinRange,FMaxRange);
  826. end;
  827. { ---------------------------------------------------------------------
  828. TLargeintField
  829. ---------------------------------------------------------------------}
  830. constructor TLargeintField.Create(AOwner: TComponent);
  831. begin
  832. Inherited Create(AOwner);
  833. SetDatatype(ftLargeint);
  834. FMinRange:=Low(Largeint);
  835. FMaxRange:=High(Largeint);
  836. FValidchars:=['+','-','0'..'9'];
  837. end;
  838. function TLargeintField.GetAsFloat: Double;
  839. begin
  840. Result:=GetAsLargeint;
  841. end;
  842. function TLargeintField.GetAsLargeint: Largeint;
  843. begin
  844. If Not GetValue(Result) then
  845. Result:=0;
  846. end;
  847. function TLargeIntField.GetAsVariant: Variant;
  848. Var L : Largeint;
  849. begin
  850. If GetValue(L) then
  851. Result:=L
  852. else
  853. Result:=Null;
  854. end;
  855. function TLargeintField.GetAsLongint: Longint;
  856. begin
  857. Result:=GetAsLargeint;
  858. end;
  859. function TLargeintField.GetAsString: string;
  860. Var L : Largeint;
  861. begin
  862. If GetValue(L) then
  863. Result:=IntTostr(L)
  864. else
  865. Result:='';
  866. end;
  867. function TLargeintField.GetDataSize: Word;
  868. begin
  869. Result:=SizeOf(Largeint);
  870. end;
  871. procedure TLargeintField.GetText(var AText: string; ADisplayText: Boolean);
  872. var l : largeint;
  873. fmt : string;
  874. begin
  875. Atext:='';
  876. If Not GetValue(l) then exit;
  877. If ADisplayText or (FEditFormat='') then
  878. fmt:=FDisplayFormat
  879. else
  880. fmt:=FEditFormat;
  881. If length(fmt)<>0 then
  882. AText:=FormatFloat(fmt,L)
  883. else
  884. Str(L,AText);
  885. end;
  886. function TLargeintField.GetValue(var AValue: Largeint): Boolean;
  887. type
  888. PLargeint = ^Largeint;
  889. Var P : PLargeint;
  890. begin
  891. P:=@AValue;
  892. Result:=GetData(P);
  893. end;
  894. procedure TLargeintField.SetAsFloat(AValue: Double);
  895. begin
  896. SetAsLargeint(Round(Avalue));
  897. end;
  898. procedure TLargeintField.SetAsLargeint(AValue: Largeint);
  899. begin
  900. If CheckRange(AValue) then
  901. SetData(@AValue)
  902. else
  903. RangeError(Avalue,FMinrange,FMaxRange);
  904. end;
  905. procedure TLargeintField.SetAsLongint(AValue: Longint);
  906. begin
  907. SetAsLargeint(Avalue);
  908. end;
  909. procedure TLargeintField.SetAsString(const AValue: string);
  910. Var L : largeint;
  911. code : longint;
  912. begin
  913. If length(AValue)=0 then
  914. Clear
  915. else
  916. begin
  917. Val(AVAlue,L,Code);
  918. If Code=0 then
  919. SetAsLargeint(L)
  920. else
  921. DatabaseErrorFMT(SNotAnInteger,[Avalue]);
  922. end;
  923. end;
  924. procedure TLargeintField.SetVarValue(const AValue: Variant);
  925. begin
  926. SetAsLargeint(AValue);
  927. end;
  928. Function TLargeintField.CheckRange(AValue : largeint) : Boolean;
  929. begin
  930. result := true;
  931. if (FMaxValue=0) then
  932. begin
  933. if (AValue>FMaxRange) Then result := false;
  934. end
  935. else
  936. if AValue>FMaxValue then result := false;
  937. if (FMinValue=0) then
  938. begin
  939. if (AValue<FMinRange) Then result := false;
  940. end
  941. else
  942. if AValue<FMinValue then result := false;
  943. end;
  944. Procedure TLargeintField.SetMaxValue (AValue : largeint);
  945. begin
  946. If (AValue>=FMinRange) and (AValue<=FMaxRange) then
  947. FMaxValue:=AValue
  948. else
  949. RangeError(AValue,FMinRange,FMaxRange);
  950. end;
  951. Procedure TLargeintField.SetMinValue (AValue : largeint);
  952. begin
  953. If (AValue>=FMinRange) and (AValue<=FMaxRange) then
  954. FMinValue:=AValue
  955. else
  956. RangeError(AValue,FMinRange,FMaxRange);
  957. end;
  958. { TSmallintField }
  959. function TSmallintField.GetDataSize: Word;
  960. begin
  961. Result:=SizeOf(SmallInt);
  962. end;
  963. constructor TSmallintField.Create(AOwner: TComponent);
  964. begin
  965. inherited Create(AOwner);
  966. SetDataType(ftSmallInt);
  967. FMinRange:=-32768;
  968. FMaxRange:=32767;
  969. end;
  970. { TWordField }
  971. function TWordField.GetDataSize: Word;
  972. begin
  973. Result:=SizeOf(Word);
  974. end;
  975. constructor TWordField.Create(AOwner: TComponent);
  976. begin
  977. inherited Create(AOwner);
  978. SetDataType(ftWord);
  979. FMinRange:=0;
  980. FMaxRange:=65535;
  981. FValidchars:=['+','0'..'9'];
  982. end;
  983. { TAutoIncField }
  984. constructor TAutoIncField.Create(AOwner: TComponent);
  985. begin
  986. Inherited Create(AOWner);
  987. SetDataType(ftAutoInc);
  988. FReadOnly:=True;
  989. end;
  990. Procedure TAutoIncField.SetAsLongint(AValue : Longint);
  991. begin
  992. DataBaseError(SCantSetAutoIncfields);
  993. end;
  994. { TFloatField }
  995. function TFloatField.GetAsFloat: Double;
  996. begin
  997. If Not GetData(@Result) Then
  998. Result:=0.0;
  999. end;
  1000. function TFloatField.GetAsVariant: Variant;
  1001. Var f : Double;
  1002. begin
  1003. If GetData(@f) then
  1004. Result := f
  1005. else
  1006. Result:=Null;
  1007. end;
  1008. function TFloatField.GetAsLongint: Longint;
  1009. begin
  1010. Result:=Round(GetAsFloat);
  1011. end;
  1012. function TFloatField.GetAsString: string;
  1013. Var R : Double;
  1014. begin
  1015. If GetData(@R) then
  1016. Result:=FloatToStr(R)
  1017. else
  1018. Result:='';
  1019. end;
  1020. function TFloatField.GetDataSize: Word;
  1021. begin
  1022. Result:=SizeOf(Double);
  1023. end;
  1024. procedure TFloatField.GetText(var TheText: string; ADisplayText: Boolean);
  1025. Var
  1026. fmt : string;
  1027. E : Double;
  1028. begin
  1029. TheText:='';
  1030. If Not GetData(@E) then exit;
  1031. If ADisplayText or (Length(FEditFormat) = 0) Then
  1032. Fmt:=FDisplayFormat
  1033. else
  1034. Fmt:=FEditFormat;
  1035. If fmt<>'' then
  1036. TheText:=FormatFloat(fmt,E)
  1037. else
  1038. TheText:=FloatToStrF(E,ffgeneral,FPrecision,0);
  1039. end;
  1040. procedure TFloatField.SetAsFloat(AValue: Double);
  1041. begin
  1042. If CheckRange(AValue) then
  1043. SetData(@Avalue)
  1044. else
  1045. RangeError(AValue,FMinValue,FMaxValue);
  1046. end;
  1047. procedure TFloatField.SetAsLongint(AValue: Longint);
  1048. begin
  1049. SetAsFloat(Avalue);
  1050. end;
  1051. procedure TFloatField.SetAsString(const AValue: string);
  1052. Var R : Double;
  1053. begin
  1054. try
  1055. R := StrToFloat(AValue);
  1056. SetAsFloat(R);
  1057. except
  1058. DatabaseErrorFmt(SNotAFloat, [AValue]);
  1059. end;
  1060. end;
  1061. procedure TFloatField.SetVarValue(const AValue: Variant);
  1062. begin
  1063. SetAsFloat(Avalue);
  1064. end;
  1065. constructor TFloatField.Create(AOwner: TComponent);
  1066. begin
  1067. Inherited Create(AOwner);
  1068. SetDatatype(ftfloat);
  1069. end;
  1070. Function TFloatField.CheckRange(AValue : Double) : Boolean;
  1071. begin
  1072. If (FMinValue<>0) or (FmaxValue<>0) then
  1073. Result:=(AValue>=FMinValue) and (AVAlue<=FMAxValue)
  1074. else
  1075. Result:=True;
  1076. end;
  1077. { TBooleanField }
  1078. function TBooleanField.GetAsBoolean: Boolean;
  1079. var b : wordbool;
  1080. begin
  1081. If GetData(@b) then
  1082. result := b
  1083. else
  1084. Result:=False;
  1085. end;
  1086. function TBooleanField.GetAsVariant: Variant;
  1087. Var b : wordbool;
  1088. begin
  1089. If GetData(@b) then
  1090. Result := b
  1091. else
  1092. Result:=Null;
  1093. end;
  1094. function TBooleanField.GetAsString: string;
  1095. Var B : wordbool;
  1096. begin
  1097. If Getdata(@B) then
  1098. Result:=FDisplays[False,B]
  1099. else
  1100. result:='';
  1101. end;
  1102. function TBooleanField.GetDataSize: Word;
  1103. begin
  1104. Result:=SizeOf(wordBool);
  1105. end;
  1106. function TBooleanField.GetDefaultWidth: Longint;
  1107. begin
  1108. Result:=Length(FDisplays[false,false]);
  1109. If Result<Length(FDisplays[false,True]) then
  1110. Result:=Length(FDisplays[false,True]);
  1111. end;
  1112. procedure TBooleanField.SetAsBoolean(AValue: Boolean);
  1113. var b : wordbool;
  1114. begin
  1115. b := AValue;
  1116. SetData(@b);
  1117. end;
  1118. procedure TBooleanField.SetAsString(const AValue: string);
  1119. Var Temp : string;
  1120. begin
  1121. Temp:=UpperCase(AValue);
  1122. if Temp='' then
  1123. Clear
  1124. else if pos(Temp, FDisplays[True,True])=1 then
  1125. SetAsBoolean(True)
  1126. else if pos(Temp, FDisplays[True,False])=1 then
  1127. SetAsBoolean(False)
  1128. else
  1129. DatabaseErrorFmt(SNotABoolean,[AValue]);
  1130. end;
  1131. procedure TBooleanField.SetVarValue(const AValue: Variant);
  1132. begin
  1133. SetAsBoolean(AValue);
  1134. end;
  1135. constructor TBooleanField.Create(AOwner: TComponent);
  1136. begin
  1137. Inherited Create(AOwner);
  1138. SetDataType(ftBoolean);
  1139. DisplayValues:='True;False';
  1140. end;
  1141. Procedure TBooleanField.SetDisplayValues(AValue : String);
  1142. Var I : longint;
  1143. begin
  1144. If FDisplayValues<>AValue then
  1145. begin
  1146. I:=Pos(';',AValue);
  1147. If (I<2) or (I=Length(AValue)) then
  1148. DatabaseErrorFmt(SInvalidDisplayValues,[AValue]);
  1149. FdisplayValues:=AValue;
  1150. // Store display values and their uppercase equivalents;
  1151. FDisplays[False,True]:=Copy(AValue,1,I-1);
  1152. FDisplays[True,True]:=UpperCase(FDisplays[False,True]);
  1153. FDisplays[False,False]:=Copy(AValue,I+1,Length(AValue)-i);
  1154. FDisplays[True,False]:=UpperCase(FDisplays[False,False]);
  1155. PropertyChanged(True);
  1156. end;
  1157. end;
  1158. { TDateTimeField }
  1159. procedure TDateTimeField.SetDisplayFormat(const AValue: string);
  1160. begin
  1161. if FDisplayFormat<>AValue then begin
  1162. FDisplayFormat:=AValue;
  1163. PropertyChanged(True);
  1164. end;
  1165. end;
  1166. function TDateTimeField.GetAsDateTime: TDateTime;
  1167. begin
  1168. If Not GetData(@Result) then
  1169. Result:=0;
  1170. end;
  1171. procedure TDateTimeField.SetVarValue(const AValue: Variant);
  1172. begin
  1173. SetAsDateTime(AValue);
  1174. end;
  1175. function TDateTimeField.GetAsVariant: Variant;
  1176. Var d : tDateTime;
  1177. begin
  1178. If Getdata(@d) then
  1179. Result := d
  1180. else
  1181. Result:=Null;
  1182. end;
  1183. function TDateTimeField.GetAsFloat: Double;
  1184. begin
  1185. Result:=GetAsdateTime;
  1186. end;
  1187. function TDateTimeField.GetAsString: string;
  1188. begin
  1189. GetText(Result,False);
  1190. end;
  1191. function TDateTimeField.GetDataSize: Word;
  1192. begin
  1193. Result:=SizeOf(TDateTime);
  1194. end;
  1195. procedure TDateTimeField.GetText(var TheText: string; ADisplayText: Boolean);
  1196. Var R : TDateTime;
  1197. F : String;
  1198. begin
  1199. If Not Getdata(@R) then
  1200. TheText:=''
  1201. else
  1202. begin
  1203. If (ADisplayText) and (Length(FDisplayFormat)<>0) then
  1204. F:=FDisplayFormat
  1205. else
  1206. Case DataType of
  1207. ftTime : F:=ShortTimeFormat;
  1208. ftDate : F:=ShortDateFormat;
  1209. else
  1210. F:='c'
  1211. end;
  1212. TheText:=FormatDateTime(F,R);
  1213. end;
  1214. end;
  1215. procedure TDateTimeField.SetAsDateTime(AValue: TDateTime);
  1216. begin
  1217. SetData(@Avalue);
  1218. end;
  1219. procedure TDateTimeField.SetAsFloat(AValue: Double);
  1220. begin
  1221. SetAsDateTime(AValue);
  1222. end;
  1223. procedure TDateTimeField.SetAsString(const AValue: string);
  1224. Var R : TDateTime;
  1225. begin
  1226. R:=StrToDateTime(AVAlue);
  1227. SetData(@R);
  1228. end;
  1229. constructor TDateTimeField.Create(AOwner: TComponent);
  1230. begin
  1231. Inherited Create(AOwner);
  1232. SetDataType(ftDateTime);
  1233. end;
  1234. { TDateField }
  1235. constructor TDateField.Create(AOwner: TComponent);
  1236. begin
  1237. Inherited Create(AOwner);
  1238. SetDataType(ftDate);
  1239. end;
  1240. { TTimeField }
  1241. constructor TTimeField.Create(AOwner: TComponent);
  1242. begin
  1243. Inherited Create(AOwner);
  1244. SetDataType(ftTime);
  1245. end;
  1246. procedure TTimeField.SetAsString(const AValue: string);
  1247. Var R : TDateTime;
  1248. begin
  1249. R:=StrToTime(AVAlue);
  1250. SetData(@R);
  1251. end;
  1252. { TBinaryField }
  1253. class procedure TBinaryField.CheckTypeSize(AValue: Longint);
  1254. begin
  1255. // Just check for really invalid stuff; actual size is
  1256. // dependent on the record...
  1257. If AValue<1 then
  1258. DatabaseErrorfmt(SInvalidFieldSize,[Avalue]);
  1259. end;
  1260. function TBinaryField.GetAsString: string;
  1261. begin
  1262. Setlength(Result,DataSize);
  1263. GetData(Pointer(Result));
  1264. end;
  1265. procedure TBinaryField.GetText(var TheText: string; ADisplayText: Boolean);
  1266. begin
  1267. TheText:=GetAsString;
  1268. end;
  1269. procedure TBinaryField.SetAsString(const AValue: string);
  1270. Var Buf : PChar;
  1271. Allocated : Boolean;
  1272. begin
  1273. Allocated:=False;
  1274. If Length(AVAlue)=DataSize then
  1275. Buf:=PChar(Avalue)
  1276. else
  1277. begin
  1278. GetMem(Buf,DataSize);
  1279. Move(Pchar(Avalue)[0],Buf^,DataSize);
  1280. Allocated:=True;
  1281. end;
  1282. SetData(Buf);
  1283. If Allocated then
  1284. FreeMem(Buf,DataSize);
  1285. end;
  1286. procedure TBinaryField.SetText(const AValue: string);
  1287. begin
  1288. SetAsString(Avalue);
  1289. end;
  1290. procedure TBinaryField.SetVarValue(const AValue: Variant);
  1291. begin
  1292. SetAsString(Avalue);
  1293. end;
  1294. constructor TBinaryField.Create(AOwner: TComponent);
  1295. begin
  1296. Inherited Create(AOwner);
  1297. end;
  1298. { TBytesField }
  1299. function TBytesField.GetDataSize: Word;
  1300. begin
  1301. Result:=Size;
  1302. end;
  1303. constructor TBytesField.Create(AOwner: TComponent);
  1304. begin
  1305. Inherited Create(AOwner);
  1306. SetDataType(ftBytes);
  1307. Size:=16;
  1308. end;
  1309. { TVarBytesField }
  1310. function TVarBytesField.GetDataSize: Word;
  1311. begin
  1312. Result:=Size+2;
  1313. end;
  1314. constructor TVarBytesField.Create(AOwner: TComponent);
  1315. begin
  1316. INherited Create(AOwner);
  1317. SetDataType(ftvarbytes);
  1318. Size:=16;
  1319. end;
  1320. { TBCDField }
  1321. class procedure TBCDField.CheckTypeSize(AValue: Longint);
  1322. begin
  1323. If not (AValue in [1..4]) then
  1324. DatabaseErrorfmt(SInvalidFieldSize,[Avalue]);
  1325. end;
  1326. function TBCDField.GetAsCurrency: Currency;
  1327. Var C : system.Currency;
  1328. begin
  1329. if GetData(@C) then
  1330. result := C;
  1331. end;
  1332. function TBCDField.GetAsVariant: Variant;
  1333. Var c : system.Currency;
  1334. begin
  1335. If GetData(@c) then
  1336. Result := c
  1337. else
  1338. Result:=Null;
  1339. end;
  1340. function TBCDField.GetAsFloat: Double;
  1341. begin
  1342. result := GetAsCurrency;
  1343. end;
  1344. function TBCDField.GetAsLongint: Longint;
  1345. begin
  1346. result := round(GetAsCurrency);
  1347. end;
  1348. function TBCDField.GetAsString: string;
  1349. var c : system.currency;
  1350. begin
  1351. If GetData(@C) then
  1352. Result:=CurrToStr(C)
  1353. else
  1354. Result:='';
  1355. end;
  1356. function TBCDField.GetDataSize: Word;
  1357. begin
  1358. result := sizeof(currency);
  1359. end;
  1360. function TBCDField.GetDefaultWidth: Longint;
  1361. begin
  1362. if precision > 0 then result := precision
  1363. else result := 10;
  1364. end;
  1365. procedure TBCDField.GetText(var TheText: string; ADisplayText: Boolean);
  1366. var
  1367. c : system.currency;
  1368. fmt: String;
  1369. begin
  1370. if GetData(@C) then begin
  1371. if aDisplayText or (FEditFormat='') then
  1372. fmt := FDisplayFormat
  1373. else
  1374. fmt := FEditFormat;
  1375. if fmt<>'' then
  1376. TheText := FormatFloat(fmt,C)
  1377. else if fCurrency then begin
  1378. if aDisplayText then
  1379. TheText := FloatToStrF(C, ffCurrency, FPrecision, 2{digits?})
  1380. else
  1381. TheText := FloatToStrF(C, ffFixed, FPrecision, 2{digits?});
  1382. end else
  1383. TheText := FloatToStrF(C, ffGeneral, FPrecision, 0{digits?});
  1384. end else
  1385. TheText := '';
  1386. end;
  1387. procedure TBCDField.SetAsCurrency(AValue: Currency);
  1388. begin
  1389. If CheckRange(AValue) then
  1390. setdata(@AValue)
  1391. else
  1392. RangeError(AValue,FMinValue,FMaxvalue);
  1393. end;
  1394. procedure TBCDField.SetVarValue(const AValue: Variant);
  1395. begin
  1396. SetAsCurrency(AValue);
  1397. end;
  1398. Function TBCDField.CheckRange(AValue : Currency) : Boolean;
  1399. begin
  1400. If (FMinValue<>0) or (FmaxValue<>0) then
  1401. Result:=(AValue>=FMinValue) and (AVAlue<=FMaxValue)
  1402. else
  1403. Result:=True;
  1404. end;
  1405. procedure TBCDField.SetAsFloat(AValue: Double);
  1406. begin
  1407. SetAsCurrency(AValue);
  1408. end;
  1409. procedure TBCDField.SetAsLongint(AValue: Longint);
  1410. begin
  1411. SetAsCurrency(AValue);
  1412. end;
  1413. procedure TBCDField.SetAsString(const AValue: string);
  1414. begin
  1415. SetAsCurrency(strtocurr(AValue));
  1416. end;
  1417. constructor TBCDField.Create(AOwner: TComponent);
  1418. begin
  1419. Inherited Create(AOwner);
  1420. FMaxvalue := 0;
  1421. FMinvalue := 0;
  1422. SetDataType(ftBCD);
  1423. FPrecision := 15;
  1424. Size:=4;
  1425. end;
  1426. { TBlobField }
  1427. procedure TBlobField.AssignTo(Dest: TPersistent);
  1428. begin
  1429. //!! To be implemented
  1430. end;
  1431. Function TBlobField.GetBlobStream(Mode : TBlobStreamMode) : TStream;
  1432. begin
  1433. Result:=FDataset.CreateBlobStream(Self,Mode);
  1434. end;
  1435. procedure TBlobField.FreeBuffers;
  1436. begin
  1437. end;
  1438. function TBlobField.GetAsString: string;
  1439. var
  1440. Stream: TStream;
  1441. begin
  1442. Stream := GetBlobStream(bmRead);
  1443. if Stream <> nil then
  1444. With Stream do
  1445. try
  1446. SetLength(Result,Size);
  1447. ReadBuffer(Pointer(Result)^,Size);
  1448. finally
  1449. Free
  1450. end
  1451. else
  1452. Result := '(blob)';
  1453. end;
  1454. function TBlobField.GetBlobSize: Longint;
  1455. var
  1456. Stream: TStream;
  1457. begin
  1458. Stream := GetBlobStream(bmread);
  1459. if Stream <> nil then
  1460. With Stream do
  1461. try
  1462. Result:=Size;
  1463. finally
  1464. Free;
  1465. end
  1466. else
  1467. result := 0;
  1468. end;
  1469. function TBlobField.GetIsNull: Boolean;
  1470. begin
  1471. If Not Modified then
  1472. result:= inherited GetIsnull
  1473. else
  1474. With GetBlobStream(bmread) do
  1475. try
  1476. Result:=(Size=0);
  1477. Finally
  1478. Free;
  1479. end;
  1480. end;
  1481. procedure TBlobField.GetText(var TheText: string; ADisplayText: Boolean);
  1482. begin
  1483. TheText:=GetAsString;
  1484. end;
  1485. procedure TBlobField.SetAsString(const AValue: string);
  1486. begin
  1487. With GetBlobStream(bmwrite) do
  1488. try
  1489. WriteBuffer(Pointer(Avalue)^,Length(Avalue));
  1490. finally
  1491. Free;
  1492. end;
  1493. end;
  1494. procedure TBlobField.SetText(const AValue: string);
  1495. begin
  1496. SetAsString(AValue);
  1497. end;
  1498. procedure TBlobField.SetVarValue(const AValue: Variant);
  1499. begin
  1500. SetAsString(AValue);
  1501. end;
  1502. constructor TBlobField.Create(AOwner: TComponent);
  1503. begin
  1504. Inherited Create(AOWner);
  1505. SetDataType(ftBlob);
  1506. end;
  1507. procedure TBlobField.Assign(Source: TPersistent);
  1508. begin
  1509. //!! To be implemented
  1510. end;
  1511. procedure TBlobField.Clear;
  1512. begin
  1513. GetBlobStream(bmWrite).free;
  1514. end;
  1515. class function TBlobField.IsBlob: Boolean;
  1516. begin
  1517. Result:=True;
  1518. end;
  1519. procedure TBlobField.LoadFromFile(const FileName: string);
  1520. Var S : TFileStream;
  1521. begin
  1522. S:=TFileStream.Create(FileName,fmOpenRead);
  1523. try
  1524. LoadFromStream(S);
  1525. finally
  1526. S.Free;
  1527. end;
  1528. end;
  1529. procedure TBlobField.LoadFromStream(Stream: TStream);
  1530. begin
  1531. With GetBlobStream(bmWrite) do
  1532. Try
  1533. CopyFrom(Stream,0);
  1534. finally
  1535. Free;
  1536. end;
  1537. end;
  1538. procedure TBlobField.SaveToFile(const FileName: string);
  1539. Var S : TFileStream;
  1540. begin
  1541. S:=TFileStream.Create(FileName,fmCreate);
  1542. try
  1543. SaveToStream(S);
  1544. finally
  1545. S.Free;
  1546. end;
  1547. end;
  1548. procedure TBlobField.SaveToStream(Stream: TStream);
  1549. Var S : TStream;
  1550. begin
  1551. S:=GetBlobStream(bmRead);
  1552. Try
  1553. Stream.CopyFrom(S,0);
  1554. finally
  1555. S.Free;
  1556. end;
  1557. end;
  1558. procedure TBlobField.SetFieldType(AValue: TFieldType);
  1559. begin
  1560. If AValue in [Low(TBlobType)..High(TBlobType)] then
  1561. SetDatatype(Avalue);
  1562. end;
  1563. { TMemoField }
  1564. constructor TMemoField.Create(AOwner: TComponent);
  1565. begin
  1566. Inherited Create(AOwner);
  1567. SetDataType(ftMemo);
  1568. end;
  1569. { TGraphicField }
  1570. constructor TGraphicField.Create(AOwner: TComponent);
  1571. begin
  1572. Inherited Create(AOwner);
  1573. SetDataType(ftGraphic);
  1574. end;
  1575. { TFields }
  1576. Constructor TFields.Create(ADataset : TDataset);
  1577. begin
  1578. FDataSet:=ADataset;
  1579. FFieldList:=TList.Create;
  1580. FValidFieldKinds:=[fkData..fkInternalcalc];
  1581. end;
  1582. Destructor TFields.Destroy;
  1583. begin
  1584. FFieldList.Free;
  1585. end;
  1586. Procedure Tfields.Changed;
  1587. begin
  1588. If Assigned(FOnChange) then
  1589. FOnChange(Self);
  1590. end;
  1591. Procedure TFields.CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
  1592. begin
  1593. If Not (FieldKind in ValidFieldKinds) Then
  1594. DatabaseErrorFmt(SInvalidFieldKind,[Field.FieldName]);
  1595. end;
  1596. Function Tfields.GetCount : Longint;
  1597. begin
  1598. Result:=FFieldList.Count;
  1599. end;
  1600. Function TFields.GetField (Index : longint) : TField;
  1601. begin
  1602. Result:=Tfield(FFieldList[Index]);
  1603. end;
  1604. Procedure TFields.SetFieldIndex (Field : TField;Value : Integer);
  1605. Var Old : Longint;
  1606. begin
  1607. Old := FFieldList.indexOf(Field);
  1608. If Old=-1 then
  1609. Exit;
  1610. // Check value
  1611. If Value<FFieldList.Count Then Value:=0;
  1612. If Value>=Count then Value:=Count-1;
  1613. If Value<>Old then
  1614. begin
  1615. FFieldList.Delete(Old);
  1616. FFieldList.Insert(Value,Field);
  1617. Field.PropertyChanged(True);
  1618. Changed;
  1619. end;
  1620. end;
  1621. Procedure TFields.Add(Field : TField);
  1622. begin
  1623. CheckFieldName(Field.FieldName);
  1624. FFieldList.Add(Field);
  1625. Field.FFields:=Self;
  1626. Changed;
  1627. end;
  1628. Procedure TFields.CheckFieldName (Const Value : String);
  1629. Var I : longint;
  1630. S : String;
  1631. begin
  1632. If FindField(Value)<>Nil then
  1633. DataBaseErrorFmt(SDuplicateFieldName,[Value],FDataset);
  1634. end;
  1635. Procedure TFields.CheckFieldNames (Const Value : String);
  1636. Var I : longint;
  1637. S,T : String;
  1638. begin
  1639. T:=Value;
  1640. Repeat
  1641. I:=Pos(T,';');
  1642. If I=0 Then I:=Length(T);
  1643. S:=Copy(T,1,I-1);
  1644. Delete(T,1,I);
  1645. // Will raise an error if no such field...
  1646. FieldByName(S);
  1647. Until (T='');
  1648. end;
  1649. Procedure TFields.Clear;
  1650. begin
  1651. FFieldList.Clear;
  1652. end;
  1653. Function TFields.FindField (Const Value : String) : TField;
  1654. Var S : String;
  1655. I : longint;
  1656. begin
  1657. Result:=Nil;
  1658. S:=UpperCase(Value);
  1659. For I:=0 To FFieldList.Count-1 do
  1660. If S=UpperCase(TField(FFieldList[i]).FieldName) Then
  1661. Begin
  1662. {$ifdef dsdebug}
  1663. Writeln ('Found field ',Value);
  1664. {$endif}
  1665. Result:=TField(FFieldList[I]);
  1666. Exit;
  1667. end;
  1668. end;
  1669. Function TFields.FieldByName (Const Value : String) : TField;
  1670. begin
  1671. Result:=FindField(Value);
  1672. If result=Nil then
  1673. DatabaseErrorFmt(SFieldNotFound,[Value],FDataset);
  1674. end;
  1675. Function TFields.FieldByNumber(FieldNo : Integer) : TField;
  1676. Var i : Longint;
  1677. begin
  1678. Result:=Nil;
  1679. For I:=0 to FFieldList.Count-1 do
  1680. If FieldNo=TField(FFieldList[I]).FieldNo then
  1681. begin
  1682. Result:=TField(FFieldList[i]);
  1683. Exit;
  1684. end;
  1685. end;
  1686. Procedure TFields.GetFieldNames (Values : TStrings);
  1687. Var i : longint;
  1688. begin
  1689. Values.Clear;
  1690. For I:=0 to FFieldList.Count-1 do
  1691. Values.Add(Tfield(FFieldList[I]).FieldName);
  1692. end;
  1693. Function TFields.IndexOf(Field : TField) : Longint;
  1694. Var i : longint;
  1695. begin
  1696. Result:=-1;
  1697. For I:=0 To FFieldList.Count-1 do
  1698. If Pointer(Field)=FFieldList[i] Then
  1699. Exit(I);
  1700. end;
  1701. procedure TFields.Remove(Value : TField);
  1702. Var I : longint;
  1703. begin
  1704. I:=IndexOf(Value);
  1705. If I<>0 then
  1706. FFieldList.Delete(I);
  1707. end;
  1708. {
  1709. $Log$
  1710. Revision 1.34 2005-05-12 18:52:32 michael
  1711. - Patch from Jesus Reyes:
  1712. * TFloatField.SetAsString doesn't look at DecimalSeparator for
  1713. converting a string into a Float
  1714. * TBooleanField.SetAsString won't accept an empty string as a valid
  1715. value, also the patch allows strings as T, F or any starting
  1716. substring of DisplayValues to be accepted.
  1717. Revision 1.33 2005/04/26 16:48:58 michael
  1718. * Some patches from Uberto Barbini
  1719. + TLoginEvent more Delphi compatible (D5 and bigger).
  1720. * AsCurrency Property for TField.
  1721. Revision 1.32 2005/04/26 15:45:30 michael
  1722. + Patch from Sergey Smirnov to fix TTimeField.AsString
  1723. Revision 1.31 2005/04/16 10:02:13 michael
  1724. + Patch to show/enter alternate charsets in grid editor.
  1725. Revision 1.30 2005/04/10 22:18:43 joost
  1726. Patch from Alexandrov Alexandru
  1727. - implemented TDataset.BindFields
  1728. - master-detail relation implemented
  1729. - improved variant-support for fields
  1730. - implemented TField.Assign and TField.AssignValue
  1731. Revision 1.29 2005/04/04 07:30:51 michael
  1732. + Patch from Jesus reyes to notify changes to DisplayFormat
  1733. Revision 1.28 2005/03/23 08:17:51 michael
  1734. + Several patches from Jose A. Rimon
  1735. # Prevents "field not found" error, when use a query without the primary key
  1736. Set SQLlen of different data types
  1737. Use AliasName instead of SQLname to avoid "duplicate field name" error, for
  1738. example when using "coalesce" more than once
  1739. use SQLScale in ftLargeInt to get actual values
  1740. Send query to server with different lines. Provides line info in sqlErrors
  1741. and allows single line comments
  1742. Revision 1.27 2005/03/15 22:44:22 michael
  1743. * Patch from Luiz Americo
  1744. - fixes a memory leak in TBlobField.GetAsString
  1745. Revision 1.26 2005/03/01 14:00:53 joost
  1746. - Fix to avoid scientific format in TDBCFields from Jesus Reyes
  1747. Revision 1.25 2005/02/28 16:19:07 joost
  1748. - Boolean fields are wordbool's now
  1749. Revision 1.24 2005/02/16 09:31:58 michael
  1750. - Remove TTimeField and TDateField GetDataSize functions since both are exactly
  1751. equal to their ancestor: TDateTimeField.GetDataSize
  1752. - TAutoInc fields are set to ReadyOnly on create
  1753. - In TFieldDef.CreateField the presence of faReadyOnly in Attributes is respected
  1754. Revision 1.23 2005/02/14 17:13:12 peter
  1755. * truncate log
  1756. Revision 1.22 2005/02/07 11:22:23 joost
  1757. - Implemented TField.DisplayName
  1758. Revision 1.21 2005/01/12 10:29:54 michael
  1759. * Patch from Joost Van der Sluis:
  1760. - removed some duplicate definitions
  1761. - restructured SetDataset
  1762. - implemented UpdateMode, ProviderFlags
  1763. }