delphi 导出 excel
procedure Tfrm_main.XLGW_Excel(p_int_Row_Begin, p_int_Col_Begin,
p_int_Row_End, p_int_Col_End: Integer; p_str_Value, p_str: String);
var
m_Query : TADOQuery;
m_StringList_FieldNames : TStringList;
m_int,rowid : Integer;
m_int_Row : Integer;
ExcelApp,ExcelObj:TExcel; //引用excel单元
m_str,Astr : String;
HJXLCD:string;
i:Integer; //用于控制列宽变量
begin
m_Query := TADOQuery.Create(nil);
ExcelObj:=TExcel.Create;
try
{填写表头}
m_Query.Connection:= sqlclass.conn;
m_str := p_str;
m_Query.Close;
m_Query.SQL.Clear;
m_Query.SQL.Add(m_str);
try
m_Query.Open;
except
ShowMessage('报表输出失败,请重新计算!');
Exit;
end;
if m_Query.IsEmpty then
begin
ShowMessage('没有要导出的数据!');
Exit;
end;
if not ExcelObj.New_WorkBook then //显示工作薄
begin
ShowMessage('新建工作簿失败');
Exit;
end;
try
//页面设置 //纵向xlPortrait //横向xlLandscape
ExcelObj.SetSheetPage(xlPaperA4,xlLandscape,0.6,0.6,0.6,0.6,0.3,0.3);
except
end;
ExcelObj.IsVisible(True); //控制是否显示Excel
m_StringList_FieldNames := TStringList.Create;
m_Query.GetFieldNames(m_StringList_FieldNames);
ExcelObj .SetCell('序号',2,1,0);
for m_int := 1 to m_StringList_FieldNames.Count do
begin
//设置指定单元格的值
ExcelObj.SetCell(m_StringList_FieldNames.Strings[m_int - 1],2, m_int+1,0);
end;
{写入数据}
rowid :=0;
m_int_Row := 3; //行
while not m_Query.Eof do
begin
rowid:=rowid+1;
ExcelObj.SetCell(IntToStr(rowid),m_int_Row, 1,1); //加序号
for m_int := 1 to m_StringList_FieldNames.Count do
begin
//判断输出字段类型
// (0:字符型;1:整形;2,3:数值型) 增加清零操作
Astr:= m_Query.FieldByName(m_StringList_FieldNames.Strings[m_int - 1]).AsString;
{ if m_Query.Fields[m_int - 1].DataType in [ftSmallint, ftInteger,ftBCD ] then
begin
if (Astr = '') or (StrtoInt(Astr)=0) then
begin
Continue;
end;
//ExcelObj.SetCell(Astr,m_int_Row, m_int+1,1); //weixing 20100707
end
else }
if m_Query.Fields[m_int - 1].DataType in [ftWord,ftFloat] then
begin
if (Astr = '') or (StrtoFloat(Astr)=0) then
begin
Continue;
end;
ExcelObj.SetCell(Astr,m_int_Row, m_int+1,2);
end
else if m_Query.Fields[m_int - 1].DataType in [ftInteger] then //weixing 20100707
begin
if (Astr = '') or (StrtoFloat(Astr)=0) then
begin
Continue;
end;
ExcelObj.SetCell(Astr,m_int_Row, m_int+1,1);
end
else
begin
ExcelObj.SetCell(Astr,m_int_Row, m_int+1,0);
end;//if
end; //if
// end;//for
m_int_Row := m_int_Row + 1;
m_Query.Next;
end;//While
for i:=1 to 13 do
begin
if (i=1) then
ExcelObj.SetColumnWidth(i,24)
else
ExcelObj.SetColumnWidth(i,7);
end;
for m_int:=1 to m_int_Row-1 do
begin
ExcelObj.SetRowHeight(m_int,18); //设置指定行的行高
//单元格居中
ExcelObj.SetRowHorizontalAlignment(m_int,xlHAlignCenter);
ExcelObj.SetRowVerticalAlignment(m_int,xlHAlignCenter);
end;
p_int_Col_End:=m_StringList_FieldNames.Count;
{设置表格函数}
ExcelObj.MergeCells(p_int_Row_Begin, p_int_Col_Begin,p_int_Row_End, p_int_Col_End);//合并单元格
//设置标题指定范围的值
ExcelObj.SetRangeValue(1,1,p_int_Row_Begin, p_int_Col_Begin,p_str_Value);
//生成标题参数设置
ExcelObj.SetRowFontStyle(p_int_Row_Begin,'加粗','宋体',0,15);
//标题行高
ExcelObj.SetRowHeight(1,33); //设置指定行的行高
//加单元格
ExcelObj.SetRangeOutBorderStyle(2,1,m_int_Row-1, m_StringList_FieldNames.Count+1,2,0,1);//单元格外部加边线
ExcelObj.SetRangeInnerLineStyle(2,1,m_int_Row-1, m_StringList_FieldNames.Count+1,2,0,1);//单元格内部加边线
ExcelObj.SetRangeAutoWrap(3,1,3, m_StringList_FieldNames.Count);//指定行自动换行
//ExcelObj.SetRowFontStyle(3,'加粗','宋体',0,12);//生成排头参数设置
//最后一行合计所有数值字段
//ExcelObj.SetRangeValue(m_int_Row,1,m_int_Row,1,'合计'); //往单元格写入'合计';
{ for m_int := 1 to m_StringList_FieldNames.Count do
//行列号为: m_int_Row,m_int ;
begin
if m_Query.Fields[m_int - 1].DataType in [ftSmallint, ftInteger, ftWord,ftFloat,ftBCD] then
begin
HJXLCD:=FloatToStr(ExcelObj.Sum(4,m_int,m_int_Row,m_int)); //合计线路长度
ExcelObj.SetRangeValue(m_int_Row,m_int,m_int_Row,m_int,HJXLCD);
end;
end; }
ExcelObj.CellAutoFit;//自动列宽
m_StringList_FieldNames.free;
finally
m_Query.Free;
ExcelObj.Destroy;
end;
end;
p_int_Row_End, p_int_Col_End: Integer; p_str_Value, p_str: String);
var
m_Query : TADOQuery;
m_StringList_FieldNames : TStringList;
m_int,rowid : Integer;
m_int_Row : Integer;
ExcelApp,ExcelObj:TExcel; //引用excel单元
m_str,Astr : String;
HJXLCD:string;
i:Integer; //用于控制列宽变量
begin
m_Query := TADOQuery.Create(nil);
ExcelObj:=TExcel.Create;
try
{填写表头}
m_Query.Connection:= sqlclass.conn;
m_str := p_str;
m_Query.Close;
m_Query.SQL.Clear;
m_Query.SQL.Add(m_str);
try
m_Query.Open;
except
ShowMessage('报表输出失败,请重新计算!');
Exit;
end;
if m_Query.IsEmpty then
begin
ShowMessage('没有要导出的数据!');
Exit;
end;
if not ExcelObj.New_WorkBook then //显示工作薄
begin
ShowMessage('新建工作簿失败');
Exit;
end;
try
//页面设置 //纵向xlPortrait //横向xlLandscape
ExcelObj.SetSheetPage(xlPaperA4,xlLandscape,0.6,0.6,0.6,0.6,0.3,0.3);
except
end;
ExcelObj.IsVisible(True); //控制是否显示Excel
m_StringList_FieldNames := TStringList.Create;
m_Query.GetFieldNames(m_StringList_FieldNames);
ExcelObj .SetCell('序号',2,1,0);
for m_int := 1 to m_StringList_FieldNames.Count do
begin
//设置指定单元格的值
ExcelObj.SetCell(m_StringList_FieldNames.Strings[m_int - 1],2, m_int+1,0);
end;
{写入数据}
rowid :=0;
m_int_Row := 3; //行
while not m_Query.Eof do
begin
rowid:=rowid+1;
ExcelObj.SetCell(IntToStr(rowid),m_int_Row, 1,1); //加序号
for m_int := 1 to m_StringList_FieldNames.Count do
begin
//判断输出字段类型
// (0:字符型;1:整形;2,3:数值型) 增加清零操作
Astr:= m_Query.FieldByName(m_StringList_FieldNames.Strings[m_int - 1]).AsString;
{ if m_Query.Fields[m_int - 1].DataType in [ftSmallint, ftInteger,ftBCD ] then
begin
if (Astr = '') or (StrtoInt(Astr)=0) then
begin
Continue;
end;
//ExcelObj.SetCell(Astr,m_int_Row, m_int+1,1); //weixing 20100707
end
else }
if m_Query.Fields[m_int - 1].DataType in [ftWord,ftFloat] then
begin
if (Astr = '') or (StrtoFloat(Astr)=0) then
begin
Continue;
end;
ExcelObj.SetCell(Astr,m_int_Row, m_int+1,2);
end
else if m_Query.Fields[m_int - 1].DataType in [ftInteger] then //weixing 20100707
begin
if (Astr = '') or (StrtoFloat(Astr)=0) then
begin
Continue;
end;
ExcelObj.SetCell(Astr,m_int_Row, m_int+1,1);
end
else
begin
ExcelObj.SetCell(Astr,m_int_Row, m_int+1,0);
end;//if
end; //if
// end;//for
m_int_Row := m_int_Row + 1;
m_Query.Next;
end;//While
for i:=1 to 13 do
begin
if (i=1) then
ExcelObj.SetColumnWidth(i,24)
else
ExcelObj.SetColumnWidth(i,7);
end;
for m_int:=1 to m_int_Row-1 do
begin
ExcelObj.SetRowHeight(m_int,18); //设置指定行的行高
//单元格居中
ExcelObj.SetRowHorizontalAlignment(m_int,xlHAlignCenter);
ExcelObj.SetRowVerticalAlignment(m_int,xlHAlignCenter);
end;
p_int_Col_End:=m_StringList_FieldNames.Count;
{设置表格函数}
ExcelObj.MergeCells(p_int_Row_Begin, p_int_Col_Begin,p_int_Row_End, p_int_Col_End);//合并单元格
//设置标题指定范围的值
ExcelObj.SetRangeValue(1,1,p_int_Row_Begin, p_int_Col_Begin,p_str_Value);
//生成标题参数设置
ExcelObj.SetRowFontStyle(p_int_Row_Begin,'加粗','宋体',0,15);
//标题行高
ExcelObj.SetRowHeight(1,33); //设置指定行的行高
//加单元格
ExcelObj.SetRangeOutBorderStyle(2,1,m_int_Row-1, m_StringList_FieldNames.Count+1,2,0,1);//单元格外部加边线
ExcelObj.SetRangeInnerLineStyle(2,1,m_int_Row-1, m_StringList_FieldNames.Count+1,2,0,1);//单元格内部加边线
ExcelObj.SetRangeAutoWrap(3,1,3, m_StringList_FieldNames.Count);//指定行自动换行
//ExcelObj.SetRowFontStyle(3,'加粗','宋体',0,12);//生成排头参数设置
//最后一行合计所有数值字段
//ExcelObj.SetRangeValue(m_int_Row,1,m_int_Row,1,'合计'); //往单元格写入'合计';
{ for m_int := 1 to m_StringList_FieldNames.Count do
//行列号为: m_int_Row,m_int ;
begin
if m_Query.Fields[m_int - 1].DataType in [ftSmallint, ftInteger, ftWord,ftFloat,ftBCD] then
begin
HJXLCD:=FloatToStr(ExcelObj.Sum(4,m_int,m_int_Row,m_int)); //合计线路长度
ExcelObj.SetRangeValue(m_int_Row,m_int,m_int_Row,m_int,HJXLCD);
end;
end; }
ExcelObj.CellAutoFit;//自动列宽
m_StringList_FieldNames.free;
finally
m_Query.Free;
ExcelObj.Destroy;
end;
end;
{利用OLE技术实现的与Excel应用程序的接口
可以实现表格设计,数据输出,模板定制,
打印设置,打印预览,打印表格等功能;}
unit Excel_Unit;{单元名称}
interface{接口部分}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Excel97,OleServer, StdCtrls,Variants,ExcelConst_Unit,ComObj;
const
//报表平面图参数
pm_Title = '配 电 线 路 条 图';
pm_PageRows = 21;
pm_PageOffset = 530;// //页与页之间图形距离
pm_LineLeft = 123; //线起始left
pm_LineTop = 72;//74; //线起始top
pm_LineRight = 727;//705; //线终止right //水平所以没有y坐标
pm_GanFirstLeft = 118; //最左第一个杆的left坐标
pm_GanOffset = 60; //杆间距
pm_GanTop = 166;//67; //杆距顶top
pm_GanD = 10; //杆径 12
pm_BYQD = 13;//14; //变压器大小 13
pm_BYQY = -7; //变压器距杆距离 20
pm_Distance = 27;//30; //转角箭头线段长
dm_GanTop = 143.25; //断面杆
dm_HaiBa = 0; //海拔
dm_HuChui = 5; //导线下垂弧度
//下面记录类型用于绘制平断面图
type
TRecData = record
XLMC: String; //线路名称
GH: String; //杆号
GX: String; //电杆种类及杆型
GG: String; //杆高
MS: String; //埋深
DXPL: String; //导线排列
DXXH: String; //导线型号
DJ: String; //档距
LJCD: String; //累计长度
ZJBZ: Integer; //画转角标志 1: 画转角 0: 不画转角
ZJ: String; //线路转角
JCKY: String; //交叉跨越
CZJL: String; //垂直距离
HDGG: String; //横担规格
LXWZ: String; //拉线位置
LXXHGS: String; //拉线型号/根数
JYZXHSL: String;//绝缘子型号/数量
GZZSY: String; //故障指示仪
BTXS: String; //变台型式
PBRL: String; //配变容量
HM: String; //户名
BLQGG: String; //避雷器规格
BLQSL: String; //避雷器数量
KGGG: String; //开关规格
KGSL: String; //开关数量
FZ1ZJ: String; //分支1转角
FZ2ZJ: String; //分支2转角
FZ1MC: String; //分支1名称
FZ2MC: String; //分支2名称
IsCable: Integer; //是否有电缆 1: 电缆 0: 不是电缆
IsTJPole: Integer; //是否是引出分支杆
end;
PRecData = ^TRecData;
type
TWindowObject = record
WinHandle : HWnd; {Window Handle}
WinCaption : String; {Window Caption Text (If any)}
ProcessID : Integer; {Process the window belongs to}
IsVisible : Boolean; {Is the window visible?}
IsEnabled : Boolean; {Is the window enabled for mouse/keyboard input?}
IsIconic : Boolean; {Is the window minimized?}
WindowRect : TRect; {Window Dimensions}
{Add more properties here if you like,
then fill them in at the WindowCallback
function.}
end;
PTWindowObject = ^TWindowObject;
//Excel操作类
TExcel = class(TObject)
private
MyExcel: Variant; //存储Excel对象
Book :Variant; //当前工作表
Sheet:Variant; //当前工作表
protected
{ protected declarations }
function GetRowNum(TStr:string):Integer; //获取指定单元格的行号()
function GetColNum(TStr:string):Integer; //获取指定单元格的行号
public
{ Public declarations }
IsPageSetup:Boolean; //是否进行了页面设置
Template_Path:string; //模板路径
Template_Name:string; //模板名称
Template_OpenName:String; //打开的模板的名称
ActiveSheet:Integer; //当前活动的页
UsedRowBeg:Integer; //当前已使用的起始行
UsedColBeg:Integer; //当前已使用的起始列
UsedRowEnd:Integer; //当前已使用的终止行
UsedColEnd:Integer; //当前已使用的终止列
CurRowBeg:Integer; //要使用的起始行
CurColBeg:Integer; //要使用的起始列
CurRowEnd:Integer; //要使用的终止行
CurColEnd:Integer; //要使用的终止列
//下面为类操作
Constructor Create(); //创建Excel对象
Destructor Destroy; virtual; //释放Excel对象
//Excel操作
procedure IsVisible(IsOrNo:Boolean); //控制Excel是否显示
procedure IsAlert(IsOrNo:Boolean); //控制Excel是否出现警告存盘的对话框
function SetActiveWindowGridVisible(IsVisible:Boolean=True):Boolean; //设置当前窗口网格的显示与否
function SaveToFile(AFileName:string):Boolean; //Excel数据保存到文件
procedure ExitExcel; //退出Excel
//工作簿操作
function New_WorkBook:Boolean; //新建工作簿
function OpenExcelFile(FileName:string): Boolean; //打开指定的Excel文件
function IsWorkbookExit:Integer; //判断是否存在工作簿
//工作表操作
function SetCurrentSheet(SheetNum:Integer):Boolean; //设置当前工作表
function GetSheetsNameList(var FileName:TstringList):Boolean; //得到工作簿中工作表名称列表
function GetSheetRange:string; //获取当前工作表中的工作范围
function SetSheetPage(APageType,Orientation:Integer;LeftMargin,RightMargin,TopMargin,
BottomMargin,HeaderMargin,FooterMargin:Double):Boolean; //对指定的工作表进行页面设置
//Range或Cell操作
function GetCell(Row,Col:Integer):Variant; //得到当前工作表中某行某列的值
procedure SetCell(Value: String; Row, Col: Integer;AType:Integer); //设置指定单元格的值
function GetRangeValue(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):String; //获取指定范围的值
function SetRangeValue(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;AValue:string):Boolean; //设置指定范围的值
function InsertPicIntoSheet(ABeginRow,ABeginCol:Integer;APicFile:String):Boolean;//向指定工作表中插入图片
function Sum(BeginRow,BeginCol,EndRow,EndCol:Integer):Double; //对指定单元格间的值求和
//文本框操作
function InsertTextBox(AX,AY,AWidth,AHeight:Double;AOrient:Integer=msoTextOrientationHorizontalRotatedFarEast):Variant;//在指定位置插入文本框
function SetTextBoxFillStyle(ATextBox:Variant;AVisible:Integer;ATransparency:Double=0):Boolean; //设置文本框填充样式
function SetTextBoxLineStyle(ATextBox:Variant;AVisible:Integer;ATransparency:Double=0):Boolean; //设置文本框边框样式
function SetTextBoxFontStyle(ATextBox:Variant;AFontName,AFontStyle:String;
AFontSize:Integer = 12;AFontColor:Integer=0):Boolean; //设置文本框中字体样式
function SetTextBoxAlignment(ATextBox:Variant;HAlign:Integer=xlLeft;VAlign:Integer=xlBottom):Boolean; //设置文本框水平和垂直对齐方式
function SetTextBoxText(ATextBox:Variant;AText:string):Boolean; //设置文本框中文字内容
//格式化单元格操作
function MergeCells(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Variant; //合并单元格
procedure CellAutoFit; //设置单元格为自动列宽
//格式化行高和列宽
function SetColumnWidth(AColNum:Integer;AColWidth:Double):Boolean; //设置指定列的宽度
function SetRowHeight(ARowNum:Integer;ARowHeight:Double):Boolean; //设置指定行的行高
function SetRangeColWidth(ABeginRow,ABeginCol,AEndRow,AEndCol:Integer;AColWidth:Double):Boolean; //设置指定范围内单元格的列宽
//格式化指定区域范围
function SetRangeFontStyle(BeginRow,BeginCol,EndRow, EndCol:Integer;
AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean; //设置范围
function SetRowFontStyle(ARowNum:Integer;AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean; //设置指定行的字体样式
function SetColumnFontStyle(AColNum:Integer;AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean; //设置指定列的字体样式
function SetRangeOutBorderStyle(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
AWeight:Integer=2;ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean; //设置指定范围的外边框样式
function SetRowOutBorderStyle(ARowNum:Integer;AWeight:Integer=2;
ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean; //设置指定行的外边框样式
function SetColumnOutBorderStyle(AColNum:Integer;AWeight:Integer=2;ALineColor:Integer=0; //设置指定列的外边框样式
ALineStyle:Integer=xlContinuous):Boolean;
function SetRangeInnerLineStyle(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
AWeight:Integer=2;ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean; //设置指定范围的分隔线样式
function SetRowInnerLineStyle(ARowNum:Integer;AWeight:Integer=2;ALineColor:Integer=0;
ALineStyle:Integer=xlContinuous):Boolean; //设置指定行的分隔线样式
function SetColumnInnerLineStyle(AColNum:Integer;AWeight:Integer=2;ALineColor:Integer=0;
ALineStyle:Integer=xlContinuous):Boolean; //设置指定列的分隔线样式
function SetRangeHorizontalAlignment(ABegRowNum,ABegColNum,AEndRowNum,
AEndColNum:Integer;AAlign:Integer=xlLeft):Boolean; //设置范围的水平对其方式
function SetRangeVerticalAlignment(ABegRowNum,ABegColNum,AEndRowNum,
AEndColNum:Integer;AAlign:Integer=xlBottom):Boolean; //设置范围的垂直对其方式
function SetRowHorizontalAlignment(ARowNum:Integer;AAlign:Integer=xlLeft):Boolean; //设置指定行的水平对其方式
function SetRowVerticalAlignment(ARowNum:Integer;AAlign:Integer=xlBottom):Boolean; //设置指定行的垂直平对其方式
function SetColumnHorizontalAlignment(AColNum:Integer;AAlign:Integer=xlLeft):Boolean; //设置指定列的水平对其方式
function SetColumnVerticalAlignment(AColNum:Integer;AAlign:Integer=xlBottom):Boolean; //设置指定列的垂直对其方式
function SetRangeAutoWrap(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Boolean; //设置指定区域格式为自动换行
function CancelRangeAutoWrap(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Boolean; //取消指定区域的自动换行
function SetRangeBackGround(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
APattern:Integer=xlSolid;APatternColor:Integer=xlNone;ABackColor:Integer=xlNone):Boolean; //设置指定范围的背景图案
//格式化箭头线
function FormatArrowLineEndHead(ALine:Variant;AheadStyle:Integer=msoArrowheadTriangle;
AheadLength:Integer=msoArrowheadLengthMedium;AheadWidth:Integer=msoArrowheadWidthMedium):Boolean; //格式化箭头线的末端样式
function FormatArrowLineBeginHead(ALine:Variant;AheadStyle:Integer=msoArrowheadTriangle;
AheadLength:Integer=msoArrowheadLengthMedium;AheadWidth:Integer=msoArrowheadWidthMedium):Boolean; //格式化箭头线的首端样式
function FormatArrowLine(ALine:Variant;AWidth:Double=1.5;AStyle:Integer=msoLineSingle;ADashStyle:Integer=msoLineSolid):Boolean; //格式化箭头线的线样式
//数据库中数据转为Excel操作
procedure SetTheFieldsName(AFields:TStringList;BeginRow,BeginCol,FieldNumber:Integer;IsNeedXuHao:Boolean); //设置Excel工作表中的列名
procedure TransferDataToExcel(FieldValues:Array of TStringList;BeginRow,BeginCol,FieldNumber,RcdNumber:Integer;IsNeedXuHao:Boolean); //转换数据到Excel
procedure DataToExcelUpPage(FieldValues:Array of TStringList;BeginRow,BeginCol,FieldNumber,
RcdNumber:Integer;IsNeedXuHao:Boolean;IsHengXiangOrZongXiang:Boolean=False); //使用Excel将指定的数据打印输出
//
procedure Print_PageSetup(); //打印页面设置
procedure Print_PrintView; //打印预览
procedure Print_PrintOut; //打印输出
//
function Get_Template_Path():String; //获取模板路径
procedure Set_Template_Path(PathName:String); //设置模板路径
procedure Set_Template_OpenName(TemplateName:String); //设置打开模板的名称
function Open_Template():Variant; //打开模板
procedure Save_Template(); //保存模板
//
procedure SetTableTitle(TitleName:String;BeginRow,BeginCol,Row,Col,FontSize:integer;
IsNeedXuHao:Boolean=False;IsNeedFrame:Boolean=True); //设置表的标题(表头)
//绘制平断面图
procedure CreatePage(APage: Integer;ABDZMC, AXLMC: String;AValueList: TStringList); //创建页
procedure FormatCells(APage, AColNum, ARow: Integer;AColName: String
;AValueList: TStringList); //绘制平断面图时根据不同情况格式化单元格
procedure GetCellDMGanCoord(APage, ACellIndex: Integer;var AX, AY: Double); //获取指定页,指定cell的断面杆的中心坐标
procedure CreateDMT(AX1, AY1, AGanGao: Double;AIsTJPole, AIsFirstPole,
AIsCable: Boolean;var AOldY2: Double); //创建断面图
procedure GetCellGanCoord(APage, ACellIndex: Integer;var AX, AY: Double); //获取指定页,指定cell的杆的中心坐标
procedure CreateFZLine(AX, AY,AYOffSet,AAngle: Double;AXLMC: String); //画分支 创建转角箭头线
procedure CreateArrowheadLine(AX, AY, AAngle: Double); //创建转角箭头线
function DoubleToFenMiao(Jiao:Double):string; //双精度的度转换为度分秒
procedure DrawBYQText(AX, AY : Double;AText: String); //绘制变压器文本
procedure DrawBYQ(AX, AY : Double); //绘制变压器
function GetPoleHight(AHight: Double): Double; //以15米杆高为标准计算d当前杆塔图形高度
//暂不使用的功能
function FindTheExcelMainWindow:Integer; //辅助工程找出当前系统环境中的运行的excel的主窗体句柄:
procedure DisableSystemCloseBox; //使当前Excel应用程序的关闭按钮失效
//
Published
{ Published declarations }
end;
const
RcdCountOfEachPageOfHengXiang=22;
RcdCountOfEachPageOfZongXiang=44;
var
MyWindowPtr : ^TWindowObject;
V_PageOffset: Double;
implementation {实现部分}
{ Excel }
{
功能描述:创建Excel对象
输入参数: 无
输出参数:无
创建时间: 2006-04-07
创建人: 赵占轻
}
constructor TExcel.Create();
begin
Inherited;
try
MyExcel:=CreateOleObject('Excel.Application'); //创建Excel对象
except
end;
//
// New(MyWindowPtr);
//
end;
{
功能描述:使用Excel将指定的数据打印输出
输入参数:FieldValues 待输出的数据列表
BeginRow 起始行号
BeginCol 起始列号
FieldNumber 字段数
RcdNumber 记录数
IsNeedXuHao 是否需要序号
IsHengXiangOrZongXiang 纵向还是横向 (True:纵向False:横向)
输出参数:无
创建时间:2006-04-13
创建人: 赵占轻
}
procedure TExcel.DataToExcelUpPage(FieldValues: array of TStringList; BeginRow,
BeginCol, FieldNumber, RcdNumber: Integer; IsNeedXuHao: Boolean;IsHengXiangOrZongXiang:Boolean=False);
var
nPageNumber,nLastPageRcdCount,i,nTmp:Integer;
vSheet:Variant;
begin
if IsHengXiangOrZongXiang then
begin
nLastPageRcdCount:=(RcdNumber mod RcdCountOfEachPageOfZongXiang);
nPageNumber:=((RcdNumber-nLastPageRcdCount) div RcdCountOfEachPageOfZongXiang);
ntmp:=RcdCountOfEachPageOfZongXiang;
end else
begin
nLastPageRcdCount:=(RcdNumber mod RcdCountOfEachPageOfHengXiang);
nPageNumber:=((RcdNumber-nLastPageRcdCount) div RcdCountOfEachPageOfHengXiang);
nTmp:=RcdCountOfEachPageOfHengXiang;
end;//
//循环执行打印工作:
for i:=1 to nPageNumber do
begin
try
vSheet:=Open_Template; //打开模板
except
MyExcel.Quit;
Exit;
end;//
TransferDataToExcel(FieldValues,BeginRow,BeginCol,FieldNumber,ntmp,IsNeedXuHao); //数据输出到Excel
try
Print_PrintOut; //从Excel中打印输出
except
ShowMessage('打印机错误,请检查你的打印机设备是否正常!');
Exit;
end;//
end;//
//执行剩余打印工作:
if nLastPageRcdCount>0 then
begin
try
vSheet:=Open_Template;
except
MyExcel.Quit;
Exit;
end;//
TransferDataToExcel(FieldValues,BeginRow,BeginCol,FieldNumber,nLastPageRcdCount,IsNeedXuHao);
try
Print_PrintOut;
except
ShowMessage('打印机错误,请检查你的打印机设备是否正常!');
Exit;
end;//
end;//
end;
{
功能描述:释放Excel对象变量
输入参数:无
输出参数: 无
创建时间:2006-04-07
创建人: 赵占轻
}
destructor TExcel.Destroy;
begin
//
inherited;
MyExcel:=UnAssigned;
end;
{
功能描述:使Excel程序关闭按钮失效
输入参数:无
输出参数:无
创建时间:2006-04-18
创建人: 刘惠城
}
procedure TExcel.DisableSystemCloseBox;
var
hExcelWindow : HWND;
hSysMenu : HMENU;
nrlt:Integer;
begin
// Find the Excel2000 handle
nrlt:=FindTheExcelMainWindow;
if nrlt=0 then
begin
Exit;
end
else
begin
hExcelWindow:=MyWindowPtr.WinHandle;
end;//
if hExcelWindow <> 0 then
begin
hSysMenu := GetSystemMenu (hExcelWindow, false);
EnableMenuItem (hSysMenu, SC_CLOSE, MF_DISABLED)
end;
end;
//-------------------------------------------------------------------------//
{
功能描述:退出Excel
输入参数:无
输出参数:无
创建时间:2003-11-09
创建人: 徐伟亮
}
procedure TExcel.ExitExcel;
begin
try
Book.Saved:=True; //自动退出Excel时保存修改内容
except
end;
MyExcel.Quit;
end;
{
功能描述:辅助工程找出当前系统环境中的运行的excel的主窗体句柄
输入参数:无
输出参数:1:找到结果;0:未找到结果
创建时间:2006-04-18
创建人: 刘惠城
}
function TExcel.FindTheExcelMainWindow:Integer;//will alter
function WindowCallback(WHandle : HWnd; Var Parm : Pointer) : Boolean; stdcall;
{This function is called once for each window}
Var MyString : PChar;
MyInt : Integer;
caption1:PChar;
begin
caption1:='Microsoft Excel';
MyString := Allocmem(255);
GetWindowText(WHandle,MyString,255);
if StrPos(MyString,caption1)=nil then
begin
//FreeMem(caption1,16);
Result := True;//Not find,continue to enumerate windows;
Exit;
end;//
//
{Window Handle (Passed by the enumeration)}
MyWindowPtr.WinHandle := WHandle;
{Window text}
MyWindowPtr.WinCaption := String(MyString);
FreeMem(MyString,255);
{Process ID}
MyInt := 0;
MyWindowPtr.ProcessID := GetWindowThreadProcessId(WHandle,@MyInt);
{Visiblity}
MyWindowPtr.IsVisible := IsWindowVisible(WHandle);
{Enabled}
MyWindowPtr.IsEnabled := IsWindowEnabled(WHandle);
{Iconic}
MyWindowPtr.IsIconic := IsIconic(WHandle);
{Window Dimensions}
MyWindowPtr.WindowRect := Rect(0,0,0,0);
GetWindowRect(WHandle,MyWindowPtr.WindowRect);
//
Result := False; {Everything's okay.Stop to enumerate windows}
end;
//
begin
//
EnumWindows(@WindowCallback,0);
if MyWindowPtr.WinHandle = 0 then
begin
Result:=0;
end else
begin
Result:=1;
end;
end;
{
功能描述:获取模板路径
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
function TExcel.Get_Template_Path: String;
begin
//
Result:=Template_Path;
end;
{
功能描述:控制是否出现警告存盘的对话框;
输入参数:IsOrNo:控制是否显示提示框
(True:显示提示框;False:不显示提示框)
输出参数:无
创建时间:2006-04-07
创建人: 赵占轻
}
procedure TExcel.IsAlert(IsOrNo: Boolean);
begin
MyExcel.DisplayAlerts:=IsOrNo; //是否出现警告存盘的对话框;
end;
{
功能描述:控制是否显示Excel
输入参数:IsOrNo:
(True:显示Excel;False:不显示Excel)
输出参数:无
创建日期:2003-10-20
创建人: 赵占轻
}
procedure TExcel.IsVisible(IsOrNo: Boolean);
begin
if IsOrNo then
begin
MyExcel.Visible:= True;
end else
begin
MyExcel.Visible :=False;
end;
end;
{
功能描述:判断是否存在工作簿
输入参数:无
输出参数:0:不存在工作簿;1:存在工作簿
创建时间:2006-04-07
创建人: 赵占轻
}
function TExcel.IsWorkbookExit: Integer;
var
nBookCount:Integer;
begin
nBookCount:=MyExcel.Workbooks.Count; //获取工作簿数量
if nBookCount<=0 then
begin
Result:=0;
Exit;
end;//
Result:=1;
end;
{
功能描述:新建工作簿
输入参数:无
输出参数:执行成功返回真否则返回假
创建时间:2006-04-14
创建人: 赵占轻
}
function TExcel.New_WorkBook:Boolean;
begin
{在启动Excel之前,最好将以前运行的实例关闭
因为有时会出现异常的情况;}
//启动Excel应用程序:
Result:=False;
try
if MyExcel.Workbooks.Count>=1 then //如果Excel已经启动,
begin //且工作薄存在,则置
Book:=MyExcel.Workbooks[1]; //第一个工作薄为当前
Sheet:=MyExcel.Workbooks [1].Worksheets[1];//工作薄;
Exit;
end;//
Book:=MyExcel.Workbooks.Add;
if MyExcel.Worksheets.Count>=1 then
begin
Sheet:=Book.Worksheets.Item[1];
end;
except
Exit;
end;
Result:=True;
end;
{
功能描述:打开模板
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
function TExcel.Open_Template:Variant;
var
sTmp:String;
begin
//打开模板
if MyExcel.Workbooks.Count>=1 then
begin
Book:=MyExcel.Workbooks[1];
Book.Close;
end;//
sTmp:=Template_Path+Template_OpenName;
Book:=MyExcel.Workbooks.Add (sTmp,0);
Result:=MyExcel.Workbooks [1].Worksheets[1];
end;
{
功能描述:打印页面设置
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Print_PageSetup;
begin
//打印设置
IsPageSetup:=MyExcel.Dialogs.Item[xlDialogPageSetup].Show(
EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam);
end;
{
功能描述:打印输出
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Print_PrintOut;
begin
Sheet.PrintOut(EmptyParam);
end;
{
功能描述:打印预览
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Print_PrintView;
begin
Sheet.PrintPreview;
end;
{
功能描述:保存模板
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Save_Template;
var
sTmp:String;
begin
//保存模板
sTmp:=Template_Path+Template_Name;
Book.SaveAs(sTmp,xlTemplate);
end;
{
功能描述:设置表的标题
输入参数:TitleName 标题名称
BeginRow 开始行
BeginCol 开始列
Row 所占用的行数
Col 列数
FontSize 字体大小
IsNeedXuHao 是否需要序号
IsNeedFrame 是否需要框架
输出参数:无
创建时间:2003-10-20
创建人: 赵占轻
}
procedure TExcel.SetTableTitle(TitleName: String;
BeginRow,BeginCol,Row, Col,FontSize: integer;
IsNeedXuHao:Boolean=False;IsNeedFrame:Boolean=True);
var
vRange,vCell1,vCell2:Variant;
nCol,nRow:Integer;
sTitleName:String;
begin
sTitleName:=TitleName; //记录标题名
nCol:=Col; //记录标题所占用的列数
nRow:=Row; //记录标题所占用的行数
vCell1:=Sheet.Cells[BeginRow,BeginCol]; //记录起始单元格
if IsNeedXuHao then //需要序号
begin
MergeCells(BeginRow,BeginCol,nRow,nCol+1); //合并单元格
SetRangeHorizontalAlignment(BeginRow,BeginCol,nRow,nCol+1,xlHAlignCenter);//水平对其方式为居中
SetRangeVerticalAlignment(BeginRow,BeginCol,nRow,nCol+1,xlVAlignCenter); //垂直对其方式为居中
//设置字体样式
SetRangeFontStyle(BeginRow,BeginCol,nRow,nCol+1,'正常','宋体',5,FontSize); //设置指定范围的字体样式
SetRangeValue(BeginRow,BeginCol,nRow,nCol+1,sTitleName); //设置标题
if IsNeedFrame then //需要边框
begin
SetRangeOutBorderStyle(BeginRow,BeginCol,nRow,nCol,1,0,1);
end;
end
else //不需要序号
begin
MergeCells(BeginRow,BeginCol,nRow,nCol); //合并单元格
SetRangeHorizontalAlignment(BeginRow,BeginCol,nRow,nCol,xlHAlignCenter);//水平对其方式为居中
SetRangeVerticalAlignment(BeginRow,BeginCol,nRow,nCol,xlVAlignCenter); //垂直对其方式为居中
//设置字体样式
SetRangeFontStyle(BeginRow,BeginCol,nRow,nCol,'正常','宋体',5,FontSize); //设置指定范围的字体样式
SetRangeValue(BeginRow,BeginCol,nRow,nCol,sTitleName);
if IsNeedFrame then //需要边框
begin
SetRangeOutBorderStyle(BeginRow,BeginCol,nRow,nCol,1,0,1);
end;
end;
end;
{
功能描述:设置Excel工作表中的列名
输入参数: AFields 列名列表
BeginRow 起始行号
BeginCol 起始列号
FieldNumber 列数
IsNeedXuHao 是否需要序号
输出参数:无
创建时间:2006-04-13
创建人: 赵占轻
}
procedure TExcel.SetTheFieldsName(AFields:TStringList;BeginRow,BeginCol,FieldNumber:Integer;IsNeedXuHao:Boolean);
var
vRange,vCell1,vCell2:Variant;
nCol,i,j:Integer;
sValue:String;
begin
nCol:=BeginCol+FieldNumber-1;
//从数据库中读出字段名并输出到第一列:
vCell1:=Sheet.Cells[BeginRow,BeginCol];
vCell2:=Sheet.Cells[BeginRow,nCol];
vRange:=Sheet.Range[vCell1,vCell2];
// SetRangeFontStyle(vRange,'常规','宋体',5,13); //设置指定范围的字体样式
if IsNeedXuHao then
begin
Sheet.Cells[BeginRow,BeginCol]:='序号';
for i:=BeginCol to FieldNumber do
begin
sValue:=AFields[i-1];
Sheet.Cells[BeginRow,i+1]:=sValue;
Sheet.Cells[BeginRow,i+1].Borders.LineStyle:=1;
end;
exit;
end;
//-----------------------------------------//
j:=0;
for i:=BeginCol to FieldNumber+BeginCol-1 do
begin
sValue:=AFields[j];
Sheet.Cells[BeginRow,i].Borders.LineStyle:=1;
Sheet.Cells[BeginRow,i]:=sValue;
Sheet.Cells[BeginRow,i].HorizontalAlignment:= xlHAlignCenter;
Sheet.Cells[BeginRow,i].VerticalAlignment:=xlVAlignCenter;
j:=j+1;
end;
end;
{
功能描述:设置打开模板的名称
输入参数: TemplateName:模板名称
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Set_Template_OpenName(TemplateName: String);
begin
//
Template_OpenName:=TemplateName;
end;
{
功能描述:设置模板路径
输入参数:PathName:路径名
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Set_Template_Path(PathName: String);
begin
//
Template_Path:=PathName;
end;
{
功能描述:转换数据到Excel
输入参数:FieldValues 字段值列表
BeginRow 起始行号
BeginCol 起始列号
FieldNumber 字段数
RcdNumber 记录数
IsNeedXuHao 是否需要序号
输出参数:无
创建时间:2006-04-13
创建人: 赵占轻
}
procedure TExcel.TransferDataToExcel(FieldValues:Array of TStringList; BeginRow, BeginCol,
FieldNumber,RcdNumber: Integer; IsNeedXuHao: Boolean);
var
i,j,nSerial:Integer;
sValue:String;
begin
//
//设置序号值:
if IsNeedXuHao then
begin
nSerial:=1;
for i:=BeginRow to BeginRow+RcdNumber do //
begin
//
Sheet.Cells[i,BeginCol].Borders.LineStyle:=1;
Sheet.Cells[i,BeginCol]:=nSerial;
Sheet.Cells[i,BeginCol].HorizontalAlignment:= xlHAlignCenter;
Sheet.Cells[i,BeginCol].VerticalAlignment:=xlVAlignCenter;
//
if i=BeginRow+RcdNumber-1 then
begin
break;
end;//
nSerial:=nSerial+1;
end;//
BeginCol:=BeginCol+1;
end;//
// 传输数据到Excel工作表
for i:=0 to RcdNumber-1 do
begin
for j:=0 to FieldNumber-1 do
begin
sValue:=FieldValues[i][j] ;
Sheet.Cells[BeginRow+i,BeginCol+j].Borders.LineStyle:=1;
Sheet.Cells[BeginRow+i,BeginCol+j]:=sValue;
Sheet.Cells[BeginRow+i,BeginCol+j].HorizontalAlignment:= xlHAlignCenter;
Sheet.Cells[BeginRow+i,BeginCol+j].VerticalAlignment:=xlVAlignCenter;
end;//
end;//
end;
{
功能描述:得到当前工作表中某行某列的值
输入参数:Row:指定行号;
Col:指定单元格列号
输出参数:返回指定单元格的值
创建时间:2006-04-11
创建人: 赵占轻
}
function TExcel.GetCell(Row,Col:Integer):Variant;
begin
if (Row=0) or (Col=0) then
begin
Result:=-1;
Exit;
end;
Result:=Sheet.Cells[Row,Col];
end;
{
功能描述:对指定单元格间的值求和
输入参数:BeginRow 起始单元格的行号
BeginCol 起始单元格的列号
EndRow 终止单元格的行号
EndCol 终止单元格的列号
输出参数:返回总和值
创建时间:2006-04-11
创建人: 赵占轻
}
function TExcel.Sum(BeginRow,BeginCol,EndRow,EndCol:Integer):Double;
var
dTotal:Double;
vRange,vCell1,vCell2:Variant;
begin
vCell1:=Sheet.Cells[BeginRow,BeginCol]; //获取起始单元格
vCell2:=Sheet.Cells[EndRow,EndCol]; //获取终止单元格
vRange:=MyExcel.Range[vCell1,vCell2];
//计算总和
dTotal:=MyExcel.Sum (vRange,vRange,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam);
//
Result:=dTotal/2.0;
end;//
{
功能描述:设置指定单元格的值
输入参数:Value: 设置的单元格的值
Row: 指定单元格的行号
Col: 指定单元格的列号
AType:单元格值的类型 (0:字符型;1:整形;2,3:数值型)
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.SetCell(Value: String; Row, Col: Integer;AType:Integer);
begin
case AType of
0: //字符型
begin
//格式化单元格为文本样式,确保数据格式正确
Sheet.Cells[Row,Col].NumberFormatLocal:='@';
end;
1: //整型
begin
Sheet.Cells[Row,Col].NumberFormatLocal:='0';
end;
2:
begin
//格式化单元格为文本样式,确保数据格式正确
Sheet.Cells[Row,Col].NumberFormatLocal:='0.00000';
end;
3: //浮点型
begin
Sheet.Cells[Row,Col].NumberFormatLocal:='0.00000';
end;
end;
Sheet.Cells[Row,Col]:=Value;
end;
{
功能描述:设置单元格为自动列宽
输入参数:无
输出参数:无
创建时间:2003-11-20
创建人: 赵占轻
}
procedure TExcel.CellAutoFit;
begin
MyExcel.Columns.AutoFit;
end;
{
功能描述: 打开指定的Excel文件
输入参数: FileName:要打开的文件名 如:c:\test.xls
输出参数: 执行成功返回真否则返回假
创建时间: 2006-04-07
设计人: 赵占轻
}
function TExcel.OpenExcelFile(FileName: string): Boolean;
begin
Result:=False;
try
Book:=MyExcel.Workbooks.Open(FileName);
Sheet:=Book.WorkSheets.Item[1];
except
Exit;
end;
Result:=True;
end;
{
功能描述: 得到指定的工作表
输入参数: SheetNum:工作表顺序号;ASheet:记录获取的工作表
输出参数: 执行成功返回真否则返回假
输入输出参数:ASheet:返回获取的工作表
创建时间: 2006-04-11
创建人: 赵占轻
}
{
功能描述:获取当前活动工作簿中指定工作表的工作范围
输入参数:ASheet:要操作的工作表;SheetNum:指定工作簿中工作表的序号
输出参数:工作区地址字符串 如"A1:Z200"
创建时间: 2006-04-07
创建人: 赵占轻
}
function TExcel.GetSheetRange:string;
var
sTemp:String;
i:Integer;
begin
sTemp:=Sheet.UsedRange.AddressLocal; //取指定工作表中的工作范围
//分析字符串提取行列号
for i:=1 to Length(sTemp) do
begin
if sTemp[i]<>'$' then
begin
Result:=Result+sTemp[i];
end;
end;
if Pos(':',ReSult)=0 then
begin
UsedRowBeg:=GetRowNum(ReSult); //起始行号
UsedColBeg:=GetColNum(Result); //起始列号
UsedRowEnd:=UsedRowBeg; //终止行号
UsedColEnd:=UsedColBeg; //终止列号
Result:=Result+':'+Result;
end
else
begin
sTemp:=Copy(Result,1,Pos(':',Result)-1);
UsedRowBeg:=GetRowNum(sTemp); //起始行号
UsedColBeg:=GetColNum(sTemp); //其实列号
sTemp:=Copy(Result,Pos(':',Result)+1,Length(Result)-Pos(':',Result));
UsedRowEnd:=GetRowNum(sTemp); //终止行号
UsedColEnd:=GetColNum(sTemp); //终止列号
end;
end;
{
功能描述:获取指定单元格的列号
输入参数: TStr:单元格地址
输出参数: 单元格列号
创建时间: 2006-04-07
创建人: 赵占轻
}
function TExcel.GetColNum(TStr:string):Integer;
begin
Result:=StrToInt(Sheet.Range[TStr].Cells.Column);
end;
{
功能描述:获取指定单元格的行号
输入参数: TStr:单元格地址
输出参数: 单元格行号
创建时间: 2006-04-07
创建人: 赵占轻
}
function TExcel.GetRowNum(TStr:string):Integer;
begin
Result:=StrToInt(Sheet.Range[TStr].Cells.Row);
end;
{
功能描述: 得到当前工作簿中所有工作表名称
输入参数: FileName:用于返回获取的所有工作表名称
输出参数: 操作结果 True:执行成功;False: 执行失败
输入输出参数:FileName:用于返回获取的所有工作表名称
创建时间: 2003-10-24
创建人: 赵占轻
}
function TExcel.GetSheetsNameList(var FileName:TstringList):Boolean;
var
i:Integer;
vSheet:Variant;
begin
try
for i:=1 to MyExcel.ActiveWorkbook.Sheets.Count do
begin
vSheet:=MyExcel.ActiveWorkbook.Worksheets[i]; //获取第i个工作表
FileName.Add(VSheet.Name); //记录第i个工作表的名称
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:合并单元格
输入参数:ABegRowNum: 待合并单元格的起始行号
ABegColNum: 起始列号
AEndRowNum: 终止行号
AEndColNum: 终止列号
输出参数: 返回合并后的单元格
创建时间: 2006-04-11
创建人: 赵占轻
}
function TExcel.MergeCells(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Variant; //合并单元格
var
vRange:Variant;
vBegCell,vEndCell:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell]; //获取指定单元格间的范围
vRange.Merge; //合并单元格
Result:=vRange;
except
Result:=Null;
end;
end;
{
功能描述:设置指定范围单元格的字体样式
输入参数:BeginRow 指定范围的起始单元格行号;
BeginCol 指定范围的起始单元格列号;
EndRow 指定范围的终止单元格行号
EndCol 指定范围的终止单元格列号
AFontStyle 目标字体样式(如粗体);
AFontName 目标字体名称;
AFontSize 目标字体大小
AFontColor 目标字体颜色
输出参数:执行成功返回真;否则返回假
创建时间:2006-04-12
创建人: 赵占轻
}
function TExcel.SetRangeFontStyle(BeginRow,BeginCol,EndRow, EndCol:Integer;
AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean; //设置范围
var
vRange:Variant;
vBegCel,vEndCell:Variant;
begin
try
vBegCel:=Sheet.Cells[BeginRow,BeginCol];
vEndCell:=Sheet.Cells[EndRow, EndCol];
vRange:=Sheet.Range[vBegCel,vEndCell];
vRange.Font.ColorIndex:=AFontColor; //设置字体颜色
vRange.Font.Name:=AFontName; //设置字体名称
vRange.Font.Size:=AFontSize; //设置字体大小
vRange.Font.FontStyle:=AFontStyle; //设置字体样式
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定范围的外边框样式
输入参数:ABegRowNum 待设置范围的起始行号
ABegColNum 待设置范围的起始列号
AEndRowNum 待设置范围的终止行号
AEndColNum 待设置范围的终止列号
AWeight 边线粗度
ALineColor 边线颜色
ALineStyle 边线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetRangeOutBorderStyle(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
AWeight:Integer=2;ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean;
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
try
//设置左边框
vRange.Borders.Item[xlEdgeLeft].LineStyle :=ALineStyle;
vRange.Borders.Item[xlEdgeLeft].Weight := AWeight;
vRange.Borders.Item[xlEdgeLeft].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置顶边框
vRange.Borders.Item[xlEdgeTop].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeTop].Weight := AWeight;
vRange.Borders.Item[xlEdgeTop].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置底边框
vRange.Borders.Item[xlEdgeBottom].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeBottom].Weight := AWeight;
vRange.Borders.Item[xlEdgeBottom].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置右边框
vRange.Borders.Item[xlEdgeRight].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeRight].Weight := AWeight;
vRange.Borders.Item[xlEdgeRight].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定范围的分隔线样式
输入参数:ABegRowNum 待设置范围的起始行号
ABegColNum 待设置范围的起始列号
AEndRowNum 待设置范围的终止行号
AEndColNum 待设置范围的终止列号
AWeight 分割线粗度
ALineColor 分割线颜色
ALineStyle 分割线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRangeInnerLineStyle(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
AWeight:Integer=2;ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean; //设置指定范围的分隔线样式
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
try
//设置垂直线样式
vRange.Borders.Item[xlInsideVertical].LineStyle :=ALineStyle;
vRange.Borders.Item[xlInsideVertical].Weight := AWeight;
vRange.Borders.Item[xlInsideVertical].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置水平线样式
vRange.Borders.Item[xlInsideHorizontal].LineStyle := ALineStyle;
vRange.Borders.Item[xlInsideHorizontal].Weight := AWeight;
vRange.Borders.Item[xlInsideHorizontal].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置当前工作表,并将指定的工作表存储到类属性Sheet中供其他操作使用
输入参数:待指定的工作表的序号
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetCurrentSheet(SheetNum:Integer):Boolean; //设置当前工作簿
begin
Result:=False;
try
Sheet:=MyExcel.Worksheets.Item[SheetNum];
Result:=True;
except
end;
end;
{
功能描述:设置范围的水平对其方式
输入参数:ABegRowNum 待设置的范围的起始行号
ABegColNum 待设置的范围的起始列号
AEndRowNum 待设置的范围的终止行号
AEndColNum 待设置的范围的终止列号
AAlign 对其方式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRangeHorizontalAlignment(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;AAlign:Integer=xlLeft):Boolean;
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.HorizontalAlignment:= AAlign; //水平对其方式为居中
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置范围的垂直对其方式
输入参数:ABegRowNum 待设置的范围起始行号
ABegColNum 待设置的范围起始列号
AEndRowNum 待设置的范围终止行号
AEndColNum 待设置的范围终止列号
AAlign 对其方式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRangeVerticalAlignment(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;AAlign:Integer=xlBottom):Boolean; //设置范围的垂直对其方式
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.VerticalAlignment:= AAlign; //垂直对其方式为居中
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:对指定的工作表进行页面设置
输入参数:APageType: 纸张类型;
Orientation: 页面方向(横向或纵向)
LeftMargin: 左边距
RightMargin: 右边距
TopMargin: 上边距
BottomMargin: 下边距
HeaderMargin: 页眉到顶端边距
FooterMargin: 页脚到底端边距
输出参数:执行成功返回真否则返回假
创建时间: 2006-04-18
创建人: 赵占轻
}
function TExcel.SetSheetPage(APageType,Orientation:Integer;LeftMargin,RightMargin,
TopMargin,BottomMargin,HeaderMargin,FooterMargin:Double):Boolean;
begin
try
//页面设置
Sheet.PageSetup.PaperSize := APageType; // 设定纸张
Sheet.PageSetup.Orientation := Orientation;// 横向纸张
//设定页边距
Sheet.PageSetup.LeftMargin := MyExcel.InchesToPoints(LeftMargin);
Sheet.PageSetup.RightMargin := MyExcel.InchesToPoints(RightMargin);
Sheet.PageSetup.TopMargin := MyExcel.InchesToPoints(TopMargin);
Sheet.PageSetup.BottomMargin := MyExcel.InchesToPoints(BottomMargin); //1cm
Sheet.PageSetup.HeaderMargin := MyExcel.InchesToPoints(HeaderMargin);
Sheet.PageSetup.FooterMargin := MyExcel.InchesToPoints(FooterMargin);
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的宽度
输入参数:AColNum: 待设置的列的列号
AColWidth:目标列宽
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetColumnWidth(AColNum:Integer;AColWidth:Double):Boolean;
begin
try
Sheet.Columns[AColNum].ColumnWidth:=AColWidth;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定范围内单元格的列宽
输入参数:ABeginRow 指定范围的起始行号
ABeginCol 指定范围的起始列号
AEndRow 指定范围的终止行号
AEndCol 指定范围的终止列号
AColWidth:列宽
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetRangeColWidth(ABeginRow,ABeginCol,AEndRow,AEndCol:Integer;AColWidth:Double):Boolean;
var
vRange,vBeginCell,vEndCell:Variant;
begin
try
vBeginCell:=Sheet.Cells[ABeginRow,ABeginCol];
vEndCell:=Sheet.Cells[AEndRow,AEndCol];
vRange:=Sheet.Range[vBeginCell,vEndCell];
vRange.ColumnWidth:=AColWidth;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:绘制平断面图时根据不同情况格式化单元格
输入参数:APage 当前页号
AColNum 列数
ARow 行号
AColName 列名
AValueList 待填充的值的列表
输出参数:无
创建时间:2006-04-18
创建人: 赵占轻
}
procedure TExcel.FormatCells(APage, AColNum, ARow: Integer;AColName: String;AValueList: TStringList);
var
nBegRow,nEndRow:Double;
i: Integer;
sValue: String;
nIndex: Integer;
dX,dY: Double;
dX1, dY1: Double;
nPageTop:Integer;
dAngle: Double;
dOldY2: Double;
dGanGao: Double;
bIsFirstPole, bIsTJPole: Boolean;
bIsCable: Boolean;
begin
dAngle:=0;
nPageTop := (APage-1)*pm_PageRows; //每页行数
//处理行高
case ARow of
6, 13:
begin
//情况特殊,需要加高
Sheet.Rows[nPageTop+ARow].RowHeight := 28;
end;
18:
begin
//情况特殊,需要加高
Sheet.Rows[nPageTop+ARow].RowHeight := 33;
end;
else
begin
Sheet.Rows[nPageTop+ARow].RowHeight := 15;
end;
end;
//列头
MergeCells(nPageTop+ARow,1,nPageTop+ARow,2);
SetRangeOutBorderStyle(nPageTop+ARow,1,nPageTop+ARow,2,1,0,1);
SetRangeFontStyle(nPageTop+ARow,1,nPageTop+ARow,2,'常规','宋体',1,11);
SetRangeHorizontalAlignment(nPageTop+ARow,1,nPageTop+ARow,2,xlCenter);
SetRangeVerticalAlignment(nPageTop+ARow,1,nPageTop+ARow,2,xlCenter);
SetRangeValue(nPageTop+ARow,1,nPageTop+ARow,2,AColName);
if (ARow = 10)or(ARow = 11)or(ARow = 13) then //档距和累计长度特殊
begin
//合并第一个格
SetRangeOutBorderStyle(nPageTop+ARow,3,nPageTop+ARow,3,1,0,1);
SetRangeFontStyle(nPageTop+ARow,3,nPageTop+ARow,3,'常规','宋体',1,11);
SetRangeHorizontalAlignment(nPageTop+ARow,3,nPageTop+ARow,3,xlCenter);
SetRangeVerticalAlignment(nPageTop+ARow,3,nPageTop+ARow,3,xlCenter);
nIndex := (APage-1)*AColNum;
if nIndex <= AValueList.Count -1 then //防止数据溢出
begin
case ARow of
10: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.DJ;
11: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.LJCD;
13: SValue := PRecData(Integer(AValueList.Objects[nIndex]))^.JCKY;
end;
if sValue <> '0' then
begin
SetRangeValue(nPageTop+ARow,3,nPageTop+ARow,3,sValue);
end;
end;
//合并最后一个格
SetRangeOutBorderStyle(nPageTop+ARow,24,nPageTop+ARow,24,1,0,1);
SetRangeFontStyle(nPageTop+ARow,24,nPageTop+ARow,24,'常规','宋体',1,11);
SetRangeHorizontalAlignment(nPageTop+ARow,24,nPageTop+ARow,24,xlCenter);
SetRangeVerticalAlignment(nPageTop+ARow,24,nPageTop+ARow,24,xlCenter);
//处理列
for i := 0 to 9 do
begin
MergeCells(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5);
SetRangeOutBorderStyle(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5,1,0,1);
SetRangeFontStyle(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5,'常规','宋体',1,11);
SetRangeHorizontalAlignment(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5,xlCenter);
SetRangeVerticalAlignment(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5,xlCenter);
nIndex := (APage-1)*AColNum+i+1;
if nIndex <= AValueList.Count -1 then //防止数据溢出
begin
case ARow of
10: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.DJ;
11: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.LJCD;
13:
begin
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.JCKY;
SetRangeAutoWrap(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5);//自动换行
end;
end;
if sValue <> '0' then
begin
Self.SetRangeValue(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5,sValue);
end;
end;
end;
Exit;
end;
//普通情况
for i := 0 to 10 do
begin
MergeCells(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4);
SetRangeOutBorderStyle(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,1,0,1);
SetRangeFontStyle(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,'常规','宋体',1,10);
SetRangeHorizontalAlignment(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,xlCenter);
SetRangeVerticalAlignment(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,xlCenter);
nIndex := (APage-1)*AColNum + i;
if nIndex <= AValueList.Count -1 then
begin
case ARow of
5:
begin
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.GH;
if PRecData(Integer(AValueList.Objects[nIndex]))^.GG <> '' then
begin
dGanGao := StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.GG);
end
else begin
dGanGao := 10;
end;
if i = 0 then
begin
if PRecData(Integer(AValueList.Objects[nIndex]))^.IsTJPole =1 then
begin
bIsTJPole := True;
bIsFirstPole := True;
end
else begin
bIsFirstPole := True;
bIsTJPole := False;
end;
end
else begin
bIsFirstPole := False;
bIsTJPole := False;
end;
if PRecData(Integer(AValueList.Objects[nIndex]))^.IsCable = 1 then
begin
bIsCable := True; //是电缆
end
else begin
bIsCable := False; //不是电缆
end;
GetCellDMGanCoord(APage, i+1, dX1, dY1);
//画断面图
CreateDMT( dX1, dY1, dGanGao, bIsTJPole, bIsFirstPole, bIsCable, dOldY2);
//画分支
if PRecData(Integer(AValueList.Objects[nIndex]))^.FZ1ZJ <> '' then
begin
dAngle := StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ1ZJ);
//画分支
GetCellGanCoord(APage, i+1, dX, dY);
CreateFZLine(dX, dY,0,dAngle, PRecData(Integer(AValueList.Objects[nIndex]))^.FZ1MC);
end;
if PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ <> '' then
begin
GetCellGanCoord(APage, i+1, dX, dY);
if dAngle >= 0 then
begin
if StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ)>=0 then
begin
//画分支 线路名同向
CreateFZLine(dX, dY, 14, StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ), PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2MC);
end
else begin
CreateFZLine(dX, dY,0, StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ), PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2MC);
end;
end
else begin
if StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ)<0 then
begin
//画分支 线路名同向
CreateFZLine(dX, dY, -14, StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ), PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2MC);
end
else begin
CreateFZLine(dX, dY,0, StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ), PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2MC); end;
end;
end;
end;
6:
begin
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.GX;
SetRangeAutoWrap(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4);//自动换行
end;
7: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.GG;
8: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.MS;
9: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.DXXH;
12:
begin
Self.SetRangeFontStyle(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,'常规','宋体',0,9);
if PRecData(Integer(AValueList.Objects[nIndex]))^.ZJ <> '' then
begin
//画转角
GetCellGanCoord(APage, i+1, dX, dY);
CreateArrowheadLine(dX, dY, StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.ZJ));
end;
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.ZJ;
if sValue <> '' then
begin
sValue := DoubleToFenMiao(Abs(StrToFloat(sValue)));
end;
end;
14: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.CZJL;
15: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.HDGG;
16: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.LXWZ;
17: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.LXXHGS;
18:
begin
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.JYZXHSL;
SetRangeAutoWrap(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4);//自动换行
end;
19: //变台
begin
if i <> 0 then
begin
GetCellGanCoord(APage, i, dX1, dY1); //上一个点坐标
GetCellGanCoord(APage, i+1, dX, dY); //当前点坐标
if PRecData(Integer(AValueList.Objects[nIndex]))^.BTXS <> '' then
begin
if PRecData(Integer(AValueList.Objects[nIndex-1]))^.BTXS <> '' then
begin
//前一棵杆有变压器
//画线
Sheet.Shapes.AddLine(dX1+pm_BYQD-2, dY1, dX-pm_BYQD+2, dY).Select;
end
else begin
//前一棵杆无变压器
Sheet.Shapes.AddLine(dX1, dY1, dX-pm_BYQD+2, dY).Select;
end;
end
else begin
if PRecData(Integer(AValueList.Objects[nIndex-1]))^.BTXS <> '' then
begin
//画线
Sheet.Shapes.AddLine(dX1+pm_BYQD-2, dY1, dX, dY).Select;
end
else begin
Sheet.Shapes.AddLine(dX1, dY1, dX, dY).Select;
end;
end;
MyExcel.Selection.ShapeRange.ZOrder(msoSendToBack);
end;
if PRecData(Integer(AValueList.Objects[nIndex]))^.BTXS <> '' then
begin
//画变台
GetCellGanCoord(APage, i+1, dX, dY);
DrawBYQ(dX, dY);
DrawBYQText(dX, dY, PRecData(Integer(AValueList.Objects[nIndex]))^.HM);
end
else begin
//画杆
Sheet.Shapes.AddShape(msoShapeOval, pm_GanFirstLeft+(i*pm_GanOffset), (APage-1)*V_PageOffset+pm_GanTop, pm_GanD, pm_GanD);
end;
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.BTXS;
end;
20: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.PBRL;
end;
end
else begin
//为了填补空格
sValue := '';
end;
if sValue <> '' then
begin
SetRangeValue(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,sValue);//自动换行
end;
end;
end;
{
//功能描述:创建页
//输入参数:APage 当前页号
ABDZMC 变电站名称
AXLMC 线路名称
AValueList 要输入的数据值列表
//输出参数:无
//创建时间:2006-04-14
//创建人: 赵占轻
}
procedure TExcel.CreatePage(APage: Integer;ABDZMC, AXLMC: String;AValueList: TStringList);
var
sGDSMC: String;
nColNum: Integer;
sColName: String;
nPageTop: Integer;
AFontColor: TColor;
nRow: Integer;
i: Integer;
begin
sGDSMC := '城关供电所';
nColNum := 11; //字段列数
nPageTop := (APage-1)*pm_PageRows; //每页行数
AFontColor := 1;
//处理第1行数据 标题
nRow := 1;
SetRowHeight(nPageTop+nRow,20.25);
//设定合并单元格
MergeCells(nPageTop+nRow,1,nPageTop+nRow,24);
SetRangeFontStyle(nPageTop+nRow,1,nPageTop+nRow,24,'粗体','宋体',AFontColor,16); //设置指定区域中字体样式
SetRangeHorizontalAlignment(nPageTop+nRow,1,nPageTop+nRow,24,xlCenter); //设置水平对齐方式
SetRangeVerticalAlignment(nPageTop+nRow,1,nPageTop+nRow,24,xlCenter); //设置垂直对齐方式
SetRangeValue(nPageTop+nRow,1,nPageTop+nRow,24,pm_Title); //设置指定区域的值
//处理第2行数据
nRow := 2;
SetRowHeight(nPageTop+nRow,23.25);
//设定合并单元格
MergeCells(nPageTop+nRow,1,nPageTop+nRow,2);
SetRangeFontStyle(nPageTop+nRow,1,nPageTop+nRow,2,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeVerticalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeValue(nPageTop+nRow,1,nPageTop+nRow,2,'线路名称:');
//
MergeCells(nPageTop+nRow,3,nPageTop+nRow,6);
SetRangeFontStyle(nPageTop+nRow,3,nPageTop+nRow,6,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,3,nPageTop+nRow,6,xlLeft);
SetRangeVerticalAlignment(nPageTop+nRow,3,nPageTop+nRow,6,xlCenter);
SetRangeValue(nPageTop+nRow,3,nPageTop+nRow,6,AXLMC); //线路名称
MergeCells(nPageTop+nRow,7,nPageTop+nRow,8);
SetRangeFontStyle(nPageTop+nRow,7,nPageTop+nRow,8,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,7,nPageTop+nRow,8,xlRight);
SetRangeVerticalAlignment(nPageTop+nRow,7,nPageTop+nRow,8,xlCenter);
SetRangeValue(nPageTop+nRow,7,nPageTop+nRow,8,''); //'变电站名称:';
//
MergeCells(nPageTop+nRow,9,nPageTop+nRow,14);
SetRangeFontStyle(nPageTop+nRow,9,nPageTop+nRow,14,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,9,nPageTop+nRow,14,xlLeft);
SetRangeVerticalAlignment(nPageTop+nRow,9,nPageTop+nRow,14,xlCenter);
SetRangeValue(nPageTop+nRow,9,nPageTop+nRow,14,ABDZMC); //赋变电站名称
MergeCells(nPageTop+nRow,21,nPageTop+nRow,23);
SetRangeFontStyle(nPageTop+nRow,21,nPageTop+nRow,23,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,21,nPageTop+nRow,23,xlCenter);
SetRangeVerticalAlignment(nPageTop+nRow,21,nPageTop+nRow,23,xlCenter);
SetRangeValue(nPageTop+nRow,21,nPageTop+nRow,23,'');
//处理第3行数据
nRow := 3;
SetRowHeight(nPageTop+nRow,100);
MergeCells(nPageTop+nRow,1,nPageTop+nRow,2);
SetRangeOutBorderStyle(nPageTop+nRow,1,nPageTop+nRow,2,1,1,1);
SetRangeFontStyle(nPageTop+nRow,1,nPageTop+nRow,2,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeVerticalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeValue(nPageTop+nRow,1,nPageTop+nRow,2,'断 面 图');
MergeCells(nPageTop+nRow,3,nPageTop+nRow,24);
SetRangeOutBorderStyle(nPageTop+nRow,3,nPageTop+nRow,24,1,1,1);
SetRangeFontStyle(nPageTop+nRow,3,nPageTop+nRow,24,'常规','宋体',AFontColor,11);
nRow := 4;
SetRowHeight(nPageTop+nRow,69);
MergeCells(nPageTop+nRow,1,nPageTop+nRow,2);
SetRangeOutBorderStyle(nPageTop+nRow,1,nPageTop+nRow,2,1,1,1);
SetRangeFontStyle(nPageTop+nRow,1,nPageTop+nRow,2,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeVerticalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeValue(nPageTop+nRow,1,nPageTop+nRow,2,'平 面 图');
MergeCells(nPageTop+nRow,3,nPageTop+nRow,24);
SetRangeOutBorderStyle(nPageTop+nRow,3,nPageTop+nRow,24,1,1,1);
SetRangeFontStyle(nPageTop+nRow,3,nPageTop+nRow,24,'常规','宋体',AFontColor,11);
//InitShape(Sheet, APage); //初始化图
//5
nRow := nRow+1;
sColName := '杆 号';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
//6
nRow := nRow+1;
sColName := '电杆种类及杆型';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
//7
nRow := nRow+1;
sColName := '杆高(米)';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
//8
nRow := nRow+1;
sColName := '埋深(米)';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '导线型号';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '档距(米)';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '累计长度(米)';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '线路转角';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '交叉跨越';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '垂直距离';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '横担规格';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '拉线位置';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '拉线型号/根数';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '绝缘子型号/数量';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '变台型式';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '配变容量';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
SetRowHeight(nPageTop+nRow,15);
if V_PageOffset = 0 then
begin
//计算页间距
V_PageOffset := 0;
for i := 1 to pm_PageRows do
begin
V_PageOffset := V_PageOffset + Sheet.Rows[i].RowHeight;
end;
V_PageOffset := V_PageOffset - 1; //经验值
end;
end;
{
功能描述:获取指定范围的值
输入参数:ABegRowNum: 指定范围的起始行号
ABegColNum:起始列号
AEndRowNum:终止行号
AEndColNum: 终止列号
输出参数:返回指定范围的值
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.GetRangeValue(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):String; //获取指定范围的值
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
Result:=vRange.value;
except
end;
end;
{
功能描述:设置指定范围的值
输入参数:ABegRowNum 指定范围的起始行号
ABegColNum 指定范围的起始列号
AEndRowNum 指定范围的终止行号
AEndColNum 指定范围的终止列号
AValue 待写入指定范围的值
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRangeValue(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;AValue:string):Boolean; //设置指定范围的值
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.Value:=AValue;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定区域格式为自动换行
输入参数:ABegRowNum 指定的范围的起始行号
ABegColNum 指定的范围的起始列号
AEndRowNum 指定的范围的终止行号
AEndColNum 指定的范围的终止列号
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetRangeAutoWrap(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Boolean; //设置指定区域格式为自动换行
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.WrapText := 1; //自动换行
vRange.ShrinkToFit := False;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:取消指定区域的自动换行
输入参数:ABegRowNum 指定的范围的起始行号
ABegColNum 指定的范围的起始列号
AEndRowNum 指定的范围的终止行号
AEndColNum 指定的范围的终止列号
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.CancelRangeAutoWrap(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Boolean;
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.WrapText := 0; //自动换行
vRange.ShrinkToFit := True;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述: 获取指定页,指定cell的断面杆的中心坐标
输入参数: APage 当前页号
ACellIndex 当前单元格列号
输出参数: 无
输入输出参数:AX 用于返回断面杆的中心X坐标
AY 用于返回断面杆的中心Y坐标
创建时间: 2006-04-18
创建人: 赵占轻
}
procedure TExcel.GetCellDMGanCoord(APage, ACellIndex: Integer;var AX, AY: Double);
begin
AX := pm_GanFirstLeft+((ACellIndex-1)*pm_GanOffset) + pm_GanD/2;
AY := (APage-1)*V_PageOffset+dm_GanTop;
end;
{
功能描述: 创建断面图
输入参数: AX1 杆塔底端X坐标
AY1 杆塔底端Y坐标
AGanGao 实际杆高
AIsTJPole 是否T接杆
AIsFirstPole 是否第一颗杆
AIsCable 是否下电缆杆
输出参数: 无
输入输出参数:AOldY2:返回杆塔的顶点Y坐标
创建时间: 2006-04-18
创建人: 赵占轻
}
procedure TExcel.CreateDMT(AX1, AY1, AGanGao: Double;AIsTJPole, AIsFirstPole, AIsCable: Boolean;var AOldY2: Double);
//创建断面图
var
AX2, AY2: Double;
AShape: Variant;
freBuilder: Variant;
begin
AGanGao := GetPoleHight(AGanGao); //计算图上杆高
AX2 := AX1;// + pm_GanOffset;
AY2 := AY1 - dm_HaiBa - AGanGao;
//断面图杆
Sheet.Shapes.Addline(AX1, AY1 ,AX2, AY2);
if not AIsFirstPole then
begin
if AIsCable then
begin
//断面图电缆
AShape := Sheet.Shapes.AddLine(AX2, AY2, AX2-3, AY2);
AShape.Line.DashStyle := 4;
AShape := Sheet.Shapes.AddLine(AX2-3, AY2, AX2-3, AY2+AGanGao-3);
AShape.Line.DashStyle := 4;
AShape := Sheet.Shapes.AddLine(AX2-3, AY2+AGanGao-3, AX2-pm_GanOffset+3, AY2+AGanGao-3);
AShape.Line.DashStyle := 4;
AShape := Sheet.Shapes.AddLine(AX2-pm_GanOffset+3, AY2+AGanGao-3, AX2-pm_GanOffset+3, AOldY2);
AShape.Line.DashStyle := 4;
AShape := Sheet.Shapes.AddLine(AX2-pm_GanOffset+3, AOldY2, AX2-pm_GanOffset, AOldY2);
AShape.Line.DashStyle := 4;
end
else begin
//断面图导线
freBuilder := Sheet.Shapes.BuildFreeform(msoEditingAuto, AX2, AY2);
if AOldY2 - AY2 > dm_HuChui then
begin
freBuilder.AddNodes(msoSegmentCurve, msoEditingAuto, AX2-pm_GanOffset/2, AY2+(AOldY2-AY2)/2+dm_HuChui);
end
else begin
freBuilder.AddNodes(msoSegmentCurve, msoEditingAuto, AX2-pm_GanOffset/2, AY2+dm_HuChui);
end;
freBuilder.AddNodes(msoSegmentCurve, msoEditingAuto, AX2-pm_GanOffset, AOldY2);
freBuilder.ConvertToShape;
end;
end
else begin
if not AIsTJPole then
begin
//如果不是T接杆
freBuilder := Sheet.Shapes.BuildFreeform(msoEditingAuto, AX2, AY2);
freBuilder.AddNodes(msoSegmentCurve, msoEditingAuto, AX2-pm_GanOffset/4, AY2+(dm_HuChui*2/3));
freBuilder.AddNodes(msoSegmentCurve, msoEditingAuto, AX2-pm_GanOffset/2, AY2+dm_HuChui);
freBuilder.ConvertToShape;
end;
end;
AOldY2 := AY2;
end;
{
功能描述: 获取指定页,指定cell的杆的中心坐标
输入参数: APage 当前页号
ACellIndex 单元格列号
输出参数: 无
输入输出参数:计算结构存入AX,AY中
创建时间: 2006-04-18
创建人: 李志强
}
procedure TExcel.GetCellGanCoord(APage, ACellIndex: Integer;var AX, AY: Double);
begin
AX := pm_GanFirstLeft+((ACellIndex-1)*pm_GanOffset) + pm_GanD/2;
AY := (APage-1)*V_PageOffset+pm_GanTop + pm_GanD/2;
end;
{
功能描述:画分支 创建转角箭头线
输入参数:AX 箭头线起点X坐标
AY 箭头线起点Y坐标
AYOffSet 文本框偏移量
AAngle 箭头线转角
AXLMC 分支名称
输出参数:无
创建时间:2006-04-17
创建人: 赵占轻
}
procedure TExcel.CreateFZLine(AX, AY,AYOffSet,AAngle: Double;AXLMC: String);
var
vShape: Variant;
dX2, dY2: Double;
vSelection:Variant;
begin
//角度向右为负 图形显示向下
dX2 := AX + pm_Distance * Sin((90-AAngle)*Pi/180);
dY2 := AY - pm_Distance * Cos((90-AAngle)*Pi/180);
vShape := Sheet.Shapes.AddLine(AX, AY, dX2, dY2);
//格式化箭头线
FormatArrowLineEndHead(vShape,msoArrowheadTriangle,msoArrowheadLengthMedium,msoArrowheadWidthMedium);
FormatArrowLine(vShape,1.5,msoLineSingle,msoLineSolid);
//插入文本框
if AAngle < 0 then
begin
vSelection:=Sheet.Shapes.AddTextbox(msoTextOrientationHorizontal, AX-pm_GanOffset/2-5, AY+25+AYOffSet, 70, 11).Select;
end
else begin
vSelection:=Sheet.Shapes.AddTextbox(msoTextOrientationHorizontal, AX-pm_GanOffset/2-5, AY-26+AYOffSet, 70, 11).Select;
end;
//格式化文本框
SetTextBoxFillStyle(vSelection,msoFalse,0); //设置文本框填充样式
SetTextBoxLineStyle(vSelection,msoFalse,0); //设置文本框边线样式
SetTextBoxFontStyle(vSelection,'宋体','常规',9,0); //设置文本框字体样式
SetTextBoxText(vSelection,AXLMC); //设置文本框内容
SetTextBoxAlignment(vSelection,xlCenter,xlCenter); //设置文本框对齐方式
end;
{
功能描述:创建转角箭头线
输入参数:AX 转角箭头线的起始X坐标
AY 转角箭头线的起始Y坐标
AAngle 转角箭头线的角度
输出参数:无
创建时间:2006-04-17
创建人: 赵占轻
}
procedure TExcel.CreateArrowheadLine(AX, AY, AAngle: Double);
var
vShape: Variant;
dX2, dY2: Double;
begin
//角度向右为负 图形显示向下
dX2 := AX + pm_Distance * Sin((90-AAngle)*Pi/180); //计算转角箭头线的终点X坐标
dY2 := AY - pm_Distance * Cos((90-AAngle)*Pi/180); //计算转角箭头线的终点Y坐标
vShape := Sheet.Shapes.AddLine(AX, AY, dX2, dY2); //绘制转角箭头线
//下面设置箭头线的样式
Self.FormatArrowLineEndHead(vShape,msoArrowheadTriangle,msoArrowheadLengthMedium,msoArrowheadWidthMedium);
end;
{
功能描述:双精度的度转换为度分秒
输入参数:双精度的角度
输出参数:返回度分秒字符串
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.DoubleToFenMiao(Jiao:Double):string;
var
TmpD:double;
TmpI:integer;
Str:string;
begin
TmpI:=Trunc(Jiao);
Str:=IntToStr(TmpI);
TmpD:=Jiao-TmpI;
TmpD:=TmpD*60;
TmpI:=Trunc(TmpD);
//Str:=Str+'度'+IntToStr(TmpI);
Str:=Str+'°'+IntToStr(TmpI);
TmpD:=TmpD-TmpI;
TmpD:=TmpD*60;
TmpI:=Trunc(TmpD);
//Str:=Str+'分'+IntToStr(TmpI)+'秒';
Str:=Str+'′'+IntToStr(TmpI)+'″';
result:=Str;
end;
{
功能描述:绘制变压器文本
输入参数:AX 文本X坐标
AY 文本Y坐标
AText 文本内容
输出参数:无
创建时间:2006-04-17
创建人: 赵占轻
}
procedure TExcel.DrawBYQText(AX, AY : Double;AText: String);
var
vSelection:Variant;
begin
vSelection:=InsertTextBox(AX-pm_GanOffset/2+1,AY+7,58,33,msoTextOrientationHorizontal); //插入文本框
SetTextBoxAlignment(vSelection,xlCenter,xlCenter); //设置文本框对齐方式
SetTextBoxFillStyle(vSelection,msoFalse,0); //设置文本框填充样式
SetTextBoxLineStyle(vSelection,msoFalse,0); //设置文本框边线样式
SetTextBoxFontStyle(vSelection,'宋体','常规',9,0,); //设置文本框的字体样式
Self.SetTextBoxText(vSelection,AText); //设置文本框内容
end;
{
功能描述:绘制变压器
输入参数:AX 初始X坐标
AY:初始Y坐标
输入参数:无
创建时间:2006-04-17
创建人: 赵占轻
}
procedure TExcel.DrawBYQ(AX, AY : Double);
var
AX2, AY2: Double;
AShape: Variant;
begin
AY2 := AY + pm_BYQY;
AX2 := AX - pm_GanD;
AShape := Sheet.Shapes.AddShape(msoShapeOval, AX2, AY2, pm_BYQD, pm_BYQD); //绘制左圈
AShape.Fill.Visible := False;
AX2 := AX-pm_GanD/3;
AShape := Sheet.Shapes.AddShape(msoShapeOval, AX2, AY2, pm_BYQD, pm_BYQD); //绘制右圈
AShape.Fill.Visible := False;
end;
{
功能描述:设置指定行的行高
输入参数:ARowNum: 指定行的行号;
ARowHeight: 目标行高度值
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetRowHeight(ARowNum:Integer;ARowHeight:Double):Boolean;
begin
try
Sheet.Rows[ARowNum].RowHeight := ARowHeight;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:以15米杆高为标准计算d当前杆塔图形高度
输入参数:AHight:杆塔高度
输出参数:杆塔高度
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.GetPoleHight(AHight: Double): Double;
begin
//已15米杆为标准
Result := AHight*(80/15);
end;
{
功能描述:向指定工作表中插入图片
输入参数:ABeginRow 图片左上脚所处的单元格行号
ABeginCol 图片左上脚所处的单元格列号
APicFile 要插入的图片的全名
输出参数:插入成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.InsertPicIntoSheet(ABeginRow,ABeginCol:Integer;APicFile:String):Boolean;
var
vBeginCell:Variant;
begin
try
vBeginCell:=Sheet.Cells[ABeginRow,ABeginCol];
vBeginCell.Select;
Sheet.Pictures.Insert(APicFile);
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定范围的背景图案
输入参数: ABegRowNum 指定的范围的起始行号
ABegColNum 指定的范围的起始列号
AEndRowNum 指定的范围的终止行号
AEndColNum 指定的范围的终止列号
APattern 图案样式
APatternColor 图案颜色
ABackColor 背景颜色
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetRangeBackGround(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
APattern:Integer=xlSolid;APatternColor:Integer=xlNone;ABackColor:Integer=xlNone):Boolean;
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.Interior.ColorIndex:=ABackColor;
vRange.Interior.Pattern:=APattern;
vRange.Interior.PatternColorIndex:=APatternColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:在指定位置插入文本框
输入参数:AX 文本框左上角X坐标
AY 文本框左上角Y坐标
AWidth 文本框宽
AHeight 文本框高
AAlign 文本框中文本方向
(xlHorizontal 文字字头朝上 横向排列
xlVertical 文字字头朝上 竖向排列
xlUpward 文字字头朝右 横向排列
xlDownward 文字字头朝左 横向排列
)
输出参数:执行成功返回插入的文本框
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.InsertTextBox(AX,AY,AWidth,AHeight:Double;AOrient:Integer=msoTextOrientationHorizontalRotatedFarEast):Variant;
begin
try
Sheet.Shapes.AddTextbox(AOrient,AX, AY,AWidth,AHeight).Select;
Result:=MyExcel.selection;//加入文本框
except
end;
end;
{
功能描述:设置文本框填充样式
输入参数:ATextBox 指定的文本框
AVisible 文本框是否显示填充样式
ATransparency 透明程度
0: 不透明
0.5 半透明
1 透明
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetTextBoxFillStyle(ATextBox:Variant;AVisible:Integer;ATransparency:Double=0):Boolean;
begin
try
ATextBox.ShapeRange.Fill.Visible := AVisible;
ATextBox.ShapeRange.Fill.Transparency := ATransparency;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置文本框边框样式
输入参数:ATextBox: 指定文本框;
AVisible: 边框是否可见;
ATransparency:透明程度
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetTextBoxLineStyle(ATextBox:Variant;AVisible:Integer;ATransparency:Double=0):Boolean;
begin
try
ATextBox.ShapeRange.Line.Transparency := ATransparency;
ATextBox.ShapeRange.Line.Visible := AVisible;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置文本框中文字内容
输入参数:ATextBox: 指定文本框
AText: 内容字符串
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetTextBoxText(ATextBox:Variant;AText:string):Boolean;
begin
try
ATextBox.Characters.Text := AText;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置文本框中字体样式
输入参数:ATextBox: 指定文本框;
AFontName: 字体名称;
AFontStyle: 字体样式;
AFontSize: 字体大小
AFontColor: 字体颜色
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetTextBoxFontStyle(ATextBox:Variant;AFontName,AFontStyle:String;AFontSize:Integer=12;AFontColor:Integer=0):Boolean;
begin
try
//设置文本框样式
ATextBox.Font.Name := '宋体';
ATextBox.Font.Size := AFontSize;
ATextBox.Font.ColorIndex:=AFontColor; //设置字体颜色
ATextBox.Font.FontStyle:=AFontStyle;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置文本框水平和垂直对齐方式
输入参数:ATextBox: 指定文本框
HAlign: 水平对齐方式;(xlCenter 居中 ;xlLeft 靠左;xlRight 靠右;xlJustify 两端对齐)
VAlign: 垂直对齐方式 (xlCenter 居中 ;xlTop 靠左;xlBottom 靠右;xlJustify 两端对齐)
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetTextBoxAlignment(ATextBox:Variant;HAlign:Integer=xlLeft;VAlign:Integer=xlBottom):Boolean;
begin
try
ATextBox.HorizontalAlignment := HAlign;
ATextBox.VerticalAlignment := VAlign;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:格式化箭头线的末端样式
输入参数:ALine 待格式化的箭头线
AheadStyle 末端样式
AheadLength 末端长
AheadWidth 末端宽
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.FormatArrowLineEndHead(ALine:Variant;AheadStyle:Integer=msoArrowheadTriangle;
AheadLength:Integer=msoArrowheadLengthMedium;AheadWidth:Integer=msoArrowheadWidthMedium):Boolean;
begin
try
ALine.Line.EndArrowheadLength := AheadLength;
ALine.Line.EndArrowheadWidth := AheadWidth;
ALine.Line.EndArrowheadStyle := AheadStyle;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:格式化箭头线的首端样式
输入参数:ALine 待格式化的箭头线
AheadStyle 首端样式
AheadLength 首端长
AheadWidth 首端宽
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.FormatArrowLineBeginHead(ALine:Variant;AheadStyle:Integer=msoArrowheadTriangle;
AheadLength:Integer=msoArrowheadLengthMedium;AheadWidth:Integer=msoArrowheadWidthMedium):Boolean;
begin
try
ALine.Line.BeginArrowheadLength := AheadLength;
ALine.Line.BeginArrowheadWidth := AheadWidth;
ALine.Line.BeginArrowheadStyle := AheadStyle;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:格式化箭头线的线样式
输入参数:ALine 待格式化的箭头线
AWidth 线宽
AStyle 线样式
ADashStyle 虚线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.FormatArrowLine(ALine:Variant;AWidth:Double=1.5;AStyle:Integer=msoLineSingle;ADashStyle:Integer=msoLineSolid):Boolean;
begin
try
ALine.Line.Weight := AWidth;
ALine.Line.DashStyle := ADashStyle;
ALine.Line.Style := AStyle;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置当前窗口网格的显示与否
输入参数:IsVisible:控制网格显示的参数
(True:显示网格;False:隐藏网格)
输出参数:执行成功返回真否则返回假
创建时间:2006-05-07
创建人: 赵占轻
}
function TExcel.SetActiveWindowGridVisible(IsVisible:Boolean=True):Boolean; //设置当前窗口网格的显示与否
begin
Result:=False;
try
MyExcel.Application.ActiveWindow.DisplayGridlines:=IsVisible;
except
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定行的字体样式
输入参数:ARowNum: 待设置的行的行号
AFontStyle:目标字体样式(如粗体);
AFontName: 目标字体名称;
AFontColor 目标字体颜色
AFontSize: 目标字体大小
输出参数:执行成功返回真;否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetRowFontStyle(ARowNum:Integer;AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean;
var
vRange:Variant;
begin
try
vRange:=Sheet.Rows[ARowNum];
vRange.Font.ColorIndex:=AFontColor; //设置字体颜色
vRange.Font.Name:=AFontName; //设置字体名称
vRange.Font.Size:=AFontSize; //设置字体大小
vRange.Font.FontStyle:=AFontStyle; //设置字体样式
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的字体样式
输入参数:AColNum: 待设置的列的列号
AFontStyle: 目标字体样式(如粗体);
AFontName: 目标字体名称;
AFontColor: 目标字体颜色
AFontSize: 目标字体大小
输出参数:执行成功返回真;否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetColumnFontStyle(AColNum:Integer;AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean; //设置指定列的字体样式
var
vRange:Variant;
begin
try
vRange:=Sheet.Columns[AColNum];
vRange.Font.ColorIndex:=AFontColor; //设置字体颜色
vRange.Font.Name:=AFontName; //设置字体名称
vRange.Font.Size:=AFontSize; //设置字体大小
vRange.Font.FontStyle:=AFontStyle; //设置字体样式
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定行的外边框样式
输入参数:ARowNum 待设置行的行号
AWeight 边线粗度
ALineColor 边线颜色
ALineStyle 边线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetRowOutBorderStyle(ARowNum:Integer;AWeight:Integer=2;
ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean; //设置指定行的外边框样式
var
vRange:Variant;
begin
vRange:=Sheet.Rows[ARowNum];
try
//设置左边框
vRange.Borders.Item[xlEdgeLeft].LineStyle :=ALineStyle;
vRange.Borders.Item[xlEdgeLeft].Weight := AWeight;
vRange.Borders.Item[xlEdgeLeft].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置顶边框
vRange.Borders.Item[xlEdgeTop].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeTop].Weight := AWeight;
vRange.Borders.Item[xlEdgeTop].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置底边框
vRange.Borders.Item[xlEdgeBottom].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeBottom].Weight := AWeight;
vRange.Borders.Item[xlEdgeBottom].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置右边框
vRange.Borders.Item[xlEdgeRight].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeRight].Weight := AWeight;
vRange.Borders.Item[xlEdgeRight].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的外边框样式
输入参数:AColNum 待设置列的列号
AWeight 边线粗度
ALineColor 边线颜色
ALineStyle 边线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetColumnOutBorderStyle(AColNum:Integer;AWeight:Integer=2;ALineColor:Integer=0; //设置指定列的外边框样式
ALineStyle:Integer=xlContinuous):Boolean;
var
vRange:Variant;
begin
vRange:=Sheet.Columns[AColNum];
try
//设置左边框
vRange.Borders.Item[xlEdgeLeft].LineStyle :=ALineStyle;
vRange.Borders.Item[xlEdgeLeft].Weight := AWeight;
vRange.Borders.Item[xlEdgeLeft].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置顶边框
vRange.Borders.Item[xlEdgeTop].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeTop].Weight := AWeight;
vRange.Borders.Item[xlEdgeTop].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置底边框
vRange.Borders.Item[xlEdgeBottom].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeBottom].Weight := AWeight;
vRange.Borders.Item[xlEdgeBottom].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置右边框
vRange.Borders.Item[xlEdgeRight].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeRight].Weight := AWeight;
vRange.Borders.Item[xlEdgeRight].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定行的分隔线样式
输入参数:ARowNum 待设置的行号
AWeight 分割线粗度
ALineColor 分割线颜色
ALineStyle 分割线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetRowInnerLineStyle(ARowNum:Integer;AWeight:Integer=2;ALineColor:Integer=0; //设置指定行的分隔线样式
ALineStyle:Integer=xlContinuous):Boolean;
var
vRange:Variant;
begin
vRange:=Sheet.Rows[ARowNum];
try
//设置垂直线样式
vRange.Borders.Item[xlInsideVertical].LineStyle :=ALineStyle;
vRange.Borders.Item[xlInsideVertical].Weight := AWeight;
vRange.Borders.Item[xlInsideVertical].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置水平线样式
vRange.Borders.Item[xlInsideHorizontal].LineStyle := ALineStyle;
vRange.Borders.Item[xlInsideHorizontal].Weight := AWeight;
vRange.Borders.Item[xlInsideHorizontal].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的分隔线样式
输入参数:AColNum 待设置的列号
AWeight 分割线粗度
ALineColor 分割线颜色
ALineStyle 分割线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetColumnInnerLineStyle(AColNum:Integer;AWeight:Integer=2;ALineColor:Integer=0; //设置指定列的分隔线样式
ALineStyle:Integer=1):Boolean;
var
vRange:Variant;
begin
vRange:=Sheet.Columns[AColNum];
try
//设置垂直线样式
vRange.Borders.Item[xlInsideVertical].LineStyle :=ALineStyle;
vRange.Borders.Item[xlInsideVertical].Weight := AWeight;
vRange.Borders.Item[xlInsideVertical].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置水平线样式
vRange.Borders.Item[xlInsideHorizontal].LineStyle := ALineStyle;
vRange.Borders.Item[xlInsideHorizontal].Weight := AWeight;
vRange.Borders.Item[xlInsideHorizontal].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定行的水平对其方式
输入参数:ARowNum 待设置的列号
AAlign 对其方式 常用值:
xlCenter 居中
xlLeft 靠左
xlRight 靠右
xlJustify 两端对齐
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRowHorizontalAlignment(ARowNum:Integer;AAlign:Integer=xlLeft):Boolean;
var
vRange:Variant;
begin
try
vRange:=Sheet.Rows[ARowNum];
vRange.HorizontalAlignment:= AAlign;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定行的垂直对其方式
输入参数:ARowNum 待设置的行号
AAlign 对其方式 常用值
xlCenter居中
xlTop 靠左
xlBottom 靠右
xlJustify 两端对齐
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRowVerticalAlignment(ARowNum:Integer;AAlign:Integer=xlBottom):Boolean; //设置指定行的垂直平对其方式
var
vRange:Variant;
begin
try
vRange:=Sheet.Rows[ARowNum];
vRange.VerticalAlignment:= AAlign;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的水平对其方式
输入参数:AColNum 待设置的列号
AAlign 对其方式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetColumnHorizontalAlignment(AColNum:Integer;AAlign:Integer=xlLeft):Boolean; //设置指定列的水平对其方式
var
vRange:Variant;
begin
try
vRange:=Sheet.Columns[AColNum];
vRange.HorizontalAlignment:= AAlign;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的垂直对其方式
输入参数:AColNum: 待设置的列号;AAlign:对其方式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetColumnVerticalAlignment(AColNum:Integer;AAlign:Integer=xlBottom):Boolean;
var
vRange:Variant;
begin
try
vRange:=Sheet.Columns[AColNum];
vRange.VerticalAlignment:= AAlign;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:Excel数据保存到文件
输入参数:AFileName:待保存的文件全名
输出参数:保存成功返回真否则返回假
创建时间:2006-05-30
创建人: 赵占轻
}
function TExcel.SaveToFile(AFileName:string):Boolean; //Excel数据保存到文件
begin
try
if FileExists(AFileName) then
begin
if DeleteFile(AFileName) then
begin
MyExcel.ActiveWorkbook.saveAs(AFileName);
end else
begin
Result:=False;
Exit;
end;
end else
begin
MyExcel.ActiveWorkbook.saveAs(AFileName);
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
end.//This Unit is over;
可以实现表格设计,数据输出,模板定制,
打印设置,打印预览,打印表格等功能;}
unit Excel_Unit;{单元名称}
interface{接口部分}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Excel97,OleServer, StdCtrls,Variants,ExcelConst_Unit,ComObj;
const
//报表平面图参数
pm_Title = '配 电 线 路 条 图';
pm_PageRows = 21;
pm_PageOffset = 530;// //页与页之间图形距离
pm_LineLeft = 123; //线起始left
pm_LineTop = 72;//74; //线起始top
pm_LineRight = 727;//705; //线终止right //水平所以没有y坐标
pm_GanFirstLeft = 118; //最左第一个杆的left坐标
pm_GanOffset = 60; //杆间距
pm_GanTop = 166;//67; //杆距顶top
pm_GanD = 10; //杆径 12
pm_BYQD = 13;//14; //变压器大小 13
pm_BYQY = -7; //变压器距杆距离 20
pm_Distance = 27;//30; //转角箭头线段长
dm_GanTop = 143.25; //断面杆
dm_HaiBa = 0; //海拔
dm_HuChui = 5; //导线下垂弧度
//下面记录类型用于绘制平断面图
type
TRecData = record
XLMC: String; //线路名称
GH: String; //杆号
GX: String; //电杆种类及杆型
GG: String; //杆高
MS: String; //埋深
DXPL: String; //导线排列
DXXH: String; //导线型号
DJ: String; //档距
LJCD: String; //累计长度
ZJBZ: Integer; //画转角标志 1: 画转角 0: 不画转角
ZJ: String; //线路转角
JCKY: String; //交叉跨越
CZJL: String; //垂直距离
HDGG: String; //横担规格
LXWZ: String; //拉线位置
LXXHGS: String; //拉线型号/根数
JYZXHSL: String;//绝缘子型号/数量
GZZSY: String; //故障指示仪
BTXS: String; //变台型式
PBRL: String; //配变容量
HM: String; //户名
BLQGG: String; //避雷器规格
BLQSL: String; //避雷器数量
KGGG: String; //开关规格
KGSL: String; //开关数量
FZ1ZJ: String; //分支1转角
FZ2ZJ: String; //分支2转角
FZ1MC: String; //分支1名称
FZ2MC: String; //分支2名称
IsCable: Integer; //是否有电缆 1: 电缆 0: 不是电缆
IsTJPole: Integer; //是否是引出分支杆
end;
PRecData = ^TRecData;
type
TWindowObject = record
WinHandle : HWnd; {Window Handle}
WinCaption : String; {Window Caption Text (If any)}
ProcessID : Integer; {Process the window belongs to}
IsVisible : Boolean; {Is the window visible?}
IsEnabled : Boolean; {Is the window enabled for mouse/keyboard input?}
IsIconic : Boolean; {Is the window minimized?}
WindowRect : TRect; {Window Dimensions}
{Add more properties here if you like,
then fill them in at the WindowCallback
function.}
end;
PTWindowObject = ^TWindowObject;
//Excel操作类
TExcel = class(TObject)
private
MyExcel: Variant; //存储Excel对象
Book :Variant; //当前工作表
Sheet:Variant; //当前工作表
protected
{ protected declarations }
function GetRowNum(TStr:string):Integer; //获取指定单元格的行号()
function GetColNum(TStr:string):Integer; //获取指定单元格的行号
public
{ Public declarations }
IsPageSetup:Boolean; //是否进行了页面设置
Template_Path:string; //模板路径
Template_Name:string; //模板名称
Template_OpenName:String; //打开的模板的名称
ActiveSheet:Integer; //当前活动的页
UsedRowBeg:Integer; //当前已使用的起始行
UsedColBeg:Integer; //当前已使用的起始列
UsedRowEnd:Integer; //当前已使用的终止行
UsedColEnd:Integer; //当前已使用的终止列
CurRowBeg:Integer; //要使用的起始行
CurColBeg:Integer; //要使用的起始列
CurRowEnd:Integer; //要使用的终止行
CurColEnd:Integer; //要使用的终止列
//下面为类操作
Constructor Create(); //创建Excel对象
Destructor Destroy; virtual; //释放Excel对象
//Excel操作
procedure IsVisible(IsOrNo:Boolean); //控制Excel是否显示
procedure IsAlert(IsOrNo:Boolean); //控制Excel是否出现警告存盘的对话框
function SetActiveWindowGridVisible(IsVisible:Boolean=True):Boolean; //设置当前窗口网格的显示与否
function SaveToFile(AFileName:string):Boolean; //Excel数据保存到文件
procedure ExitExcel; //退出Excel
//工作簿操作
function New_WorkBook:Boolean; //新建工作簿
function OpenExcelFile(FileName:string): Boolean; //打开指定的Excel文件
function IsWorkbookExit:Integer; //判断是否存在工作簿
//工作表操作
function SetCurrentSheet(SheetNum:Integer):Boolean; //设置当前工作表
function GetSheetsNameList(var FileName:TstringList):Boolean; //得到工作簿中工作表名称列表
function GetSheetRange:string; //获取当前工作表中的工作范围
function SetSheetPage(APageType,Orientation:Integer;LeftMargin,RightMargin,TopMargin,
BottomMargin,HeaderMargin,FooterMargin:Double):Boolean; //对指定的工作表进行页面设置
//Range或Cell操作
function GetCell(Row,Col:Integer):Variant; //得到当前工作表中某行某列的值
procedure SetCell(Value: String; Row, Col: Integer;AType:Integer); //设置指定单元格的值
function GetRangeValue(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):String; //获取指定范围的值
function SetRangeValue(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;AValue:string):Boolean; //设置指定范围的值
function InsertPicIntoSheet(ABeginRow,ABeginCol:Integer;APicFile:String):Boolean;//向指定工作表中插入图片
function Sum(BeginRow,BeginCol,EndRow,EndCol:Integer):Double; //对指定单元格间的值求和
//文本框操作
function InsertTextBox(AX,AY,AWidth,AHeight:Double;AOrient:Integer=msoTextOrientationHorizontalRotatedFarEast):Variant;//在指定位置插入文本框
function SetTextBoxFillStyle(ATextBox:Variant;AVisible:Integer;ATransparency:Double=0):Boolean; //设置文本框填充样式
function SetTextBoxLineStyle(ATextBox:Variant;AVisible:Integer;ATransparency:Double=0):Boolean; //设置文本框边框样式
function SetTextBoxFontStyle(ATextBox:Variant;AFontName,AFontStyle:String;
AFontSize:Integer = 12;AFontColor:Integer=0):Boolean; //设置文本框中字体样式
function SetTextBoxAlignment(ATextBox:Variant;HAlign:Integer=xlLeft;VAlign:Integer=xlBottom):Boolean; //设置文本框水平和垂直对齐方式
function SetTextBoxText(ATextBox:Variant;AText:string):Boolean; //设置文本框中文字内容
//格式化单元格操作
function MergeCells(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Variant; //合并单元格
procedure CellAutoFit; //设置单元格为自动列宽
//格式化行高和列宽
function SetColumnWidth(AColNum:Integer;AColWidth:Double):Boolean; //设置指定列的宽度
function SetRowHeight(ARowNum:Integer;ARowHeight:Double):Boolean; //设置指定行的行高
function SetRangeColWidth(ABeginRow,ABeginCol,AEndRow,AEndCol:Integer;AColWidth:Double):Boolean; //设置指定范围内单元格的列宽
//格式化指定区域范围
function SetRangeFontStyle(BeginRow,BeginCol,EndRow, EndCol:Integer;
AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean; //设置范围
function SetRowFontStyle(ARowNum:Integer;AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean; //设置指定行的字体样式
function SetColumnFontStyle(AColNum:Integer;AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean; //设置指定列的字体样式
function SetRangeOutBorderStyle(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
AWeight:Integer=2;ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean; //设置指定范围的外边框样式
function SetRowOutBorderStyle(ARowNum:Integer;AWeight:Integer=2;
ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean; //设置指定行的外边框样式
function SetColumnOutBorderStyle(AColNum:Integer;AWeight:Integer=2;ALineColor:Integer=0; //设置指定列的外边框样式
ALineStyle:Integer=xlContinuous):Boolean;
function SetRangeInnerLineStyle(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
AWeight:Integer=2;ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean; //设置指定范围的分隔线样式
function SetRowInnerLineStyle(ARowNum:Integer;AWeight:Integer=2;ALineColor:Integer=0;
ALineStyle:Integer=xlContinuous):Boolean; //设置指定行的分隔线样式
function SetColumnInnerLineStyle(AColNum:Integer;AWeight:Integer=2;ALineColor:Integer=0;
ALineStyle:Integer=xlContinuous):Boolean; //设置指定列的分隔线样式
function SetRangeHorizontalAlignment(ABegRowNum,ABegColNum,AEndRowNum,
AEndColNum:Integer;AAlign:Integer=xlLeft):Boolean; //设置范围的水平对其方式
function SetRangeVerticalAlignment(ABegRowNum,ABegColNum,AEndRowNum,
AEndColNum:Integer;AAlign:Integer=xlBottom):Boolean; //设置范围的垂直对其方式
function SetRowHorizontalAlignment(ARowNum:Integer;AAlign:Integer=xlLeft):Boolean; //设置指定行的水平对其方式
function SetRowVerticalAlignment(ARowNum:Integer;AAlign:Integer=xlBottom):Boolean; //设置指定行的垂直平对其方式
function SetColumnHorizontalAlignment(AColNum:Integer;AAlign:Integer=xlLeft):Boolean; //设置指定列的水平对其方式
function SetColumnVerticalAlignment(AColNum:Integer;AAlign:Integer=xlBottom):Boolean; //设置指定列的垂直对其方式
function SetRangeAutoWrap(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Boolean; //设置指定区域格式为自动换行
function CancelRangeAutoWrap(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Boolean; //取消指定区域的自动换行
function SetRangeBackGround(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
APattern:Integer=xlSolid;APatternColor:Integer=xlNone;ABackColor:Integer=xlNone):Boolean; //设置指定范围的背景图案
//格式化箭头线
function FormatArrowLineEndHead(ALine:Variant;AheadStyle:Integer=msoArrowheadTriangle;
AheadLength:Integer=msoArrowheadLengthMedium;AheadWidth:Integer=msoArrowheadWidthMedium):Boolean; //格式化箭头线的末端样式
function FormatArrowLineBeginHead(ALine:Variant;AheadStyle:Integer=msoArrowheadTriangle;
AheadLength:Integer=msoArrowheadLengthMedium;AheadWidth:Integer=msoArrowheadWidthMedium):Boolean; //格式化箭头线的首端样式
function FormatArrowLine(ALine:Variant;AWidth:Double=1.5;AStyle:Integer=msoLineSingle;ADashStyle:Integer=msoLineSolid):Boolean; //格式化箭头线的线样式
//数据库中数据转为Excel操作
procedure SetTheFieldsName(AFields:TStringList;BeginRow,BeginCol,FieldNumber:Integer;IsNeedXuHao:Boolean); //设置Excel工作表中的列名
procedure TransferDataToExcel(FieldValues:Array of TStringList;BeginRow,BeginCol,FieldNumber,RcdNumber:Integer;IsNeedXuHao:Boolean); //转换数据到Excel
procedure DataToExcelUpPage(FieldValues:Array of TStringList;BeginRow,BeginCol,FieldNumber,
RcdNumber:Integer;IsNeedXuHao:Boolean;IsHengXiangOrZongXiang:Boolean=False); //使用Excel将指定的数据打印输出
//
procedure Print_PageSetup(); //打印页面设置
procedure Print_PrintView; //打印预览
procedure Print_PrintOut; //打印输出
//
function Get_Template_Path():String; //获取模板路径
procedure Set_Template_Path(PathName:String); //设置模板路径
procedure Set_Template_OpenName(TemplateName:String); //设置打开模板的名称
function Open_Template():Variant; //打开模板
procedure Save_Template(); //保存模板
//
procedure SetTableTitle(TitleName:String;BeginRow,BeginCol,Row,Col,FontSize:integer;
IsNeedXuHao:Boolean=False;IsNeedFrame:Boolean=True); //设置表的标题(表头)
//绘制平断面图
procedure CreatePage(APage: Integer;ABDZMC, AXLMC: String;AValueList: TStringList); //创建页
procedure FormatCells(APage, AColNum, ARow: Integer;AColName: String
;AValueList: TStringList); //绘制平断面图时根据不同情况格式化单元格
procedure GetCellDMGanCoord(APage, ACellIndex: Integer;var AX, AY: Double); //获取指定页,指定cell的断面杆的中心坐标
procedure CreateDMT(AX1, AY1, AGanGao: Double;AIsTJPole, AIsFirstPole,
AIsCable: Boolean;var AOldY2: Double); //创建断面图
procedure GetCellGanCoord(APage, ACellIndex: Integer;var AX, AY: Double); //获取指定页,指定cell的杆的中心坐标
procedure CreateFZLine(AX, AY,AYOffSet,AAngle: Double;AXLMC: String); //画分支 创建转角箭头线
procedure CreateArrowheadLine(AX, AY, AAngle: Double); //创建转角箭头线
function DoubleToFenMiao(Jiao:Double):string; //双精度的度转换为度分秒
procedure DrawBYQText(AX, AY : Double;AText: String); //绘制变压器文本
procedure DrawBYQ(AX, AY : Double); //绘制变压器
function GetPoleHight(AHight: Double): Double; //以15米杆高为标准计算d当前杆塔图形高度
//暂不使用的功能
function FindTheExcelMainWindow:Integer; //辅助工程找出当前系统环境中的运行的excel的主窗体句柄:
procedure DisableSystemCloseBox; //使当前Excel应用程序的关闭按钮失效
//
Published
{ Published declarations }
end;
const
RcdCountOfEachPageOfHengXiang=22;
RcdCountOfEachPageOfZongXiang=44;
var
MyWindowPtr : ^TWindowObject;
V_PageOffset: Double;
implementation {实现部分}
{ Excel }
{
功能描述:创建Excel对象
输入参数: 无
输出参数:无
创建时间: 2006-04-07
创建人: 赵占轻
}
constructor TExcel.Create();
begin
Inherited;
try
MyExcel:=CreateOleObject('Excel.Application'); //创建Excel对象
except
end;
//
// New(MyWindowPtr);
//
end;
{
功能描述:使用Excel将指定的数据打印输出
输入参数:FieldValues 待输出的数据列表
BeginRow 起始行号
BeginCol 起始列号
FieldNumber 字段数
RcdNumber 记录数
IsNeedXuHao 是否需要序号
IsHengXiangOrZongXiang 纵向还是横向 (True:纵向False:横向)
输出参数:无
创建时间:2006-04-13
创建人: 赵占轻
}
procedure TExcel.DataToExcelUpPage(FieldValues: array of TStringList; BeginRow,
BeginCol, FieldNumber, RcdNumber: Integer; IsNeedXuHao: Boolean;IsHengXiangOrZongXiang:Boolean=False);
var
nPageNumber,nLastPageRcdCount,i,nTmp:Integer;
vSheet:Variant;
begin
if IsHengXiangOrZongXiang then
begin
nLastPageRcdCount:=(RcdNumber mod RcdCountOfEachPageOfZongXiang);
nPageNumber:=((RcdNumber-nLastPageRcdCount) div RcdCountOfEachPageOfZongXiang);
ntmp:=RcdCountOfEachPageOfZongXiang;
end else
begin
nLastPageRcdCount:=(RcdNumber mod RcdCountOfEachPageOfHengXiang);
nPageNumber:=((RcdNumber-nLastPageRcdCount) div RcdCountOfEachPageOfHengXiang);
nTmp:=RcdCountOfEachPageOfHengXiang;
end;//
//循环执行打印工作:
for i:=1 to nPageNumber do
begin
try
vSheet:=Open_Template; //打开模板
except
MyExcel.Quit;
Exit;
end;//
TransferDataToExcel(FieldValues,BeginRow,BeginCol,FieldNumber,ntmp,IsNeedXuHao); //数据输出到Excel
try
Print_PrintOut; //从Excel中打印输出
except
ShowMessage('打印机错误,请检查你的打印机设备是否正常!');
Exit;
end;//
end;//
//执行剩余打印工作:
if nLastPageRcdCount>0 then
begin
try
vSheet:=Open_Template;
except
MyExcel.Quit;
Exit;
end;//
TransferDataToExcel(FieldValues,BeginRow,BeginCol,FieldNumber,nLastPageRcdCount,IsNeedXuHao);
try
Print_PrintOut;
except
ShowMessage('打印机错误,请检查你的打印机设备是否正常!');
Exit;
end;//
end;//
end;
{
功能描述:释放Excel对象变量
输入参数:无
输出参数: 无
创建时间:2006-04-07
创建人: 赵占轻
}
destructor TExcel.Destroy;
begin
//
inherited;
MyExcel:=UnAssigned;
end;
{
功能描述:使Excel程序关闭按钮失效
输入参数:无
输出参数:无
创建时间:2006-04-18
创建人: 刘惠城
}
procedure TExcel.DisableSystemCloseBox;
var
hExcelWindow : HWND;
hSysMenu : HMENU;
nrlt:Integer;
begin
// Find the Excel2000 handle
nrlt:=FindTheExcelMainWindow;
if nrlt=0 then
begin
Exit;
end
else
begin
hExcelWindow:=MyWindowPtr.WinHandle;
end;//
if hExcelWindow <> 0 then
begin
hSysMenu := GetSystemMenu (hExcelWindow, false);
EnableMenuItem (hSysMenu, SC_CLOSE, MF_DISABLED)
end;
end;
//-------------------------------------------------------------------------//
{
功能描述:退出Excel
输入参数:无
输出参数:无
创建时间:2003-11-09
创建人: 徐伟亮
}
procedure TExcel.ExitExcel;
begin
try
Book.Saved:=True; //自动退出Excel时保存修改内容
except
end;
MyExcel.Quit;
end;
{
功能描述:辅助工程找出当前系统环境中的运行的excel的主窗体句柄
输入参数:无
输出参数:1:找到结果;0:未找到结果
创建时间:2006-04-18
创建人: 刘惠城
}
function TExcel.FindTheExcelMainWindow:Integer;//will alter
function WindowCallback(WHandle : HWnd; Var Parm : Pointer) : Boolean; stdcall;
{This function is called once for each window}
Var MyString : PChar;
MyInt : Integer;
caption1:PChar;
begin
caption1:='Microsoft Excel';
MyString := Allocmem(255);
GetWindowText(WHandle,MyString,255);
if StrPos(MyString,caption1)=nil then
begin
//FreeMem(caption1,16);
Result := True;//Not find,continue to enumerate windows;
Exit;
end;//
//
{Window Handle (Passed by the enumeration)}
MyWindowPtr.WinHandle := WHandle;
{Window text}
MyWindowPtr.WinCaption := String(MyString);
FreeMem(MyString,255);
{Process ID}
MyInt := 0;
MyWindowPtr.ProcessID := GetWindowThreadProcessId(WHandle,@MyInt);
{Visiblity}
MyWindowPtr.IsVisible := IsWindowVisible(WHandle);
{Enabled}
MyWindowPtr.IsEnabled := IsWindowEnabled(WHandle);
{Iconic}
MyWindowPtr.IsIconic := IsIconic(WHandle);
{Window Dimensions}
MyWindowPtr.WindowRect := Rect(0,0,0,0);
GetWindowRect(WHandle,MyWindowPtr.WindowRect);
//
Result := False; {Everything's okay.Stop to enumerate windows}
end;
//
begin
//
EnumWindows(@WindowCallback,0);
if MyWindowPtr.WinHandle = 0 then
begin
Result:=0;
end else
begin
Result:=1;
end;
end;
{
功能描述:获取模板路径
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
function TExcel.Get_Template_Path: String;
begin
//
Result:=Template_Path;
end;
{
功能描述:控制是否出现警告存盘的对话框;
输入参数:IsOrNo:控制是否显示提示框
(True:显示提示框;False:不显示提示框)
输出参数:无
创建时间:2006-04-07
创建人: 赵占轻
}
procedure TExcel.IsAlert(IsOrNo: Boolean);
begin
MyExcel.DisplayAlerts:=IsOrNo; //是否出现警告存盘的对话框;
end;
{
功能描述:控制是否显示Excel
输入参数:IsOrNo:
(True:显示Excel;False:不显示Excel)
输出参数:无
创建日期:2003-10-20
创建人: 赵占轻
}
procedure TExcel.IsVisible(IsOrNo: Boolean);
begin
if IsOrNo then
begin
MyExcel.Visible:= True;
end else
begin
MyExcel.Visible :=False;
end;
end;
{
功能描述:判断是否存在工作簿
输入参数:无
输出参数:0:不存在工作簿;1:存在工作簿
创建时间:2006-04-07
创建人: 赵占轻
}
function TExcel.IsWorkbookExit: Integer;
var
nBookCount:Integer;
begin
nBookCount:=MyExcel.Workbooks.Count; //获取工作簿数量
if nBookCount<=0 then
begin
Result:=0;
Exit;
end;//
Result:=1;
end;
{
功能描述:新建工作簿
输入参数:无
输出参数:执行成功返回真否则返回假
创建时间:2006-04-14
创建人: 赵占轻
}
function TExcel.New_WorkBook:Boolean;
begin
{在启动Excel之前,最好将以前运行的实例关闭
因为有时会出现异常的情况;}
//启动Excel应用程序:
Result:=False;
try
if MyExcel.Workbooks.Count>=1 then //如果Excel已经启动,
begin //且工作薄存在,则置
Book:=MyExcel.Workbooks[1]; //第一个工作薄为当前
Sheet:=MyExcel.Workbooks [1].Worksheets[1];//工作薄;
Exit;
end;//
Book:=MyExcel.Workbooks.Add;
if MyExcel.Worksheets.Count>=1 then
begin
Sheet:=Book.Worksheets.Item[1];
end;
except
Exit;
end;
Result:=True;
end;
{
功能描述:打开模板
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
function TExcel.Open_Template:Variant;
var
sTmp:String;
begin
//打开模板
if MyExcel.Workbooks.Count>=1 then
begin
Book:=MyExcel.Workbooks[1];
Book.Close;
end;//
sTmp:=Template_Path+Template_OpenName;
Book:=MyExcel.Workbooks.Add (sTmp,0);
Result:=MyExcel.Workbooks [1].Worksheets[1];
end;
{
功能描述:打印页面设置
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Print_PageSetup;
begin
//打印设置
IsPageSetup:=MyExcel.Dialogs.Item[xlDialogPageSetup].Show(
EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam);
end;
{
功能描述:打印输出
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Print_PrintOut;
begin
Sheet.PrintOut(EmptyParam);
end;
{
功能描述:打印预览
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Print_PrintView;
begin
Sheet.PrintPreview;
end;
{
功能描述:保存模板
输入参数:无
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Save_Template;
var
sTmp:String;
begin
//保存模板
sTmp:=Template_Path+Template_Name;
Book.SaveAs(sTmp,xlTemplate);
end;
{
功能描述:设置表的标题
输入参数:TitleName 标题名称
BeginRow 开始行
BeginCol 开始列
Row 所占用的行数
Col 列数
FontSize 字体大小
IsNeedXuHao 是否需要序号
IsNeedFrame 是否需要框架
输出参数:无
创建时间:2003-10-20
创建人: 赵占轻
}
procedure TExcel.SetTableTitle(TitleName: String;
BeginRow,BeginCol,Row, Col,FontSize: integer;
IsNeedXuHao:Boolean=False;IsNeedFrame:Boolean=True);
var
vRange,vCell1,vCell2:Variant;
nCol,nRow:Integer;
sTitleName:String;
begin
sTitleName:=TitleName; //记录标题名
nCol:=Col; //记录标题所占用的列数
nRow:=Row; //记录标题所占用的行数
vCell1:=Sheet.Cells[BeginRow,BeginCol]; //记录起始单元格
if IsNeedXuHao then //需要序号
begin
MergeCells(BeginRow,BeginCol,nRow,nCol+1); //合并单元格
SetRangeHorizontalAlignment(BeginRow,BeginCol,nRow,nCol+1,xlHAlignCenter);//水平对其方式为居中
SetRangeVerticalAlignment(BeginRow,BeginCol,nRow,nCol+1,xlVAlignCenter); //垂直对其方式为居中
//设置字体样式
SetRangeFontStyle(BeginRow,BeginCol,nRow,nCol+1,'正常','宋体',5,FontSize); //设置指定范围的字体样式
SetRangeValue(BeginRow,BeginCol,nRow,nCol+1,sTitleName); //设置标题
if IsNeedFrame then //需要边框
begin
SetRangeOutBorderStyle(BeginRow,BeginCol,nRow,nCol,1,0,1);
end;
end
else //不需要序号
begin
MergeCells(BeginRow,BeginCol,nRow,nCol); //合并单元格
SetRangeHorizontalAlignment(BeginRow,BeginCol,nRow,nCol,xlHAlignCenter);//水平对其方式为居中
SetRangeVerticalAlignment(BeginRow,BeginCol,nRow,nCol,xlVAlignCenter); //垂直对其方式为居中
//设置字体样式
SetRangeFontStyle(BeginRow,BeginCol,nRow,nCol,'正常','宋体',5,FontSize); //设置指定范围的字体样式
SetRangeValue(BeginRow,BeginCol,nRow,nCol,sTitleName);
if IsNeedFrame then //需要边框
begin
SetRangeOutBorderStyle(BeginRow,BeginCol,nRow,nCol,1,0,1);
end;
end;
end;
{
功能描述:设置Excel工作表中的列名
输入参数: AFields 列名列表
BeginRow 起始行号
BeginCol 起始列号
FieldNumber 列数
IsNeedXuHao 是否需要序号
输出参数:无
创建时间:2006-04-13
创建人: 赵占轻
}
procedure TExcel.SetTheFieldsName(AFields:TStringList;BeginRow,BeginCol,FieldNumber:Integer;IsNeedXuHao:Boolean);
var
vRange,vCell1,vCell2:Variant;
nCol,i,j:Integer;
sValue:String;
begin
nCol:=BeginCol+FieldNumber-1;
//从数据库中读出字段名并输出到第一列:
vCell1:=Sheet.Cells[BeginRow,BeginCol];
vCell2:=Sheet.Cells[BeginRow,nCol];
vRange:=Sheet.Range[vCell1,vCell2];
// SetRangeFontStyle(vRange,'常规','宋体',5,13); //设置指定范围的字体样式
if IsNeedXuHao then
begin
Sheet.Cells[BeginRow,BeginCol]:='序号';
for i:=BeginCol to FieldNumber do
begin
sValue:=AFields[i-1];
Sheet.Cells[BeginRow,i+1]:=sValue;
Sheet.Cells[BeginRow,i+1].Borders.LineStyle:=1;
end;
exit;
end;
//-----------------------------------------//
j:=0;
for i:=BeginCol to FieldNumber+BeginCol-1 do
begin
sValue:=AFields[j];
Sheet.Cells[BeginRow,i].Borders.LineStyle:=1;
Sheet.Cells[BeginRow,i]:=sValue;
Sheet.Cells[BeginRow,i].HorizontalAlignment:= xlHAlignCenter;
Sheet.Cells[BeginRow,i].VerticalAlignment:=xlVAlignCenter;
j:=j+1;
end;
end;
{
功能描述:设置打开模板的名称
输入参数: TemplateName:模板名称
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Set_Template_OpenName(TemplateName: String);
begin
//
Template_OpenName:=TemplateName;
end;
{
功能描述:设置模板路径
输入参数:PathName:路径名
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.Set_Template_Path(PathName: String);
begin
//
Template_Path:=PathName;
end;
{
功能描述:转换数据到Excel
输入参数:FieldValues 字段值列表
BeginRow 起始行号
BeginCol 起始列号
FieldNumber 字段数
RcdNumber 记录数
IsNeedXuHao 是否需要序号
输出参数:无
创建时间:2006-04-13
创建人: 赵占轻
}
procedure TExcel.TransferDataToExcel(FieldValues:Array of TStringList; BeginRow, BeginCol,
FieldNumber,RcdNumber: Integer; IsNeedXuHao: Boolean);
var
i,j,nSerial:Integer;
sValue:String;
begin
//
//设置序号值:
if IsNeedXuHao then
begin
nSerial:=1;
for i:=BeginRow to BeginRow+RcdNumber do //
begin
//
Sheet.Cells[i,BeginCol].Borders.LineStyle:=1;
Sheet.Cells[i,BeginCol]:=nSerial;
Sheet.Cells[i,BeginCol].HorizontalAlignment:= xlHAlignCenter;
Sheet.Cells[i,BeginCol].VerticalAlignment:=xlVAlignCenter;
//
if i=BeginRow+RcdNumber-1 then
begin
break;
end;//
nSerial:=nSerial+1;
end;//
BeginCol:=BeginCol+1;
end;//
// 传输数据到Excel工作表
for i:=0 to RcdNumber-1 do
begin
for j:=0 to FieldNumber-1 do
begin
sValue:=FieldValues[i][j] ;
Sheet.Cells[BeginRow+i,BeginCol+j].Borders.LineStyle:=1;
Sheet.Cells[BeginRow+i,BeginCol+j]:=sValue;
Sheet.Cells[BeginRow+i,BeginCol+j].HorizontalAlignment:= xlHAlignCenter;
Sheet.Cells[BeginRow+i,BeginCol+j].VerticalAlignment:=xlVAlignCenter;
end;//
end;//
end;
{
功能描述:得到当前工作表中某行某列的值
输入参数:Row:指定行号;
Col:指定单元格列号
输出参数:返回指定单元格的值
创建时间:2006-04-11
创建人: 赵占轻
}
function TExcel.GetCell(Row,Col:Integer):Variant;
begin
if (Row=0) or (Col=0) then
begin
Result:=-1;
Exit;
end;
Result:=Sheet.Cells[Row,Col];
end;
{
功能描述:对指定单元格间的值求和
输入参数:BeginRow 起始单元格的行号
BeginCol 起始单元格的列号
EndRow 终止单元格的行号
EndCol 终止单元格的列号
输出参数:返回总和值
创建时间:2006-04-11
创建人: 赵占轻
}
function TExcel.Sum(BeginRow,BeginCol,EndRow,EndCol:Integer):Double;
var
dTotal:Double;
vRange,vCell1,vCell2:Variant;
begin
vCell1:=Sheet.Cells[BeginRow,BeginCol]; //获取起始单元格
vCell2:=Sheet.Cells[EndRow,EndCol]; //获取终止单元格
vRange:=MyExcel.Range[vCell1,vCell2];
//计算总和
dTotal:=MyExcel.Sum (vRange,vRange,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam
,EmptyParam,EmptyParam);
//
Result:=dTotal/2.0;
end;//
{
功能描述:设置指定单元格的值
输入参数:Value: 设置的单元格的值
Row: 指定单元格的行号
Col: 指定单元格的列号
AType:单元格值的类型 (0:字符型;1:整形;2,3:数值型)
输出参数:无
创建时间:2006-04-11
创建人: 赵占轻
}
procedure TExcel.SetCell(Value: String; Row, Col: Integer;AType:Integer);
begin
case AType of
0: //字符型
begin
//格式化单元格为文本样式,确保数据格式正确
Sheet.Cells[Row,Col].NumberFormatLocal:='@';
end;
1: //整型
begin
Sheet.Cells[Row,Col].NumberFormatLocal:='0';
end;
2:
begin
//格式化单元格为文本样式,确保数据格式正确
Sheet.Cells[Row,Col].NumberFormatLocal:='0.00000';
end;
3: //浮点型
begin
Sheet.Cells[Row,Col].NumberFormatLocal:='0.00000';
end;
end;
Sheet.Cells[Row,Col]:=Value;
end;
{
功能描述:设置单元格为自动列宽
输入参数:无
输出参数:无
创建时间:2003-11-20
创建人: 赵占轻
}
procedure TExcel.CellAutoFit;
begin
MyExcel.Columns.AutoFit;
end;
{
功能描述: 打开指定的Excel文件
输入参数: FileName:要打开的文件名 如:c:\test.xls
输出参数: 执行成功返回真否则返回假
创建时间: 2006-04-07
设计人: 赵占轻
}
function TExcel.OpenExcelFile(FileName: string): Boolean;
begin
Result:=False;
try
Book:=MyExcel.Workbooks.Open(FileName);
Sheet:=Book.WorkSheets.Item[1];
except
Exit;
end;
Result:=True;
end;
{
功能描述: 得到指定的工作表
输入参数: SheetNum:工作表顺序号;ASheet:记录获取的工作表
输出参数: 执行成功返回真否则返回假
输入输出参数:ASheet:返回获取的工作表
创建时间: 2006-04-11
创建人: 赵占轻
}
{
功能描述:获取当前活动工作簿中指定工作表的工作范围
输入参数:ASheet:要操作的工作表;SheetNum:指定工作簿中工作表的序号
输出参数:工作区地址字符串 如"A1:Z200"
创建时间: 2006-04-07
创建人: 赵占轻
}
function TExcel.GetSheetRange:string;
var
sTemp:String;
i:Integer;
begin
sTemp:=Sheet.UsedRange.AddressLocal; //取指定工作表中的工作范围
//分析字符串提取行列号
for i:=1 to Length(sTemp) do
begin
if sTemp[i]<>'$' then
begin
Result:=Result+sTemp[i];
end;
end;
if Pos(':',ReSult)=0 then
begin
UsedRowBeg:=GetRowNum(ReSult); //起始行号
UsedColBeg:=GetColNum(Result); //起始列号
UsedRowEnd:=UsedRowBeg; //终止行号
UsedColEnd:=UsedColBeg; //终止列号
Result:=Result+':'+Result;
end
else
begin
sTemp:=Copy(Result,1,Pos(':',Result)-1);
UsedRowBeg:=GetRowNum(sTemp); //起始行号
UsedColBeg:=GetColNum(sTemp); //其实列号
sTemp:=Copy(Result,Pos(':',Result)+1,Length(Result)-Pos(':',Result));
UsedRowEnd:=GetRowNum(sTemp); //终止行号
UsedColEnd:=GetColNum(sTemp); //终止列号
end;
end;
{
功能描述:获取指定单元格的列号
输入参数: TStr:单元格地址
输出参数: 单元格列号
创建时间: 2006-04-07
创建人: 赵占轻
}
function TExcel.GetColNum(TStr:string):Integer;
begin
Result:=StrToInt(Sheet.Range[TStr].Cells.Column);
end;
{
功能描述:获取指定单元格的行号
输入参数: TStr:单元格地址
输出参数: 单元格行号
创建时间: 2006-04-07
创建人: 赵占轻
}
function TExcel.GetRowNum(TStr:string):Integer;
begin
Result:=StrToInt(Sheet.Range[TStr].Cells.Row);
end;
{
功能描述: 得到当前工作簿中所有工作表名称
输入参数: FileName:用于返回获取的所有工作表名称
输出参数: 操作结果 True:执行成功;False: 执行失败
输入输出参数:FileName:用于返回获取的所有工作表名称
创建时间: 2003-10-24
创建人: 赵占轻
}
function TExcel.GetSheetsNameList(var FileName:TstringList):Boolean;
var
i:Integer;
vSheet:Variant;
begin
try
for i:=1 to MyExcel.ActiveWorkbook.Sheets.Count do
begin
vSheet:=MyExcel.ActiveWorkbook.Worksheets[i]; //获取第i个工作表
FileName.Add(VSheet.Name); //记录第i个工作表的名称
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:合并单元格
输入参数:ABegRowNum: 待合并单元格的起始行号
ABegColNum: 起始列号
AEndRowNum: 终止行号
AEndColNum: 终止列号
输出参数: 返回合并后的单元格
创建时间: 2006-04-11
创建人: 赵占轻
}
function TExcel.MergeCells(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Variant; //合并单元格
var
vRange:Variant;
vBegCell,vEndCell:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell]; //获取指定单元格间的范围
vRange.Merge; //合并单元格
Result:=vRange;
except
Result:=Null;
end;
end;
{
功能描述:设置指定范围单元格的字体样式
输入参数:BeginRow 指定范围的起始单元格行号;
BeginCol 指定范围的起始单元格列号;
EndRow 指定范围的终止单元格行号
EndCol 指定范围的终止单元格列号
AFontStyle 目标字体样式(如粗体);
AFontName 目标字体名称;
AFontSize 目标字体大小
AFontColor 目标字体颜色
输出参数:执行成功返回真;否则返回假
创建时间:2006-04-12
创建人: 赵占轻
}
function TExcel.SetRangeFontStyle(BeginRow,BeginCol,EndRow, EndCol:Integer;
AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean; //设置范围
var
vRange:Variant;
vBegCel,vEndCell:Variant;
begin
try
vBegCel:=Sheet.Cells[BeginRow,BeginCol];
vEndCell:=Sheet.Cells[EndRow, EndCol];
vRange:=Sheet.Range[vBegCel,vEndCell];
vRange.Font.ColorIndex:=AFontColor; //设置字体颜色
vRange.Font.Name:=AFontName; //设置字体名称
vRange.Font.Size:=AFontSize; //设置字体大小
vRange.Font.FontStyle:=AFontStyle; //设置字体样式
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定范围的外边框样式
输入参数:ABegRowNum 待设置范围的起始行号
ABegColNum 待设置范围的起始列号
AEndRowNum 待设置范围的终止行号
AEndColNum 待设置范围的终止列号
AWeight 边线粗度
ALineColor 边线颜色
ALineStyle 边线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetRangeOutBorderStyle(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
AWeight:Integer=2;ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean;
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
try
//设置左边框
vRange.Borders.Item[xlEdgeLeft].LineStyle :=ALineStyle;
vRange.Borders.Item[xlEdgeLeft].Weight := AWeight;
vRange.Borders.Item[xlEdgeLeft].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置顶边框
vRange.Borders.Item[xlEdgeTop].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeTop].Weight := AWeight;
vRange.Borders.Item[xlEdgeTop].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置底边框
vRange.Borders.Item[xlEdgeBottom].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeBottom].Weight := AWeight;
vRange.Borders.Item[xlEdgeBottom].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置右边框
vRange.Borders.Item[xlEdgeRight].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeRight].Weight := AWeight;
vRange.Borders.Item[xlEdgeRight].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定范围的分隔线样式
输入参数:ABegRowNum 待设置范围的起始行号
ABegColNum 待设置范围的起始列号
AEndRowNum 待设置范围的终止行号
AEndColNum 待设置范围的终止列号
AWeight 分割线粗度
ALineColor 分割线颜色
ALineStyle 分割线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRangeInnerLineStyle(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
AWeight:Integer=2;ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean; //设置指定范围的分隔线样式
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
try
//设置垂直线样式
vRange.Borders.Item[xlInsideVertical].LineStyle :=ALineStyle;
vRange.Borders.Item[xlInsideVertical].Weight := AWeight;
vRange.Borders.Item[xlInsideVertical].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置水平线样式
vRange.Borders.Item[xlInsideHorizontal].LineStyle := ALineStyle;
vRange.Borders.Item[xlInsideHorizontal].Weight := AWeight;
vRange.Borders.Item[xlInsideHorizontal].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置当前工作表,并将指定的工作表存储到类属性Sheet中供其他操作使用
输入参数:待指定的工作表的序号
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetCurrentSheet(SheetNum:Integer):Boolean; //设置当前工作簿
begin
Result:=False;
try
Sheet:=MyExcel.Worksheets.Item[SheetNum];
Result:=True;
except
end;
end;
{
功能描述:设置范围的水平对其方式
输入参数:ABegRowNum 待设置的范围的起始行号
ABegColNum 待设置的范围的起始列号
AEndRowNum 待设置的范围的终止行号
AEndColNum 待设置的范围的终止列号
AAlign 对其方式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRangeHorizontalAlignment(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;AAlign:Integer=xlLeft):Boolean;
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.HorizontalAlignment:= AAlign; //水平对其方式为居中
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置范围的垂直对其方式
输入参数:ABegRowNum 待设置的范围起始行号
ABegColNum 待设置的范围起始列号
AEndRowNum 待设置的范围终止行号
AEndColNum 待设置的范围终止列号
AAlign 对其方式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRangeVerticalAlignment(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;AAlign:Integer=xlBottom):Boolean; //设置范围的垂直对其方式
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.VerticalAlignment:= AAlign; //垂直对其方式为居中
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:对指定的工作表进行页面设置
输入参数:APageType: 纸张类型;
Orientation: 页面方向(横向或纵向)
LeftMargin: 左边距
RightMargin: 右边距
TopMargin: 上边距
BottomMargin: 下边距
HeaderMargin: 页眉到顶端边距
FooterMargin: 页脚到底端边距
输出参数:执行成功返回真否则返回假
创建时间: 2006-04-18
创建人: 赵占轻
}
function TExcel.SetSheetPage(APageType,Orientation:Integer;LeftMargin,RightMargin,
TopMargin,BottomMargin,HeaderMargin,FooterMargin:Double):Boolean;
begin
try
//页面设置
Sheet.PageSetup.PaperSize := APageType; // 设定纸张
Sheet.PageSetup.Orientation := Orientation;// 横向纸张
//设定页边距
Sheet.PageSetup.LeftMargin := MyExcel.InchesToPoints(LeftMargin);
Sheet.PageSetup.RightMargin := MyExcel.InchesToPoints(RightMargin);
Sheet.PageSetup.TopMargin := MyExcel.InchesToPoints(TopMargin);
Sheet.PageSetup.BottomMargin := MyExcel.InchesToPoints(BottomMargin); //1cm
Sheet.PageSetup.HeaderMargin := MyExcel.InchesToPoints(HeaderMargin);
Sheet.PageSetup.FooterMargin := MyExcel.InchesToPoints(FooterMargin);
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的宽度
输入参数:AColNum: 待设置的列的列号
AColWidth:目标列宽
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetColumnWidth(AColNum:Integer;AColWidth:Double):Boolean;
begin
try
Sheet.Columns[AColNum].ColumnWidth:=AColWidth;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定范围内单元格的列宽
输入参数:ABeginRow 指定范围的起始行号
ABeginCol 指定范围的起始列号
AEndRow 指定范围的终止行号
AEndCol 指定范围的终止列号
AColWidth:列宽
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetRangeColWidth(ABeginRow,ABeginCol,AEndRow,AEndCol:Integer;AColWidth:Double):Boolean;
var
vRange,vBeginCell,vEndCell:Variant;
begin
try
vBeginCell:=Sheet.Cells[ABeginRow,ABeginCol];
vEndCell:=Sheet.Cells[AEndRow,AEndCol];
vRange:=Sheet.Range[vBeginCell,vEndCell];
vRange.ColumnWidth:=AColWidth;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:绘制平断面图时根据不同情况格式化单元格
输入参数:APage 当前页号
AColNum 列数
ARow 行号
AColName 列名
AValueList 待填充的值的列表
输出参数:无
创建时间:2006-04-18
创建人: 赵占轻
}
procedure TExcel.FormatCells(APage, AColNum, ARow: Integer;AColName: String;AValueList: TStringList);
var
nBegRow,nEndRow:Double;
i: Integer;
sValue: String;
nIndex: Integer;
dX,dY: Double;
dX1, dY1: Double;
nPageTop:Integer;
dAngle: Double;
dOldY2: Double;
dGanGao: Double;
bIsFirstPole, bIsTJPole: Boolean;
bIsCable: Boolean;
begin
dAngle:=0;
nPageTop := (APage-1)*pm_PageRows; //每页行数
//处理行高
case ARow of
6, 13:
begin
//情况特殊,需要加高
Sheet.Rows[nPageTop+ARow].RowHeight := 28;
end;
18:
begin
//情况特殊,需要加高
Sheet.Rows[nPageTop+ARow].RowHeight := 33;
end;
else
begin
Sheet.Rows[nPageTop+ARow].RowHeight := 15;
end;
end;
//列头
MergeCells(nPageTop+ARow,1,nPageTop+ARow,2);
SetRangeOutBorderStyle(nPageTop+ARow,1,nPageTop+ARow,2,1,0,1);
SetRangeFontStyle(nPageTop+ARow,1,nPageTop+ARow,2,'常规','宋体',1,11);
SetRangeHorizontalAlignment(nPageTop+ARow,1,nPageTop+ARow,2,xlCenter);
SetRangeVerticalAlignment(nPageTop+ARow,1,nPageTop+ARow,2,xlCenter);
SetRangeValue(nPageTop+ARow,1,nPageTop+ARow,2,AColName);
if (ARow = 10)or(ARow = 11)or(ARow = 13) then //档距和累计长度特殊
begin
//合并第一个格
SetRangeOutBorderStyle(nPageTop+ARow,3,nPageTop+ARow,3,1,0,1);
SetRangeFontStyle(nPageTop+ARow,3,nPageTop+ARow,3,'常规','宋体',1,11);
SetRangeHorizontalAlignment(nPageTop+ARow,3,nPageTop+ARow,3,xlCenter);
SetRangeVerticalAlignment(nPageTop+ARow,3,nPageTop+ARow,3,xlCenter);
nIndex := (APage-1)*AColNum;
if nIndex <= AValueList.Count -1 then //防止数据溢出
begin
case ARow of
10: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.DJ;
11: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.LJCD;
13: SValue := PRecData(Integer(AValueList.Objects[nIndex]))^.JCKY;
end;
if sValue <> '0' then
begin
SetRangeValue(nPageTop+ARow,3,nPageTop+ARow,3,sValue);
end;
end;
//合并最后一个格
SetRangeOutBorderStyle(nPageTop+ARow,24,nPageTop+ARow,24,1,0,1);
SetRangeFontStyle(nPageTop+ARow,24,nPageTop+ARow,24,'常规','宋体',1,11);
SetRangeHorizontalAlignment(nPageTop+ARow,24,nPageTop+ARow,24,xlCenter);
SetRangeVerticalAlignment(nPageTop+ARow,24,nPageTop+ARow,24,xlCenter);
//处理列
for i := 0 to 9 do
begin
MergeCells(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5);
SetRangeOutBorderStyle(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5,1,0,1);
SetRangeFontStyle(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5,'常规','宋体',1,11);
SetRangeHorizontalAlignment(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5,xlCenter);
SetRangeVerticalAlignment(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5,xlCenter);
nIndex := (APage-1)*AColNum+i+1;
if nIndex <= AValueList.Count -1 then //防止数据溢出
begin
case ARow of
10: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.DJ;
11: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.LJCD;
13:
begin
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.JCKY;
SetRangeAutoWrap(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5);//自动换行
end;
end;
if sValue <> '0' then
begin
Self.SetRangeValue(nPageTop+ARow,i*2+4,nPageTop+ARow,i*2+5,sValue);
end;
end;
end;
Exit;
end;
//普通情况
for i := 0 to 10 do
begin
MergeCells(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4);
SetRangeOutBorderStyle(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,1,0,1);
SetRangeFontStyle(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,'常规','宋体',1,10);
SetRangeHorizontalAlignment(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,xlCenter);
SetRangeVerticalAlignment(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,xlCenter);
nIndex := (APage-1)*AColNum + i;
if nIndex <= AValueList.Count -1 then
begin
case ARow of
5:
begin
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.GH;
if PRecData(Integer(AValueList.Objects[nIndex]))^.GG <> '' then
begin
dGanGao := StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.GG);
end
else begin
dGanGao := 10;
end;
if i = 0 then
begin
if PRecData(Integer(AValueList.Objects[nIndex]))^.IsTJPole =1 then
begin
bIsTJPole := True;
bIsFirstPole := True;
end
else begin
bIsFirstPole := True;
bIsTJPole := False;
end;
end
else begin
bIsFirstPole := False;
bIsTJPole := False;
end;
if PRecData(Integer(AValueList.Objects[nIndex]))^.IsCable = 1 then
begin
bIsCable := True; //是电缆
end
else begin
bIsCable := False; //不是电缆
end;
GetCellDMGanCoord(APage, i+1, dX1, dY1);
//画断面图
CreateDMT( dX1, dY1, dGanGao, bIsTJPole, bIsFirstPole, bIsCable, dOldY2);
//画分支
if PRecData(Integer(AValueList.Objects[nIndex]))^.FZ1ZJ <> '' then
begin
dAngle := StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ1ZJ);
//画分支
GetCellGanCoord(APage, i+1, dX, dY);
CreateFZLine(dX, dY,0,dAngle, PRecData(Integer(AValueList.Objects[nIndex]))^.FZ1MC);
end;
if PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ <> '' then
begin
GetCellGanCoord(APage, i+1, dX, dY);
if dAngle >= 0 then
begin
if StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ)>=0 then
begin
//画分支 线路名同向
CreateFZLine(dX, dY, 14, StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ), PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2MC);
end
else begin
CreateFZLine(dX, dY,0, StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ), PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2MC);
end;
end
else begin
if StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ)<0 then
begin
//画分支 线路名同向
CreateFZLine(dX, dY, -14, StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ), PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2MC);
end
else begin
CreateFZLine(dX, dY,0, StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2ZJ), PRecData(Integer(AValueList.Objects[nIndex]))^.FZ2MC); end;
end;
end;
end;
6:
begin
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.GX;
SetRangeAutoWrap(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4);//自动换行
end;
7: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.GG;
8: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.MS;
9: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.DXXH;
12:
begin
Self.SetRangeFontStyle(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,'常规','宋体',0,9);
if PRecData(Integer(AValueList.Objects[nIndex]))^.ZJ <> '' then
begin
//画转角
GetCellGanCoord(APage, i+1, dX, dY);
CreateArrowheadLine(dX, dY, StrToFloat(PRecData(Integer(AValueList.Objects[nIndex]))^.ZJ));
end;
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.ZJ;
if sValue <> '' then
begin
sValue := DoubleToFenMiao(Abs(StrToFloat(sValue)));
end;
end;
14: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.CZJL;
15: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.HDGG;
16: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.LXWZ;
17: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.LXXHGS;
18:
begin
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.JYZXHSL;
SetRangeAutoWrap(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4);//自动换行
end;
19: //变台
begin
if i <> 0 then
begin
GetCellGanCoord(APage, i, dX1, dY1); //上一个点坐标
GetCellGanCoord(APage, i+1, dX, dY); //当前点坐标
if PRecData(Integer(AValueList.Objects[nIndex]))^.BTXS <> '' then
begin
if PRecData(Integer(AValueList.Objects[nIndex-1]))^.BTXS <> '' then
begin
//前一棵杆有变压器
//画线
Sheet.Shapes.AddLine(dX1+pm_BYQD-2, dY1, dX-pm_BYQD+2, dY).Select;
end
else begin
//前一棵杆无变压器
Sheet.Shapes.AddLine(dX1, dY1, dX-pm_BYQD+2, dY).Select;
end;
end
else begin
if PRecData(Integer(AValueList.Objects[nIndex-1]))^.BTXS <> '' then
begin
//画线
Sheet.Shapes.AddLine(dX1+pm_BYQD-2, dY1, dX, dY).Select;
end
else begin
Sheet.Shapes.AddLine(dX1, dY1, dX, dY).Select;
end;
end;
MyExcel.Selection.ShapeRange.ZOrder(msoSendToBack);
end;
if PRecData(Integer(AValueList.Objects[nIndex]))^.BTXS <> '' then
begin
//画变台
GetCellGanCoord(APage, i+1, dX, dY);
DrawBYQ(dX, dY);
DrawBYQText(dX, dY, PRecData(Integer(AValueList.Objects[nIndex]))^.HM);
end
else begin
//画杆
Sheet.Shapes.AddShape(msoShapeOval, pm_GanFirstLeft+(i*pm_GanOffset), (APage-1)*V_PageOffset+pm_GanTop, pm_GanD, pm_GanD);
end;
sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.BTXS;
end;
20: sValue := PRecData(Integer(AValueList.Objects[nIndex]))^.PBRL;
end;
end
else begin
//为了填补空格
sValue := '';
end;
if sValue <> '' then
begin
SetRangeValue(nPageTop+ARow,i*2+3,nPageTop+ARow,i*2+4,sValue);//自动换行
end;
end;
end;
{
//功能描述:创建页
//输入参数:APage 当前页号
ABDZMC 变电站名称
AXLMC 线路名称
AValueList 要输入的数据值列表
//输出参数:无
//创建时间:2006-04-14
//创建人: 赵占轻
}
procedure TExcel.CreatePage(APage: Integer;ABDZMC, AXLMC: String;AValueList: TStringList);
var
sGDSMC: String;
nColNum: Integer;
sColName: String;
nPageTop: Integer;
AFontColor: TColor;
nRow: Integer;
i: Integer;
begin
sGDSMC := '城关供电所';
nColNum := 11; //字段列数
nPageTop := (APage-1)*pm_PageRows; //每页行数
AFontColor := 1;
//处理第1行数据 标题
nRow := 1;
SetRowHeight(nPageTop+nRow,20.25);
//设定合并单元格
MergeCells(nPageTop+nRow,1,nPageTop+nRow,24);
SetRangeFontStyle(nPageTop+nRow,1,nPageTop+nRow,24,'粗体','宋体',AFontColor,16); //设置指定区域中字体样式
SetRangeHorizontalAlignment(nPageTop+nRow,1,nPageTop+nRow,24,xlCenter); //设置水平对齐方式
SetRangeVerticalAlignment(nPageTop+nRow,1,nPageTop+nRow,24,xlCenter); //设置垂直对齐方式
SetRangeValue(nPageTop+nRow,1,nPageTop+nRow,24,pm_Title); //设置指定区域的值
//处理第2行数据
nRow := 2;
SetRowHeight(nPageTop+nRow,23.25);
//设定合并单元格
MergeCells(nPageTop+nRow,1,nPageTop+nRow,2);
SetRangeFontStyle(nPageTop+nRow,1,nPageTop+nRow,2,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeVerticalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeValue(nPageTop+nRow,1,nPageTop+nRow,2,'线路名称:');
//
MergeCells(nPageTop+nRow,3,nPageTop+nRow,6);
SetRangeFontStyle(nPageTop+nRow,3,nPageTop+nRow,6,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,3,nPageTop+nRow,6,xlLeft);
SetRangeVerticalAlignment(nPageTop+nRow,3,nPageTop+nRow,6,xlCenter);
SetRangeValue(nPageTop+nRow,3,nPageTop+nRow,6,AXLMC); //线路名称
MergeCells(nPageTop+nRow,7,nPageTop+nRow,8);
SetRangeFontStyle(nPageTop+nRow,7,nPageTop+nRow,8,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,7,nPageTop+nRow,8,xlRight);
SetRangeVerticalAlignment(nPageTop+nRow,7,nPageTop+nRow,8,xlCenter);
SetRangeValue(nPageTop+nRow,7,nPageTop+nRow,8,''); //'变电站名称:';
//
MergeCells(nPageTop+nRow,9,nPageTop+nRow,14);
SetRangeFontStyle(nPageTop+nRow,9,nPageTop+nRow,14,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,9,nPageTop+nRow,14,xlLeft);
SetRangeVerticalAlignment(nPageTop+nRow,9,nPageTop+nRow,14,xlCenter);
SetRangeValue(nPageTop+nRow,9,nPageTop+nRow,14,ABDZMC); //赋变电站名称
MergeCells(nPageTop+nRow,21,nPageTop+nRow,23);
SetRangeFontStyle(nPageTop+nRow,21,nPageTop+nRow,23,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,21,nPageTop+nRow,23,xlCenter);
SetRangeVerticalAlignment(nPageTop+nRow,21,nPageTop+nRow,23,xlCenter);
SetRangeValue(nPageTop+nRow,21,nPageTop+nRow,23,'');
//处理第3行数据
nRow := 3;
SetRowHeight(nPageTop+nRow,100);
MergeCells(nPageTop+nRow,1,nPageTop+nRow,2);
SetRangeOutBorderStyle(nPageTop+nRow,1,nPageTop+nRow,2,1,1,1);
SetRangeFontStyle(nPageTop+nRow,1,nPageTop+nRow,2,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeVerticalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeValue(nPageTop+nRow,1,nPageTop+nRow,2,'断 面 图');
MergeCells(nPageTop+nRow,3,nPageTop+nRow,24);
SetRangeOutBorderStyle(nPageTop+nRow,3,nPageTop+nRow,24,1,1,1);
SetRangeFontStyle(nPageTop+nRow,3,nPageTop+nRow,24,'常规','宋体',AFontColor,11);
nRow := 4;
SetRowHeight(nPageTop+nRow,69);
MergeCells(nPageTop+nRow,1,nPageTop+nRow,2);
SetRangeOutBorderStyle(nPageTop+nRow,1,nPageTop+nRow,2,1,1,1);
SetRangeFontStyle(nPageTop+nRow,1,nPageTop+nRow,2,'常规','宋体',AFontColor,11);
SetRangeHorizontalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeVerticalAlignment(nPageTop+nRow,1,nPageTop+nRow,2,xlCenter);
SetRangeValue(nPageTop+nRow,1,nPageTop+nRow,2,'平 面 图');
MergeCells(nPageTop+nRow,3,nPageTop+nRow,24);
SetRangeOutBorderStyle(nPageTop+nRow,3,nPageTop+nRow,24,1,1,1);
SetRangeFontStyle(nPageTop+nRow,3,nPageTop+nRow,24,'常规','宋体',AFontColor,11);
//InitShape(Sheet, APage); //初始化图
//5
nRow := nRow+1;
sColName := '杆 号';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
//6
nRow := nRow+1;
sColName := '电杆种类及杆型';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
//7
nRow := nRow+1;
sColName := '杆高(米)';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
//8
nRow := nRow+1;
sColName := '埋深(米)';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '导线型号';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '档距(米)';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '累计长度(米)';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '线路转角';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '交叉跨越';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '垂直距离';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '横担规格';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '拉线位置';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '拉线型号/根数';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '绝缘子型号/数量';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '变台型式';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
sColName := '配变容量';
FormatCells(APage, nColNum, nRow, sColName, AValueList);
nRow := nRow+1;
SetRowHeight(nPageTop+nRow,15);
if V_PageOffset = 0 then
begin
//计算页间距
V_PageOffset := 0;
for i := 1 to pm_PageRows do
begin
V_PageOffset := V_PageOffset + Sheet.Rows[i].RowHeight;
end;
V_PageOffset := V_PageOffset - 1; //经验值
end;
end;
{
功能描述:获取指定范围的值
输入参数:ABegRowNum: 指定范围的起始行号
ABegColNum:起始列号
AEndRowNum:终止行号
AEndColNum: 终止列号
输出参数:返回指定范围的值
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.GetRangeValue(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):String; //获取指定范围的值
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
Result:=vRange.value;
except
end;
end;
{
功能描述:设置指定范围的值
输入参数:ABegRowNum 指定范围的起始行号
ABegColNum 指定范围的起始列号
AEndRowNum 指定范围的终止行号
AEndColNum 指定范围的终止列号
AValue 待写入指定范围的值
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRangeValue(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;AValue:string):Boolean; //设置指定范围的值
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.Value:=AValue;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定区域格式为自动换行
输入参数:ABegRowNum 指定的范围的起始行号
ABegColNum 指定的范围的起始列号
AEndRowNum 指定的范围的终止行号
AEndColNum 指定的范围的终止列号
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetRangeAutoWrap(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Boolean; //设置指定区域格式为自动换行
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.WrapText := 1; //自动换行
vRange.ShrinkToFit := False;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:取消指定区域的自动换行
输入参数:ABegRowNum 指定的范围的起始行号
ABegColNum 指定的范围的起始列号
AEndRowNum 指定的范围的终止行号
AEndColNum 指定的范围的终止列号
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.CancelRangeAutoWrap(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer):Boolean;
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.WrapText := 0; //自动换行
vRange.ShrinkToFit := True;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述: 获取指定页,指定cell的断面杆的中心坐标
输入参数: APage 当前页号
ACellIndex 当前单元格列号
输出参数: 无
输入输出参数:AX 用于返回断面杆的中心X坐标
AY 用于返回断面杆的中心Y坐标
创建时间: 2006-04-18
创建人: 赵占轻
}
procedure TExcel.GetCellDMGanCoord(APage, ACellIndex: Integer;var AX, AY: Double);
begin
AX := pm_GanFirstLeft+((ACellIndex-1)*pm_GanOffset) + pm_GanD/2;
AY := (APage-1)*V_PageOffset+dm_GanTop;
end;
{
功能描述: 创建断面图
输入参数: AX1 杆塔底端X坐标
AY1 杆塔底端Y坐标
AGanGao 实际杆高
AIsTJPole 是否T接杆
AIsFirstPole 是否第一颗杆
AIsCable 是否下电缆杆
输出参数: 无
输入输出参数:AOldY2:返回杆塔的顶点Y坐标
创建时间: 2006-04-18
创建人: 赵占轻
}
procedure TExcel.CreateDMT(AX1, AY1, AGanGao: Double;AIsTJPole, AIsFirstPole, AIsCable: Boolean;var AOldY2: Double);
//创建断面图
var
AX2, AY2: Double;
AShape: Variant;
freBuilder: Variant;
begin
AGanGao := GetPoleHight(AGanGao); //计算图上杆高
AX2 := AX1;// + pm_GanOffset;
AY2 := AY1 - dm_HaiBa - AGanGao;
//断面图杆
Sheet.Shapes.Addline(AX1, AY1 ,AX2, AY2);
if not AIsFirstPole then
begin
if AIsCable then
begin
//断面图电缆
AShape := Sheet.Shapes.AddLine(AX2, AY2, AX2-3, AY2);
AShape.Line.DashStyle := 4;
AShape := Sheet.Shapes.AddLine(AX2-3, AY2, AX2-3, AY2+AGanGao-3);
AShape.Line.DashStyle := 4;
AShape := Sheet.Shapes.AddLine(AX2-3, AY2+AGanGao-3, AX2-pm_GanOffset+3, AY2+AGanGao-3);
AShape.Line.DashStyle := 4;
AShape := Sheet.Shapes.AddLine(AX2-pm_GanOffset+3, AY2+AGanGao-3, AX2-pm_GanOffset+3, AOldY2);
AShape.Line.DashStyle := 4;
AShape := Sheet.Shapes.AddLine(AX2-pm_GanOffset+3, AOldY2, AX2-pm_GanOffset, AOldY2);
AShape.Line.DashStyle := 4;
end
else begin
//断面图导线
freBuilder := Sheet.Shapes.BuildFreeform(msoEditingAuto, AX2, AY2);
if AOldY2 - AY2 > dm_HuChui then
begin
freBuilder.AddNodes(msoSegmentCurve, msoEditingAuto, AX2-pm_GanOffset/2, AY2+(AOldY2-AY2)/2+dm_HuChui);
end
else begin
freBuilder.AddNodes(msoSegmentCurve, msoEditingAuto, AX2-pm_GanOffset/2, AY2+dm_HuChui);
end;
freBuilder.AddNodes(msoSegmentCurve, msoEditingAuto, AX2-pm_GanOffset, AOldY2);
freBuilder.ConvertToShape;
end;
end
else begin
if not AIsTJPole then
begin
//如果不是T接杆
freBuilder := Sheet.Shapes.BuildFreeform(msoEditingAuto, AX2, AY2);
freBuilder.AddNodes(msoSegmentCurve, msoEditingAuto, AX2-pm_GanOffset/4, AY2+(dm_HuChui*2/3));
freBuilder.AddNodes(msoSegmentCurve, msoEditingAuto, AX2-pm_GanOffset/2, AY2+dm_HuChui);
freBuilder.ConvertToShape;
end;
end;
AOldY2 := AY2;
end;
{
功能描述: 获取指定页,指定cell的杆的中心坐标
输入参数: APage 当前页号
ACellIndex 单元格列号
输出参数: 无
输入输出参数:计算结构存入AX,AY中
创建时间: 2006-04-18
创建人: 李志强
}
procedure TExcel.GetCellGanCoord(APage, ACellIndex: Integer;var AX, AY: Double);
begin
AX := pm_GanFirstLeft+((ACellIndex-1)*pm_GanOffset) + pm_GanD/2;
AY := (APage-1)*V_PageOffset+pm_GanTop + pm_GanD/2;
end;
{
功能描述:画分支 创建转角箭头线
输入参数:AX 箭头线起点X坐标
AY 箭头线起点Y坐标
AYOffSet 文本框偏移量
AAngle 箭头线转角
AXLMC 分支名称
输出参数:无
创建时间:2006-04-17
创建人: 赵占轻
}
procedure TExcel.CreateFZLine(AX, AY,AYOffSet,AAngle: Double;AXLMC: String);
var
vShape: Variant;
dX2, dY2: Double;
vSelection:Variant;
begin
//角度向右为负 图形显示向下
dX2 := AX + pm_Distance * Sin((90-AAngle)*Pi/180);
dY2 := AY - pm_Distance * Cos((90-AAngle)*Pi/180);
vShape := Sheet.Shapes.AddLine(AX, AY, dX2, dY2);
//格式化箭头线
FormatArrowLineEndHead(vShape,msoArrowheadTriangle,msoArrowheadLengthMedium,msoArrowheadWidthMedium);
FormatArrowLine(vShape,1.5,msoLineSingle,msoLineSolid);
//插入文本框
if AAngle < 0 then
begin
vSelection:=Sheet.Shapes.AddTextbox(msoTextOrientationHorizontal, AX-pm_GanOffset/2-5, AY+25+AYOffSet, 70, 11).Select;
end
else begin
vSelection:=Sheet.Shapes.AddTextbox(msoTextOrientationHorizontal, AX-pm_GanOffset/2-5, AY-26+AYOffSet, 70, 11).Select;
end;
//格式化文本框
SetTextBoxFillStyle(vSelection,msoFalse,0); //设置文本框填充样式
SetTextBoxLineStyle(vSelection,msoFalse,0); //设置文本框边线样式
SetTextBoxFontStyle(vSelection,'宋体','常规',9,0); //设置文本框字体样式
SetTextBoxText(vSelection,AXLMC); //设置文本框内容
SetTextBoxAlignment(vSelection,xlCenter,xlCenter); //设置文本框对齐方式
end;
{
功能描述:创建转角箭头线
输入参数:AX 转角箭头线的起始X坐标
AY 转角箭头线的起始Y坐标
AAngle 转角箭头线的角度
输出参数:无
创建时间:2006-04-17
创建人: 赵占轻
}
procedure TExcel.CreateArrowheadLine(AX, AY, AAngle: Double);
var
vShape: Variant;
dX2, dY2: Double;
begin
//角度向右为负 图形显示向下
dX2 := AX + pm_Distance * Sin((90-AAngle)*Pi/180); //计算转角箭头线的终点X坐标
dY2 := AY - pm_Distance * Cos((90-AAngle)*Pi/180); //计算转角箭头线的终点Y坐标
vShape := Sheet.Shapes.AddLine(AX, AY, dX2, dY2); //绘制转角箭头线
//下面设置箭头线的样式
Self.FormatArrowLineEndHead(vShape,msoArrowheadTriangle,msoArrowheadLengthMedium,msoArrowheadWidthMedium);
end;
{
功能描述:双精度的度转换为度分秒
输入参数:双精度的角度
输出参数:返回度分秒字符串
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.DoubleToFenMiao(Jiao:Double):string;
var
TmpD:double;
TmpI:integer;
Str:string;
begin
TmpI:=Trunc(Jiao);
Str:=IntToStr(TmpI);
TmpD:=Jiao-TmpI;
TmpD:=TmpD*60;
TmpI:=Trunc(TmpD);
//Str:=Str+'度'+IntToStr(TmpI);
Str:=Str+'°'+IntToStr(TmpI);
TmpD:=TmpD-TmpI;
TmpD:=TmpD*60;
TmpI:=Trunc(TmpD);
//Str:=Str+'分'+IntToStr(TmpI)+'秒';
Str:=Str+'′'+IntToStr(TmpI)+'″';
result:=Str;
end;
{
功能描述:绘制变压器文本
输入参数:AX 文本X坐标
AY 文本Y坐标
AText 文本内容
输出参数:无
创建时间:2006-04-17
创建人: 赵占轻
}
procedure TExcel.DrawBYQText(AX, AY : Double;AText: String);
var
vSelection:Variant;
begin
vSelection:=InsertTextBox(AX-pm_GanOffset/2+1,AY+7,58,33,msoTextOrientationHorizontal); //插入文本框
SetTextBoxAlignment(vSelection,xlCenter,xlCenter); //设置文本框对齐方式
SetTextBoxFillStyle(vSelection,msoFalse,0); //设置文本框填充样式
SetTextBoxLineStyle(vSelection,msoFalse,0); //设置文本框边线样式
SetTextBoxFontStyle(vSelection,'宋体','常规',9,0,); //设置文本框的字体样式
Self.SetTextBoxText(vSelection,AText); //设置文本框内容
end;
{
功能描述:绘制变压器
输入参数:AX 初始X坐标
AY:初始Y坐标
输入参数:无
创建时间:2006-04-17
创建人: 赵占轻
}
procedure TExcel.DrawBYQ(AX, AY : Double);
var
AX2, AY2: Double;
AShape: Variant;
begin
AY2 := AY + pm_BYQY;
AX2 := AX - pm_GanD;
AShape := Sheet.Shapes.AddShape(msoShapeOval, AX2, AY2, pm_BYQD, pm_BYQD); //绘制左圈
AShape.Fill.Visible := False;
AX2 := AX-pm_GanD/3;
AShape := Sheet.Shapes.AddShape(msoShapeOval, AX2, AY2, pm_BYQD, pm_BYQD); //绘制右圈
AShape.Fill.Visible := False;
end;
{
功能描述:设置指定行的行高
输入参数:ARowNum: 指定行的行号;
ARowHeight: 目标行高度值
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetRowHeight(ARowNum:Integer;ARowHeight:Double):Boolean;
begin
try
Sheet.Rows[ARowNum].RowHeight := ARowHeight;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:以15米杆高为标准计算d当前杆塔图形高度
输入参数:AHight:杆塔高度
输出参数:杆塔高度
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.GetPoleHight(AHight: Double): Double;
begin
//已15米杆为标准
Result := AHight*(80/15);
end;
{
功能描述:向指定工作表中插入图片
输入参数:ABeginRow 图片左上脚所处的单元格行号
ABeginCol 图片左上脚所处的单元格列号
APicFile 要插入的图片的全名
输出参数:插入成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.InsertPicIntoSheet(ABeginRow,ABeginCol:Integer;APicFile:String):Boolean;
var
vBeginCell:Variant;
begin
try
vBeginCell:=Sheet.Cells[ABeginRow,ABeginCol];
vBeginCell.Select;
Sheet.Pictures.Insert(APicFile);
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定范围的背景图案
输入参数: ABegRowNum 指定的范围的起始行号
ABegColNum 指定的范围的起始列号
AEndRowNum 指定的范围的终止行号
AEndColNum 指定的范围的终止列号
APattern 图案样式
APatternColor 图案颜色
ABackColor 背景颜色
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetRangeBackGround(ABegRowNum,ABegColNum,AEndRowNum,AEndColNum:Integer;
APattern:Integer=xlSolid;APatternColor:Integer=xlNone;ABackColor:Integer=xlNone):Boolean;
var
vBegCell,vEndCell:Variant;
vRange:Variant;
begin
try
vBegCell:=Sheet.Cells[ABegRowNum,ABegColNum];
vEndCell:=Sheet.Cells[AEndRowNum,AEndColNum];
vRange:=Sheet.Range[vBegCell,vEndCell];
vRange.Interior.ColorIndex:=ABackColor;
vRange.Interior.Pattern:=APattern;
vRange.Interior.PatternColorIndex:=APatternColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:在指定位置插入文本框
输入参数:AX 文本框左上角X坐标
AY 文本框左上角Y坐标
AWidth 文本框宽
AHeight 文本框高
AAlign 文本框中文本方向
(xlHorizontal 文字字头朝上 横向排列
xlVertical 文字字头朝上 竖向排列
xlUpward 文字字头朝右 横向排列
xlDownward 文字字头朝左 横向排列
)
输出参数:执行成功返回插入的文本框
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.InsertTextBox(AX,AY,AWidth,AHeight:Double;AOrient:Integer=msoTextOrientationHorizontalRotatedFarEast):Variant;
begin
try
Sheet.Shapes.AddTextbox(AOrient,AX, AY,AWidth,AHeight).Select;
Result:=MyExcel.selection;//加入文本框
except
end;
end;
{
功能描述:设置文本框填充样式
输入参数:ATextBox 指定的文本框
AVisible 文本框是否显示填充样式
ATransparency 透明程度
0: 不透明
0.5 半透明
1 透明
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetTextBoxFillStyle(ATextBox:Variant;AVisible:Integer;ATransparency:Double=0):Boolean;
begin
try
ATextBox.ShapeRange.Fill.Visible := AVisible;
ATextBox.ShapeRange.Fill.Transparency := ATransparency;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置文本框边框样式
输入参数:ATextBox: 指定文本框;
AVisible: 边框是否可见;
ATransparency:透明程度
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetTextBoxLineStyle(ATextBox:Variant;AVisible:Integer;ATransparency:Double=0):Boolean;
begin
try
ATextBox.ShapeRange.Line.Transparency := ATransparency;
ATextBox.ShapeRange.Line.Visible := AVisible;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置文本框中文字内容
输入参数:ATextBox: 指定文本框
AText: 内容字符串
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetTextBoxText(ATextBox:Variant;AText:string):Boolean;
begin
try
ATextBox.Characters.Text := AText;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置文本框中字体样式
输入参数:ATextBox: 指定文本框;
AFontName: 字体名称;
AFontStyle: 字体样式;
AFontSize: 字体大小
AFontColor: 字体颜色
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetTextBoxFontStyle(ATextBox:Variant;AFontName,AFontStyle:String;AFontSize:Integer=12;AFontColor:Integer=0):Boolean;
begin
try
//设置文本框样式
ATextBox.Font.Name := '宋体';
ATextBox.Font.Size := AFontSize;
ATextBox.Font.ColorIndex:=AFontColor; //设置字体颜色
ATextBox.Font.FontStyle:=AFontStyle;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置文本框水平和垂直对齐方式
输入参数:ATextBox: 指定文本框
HAlign: 水平对齐方式;(xlCenter 居中 ;xlLeft 靠左;xlRight 靠右;xlJustify 两端对齐)
VAlign: 垂直对齐方式 (xlCenter 居中 ;xlTop 靠左;xlBottom 靠右;xlJustify 两端对齐)
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.SetTextBoxAlignment(ATextBox:Variant;HAlign:Integer=xlLeft;VAlign:Integer=xlBottom):Boolean;
begin
try
ATextBox.HorizontalAlignment := HAlign;
ATextBox.VerticalAlignment := VAlign;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:格式化箭头线的末端样式
输入参数:ALine 待格式化的箭头线
AheadStyle 末端样式
AheadLength 末端长
AheadWidth 末端宽
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.FormatArrowLineEndHead(ALine:Variant;AheadStyle:Integer=msoArrowheadTriangle;
AheadLength:Integer=msoArrowheadLengthMedium;AheadWidth:Integer=msoArrowheadWidthMedium):Boolean;
begin
try
ALine.Line.EndArrowheadLength := AheadLength;
ALine.Line.EndArrowheadWidth := AheadWidth;
ALine.Line.EndArrowheadStyle := AheadStyle;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:格式化箭头线的首端样式
输入参数:ALine 待格式化的箭头线
AheadStyle 首端样式
AheadLength 首端长
AheadWidth 首端宽
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.FormatArrowLineBeginHead(ALine:Variant;AheadStyle:Integer=msoArrowheadTriangle;
AheadLength:Integer=msoArrowheadLengthMedium;AheadWidth:Integer=msoArrowheadWidthMedium):Boolean;
begin
try
ALine.Line.BeginArrowheadLength := AheadLength;
ALine.Line.BeginArrowheadWidth := AheadWidth;
ALine.Line.BeginArrowheadStyle := AheadStyle;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:格式化箭头线的线样式
输入参数:ALine 待格式化的箭头线
AWidth 线宽
AStyle 线样式
ADashStyle 虚线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-17
创建人: 赵占轻
}
function TExcel.FormatArrowLine(ALine:Variant;AWidth:Double=1.5;AStyle:Integer=msoLineSingle;ADashStyle:Integer=msoLineSolid):Boolean;
begin
try
ALine.Line.Weight := AWidth;
ALine.Line.DashStyle := ADashStyle;
ALine.Line.Style := AStyle;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置当前窗口网格的显示与否
输入参数:IsVisible:控制网格显示的参数
(True:显示网格;False:隐藏网格)
输出参数:执行成功返回真否则返回假
创建时间:2006-05-07
创建人: 赵占轻
}
function TExcel.SetActiveWindowGridVisible(IsVisible:Boolean=True):Boolean; //设置当前窗口网格的显示与否
begin
Result:=False;
try
MyExcel.Application.ActiveWindow.DisplayGridlines:=IsVisible;
except
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定行的字体样式
输入参数:ARowNum: 待设置的行的行号
AFontStyle:目标字体样式(如粗体);
AFontName: 目标字体名称;
AFontColor 目标字体颜色
AFontSize: 目标字体大小
输出参数:执行成功返回真;否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetRowFontStyle(ARowNum:Integer;AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean;
var
vRange:Variant;
begin
try
vRange:=Sheet.Rows[ARowNum];
vRange.Font.ColorIndex:=AFontColor; //设置字体颜色
vRange.Font.Name:=AFontName; //设置字体名称
vRange.Font.Size:=AFontSize; //设置字体大小
vRange.Font.FontStyle:=AFontStyle; //设置字体样式
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的字体样式
输入参数:AColNum: 待设置的列的列号
AFontStyle: 目标字体样式(如粗体);
AFontName: 目标字体名称;
AFontColor: 目标字体颜色
AFontSize: 目标字体大小
输出参数:执行成功返回真;否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetColumnFontStyle(AColNum:Integer;AFontStyle:string='常规';AFontName:string='宋体';
AFontColor:Integer=0;AFontSize:Integer=12):Boolean; //设置指定列的字体样式
var
vRange:Variant;
begin
try
vRange:=Sheet.Columns[AColNum];
vRange.Font.ColorIndex:=AFontColor; //设置字体颜色
vRange.Font.Name:=AFontName; //设置字体名称
vRange.Font.Size:=AFontSize; //设置字体大小
vRange.Font.FontStyle:=AFontStyle; //设置字体样式
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定行的外边框样式
输入参数:ARowNum 待设置行的行号
AWeight 边线粗度
ALineColor 边线颜色
ALineStyle 边线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetRowOutBorderStyle(ARowNum:Integer;AWeight:Integer=2;
ALineColor:Integer=0;ALineStyle:Integer=xlContinuous):Boolean; //设置指定行的外边框样式
var
vRange:Variant;
begin
vRange:=Sheet.Rows[ARowNum];
try
//设置左边框
vRange.Borders.Item[xlEdgeLeft].LineStyle :=ALineStyle;
vRange.Borders.Item[xlEdgeLeft].Weight := AWeight;
vRange.Borders.Item[xlEdgeLeft].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置顶边框
vRange.Borders.Item[xlEdgeTop].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeTop].Weight := AWeight;
vRange.Borders.Item[xlEdgeTop].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置底边框
vRange.Borders.Item[xlEdgeBottom].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeBottom].Weight := AWeight;
vRange.Borders.Item[xlEdgeBottom].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置右边框
vRange.Borders.Item[xlEdgeRight].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeRight].Weight := AWeight;
vRange.Borders.Item[xlEdgeRight].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的外边框样式
输入参数:AColNum 待设置列的列号
AWeight 边线粗度
ALineColor 边线颜色
ALineStyle 边线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetColumnOutBorderStyle(AColNum:Integer;AWeight:Integer=2;ALineColor:Integer=0; //设置指定列的外边框样式
ALineStyle:Integer=xlContinuous):Boolean;
var
vRange:Variant;
begin
vRange:=Sheet.Columns[AColNum];
try
//设置左边框
vRange.Borders.Item[xlEdgeLeft].LineStyle :=ALineStyle;
vRange.Borders.Item[xlEdgeLeft].Weight := AWeight;
vRange.Borders.Item[xlEdgeLeft].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置顶边框
vRange.Borders.Item[xlEdgeTop].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeTop].Weight := AWeight;
vRange.Borders.Item[xlEdgeTop].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置底边框
vRange.Borders.Item[xlEdgeBottom].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeBottom].Weight := AWeight;
vRange.Borders.Item[xlEdgeBottom].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置右边框
vRange.Borders.Item[xlEdgeRight].LineStyle := ALineStyle;
vRange.Borders.Item[xlEdgeRight].Weight := AWeight;
vRange.Borders.Item[xlEdgeRight].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定行的分隔线样式
输入参数:ARowNum 待设置的行号
AWeight 分割线粗度
ALineColor 分割线颜色
ALineStyle 分割线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetRowInnerLineStyle(ARowNum:Integer;AWeight:Integer=2;ALineColor:Integer=0; //设置指定行的分隔线样式
ALineStyle:Integer=xlContinuous):Boolean;
var
vRange:Variant;
begin
vRange:=Sheet.Rows[ARowNum];
try
//设置垂直线样式
vRange.Borders.Item[xlInsideVertical].LineStyle :=ALineStyle;
vRange.Borders.Item[xlInsideVertical].Weight := AWeight;
vRange.Borders.Item[xlInsideVertical].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置水平线样式
vRange.Borders.Item[xlInsideHorizontal].LineStyle := ALineStyle;
vRange.Borders.Item[xlInsideHorizontal].Weight := AWeight;
vRange.Borders.Item[xlInsideHorizontal].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的分隔线样式
输入参数:AColNum 待设置的列号
AWeight 分割线粗度
ALineColor 分割线颜色
ALineStyle 分割线样式
输出参数:执行成功返回真否则返回假
创建时间:2006-05-08
创建人: 赵占轻
}
function TExcel.SetColumnInnerLineStyle(AColNum:Integer;AWeight:Integer=2;ALineColor:Integer=0; //设置指定列的分隔线样式
ALineStyle:Integer=1):Boolean;
var
vRange:Variant;
begin
vRange:=Sheet.Columns[AColNum];
try
//设置垂直线样式
vRange.Borders.Item[xlInsideVertical].LineStyle :=ALineStyle;
vRange.Borders.Item[xlInsideVertical].Weight := AWeight;
vRange.Borders.Item[xlInsideVertical].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
try
//设置水平线样式
vRange.Borders.Item[xlInsideHorizontal].LineStyle := ALineStyle;
vRange.Borders.Item[xlInsideHorizontal].Weight := AWeight;
vRange.Borders.Item[xlInsideHorizontal].ColorIndex := ALineColor;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定行的水平对其方式
输入参数:ARowNum 待设置的列号
AAlign 对其方式 常用值:
xlCenter 居中
xlLeft 靠左
xlRight 靠右
xlJustify 两端对齐
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRowHorizontalAlignment(ARowNum:Integer;AAlign:Integer=xlLeft):Boolean;
var
vRange:Variant;
begin
try
vRange:=Sheet.Rows[ARowNum];
vRange.HorizontalAlignment:= AAlign;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定行的垂直对其方式
输入参数:ARowNum 待设置的行号
AAlign 对其方式 常用值
xlCenter居中
xlTop 靠左
xlBottom 靠右
xlJustify 两端对齐
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetRowVerticalAlignment(ARowNum:Integer;AAlign:Integer=xlBottom):Boolean; //设置指定行的垂直平对其方式
var
vRange:Variant;
begin
try
vRange:=Sheet.Rows[ARowNum];
vRange.VerticalAlignment:= AAlign;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的水平对其方式
输入参数:AColNum 待设置的列号
AAlign 对其方式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetColumnHorizontalAlignment(AColNum:Integer;AAlign:Integer=xlLeft):Boolean; //设置指定列的水平对其方式
var
vRange:Variant;
begin
try
vRange:=Sheet.Columns[AColNum];
vRange.HorizontalAlignment:= AAlign;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:设置指定列的垂直对其方式
输入参数:AColNum: 待设置的列号;AAlign:对其方式
输出参数:执行成功返回真否则返回假
创建时间:2006-04-13
创建人: 赵占轻
}
function TExcel.SetColumnVerticalAlignment(AColNum:Integer;AAlign:Integer=xlBottom):Boolean;
var
vRange:Variant;
begin
try
vRange:=Sheet.Columns[AColNum];
vRange.VerticalAlignment:= AAlign;
except
Result:=False;
Exit;
end;
Result:=True;
end;
{
功能描述:Excel数据保存到文件
输入参数:AFileName:待保存的文件全名
输出参数:保存成功返回真否则返回假
创建时间:2006-05-30
创建人: 赵占轻
}
function TExcel.SaveToFile(AFileName:string):Boolean; //Excel数据保存到文件
begin
try
if FileExists(AFileName) then
begin
if DeleteFile(AFileName) then
begin
MyExcel.ActiveWorkbook.saveAs(AFileName);
end else
begin
Result:=False;
Exit;
end;
end else
begin
MyExcel.ActiveWorkbook.saveAs(AFileName);
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
end.//This Unit is over;