Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Как сделать экспорт TDataSet в XML файл
{Unit to export a dataset to XML}
unit DS2XML;
interface
uses
Classes, DB;
procedure
DatasetToXML(Dataset: TDataSet; FileName: string
);
implementation
uses
SysUtils;
var
SourceBuffer: PChar;
procedure
WriteString(Stream: TFileStream; s: string
);
begin
StrPCopy(SourceBuffer, s);
Stream.Write
(SourceBuffer[0], StrLen(SourceBuffer));
end
;
procedure
WriteFileBegin(Stream: TFileStream; Dataset: TDataSet);
function
XMLFieldType(fld: TField): string
;
begin
case
fld.DataType of
ftString: Result := '"string" WIDTH="' + IntToStr(fld.Size) + '"';
ftSmallint: Result := '"i4"'; //??
ftInteger: Result := '"i4"';
ftWord: Result := '"i4"'; //??
ftBoolean: Result := '"boolean"';
ftAutoInc: Result := '"i4" SUBTYPE="Autoinc"';
ftFloat: Result := '"r8"';
ftCurrency: Result := '"r8" SUBTYPE="Money"';
ftBCD: Result := '"r8"'; //??
ftDate: Result := '"date"';
ftTime: Result := '"time"'; //??
ftDateTime: Result := '"datetime"';
else
end
;
if
fld.Required then
Result := Result + ' required="true"';
if
fld.ReadOnly then
Result := Result + ' readonly="true"';
end
;
var
i: Integer;
begin
WriteString(Stream,
'<?xml version="1.0" standalone="yes"?><!-- Generated by SMExport --> ' +
'<DATAPACKET Version="2.0">');
WriteString(Stream, '<METADATA><FIELDS>');
{write th metadata}
with
Dataset do
for
i := 0 to
FieldCount - 1 do
begin
WriteString(Stream, '<FIELD attrname="' +
Fields[i].FieldName +
'" fieldtype=' +
XMLFieldType(Fields[i]) +
'/>');
end
;
WriteString(Stream, '</FIELDS>');
WriteString(Stream,
'<PARAMS DEFAULT_ORDER="1" PRIMARY_KEY="1" LCID="1033"/>');
WriteString(Stream, '</METADATA><ROWDATA>');
end
;
procedure
WriteFileEnd(Stream: TFileStream);
begin
WriteString(Stream, '</ROWDATA></DATAPACKET>');
end
;
procedure
WriteRowStart(Stream: TFileStream; IsAddedTitle: Boolean);
begin
if
not
IsAddedTitle then
WriteString(Stream, '<ROW');
end
;
procedure
WriteRowEnd(Stream: TFileStream; IsAddedTitle: Boolean);
begin
if
not
IsAddedTitle then
WriteString(Stream, '/>');
end
;
procedure
WriteData(Stream: TFileStream; fld: TField; AString: ShortString);
begin
if
Assigned(fld) and
(AString <> '') then
WriteString(Stream, ' ' + fld.FieldName + '="' + AString + '"');
end
;
function
GetFieldStr(Field: TField): string
;
function
GetDig(i, j: Word): string
;
begin
Result := IntToStr(i);
while
(Length(Result) < j) do
Result := '0' + Result;
end
;
var
Hour, Min, Sec, MSec: Word;
begin
case
Field.DataType of
ftBoolean: Result := UpperCase(Field.AsString);
ftDate: Result := FormatDateTime('yyyymmdd', Field.AsDateTime);
ftTime: Result := FormatDateTime('hhnnss', Field.AsDateTime);
ftDateTime:
begin
Result := FormatDateTime('yyyymmdd', Field.AsDateTime);
DecodeTime(Field.AsDateTime, Hour, Min, Sec, MSec);
if
(Hour <> 0) or
(Min <> 0) or
(Sec <> 0) or
(MSec <> 0) then
Result := Result + 'T' + GetDig(Hour, 2) + ':' + GetDig(Min,
2) + ':' + GetDig(Sec, 2) + GetDig(MSec, 3);
end
;
else
Result := Field.AsString;
end
;
end
;
procedure
DatasetToXML(Dataset: TDataSet; FileName: string
);
var
Stream: TFileStream;
bkmark: TBookmark;
i: Integer;
begin
Stream := TFileStream.Create(FileName, fmCreate);
SourceBuffer := StrAlloc(1024);
WriteFileBegin(Stream, Dataset);
with
DataSet do
begin
DisableControls;
bkmark := GetBookmark;
First;
{write a title row}
WriteRowStart(Stream, True);
for
i := 0 to
FieldCount - 1 do
WriteData(Stream, nil
, Fields[i].DisplayLabel);
{write the end of row}
WriteRowEnd(Stream, True);
while
(not
EOF) do
begin
WriteRowStart(Stream, False);
for
i := 0 to
FieldCount - 1 do
WriteData(Stream, Fields[i], GetFieldStr(Fields[i]));
{write the end of row}
WriteRowEnd(Stream, False);
Next;
end
;
GotoBookmark(bkmark);
EnableControls;
end
;
WriteFileEnd(Stream);
Stream.Free;
StrDispose(SourceBuffer);
end
;
end
.
//Beispiel, Example:
uses
DS2XML;
procedure
TForm1.Button1Click(Sender: TObject);
begin
DatasetToXML(Table1, 'test.xml');
end
;