📄 wwexport.pas
字号:
else result := s;
end
else result := s;
end;
function TwwExportOptions.GetDelimiter:String;
begin
result := FDelimiter;
end;
procedure TwwExportOptions.SetDelimiter(val:String);
begin
if val <> FDelimiter then begin
{if val = '' then FDelimiter := #9
else}
FDelimiter := val;
end;
end;
function TwwExportOptions.GetFileName:String;
begin
if FFileName = '' then begin
result := '';//wwInternational.ExportFileName;
if (result = '') and not (csDesigning in Owner.ComponentState) then
result := wwExtractFileNameOnly(Application.ExeName)+'.txt'
end
else result := FFileName;
end;
procedure TwwExportOptions.SetFileName(val:String);
begin
if val <> FFileName then begin
FFileName:= val;
end;
end;
Function TwwExportOptions.XRecNoOffset: integer;
begin
if esoShowRecordNo in FOptions then result:= 1
else result:= 0;
end;
Function TwwExportOptions.QuotesPad: integer;
begin
if esoDblQuoteFields in FOptions then result := 2 else result := 0;
end;
type TwwCheatCustomDBGrid = class (TwwCustomDBGrid);
procedure TwwExportOptions.ExportToStream(fs:TStream);
var i:integer;
accept : boolean;
startpos:integer;
recordstr,fontlist:string;
grid:TwwDBGrid;
currowcount:integer;
totalstr:string;
SYLKFontList:TStrings;
exportFieldList: TStringList;
TotalPixelCount:Integer;
SYLKFormatIndex:TStringList;
function WriteHTMLHeader:string;
var i,j,k,startcol,endcol:integer;
rowstr,tempfontstr:string;
gridfont:TFont;
gridbrush:TBrush;
gridTitleAlignment:TAlignment;
groupassigned:boolean;
groupcolcount:integer;
footerrect:TRect;
footerstring:string;
begin
with Grid do begin
rowstr:='<HTML>'+wwCRLF+
'<HEAD>'+wwCRLF;
rowstr := rowstr + '<TITLE>'+FileName+'</TITLE>'+wwCRLF;
rowstr := rowstr +{'<meta http-equiv=content-style-type content=text/css>'+wwCRLF+}
'</HEAD>'+wwCRLF;
rowstr:=rowstr+'<BODY>'+wwCRLF;
{Rules = groups or rows or cols for dgrowlines and dgcolumnlines and borderstyle support}
rowstr:=rowstr+
'<TABLE ALIGN=Center BORDER="'+inttostr(HTMLBorderWidth)+'" CELLPADDING="1" CELLSPACING="0"';
//Set Table's Bidi mode. Not may want to move this to the <HTML> Tag.
if BiDiMode = bdLeftToRight then
rowstr := rowstr + ' dir="LTR"'
else {if BiDiMode = bdRightToLeft then}
rowstr := rowstr + ' dir="RTL"';
if (esoTransparentGrid in self.Options) then rowstr := rowstr+'>'
else rowstr := rowstr+' '+SetBkGrndColor(Color)+'>';
rowstr := rowstr +wwCRLF+'<THEAD>'+wwCRLF;
//Display Title.
//7/26/2001-PYW-Handle Header
if (esoShowHeader in self.options) and (esoShowTitle in self.Options) then begin
rowstr:=rowstr+
'<TR '+SetFontStr(TitleFont)+' '+SetBkGrndColor(TitleColor)+'>'+wwcrlf+
'<TH colspan="'+IntToStr(exportFieldList.count+XRecNoOffset)+'" scope="colgroup">'+TitleName+'</TH>'+wwcrlf+
'</TR>'+wwCRLF;
end;
//Now Do Titles and Group Children
j:=0;
groupassigned := False;
// Loop Twice. Once for normal titles and the Group Header if there is one and once for the group children.
//7/26/2001-PYW-Handle Header
if (esoShowHeader in self.options) then
while j<2 do begin
i:=0;
//Set Title's Font Properties
rowstr:=rowstr+'<TR '+SetFontStr(TitleFont)+' ALIGN='+getalignstr(TitleAlignment)+'>'+wwCRLF;
// If this is the RecordNo title then make sure it spans two rows. Only do this the first time.
if (j=0) and (esoShowRecordNo in self.Options) then begin
rowstr := rowstr + '<TD ALIGN="CENTER" '+ SetFontStr(TitleFont)+ ' SCOPE="col" bgcolor=#'+ ColorToHexString(TitleColor);
rowstr := rowstr + ' RowSpan="2">';
rowstr := rowstr + SetFormatStyle('#',TitleFont)+'</TD>'+wwCRLF;
end;
// Now iterate through the fields.
while (i <= ExportFieldList.Count-1) do begin
if (exportFieldList[i] = 'F') then begin
inc(i); continue;
end;
//Initialize default grid font, brush and titlealignment settings.
gridFont := Grid.Canvas.Font;
gridFont.assign(TitleFont);
gridBrush := Grid.Canvas.Brush;
GridBrush.Color:=TitleColor;
gridTitleALignment:=TitleAlignment;
// Call Grid's TitleCellColoring routine to see if titles should be painted a special color.
if esoDynamicColors in self.Options then
DoCalcTitleAttributes(DataLink.Fields[i].FieldName, gridFont, gridBrush, gridTitleAlignment);
tempfontstr := '';
if (gridfont.Name <> TitleFont.Name) or (GridFont.Size <> TitleFont.Size) or
(gridfont.Color <> TitleFont.color) then
tempfontstr := ' '+SetFontStr(GridFont);
// if (exportFieldList[i] = 'T') then begin
if (j>0) or (Columns[getdbcol(Grid,i+xIndicatorOffset)].GroupName = '') then begin
if (exportFieldList[i] = 'T') then begin
if j=0 then begin
rowstr := rowstr + '<TD'+ tempfontstr + ' ALIGN="'+getalignstr(GridTitleAlignment)+
'" SCOPE="col" bgcolor=#'+ ColorToHexString(GridBrush.Color);
rowstr := rowstr + ' RowSpan="2">';
rowstr := rowstr + SetFormatStyle(strReplaceCharWithStr(Columns[getdbcol(Grid,i+xIndicatorOffset)].DisplayLabel,'~','<BR>'),GridFont)+
'</TD>'+wwCRLF;
end
else if (Columns[getdbcol(Grid,i+xIndicatorOffset)].GroupName <> '') then begin
rowstr := rowstr + '<TD'+ tempfontstr+ ' ALIGN="'+getalignstr(GridTitleAlignment)+
'" SCOPE="col" bgcolor=#'+ ColorToHexString(GridBrush.Color);
rowstr := rowstr + ' >';
rowstr := rowstr + SetFormatStyle(strReplaceCharWithStr(Columns[getdbcol(Grid,i+xIndicatorOffset)].DisplayLabel,'~','<BR>'),GridFont)+
'</TD>'+wwCRLF;
end
end;
inc(i);
end
else begin
GroupNameCellRect(i+xIndicatorOffset,0,startcol,endcol,false);
groupColCount := 0;
for k:=startcol to endcol do begin
if exportFieldList[k-1] = 'T' then
inc(groupColcount);
end;
if groupcolCount > 0 then begin
rowstr := rowstr + '<TD'+ tempfontstr+
' SCOPE="col" bgcolor=#'+ ColorToHexString(GridBrush.Color);
rowstr := rowstr + ' ALIGN=CENTER ColSpan="'+inttostr(groupcolcount)+
'">'+SetFormatStyle(Columns[getdbcol(Grid,i+xIndicatorOffset)].GroupName,GridFont)+
'</TD>'+wwCRLF;
groupassigned := True;
end;
inc(i,endcol-startcol+1);
end;
end;
inc(j);
rowstr:=rowstr+'</TR>'+wwCRLF;
//If No Groups then we are done. Otherwise, we need to still process the children.
if not groupassigned then break;
end; //End While j<2
// 9/26/2001-If only one row then pad with additional Row because of rowspan. - PYW
if j = 1 then rowstr := rowstr+'<TR></TR>'+wwCRLF;
rowstr:=rowstr+'</THEAD>'+wwCRLF;
//NOW INSERT FOOTER CODE HERE.
//5/18/2001 - PYW - Should check grid's options to see if dgShowFooter in Options as well.
if (esoShowFooter in self.Options) and (dgShowFooter in Grid.Options) then begin
rowstr := rowstr+'<TFOOT '+SetFontStr(TitleFont)+' '+SetBkGrndColor(FooterColor)+'>'+wwCRLF;
// rowstr := rowstr+'<TH>'+wwCRLF; //10/01/2001-Remove this as it messes up footer.
//2/15/2002-PYW-Need to add space for footer cell if recordno is visible.
if (esoShowRecordNo in self.Options) then
rowstr := rowstr+'<TD> </TD>'+wwCRLF;
for i:=0 to ExportFieldList.Count-1 do begin
//10/01/2001-Only print footers for exported cells.
if (exportFieldList[i] = 'F') then continue;
FooterRect:= CellRect(i+xindicatoroffset, 0);
footerstring := Columns[getdbcol(Grid,i+xIndicatorOffset)].FooterValue;
// DoDrawFooterCell(Grid.Canvas,footerRect,Datalink.Fields[i],footerstring,footerdraw);
if footerstring <> '' then begin
rowstr := rowstr+'<TD ALIGN='+getalignstr(DataLink.Fields[i].Alignment)+' '+SetFontStr(Font)+' '+SetBkGrndColor(FooterCellColor)+'>'+footerstring+'</TD>'+wwCRLF;
end
else begin
rowstr := rowstr+'<TD> </TD>'+wwCRLF;
end;
end;
// rowstr := rowstr+'</TH>'+wwCRLF; //10/01/2001-Remove this as it messes up footer.
rowstr := rowstr + '</TFOOT>'+wwCRLF;
end;
rowstr:=rowstr+'<TBODY>'+wwCRLF;
end;
result := rowstr;
end;
function WriteHTMLDataRow:string;
var i,j,pos1,pos2,pos3:integer;
AControlType, Parameters: wwSmallString;
checkstr,uncheckstr:string;
Rowstr,LinkAddress,tempstr:String;
xfactor:extended;
gridfont:TFont;
gridbrush:TBrush;
URLDisplay,controlname,combostr,radiostr,displaystr:string;
customedit:TWinControl;
begin
with Grid do begin
RowStr:='<TR VALIGN="TOP" '+SetFontStr(Font)+'>'+wwCRLF;
if esoShowRecordNo in self.Options then
RowStr:=RowStr+'<TD WIDTH="0*" NOWRAP ALIGN="right" scope="row" '+SetFontStr(TitleFont)+' '+SetBkgrndColor(TitleColor)+'>'+
IntToStr(curRowCount)+'</TD>'+wwCRLF;
for i:=0 to exportFieldList.Count-1 do begin
if (exportFieldList[i] = 'F') then continue;
GetControlInfo(Datalink.Fields[i].FieldName, AControlType, Parameters);
// tempstr := GetFieldValue(i);
tempstr := TrimRight(GetFieldValue(i)); //6/3/2001-PYW-Strip Trailing Spaces.
if (esoAddControls in self.Options) then begin
if (AControlType = 'CheckBox') then begin
isCheckBox(i+xIndicatorOffset, 1, checkstr, uncheckstr);
if tempstr = checkstr then
tempstr:='<input align="middle" type="checkbox" checked >'
else
tempstr:='<INPUT ALIGN="middle" TYPE="checkbox" >';
end
else if (AControlType = 'CustomEdit') then begin
Pos1:= 1;
controlname:= strGetToken(Parameters, ';', Pos1);
customEdit:= GetComponent(controlname);
if customEdit is TwwRadioGroup then begin
with TwwRadioGroup(customedit) do begin
radiostr :='';
for j:= 0 to Items.count-1 do begin
radiostr := radiostr+'<input align="middle" type="radio" value="'+GetButtonValue(j)+'" name="radio'+inttostr(currowcount)+'"';
//7/26/2001 - PYW - Need to compare the display value and not stored value.
if AnsiCompareText(tempstr,GetDisplayValue(GetButtonValue(j)))=0 then
radiostr := radiostr +' checked';
radiostr := radiostr+'>'+items[j]+'<BR>'+wwCRLF;
end;
tempstr := radiostr;
end;
end
else if customedit is TwwCheckbox then
begin
with TwwCheckbox(customedit) do begin
if AnsiCompareText(tempstr,ValueChecked)=0 then
tempstr:='<input align="middle" type="checkbox" checked >'
else
tempstr:='<INPUT ALIGN="middle" TYPE="checkbox" >';
end;
end
else if customedit is TwwDBComboBox then begin
with Twwdbcombobox(customedit) do begin
combostr :='<Select Name="wwCombo'+inttostr(currowcount)+'">'+wwCRLF;
for j:= 0 to Items.count-1 do begin
if MapList then begin
Pos1 := 1;
displaystr := strGetToken(Items[j],#9,Pos1);
combostr := combostr+'<Option Value="'+strGetToken(Items[j],#9,Pos1)+'"';
if AnsiCompareText(tempstr,displaystr)=0 then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -