?? dbgridehimpexp.pas
字號:
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;
AFont: TFont; Background: TColor);
begin
Put(' <TD WIDTH=' + IntToStr(Column.Width) +
' ALIGN="' + GetAlignment(Column.Alignment) + '"' +
' BGCOLOR=#' + GetColor(Background) +
'>');
PutText(AFont,Column.DisplayText);
PutL('</TD>');
end;
function TDBGridEhExportAsHTML.GetAlignment(Alignment: TAlignment): String;
begin
case Alignment of
taLeftJustify: Result := 'LEFT';
taCenter: Result := 'CENTER';
taRightJustify: Result := 'RIGHT';
end;
end;
{$IFNDEF EH_LIB_4} {Borland Delphi 3.0 or C++ Builder 3.0}
type
TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);
function StringReplace(const S, OldPattern, NewPattern: string;
Flags: TReplaceFlags): string;
var
SearchStr, Patt, NewStr: string;
Offset: Integer;
begin
if rfIgnoreCase in Flags then
begin
SearchStr := AnsiUpperCase(S);
Patt := AnsiUpperCase(OldPattern);
end else
begin
SearchStr := S;
Patt := OldPattern;
end;
NewStr := S;
Result := '';
while SearchStr <> '' do
begin
Offset := AnsiPos(Patt, SearchStr);
if Offset = 0 then
begin
Result := Result + NewStr;
Break;
end;
Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
if not (rfReplaceAll in Flags) then
begin
Result := Result + NewStr;
Break;
end;
SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
end;
end;
{$ENDIF}
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 := TMemoryStream.Create;
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
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
Result := FontTblList.IndexOf(FontName);
if Result = -1 then
Result := FontTblList.Add(FontName);
end;
function TDBGridEhExportAsRTF.GetColorIndex(Color: TColor): Integer;
var RGBColor: Longint;
s:String;
begin
RGBColor := ColorToRGB(Color);
s := Format('%3d%3d%3d',[GetRValue(RGBColor),GetGValue(RGBColor),GetBValue(RGBColor)]);
Result := ColorTblList.IndexOf(s);
if Result = -1 then
Result := ColorTblList.Add(s);
end;
procedure TDBGridEhExportAsRTF.WritePrefix;
begin
end;
procedure TDBGridEhExportAsRTF.WriteSuffix;
begin
Put('}');
end;
procedure TDBGridEhExportAsRTF.WriteTitle(ColumnsList: TColumnsEhList);
var fLogPelsX: Integer;
i,w,k: Integer;
FPTitleExpArr: PTitleExpArr;
ListOfHeadTreeNodeList:TList;
ColSpan,RowSpan:Integer;
Text:String;
LeftBorder,TopBorder,BottomBorder,RightBorder:Boolean;
ExclLeftBorders,ExclTopBorders,ExclBottomBorders,ExclRightBorders:TStringList;
Space:String;
procedure AddExclBorders(Col,Row,ColSpan,RowSpan:Integer);
var i,k:Integer;
begin
for i := Col to Col + ColSpan - 1 do
for k := Row downto Row - RowSpan + 1 do
begin
if i <> Col then
ExclLeftBorders.Add(Format('%3d%3d',[i,k]));
if i <> Col + ColSpan - 1 then
ExclRightBorders.Add(Format('%3d%3d',[i,k]));
if k <> Row then
ExclTopBorders.Add(Format('%3d%3d',[i,k]));
if k <> Row - RowSpan + 1 then
ExclBottomBorders.Add(Format('%3d%3d',[i,k]));
end;
end;
procedure CalcBorders(Col,Row:Integer);
begin
LeftBorder := True; TopBorder := True;
BottomBorder := True; RightBorder := True;
if ExclLeftBorders.IndexOf(Format('%3d%3d',[Col,Row])) <> -1 then
LeftBorder := False;
if ExclRightBorders.IndexOf(Format('%3d%3d',[Col,Row])) <> -1 then
RightBorder := False;
if ExclTopBorders.IndexOf(Format('%3d%3d',[Col,Row])) <> -1 then
TopBorder := False;
if ExclBottomBorders.IndexOf(Format('%3d%3d',[Col,Row])) <> -1 then
BottomBorder := False;
end;
begin
fLogPelsX := GetDeviceCaps(DBGridEh.Canvas.Handle, LOGPIXELSX);
if DBGridEh.UseMultiTitle then
begin
Space := IntToStr(Abs(Trunc(DBGridEh.VTitleMargin / 2 / fLogPelsX * 1440 - 20)));
ExclLeftBorders := nil; ExclTopBorders := nil;
ExclBottomBorders := nil; ExclRightBorders := nil;
try
CreateMultiTitleMatrix(DBGridEh,ColumnsList,FPTitleExpArr,ListOfHeadTreeNodeList);
ExclLeftBorders := TStringList.Create;
ExclTopBorders := TStringList.Create;
ExclBottomBorders := TStringList.Create;
ExclRightBorders := TStringList.Create;
//MultiTitle
for k := ListOfHeadTreeNodeList.Count-1 downto 1 do
begin
Put('\trowd');
PutL('\trgaph40');
w := 0;
for i := 0 to ColumnsList.Count-1 do
begin
CalcSpan(ColumnsList,ListOfHeadTreeNodeList,k,i,ColSpan,RowSpan);
AddExclBorders(i,k,ColSpan,RowSpan);
CalcBorders(i,k);
WriteCellBorder(LeftBorder,TopBorder,BottomBorder,RightBorder);
Inc(w,Trunc(ColumnsList[i].Width / fLogPelsX * 1440)); // in twips
Put('\clshdng10000\clcfpat'+IntToStr(GetColorIndex((DBGridEh.FixedColor))));
PutL('\cellx'+IntToStr(w));
end;
PutL('{\trrh0');
for i := 0 to ColumnsList.Count-1 do
begin
if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[i]) <> nil then
begin
Text := THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[i]).Text;
Put('\pard\intbl{'+GetAlignment(taCenter)+'\sb'+Space+'\sa'+Space);
end else
begin
Text := '';
Put('\pard\intbl{'+GetAlignment(taCenter));
end;
PutText(DBGridEh.TitleFont, Text, DBGridEh.FixedColor);
PutL('\cell}');
end;
PutL('\pard\intbl\row}');
end;
//Bottomest titles
Put('\trowd');
PutL('\trgaph40');
w := 0;
for i := 0 to ColumnsList.Count-1 do
begin
CalcSpan(ColumnsList,ListOfHeadTreeNodeList,0,i,ColSpan,RowSpan);
AddExclBorders(i,0,ColSpan,RowSpan);
CalcBorders(i,0);
WriteCellBorder(LeftBorder,TopBorder,BottomBorder,RightBorder);
Inc(w,Trunc(ColumnsList[i].Width / fLogPelsX * 1440)); // in twips
Put('\clshdng10000\clcfpat'+IntToStr(GetColorIndex((ColumnsList[i].Title.Color))));
PutL('\cellx'+IntToStr(w));
end;
PutL('{\trrh0');
for i := 0 to ColumnsList.Count-1 do
begin
if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[0]).Items[i]) <> nil then
begin
Text := THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[0]).Items[i]).Text;
Put('\pard\intbl{'+GetAlignment(taCenter)+'\sb'+Space+'\sa'+Space);
end else
begin
Text := '';
Put('\pard\intbl{'+GetAlignment(taCenter));
end;
CalcSpan(ColumnsList,ListOfHeadTreeNodeList,0,i,ColSpan,RowSpan);
PutText(ColumnsList[i].Title.Font,Text,ColumnsList[i].Title.Color);
PutL('\cell}');
end;
PutL('\pard\intbl\row}');
finally
for i := 0 to ListOfHeadTreeNodeList.Count-1 do
TList(ListOfHeadTreeNodeList.Items[i]).Free;
ListOfHeadTreeNodeList.Free;
FreeMem(FPTitleExpArr);
ExclLeftBorders.Free;
ExclTopBorders.Free;
ExclBottomBorders.Free;
ExclRightBorders.Free;
end;
end else
begin
Put('\trowd');
PutL('\trgaph40');
w := 0;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -