?? dbgridehimpexp.pas
字號(hào):
constructor TDBGridEhExportAsCSV.Create;
begin
inherited Create;
Separator := DBGridEhImpExpCsvSeparator;
end;
procedure TDBGridEhExportAsCSV.WriteDataCell(Column: TColumnEh; FColCellParamsEh: TColCellParamsEh);
var s: String;
begin
CheckFirstCell;
s := AnsiQuotedStr(FColCellParamsEh.Text, '"');
StreamWriteString(Stream, s);
// Stream.Write(PChar(s)^, Length(s));
end;
procedure TDBGridEhExportAsCSV.WriteFooterCell(DataCol, Row: Integer;
Column: TColumnEh; AFont: TFont; Background: TColor;
Alignment: TAlignment; Text: String);
var s: String;
begin
CheckFirstCell;
s := AnsiQuotedStr(Text, '"');
StreamWriteString(Stream, s);
// Stream.Write(PChar(s)^, Length(s));
end;
procedure TDBGridEhExportAsCSV.WriteTitle(ColumnsList: TColumnsEhList);
var i: Integer;
s: String;
begin
CheckFirstRec;
for i := 0 to ColumnsList.Count - 1 do
begin
s := AnsiQuotedStr(ColumnsList[i].Title.Caption, '"');
if i <> ColumnsList.Count - 1 then
s := s + Separator;
StreamWriteString(Stream, s);
// Stream.Write(PChar(s)^, Length(s));
end;
end;
{ Routines to convert MultiTitle in matrix (List of Lists) }
type
TTitleExpRec = record
Height: Integer;
PTLeafCol: THeadTreeNode;
end;
PTitleExpRec = ^TTitleExpRec;
// TTitleExpArr = array[0..MaxListSize - 1] of TTitleExpRec;
// PTitleExpArr = ^TTitleExpArr;
TTitleExpArr = array of TTitleExpRec;
procedure CalcSpan(
ColumnsList: TColumnsEhList; ListOfHeadTreeNodeList: TList;
Row, Col: Integer;
var AColSpan: Integer; var ARowSpan: Integer
);
var Node: THeadTreeNode;
i, k: Integer;
begin
AColSpan := 1; ARowSpan := 1;
Node := THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[Row]).Items[Col]);
if Node <> nil then
begin
for k := Row - 1 downto 0 do
if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[Col]) = Node
then
begin
Inc(ARowSpan);
TList(ListOfHeadTreeNodeList.Items[k]).Items[Col] := nil;
end else
Break;
for i := Col + 1 to ColumnsList.Count - 1 do
if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[Row]).Items[i]) = Node
then
begin
Inc(AColSpan);
TList(ListOfHeadTreeNodeList.Items[Row]).Items[i] := nil;
end else
Break;
for k := Row - 1 downto Row - ARowSpan + 1 do
for i := Col + 1 to Col + AColSpan - 1 do
TList(ListOfHeadTreeNodeList.Items[k]).Items[i] := nil;
end;
end;
procedure CreateMultiTitleMatrix(DBGridEh: TCustomDBGridEh;
ColumnsList: TColumnsEhList;
var FPTitleExpArr: TTitleExpArr;
var ListOfHeadTreeNodeList: TList);
var i: Integer;
NeedNextStep: Boolean;
MinHeight: Integer;
FHeadTreeNodeList: TList;
begin
ListOfHeadTreeNodeList := nil;
// FPTitleExpArr := AllocMem(SizeOf(TTitleExpRec) * ColumnsList.Count);
SetLength(FPTitleExpArr, ColumnsList.Count);
for i := 0 to ColumnsList.Count - 1 do
begin
FPTitleExpArr[i].Height := DBGridEh.LeafFieldArr[ColumnsList[i].Index].FLeaf.Height;
FPTitleExpArr[i].PTLeafCol := DBGridEh.LeafFieldArr[ColumnsList[i].Index].FLeaf;
end;
ListOfHeadTreeNodeList := TList.Create;
NeedNextStep := True;
while True do
begin
//search min height
MinHeight := FPTitleExpArr[0].Height;
for i := 1 to ColumnsList.Count - 1 do
if FPTitleExpArr[i].Height < MinHeight then
MinHeight := FPTitleExpArr[i].Height;
//add NodeList
FHeadTreeNodeList := TList.Create;
for i := 0 to ColumnsList.Count - 1 do
begin
FHeadTreeNodeList.Add(FPTitleExpArr[i].PTLeafCol);
if FPTitleExpArr[i].Height = MinHeight then
begin
if FPTitleExpArr[i].PTLeafCol.Host <> nil then
begin
FPTitleExpArr[i].PTLeafCol := FPTitleExpArr[i].PTLeafCol.Host;
Inc(FPTitleExpArr[i].Height, FPTitleExpArr[i].PTLeafCol.Height);
NeedNextStep := True;
end;
end;
end;
if not NeedNextStep then Break;
ListOfHeadTreeNodeList.Add(FHeadTreeNodeList);
NeedNextStep := False;
end;
end;
{ TDBGridEhExportAsHTML }
procedure TDBGridEhExportAsHTML.Put(Text: String);
begin
StreamWriteString(Stream, Text);
// Stream.Write(PChar(Text)^, Length(Text));
end;
procedure TDBGridEhExportAsHTML.PutL(Text: String);
begin
Put(Text + #13#10);
end;
procedure TDBGridEhExportAsHTML.WritePrefix;
var s: String;
CellPaddingInc: String;
begin
PutL('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');
PutL('<HTML>');
PutL('<HEAD>');
PutL('<TITLE>');
PutL(DBGridEh.Name);
PutL('</TITLE>');
PutL('</HEAD>');
PutL('<BODY>');
s := '<TABLE ';
if DBGridEh.Flat then CellPaddingInc := '1' else CellPaddingInc := '2';
if DBGridEh.Options * [dgColLines, dgRowLines] <> [] then
if DBGridEh.Ctl3D then s := s + 'BORDER=1 CELLSPACING=0 CELLPADDING=' + CellPaddingInc
else s := s + 'BORDER=0 CELLSPACING=1 CELLPADDING=' + CellPaddingInc
else
s := s + 'BORDER=0 CELLSPACING=0 CELLPADDING=' + CellPaddingInc;
s := s + ' BGCOLOR=#' + GetColor(DBGridEh.FixedColor) + '>' + #13#10;
PutL(s);
end;
procedure TDBGridEhExportAsHTML.WriteSuffix;
begin
PutL('</TABLE>');
PutL('</BODY>');
PutL('</HTML>');
end;
procedure TDBGridEhExportAsHTML.WriteTitle(ColumnsList: TColumnsEhList);
var i, k: Integer;
// FPTitleExpArr: PTitleExpArr;
FPTitleExpArr: TTitleExpArr;
ListOfHeadTreeNodeList: TList;
ColSpan, RowSpan: Integer;
begin
if ColumnsList.Count = 0 then Exit;
if DBGridEh.UseMultiTitle then
begin
try
CreateMultiTitleMatrix(DBGridEh, ColumnsList, FPTitleExpArr, ListOfHeadTreeNodeList);
for k := ListOfHeadTreeNodeList.Count - 1 downto 1 do
begin
PutL('<TR>');
for i := 0 to ColumnsList.Count - 1 do
begin
if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[i]) <> nil then
begin
Put(' <TD ALIGN="CENTER"');
CalcSpan(ColumnsList, ListOfHeadTreeNodeList, k, i, ColSpan, RowSpan);
if ColSpan > 1 then
Put(' COLSPAN = "' + IntToStr(ColSpan) + '"');
if RowSpan > 1 then
Put(' ROWSPAN = "' + IntToStr(RowSpan) + '"');
Put('>');
PutText(DBGridEh.TitleFont,
THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[i]).Text);
PutL('</TD>');
end;
end;
PutL('</TR>');
end;
PutL('<TR>');
for i := 0 to ColumnsList.Count - 1 do
begin
if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[0]).Items[i]) <> nil then
begin
Put(' <TD WIDTH=' + IntToStr(ColumnsList[i].Width) + ' ALIGN="CENTER"');
CalcSpan(ColumnsList, ListOfHeadTreeNodeList, 0, i, ColSpan, RowSpan);
if ColSpan > 1 then
Put(' COLSPAN = "' + IntToStr(ColSpan) + '"');
if RowSpan > 1 then
Put(' ROWSPAN = "' + IntToStr(RowSpan) + '"');
Put('>');
PutText(ColumnsList[i].Title.Font,
THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[0]).Items[i]).Text);
PutL('</TD>');
end;
end;
PutL('</TR>');
finally
for i := 0 to ListOfHeadTreeNodeList.Count - 1 do
TList(ListOfHeadTreeNodeList.Items[i]).Free;
ListOfHeadTreeNodeList.Free;
// FreeMem(FPTitleExpArr);
end;
end else
begin
PutL('<TR>');
for i := 0 to ColumnsList.Count - 1 do
begin
Put(' <TD WIDTH=' + IntToStr(ColumnsList[i].Width) +
' ALIGN="' + GetAlignment(ColumnsList[i].Title.Alignment) + '"' + '>');
PutText(ColumnsList[i].Title.Font, ColumnsList[i].Title.Caption);
PutL('</TD>');
end;
PutL('</TR>');
end;
end;
procedure TDBGridEhExportAsHTML.WriteRecord(ColumnsList: TColumnsEhList);
begin
PutL('<TR>');
inherited;
PutL('</TR>');
end;
procedure TDBGridEhExportAsHTML.WriteDataCell(Column: TColumnEh; FColCellParamsEh: TColCellParamsEh);
begin
Put(' <TD WIDTH=' + IntToStr(Column.Width) +
' ALIGN="' + GetAlignment(FColCellParamsEh.Alignment) + '"' +
' BGCOLOR=#' + GetColor(FColCellParamsEh.Background) +
'>');
PutText(FColCellParamsEh.Font, FColCellParamsEh.Text);
PutL('</TD>');
end;
function TDBGridEhExportAsHTML.GetAlignment(Alignment: TAlignment): String;
begin
case Alignment of
taLeftJustify: Result := 'LEFT';
taCenter: Result := 'CENTER';
taRightJustify: Result := 'RIGHT';
end;
end;
procedure TDBGridEhExportAsHTML.PutText(Font: TFont; Text: String);
var s: String;
begin
s := '<FONT STYLE="font-family: ' + Font.Name;
s := s + '; font-size: ' + IntToStr(Font.Size);
s := s + 'pt; color: #' + GetColor(Font.Color) + '">';
if (fsBold in Font.Style) then s := s + '<B>';
if (fsItalic in Font.Style) then s := S + '<I>';
if (fsUnderline in Font.Style) then s := s + '<U>';
if (fsStrikeOut in Font.Style) then s := s + '<STRIKE>';
Text := StringReplace(Text, '&', '&', [rfReplaceAll]);
Text := StringReplace(Text, '<', '<', [rfReplaceAll]);
Text := StringReplace(Text, '>', '>', [rfReplaceAll]);
Text := StringReplace(Text, '"', '"', [rfReplaceAll]);
if Text <> '' then
s := s + Text
else
s := s + ' ';
if (fsBold in Font.Style) then s := s + '</B>';
if (fsItalic in Font.Style) then s := S + '</I>';
if (fsUnderline in Font.Style) then s := s + '</U>';
if (fsStrikeOut in Font.Style) then s := s + '</STRIKE>';
s := s + '</FONT>';
Put(s);
end;
function TDBGridEhExportAsHTML.GetColor(Color: TColor): String;
var s: String;
begin
if Color = clNone then
s := '000000'
else
s := IntToHex(ColorToRGB(Color), 6);
Result := Copy(s, 5, 2) + Copy(s, 3, 2) + Copy(s, 1, 2);
end;
procedure TDBGridEhExportAsHTML.WriteFooter(ColumnsList: TColumnsEhList;
FooterNo: Integer);
begin
PutL('<TR>');
inherited;
PutL('</TR>');
end;
procedure TDBGridEhExportAsHTML.WriteFooterCell(DataCol, Row: Integer;
Column: TColumnEh; AFont: TFont; Background: TColor;
Alignment: TAlignment; Text: String);
var Footer: TColumnFooterEh;
begin
Footer := Column.UsedFooter(Row);
Put(' <TD WIDTH=' + IntToStr(Column.Width) +
' ALIGN="' + GetAlignment(Footer.Alignment) + '"' +
' BGCOLOR=#' + GetColor(Background) +
'>');
PutText(AFont, Text);
PutL('</TD>');
end;
{ TDBGridEhExportAsRTF }
procedure TDBGridEhExportAsRTF.ExportToStream(AStream: TStream; IsExportAll: Boolean);
var
i: Integer;
begin
FCacheStream := TMemoryStreamEh.Create;
FCacheStream.HalfMemoryDelta := $10000;
ColorTblList := TStringList.Create;
FontTblList := TStringList.Create;
try
GetColorIndex(clBlack);
GetColorIndex(clWhite);
GetColorIndex(clBtnFace);
inherited ExportToStream(FCacheStream, IsExportAll);
Stream := AStream;
PutL('{\rtf0\ansi');
Put('{\colortbl');
for i := 0 to ColorTblList.Count - 1 do
Put('\red' + Trim(Copy(ColorTblList[i], 1, 3)) +
'\green' + Trim(Copy(ColorTblList[i], 4, 3)) +
'\blue' + Trim(Copy(ColorTblList[i], 7, 3)) + ';');
PutL('}');
Put('{\fonttbl');
for i := 0 to FontTblList.Count - 1 do
Put('\f' + IntToStr(i) + '\fnil ' + FontTblList[i] + ';');
PutL('}');
FCacheStream.SaveToStream(Stream);
finally
FCacheStream.Free;
ColorTblList.Free;
FontTblList.Free;
end;
end;
procedure TDBGridEhExportAsRTF.Put(Text: String);
begin
StreamWriteString(Stream, Text);
// Stream.Write(PChar(Text)^, Length(Text));
end;
procedure TDBGridEhExportAsRTF.PutL(Text: String);
begin
Put(Text + #13#10);
end;
procedure TDBGridEhExportAsRTF.PutText(Font: TFont; Text: String; Background: TColor);
var s: String;
begin
s := '\fs' + IntToStr(Font.Size * 2);
if (fsBold in Font.Style) then s := s + '\b';
if (fsItalic in Font.Style) then s := s + '\i';
if (fsStrikeOut in Font.Style) then s := s + '\strike';
if (fsUnderline in Font.Style) then s := s + '\ul';
s := s + '\f' + IntToStr(GetFontIndex(Font.Name));
s := s + '\cf' + IntToStr(GetColorIndex(Font.Color));
s := s + '\cb' + IntToStr(GetColorIndex(Background));
Put(s + ' ');
Put(Text);
end;
function TDBGridEhExportAsRTF.GetAlignment(Alignment: TAlignment): String;
begin
case Alignment of
taLeftJustify: Result := '\ql';
taCenter: Result := '\qc';
taRightJustify: Result := '\qr';
end;
end;
function TDBGridEhExportAsRTF.GetFontIndex(FontName: String): Integer;
begin
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -