rm_e_xls.pas
来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 827 行 · 第 1/2 页
PAS
827 行
xlEdgeBottom: bt := wawxlEdgeBottom;
end;
case TPenStyle(b.Style) of
psSolid: lRange.Borders[bt].LineStyle := wawlsThin;
psDash: lRange.Borders[bt].LineStyle := wawlsDashed;
psDot: lRange.Borders[bt].LineStyle := wawlsDotted;
psDashDot: lRange.Borders[bt].LineStyle := wawlsDashDot;
psDashDotDot: lRange.Borders[bt].LineStyle := wawlsDashDotDot;
psClear: lRange.Borders[bt].LineStyle := wawlsNone;
psInsideFrame: lRange.Borders[bt].LineStyle := wawlsNone;
end;
lRange.Borders[bt].Color := b.Color;
lRange.Borders[bt].Weight := wawxlThin;
end;
begin
if ExportFrames then
begin
_SetXLSBorder(xlEdgeLeft, lDataRec.Obj.LeftFrame);
_SetXLSBorder(xlEdgeTop, lDataRec.Obj.TopFrame);
_SetXLSBorder(xlEdgeRight, lDataRec.Obj.RightFrame);
_SetXLSBorder(xlEdgeBottom, lDataRec.Obj.BottomFrame);
end;
end;
begin
lRange := lSheet.Ranges[lItem^.LeftCol.Index + 1, lItem^.TopRow.Index + 1,
lItem^.RightCol.Index, lItem^.BottomRow.Index];
if lDataRec.BmpWidth > 0 then
begin
lRange.Value := ' ';
Exit;
end;
lCount := lDataRec.Obj.Memo.Count;
lText := '';
for i := 0 to lCount - 1 do
begin
if i <> 0 then
lText := lText + #13#10;
lText := lText + lDataRec.Obj.Memo[i];
end;
lText := RMReplaceString(lText, #1, '');
if (lText = '') or (lText = #13#10) then
begin
lRange.Value := ' ';
lRange.WrapText := False;
end
else
begin
if (Copy(lText, Length(lText) - 1, 2) = #13#10) then
lText := Copy(lText, 1, Length(lText) - 2);
lText := StringReplace(lText, 'm~2|', #$A9#$4F, [rfReplaceAll]);
lRange.Value := lText;
if THackMemoView(lDataRec.Obj).ExportAsNumber then
begin
try
lRange.Value := VarAsType(lText, varDouble);
except
end;
end;
if ((Pos(#13#10, lText) > 0) or (Pos(#10, lText) > 0)) then
lRange.WrapText := True
else
lRange.WrapText := False;
end;
lRange.Font.Assign(TRMCustomMemoView(lDataRec.Obj).Font);
_SetXLSBorders;
if (lDataRec.Obj.FillColor <> clNone) and (lDataRec.Obj.FillColor <> clWhite) then
begin
lRange.ForegroundFillPatternColor := lDataRec.Obj.FillColor;
lRange.BackgroundFillPatternColor := clWhite;
lRange.FillPattern := wawfpSolid;
end;
case THackMemoView(lDataRec.Obj).RotationType of //waw Add
rmrt90:
lRange.Rotation := 90; //Rotation +90
rmrt270:
lRange.Rotation := 180; //Rotation -90
else
lRange.Rotation := 0; //Excel Rotation Range Is -90...+90
end;
case THackMemoView(lDataRec.Obj).VAlign of
rmvBottom:
lRange.VerticalAlignment := wawxlVAlignBottom;
rmvCenter:
lRange.VerticalAlignment := wawxlVAlignCenter;
rmvTop:
lRange.VerticalAlignment := wawxlVAlignTop;
else
lRange.VerticalAlignment := wawxlVAlignJustify;
end;
case THackMemoView(lDataRec.Obj).HAlign of
rmhLeft:
lRange.HorizontalAlignment := wawxlHAlignLeft;
rmhCenter:
lRange.HorizontalAlignment := wawxlHAlignCenter;
rmhRight:
lRange.HorizontalAlignment := wawxlHAlignRight;
else
lRange.HorizontalAlignment := wawxlHAlignJustify;
end;
end;
begin
if (FpgList.Count <> 0) and (FpgList.IndexOf(IntToStr(FPageNo + 1)) < 0) then
begin
inherited; //waw 03-07-27
Exit;
end;
pe := TList.Create;
for i := 0 to FDataList.Count - 1 do
begin
New(lItem);
pe.Add(lItem);
end;
try
for i := 0 to FDataList.Count - 1 do
begin
Application.ProcessMessages;
lDataRec := FDataList[i];
lItem := pXLSExport(pe[i]);
k := 0;
while (k < FCols.Count) and not _CEP(TCol(FCols[k]).X, lDataRec.Left) do Inc(k);
if k >= FCols.Count then
lItem^.LeftCol := TCol(FCols[FCols.Add(TCol.CreateCol(lDataRec.Left))])
else
lItem^.LeftCol := TCol(FCols[k]);
k := 0;
while (k < FCols.Count) and not _CEP(TCol(FCols[k]).X, lDataRec.Left + lDataRec.Width) do Inc(k);
if k >= FCols.Count then
lItem^.RightCol := TCol(FCols[FCols.Add(TCol.CreateCol(lDataRec.Left + lDataRec.Width))])
else
lItem^.RightCol := TCol(FCols[k]);
k := 0;
while (k < FRows.Count) and not _CEP(TRow(FRows[k]).Y, lDataRec.Top) do Inc(k);
if k >= FRows.Count then
lItem^.TopRow := TRow(FRows[FRows.Add(TRow.CreateRow(lDataRec.Top, FPageNo))])
else
lItem^.TopRow := TRow(FRows[k]);
k := 0;
while (k < FRows.Count) and not _CEP(TRow(FRows[k]).Y, lDataRec.Top + lDataRec.Height) do Inc(k);
if k >= FRows.Count then
lItem^.BottomRow := TRow(FRows[FRows.Add(TRow.CreateRow(lDataRec.Top + lDataRec.Height, FPageNo))])
else
lItem^.BottomRow := TRow(FRows[k]);
end;
FCols.Sort(SortCols);
FRows.Sort(SortRows);
if (FCols.Count > 0) and (TCol(FCols[0]).X < 0) then
begin
lOffset := -TCol(FCols[0]).X;
for i := 0 to FCols.Count - 1 do // 设置cell宽度
begin
TCol(FCols[i]).X := TCol(FCols[i]).X + lOffset;
end;
end;
if FCurPageNo = 0 then //by waw
begin
lSheet := FWorkBook.AddSheet; //by waw
if (aPage.PageSize < 256) and (aPage.PageSize < Integer(wawxlPaperA3ExtraTransverse)) then
begin
lSheet.PageSetup.PaperSize := TwawXLSPaperSizeType(aPage.PageSize);
lSheet.PageSetup.FitToPagesWide := 1;
lSheet.PageSetup.FitToPagesTall := 1;
end;
if aPage.PageOrientation = rmpoPortrait then
lSheet.PageSetup.Orientation := wawxlPortrait
else
lSheet.PageSetup.Orientation := wawxlLandscape;
lSheet.PageSetup.LeftMargin := (Round(RMFromScreenPixels(aPage.spMarginLeft, rmutInches) * 100) / 100) - 0.18;
lSheet.PageSetup.TopMargin := Round(RMFromScreenPixels(aPage.spMarginTop, rmutInches) * 100) / 100;
lSheet.PageSetup.RightMargin := (Round(RMFromScreenPixels(aPage.spMarginRight, rmutInches) * 100) / 100) - 0.18;
lSheet.PageSetup.BottomMargin := Round(RMFromScreenPixels(aPage.spMarginBottom, rmutInches) * 100) / 100;
lSheet.PageSetup.HeaderMargin := 0.0;
lSheet.PageSetup.FooterMargin := 0.0;
Inc(FTotalPages); //waw
lSheet.Title := Format('Sheet%d', [FTotalPages]); //waw
for i := 0 to FCols.Count - 1 do // 设置cell宽度
begin
if i = 0 then
lSheet.Cols[i].InchWidth := Round(RMFromScreenPixels(TCol(FCols[i]).X, rmutInches) * 100) / 100
else
lSheet.Cols[i].InchWidth := Round(RMFromScreenPixels(TCol(FCols[i]).X - TCol(FCols[i - 1]).X -2, rmutInches) * 100) / 100;
end;
end
else
lSheet := FWorkBook.Sheets[FTotalPages -1];
for i := 0 to FCols.Count - 1 do // 设置 Colnum 序号
begin
TCol(FCols[i]).Index := i;
end;
for i := 0 to FRows.Count - 1 do // 设置cell高度
begin
TRow(FRows[i]).Index := FrStart + i; // 设置 Row 序号
r := TRow(FRows[i]);
if i = 0 then
lSheet.Rows[TRow(FRows[i]).Index].InchHeight := Round(RMFromScreenPixels(r.Y, rmutInches) * 100) / 100 //waw
else
begin
pr := TRow(FRows[i - 1]);
if r.PageIndex = pr.PageIndex then
lSheet.Rows[TRow(FRows[i]).Index].InchHeight := Round(RMFromScreenPixels(r.Y - pr.Y, rmutInches) * 100) / 100 //waw
else
lSheet.Rows[TRow(FRows[i]).Index].InchHeight := Round(RMFromScreenPixels(r.Y, rmutInches) * 100) / 100; //waw
end;
end;
Inc(FCurPageNo); //waw
if FCurPageNo >= FPagesOfSheet then //waw
begin
FCurPageNo := 0; //waw
FrStart := 0;
end
else
begin
FrStart := FrStart + FRows.Count;
lSheet.AddPageBreakAfterRow(FrStart);
end;
for i := 0 to FDataList.Count - 1 do
begin
Application.ProcessMessages;
lDataRec := FDataList[i];
lItem := pXLSExport(pe[i]);
lFlag := True;
for k := i + 1 to FDataList.Count - 1 do
begin
Application.ProcessMessages;
lDataRec1 := FDataList[k];
if (lDataRec1.Left >= lDataRec.Left) and (lDataRec1.Top >= lDataRec.Top) and
(lDataRec1.Left + lDataRec1.Width <= lDataRec.Left + lDataRec.Width) and
(lDataRec1.Top + lDataRec1.Height <= lDataRec.Top + lDataRec.Height) then
begin
lFlag := False;
Break;
end;
end;
if lFlag then
begin
case lDataRec.ObjType of
rmotMemo: _ExportText;
rmotPicture: _ExportPicture;
end;
end;
end;
finally
while pe.Count > 0 do
begin
Dispose(pXLSExport(pe[0]));
pe.Delete(0);
end;
pe.Free;
_ClearColsAndRows;
inherited; //waw 03-07-27
end;
end;
procedure TRMXLSExport.SaveToFile(const aFileName: string);
var
Writer: TwawCustomWriter; //By waw
begin
if FWorkBook = nil then exit;
if ExtractFileExt(aFileName) = '.xls' then
Writer := TwawExcelWriter.Create //By waw
else
Writer := TwawHTMLWriter.Create; //By waw
try
Writer.Save(FWorkBook, aFileName); //By waw
finally
Writer.Free; //By waw
end;
FWorkBook.Free; //By waw
FWorkBook := nil;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMXLSExportForm }
procedure TRMXLSExportForm.Localize;
begin
Font.Name := RMLoadStr(SRMDefaultFontName);
Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
Font.Charset := StrToInt(RMLoadStr(SCharset));
RMSetStrProp(chkExportImages, 'Caption', rmRes + 1821);
RMSetStrProp(lblExportImageFormat, 'Caption', rmRes + 1816);
RMSetStrProp(lblJPEGQuality, 'Caption', rmRes + 1814);
RMSetStrProp(Label4, 'Caption', rmRes + 1788);
RMSetStrProp(GroupBox1, 'Caption', rmRes + 044);
RMSetStrProp(rdbPrintAll, 'Caption', rmRes + 045);
RMSetStrProp(rbdPrintCurPage, 'Caption', rmRes + 046);
RMSetStrProp(rbdPrintPages, 'Caption', rmRes + 047);
RMSetStrProp(Label2, 'Caption', rmRes + 048);
RMSetStrProp(GroupBox2, 'Caption', rmRes + 379);
RMSetStrProp(Label1, 'Caption', rmRes + 378);
RMSetStrProp(chkShowAfterGenerate, 'Caption', rmRes + 380);
// RMSetStrProp(chkExportFrames, 'Caption', rmRes + 381); //显示导出过程
RMSetStrProp(chkExportFrames, 'Caption', rmRes + 1803); //导出框线
// RMSetStrProp(chkMultiSheet, 'Caption', rmRes + 382); //waw
RMSetStrProp(Label3, 'Caption', rmRes + 382); //waw
RMSetStrProp(Self, 'Caption', rmRes + 1779);
btnOK.Caption := RMLoadStr(SOk);
btnCancel.Caption := RMLoadStr(SCancel);
end;
function TRMXLSExportForm.GetExportPages: string;
begin
Result := '';
if rbdPrintCurPage.Checked then
Result := 'CURPAGE'
else if rbdPrintPages.Checked then
Result := edtPages.Text;
end;
procedure TRMXLSExportForm.FormCreate(Sender: TObject);
begin
Localize;
cmbImageFormat.Items.Clear;
{$IFDEF RXGIF}
cmbImageFormat.Items.AddObject(ImageFormats[ifGIF], TObject(ifGIF));
{$ENDIF}
{$IFDEF JPEG}
cmbImageFormat.Items.AddObject(ImageFormats[ifJPG], TObject(ifJPG));
{$ENDIF}
cmbImageFormat.Items.AddObject(ImageFormats[ifBMP], TObject(ifBMP));
cmbImageFormat.ItemIndex := 0;
end;
procedure TRMXLSExportForm.btnFileNameClick(Sender: TObject);
begin
SaveDialog.FileName := edtExportFileName.Text;
if SaveDialog.Execute then
edtExportFileName.Text := SaveDialog.FileName;
end;
procedure TRMXLSExportForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if (ModalResult = mrOK) and (edtExportFileName.Text = '') then
CanClose := False;
end;
procedure TRMXLSExportForm.rbdPrintPagesClick(Sender: TObject);
begin
edtPages.SetFocus;
end;
procedure TRMXLSExportForm.edtPagesEnter(Sender: TObject);
begin
rbdPrintPages.Checked := True;
end;
procedure TRMXLSExportForm.chkExportFramesClick(Sender: TObject);
begin
RMSetControlsEnable(gbExportImages, chkExportImages.Checked);
cmbImageFormatChange(Sender);
end;
procedure TRMXLSExportForm.edJPEGQualityKeyPress(Sender: TObject;
var Key: Char);
begin
if not (Key in ['0'..'9', #8]) then
Key := #0;
end;
procedure TRMXLSExportForm.cmbImageFormatChange(Sender: TObject);
begin
if chkExportImages.Checked and (cmbImageFormat.Text = ImageFormats[ifJPG]) then
begin
lblJPEGQuality.Enabled := True;
edJPEGQuality.Enabled := True;
edJPEGQuality.Color := clWindow;
end
else
begin
lblJPEGQuality.Enabled := False;
edJPEGQuality.Enabled := False;
edJPEGQuality.Color := clInactiveBorder;
end;
end;
initialization
finalization
{$ENDIF}
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?