$PBExportHeader$n_dw2xls_winapi.sru forward global type n_dw2xls_winapi from nonvisualobject end type type ustr_font from structure within n_dw2xls_winapi end type end forward type ustr_font from structure unsignedlong hfont string name integer size boolean bold integer spacecharwidth integer spacecharheight end type global type n_dw2xls_winapi from nonvisualobject end type global n_dw2xls_winapi n_dw2xls_winapi type prototypes FUNCTION ulong LoadLibraryA( string lpLibFileName) LIBRARY "kernel32.dll" ALIAS FOR "LoadLibraryA" FUNCTION ulong LoadLibraryW( string lpLibFileName) LIBRARY "kernel32.dll" ALIAS FOR "LoadLibraryW" FUNCTION ulong FreeLibrary(ulong hLibModule) LIBRARY "kernel32.dll" Function uint GetModuleFileNameW(ulong hModule,ref string lpFilename,ulong nSize) Library "kernel32.dll" Function uint GetModuleFileNameA(ulong hModule,ref string lpFilename,ulong nSize) Library "kernel32.dll" FUNCTION ulong GetLocaleInfoA(ulong Locale,ulong LCType,ref string lpLCData,ulong cchData) LIBRARY "kernel32.dll" FUNCTION ulong GetLocaleInfoW(ulong Locale,ulong LCType,ref string lpLCData,ulong cchData) LIBRARY "kernel32.dll" FUNCTION ulong GetSysColor (integer index) library "USER32.DLL" alias for "GetSysColor" Function ulong GetTextExtentPoint32W(ulong hdc, string lpsz,ulong cbString,ref ustr_dw2xls_Size lpSize) library "gdi32.dll" Function ulong GetTextExtentPoint32A(ulong hdc, string lpsz,ulong cbString,ref ustr_dw2xls_Size lpSize) library "gdi32.dll" Function ulong ReleaseDC(ulong hwnd,ulong hdc) library "user32.dll" Function ulong GetDC(ulong hwnd) library "user32.dll" Function ulong SelectObject(ulong hdc,ulong hObject) library "gdi32.dll" Function ulong CreateFontW(ulong H,ulong W,ulong E,ulong O,ulong W,ulong I,ulong u,ulong S,ulong C,ulong OP,ulong CP,ulong Q,ulong PAF, string F) library "gdi32.dll" Function ulong CreateFontA(ulong H,ulong W,ulong E,ulong O,ulong W,ulong I,ulong u,ulong S,ulong C,ulong OP,ulong CP,ulong Q,ulong PAF, string F) library "gdi32.dll" Function ulong CreateCompatibleDC(ulong hdc) library "gdi32.dll" function long MulDiv ( long l1,long l2, long d1) library 'kernel32.dll' function int GetDeviceCaps(ulong hdc, int nIndex) library "gdi32" Function ulong DeleteObject(ulong hObject) library "gdi32.dll" Function ulong DrawTextW(ulong hdc, string lpStr, long nCount, ref ustr_dw2xls_Rect lpRect, ulong wFormat) library "user32.dll" Function ulong DrawTextA(ulong hdc, string lpStr, long nCount, ref ustr_dw2xls_Rect lpRect, ulong wFormat) library "user32.dll" PUBLIC Function ULONG AddWorkBook() Library "XlsWriter.dll" Alias For "_AddWorkBook" PUBLIC Function ULONG AddWorkSheet(readonly ulong wb, readonly string SheetName ) Library "XlsWriter.dll" Alias For "_AddWorkSheet" PUBLIC Function int SaveWorkBook(readonly ulong wb, readonly string FileName ) Library "XlsWriter.dll" Alias For "_SaveWorkBook" PUBLIC Function int DestroyWorkBook( ulong wb) Library "XlsWriter.dll" Alias For "_DestroyWorkBook" PUBLIC Function ULONG GetCell(readonly ulong pSheet, long Row, int Column) Library "XlsWriter.dll" Alias For "_GetCell" PUBLIC Function Int GetXF(readonly ulong pCell ) Library "XlsWriter.dll" Alias For "_GetXF" PUBLIC SubRoutine SetLicense(readonly string CompanyName ,readonly string LicenseCode ) Library "XlsWriter.dll" Alias For "_SetLicense" PUBLIC SubRoutine SetDefFontName( readonly string FontName ) Library "XlsWriter.dll" Alias For "_SetDefFontName" PUBLIC SubRoutine SetDefFontSize( readonly uint FontSize ) Library "XlsWriter.dll" Alias For "_SetDefFontSize" PUBLIC SubRoutine SetProgress( readonly ulong hwnd ) Library "XlsWriter.dll" Alias For "_SetProgress" PUBLIC SubRoutine SetValue(readonly ulong pCell, readonly string Value ) Library "XlsWriter.dll" Alias For "_SetValue_String" PUBLIC SubRoutine SetValue(readonly ulong pCell, readonly double Value ) Library "XlsWriter.dll" Alias For "_SetValue_Double" PUBLIC SubRoutine MergeCells(readonly ulong pSheet, long row1, int column1 ,long row2, int column2 ) Library "XlsWriter.dll" Alias For "_MergeCells" PUBLIC SubRoutine SetXF(readonly ulong pCell, int xfIndex ) Library "XlsWriter.dll" Alias For "_SetXF" PUBLIC SubRoutine SetFontName(readonly ulong pCell, readonly string Name ) Library "XlsWriter.dll" Alias For "_SetFontName" PUBLIC SubRoutine SetFontSize(readonly ulong pCell, readonly int size ) Library "XlsWriter.dll" Alias For "_SetFontSize" PUBLIC SubRoutine SetFontBold(readonly ulong pCell, readonly boolean bold ) Library "XlsWriter.dll" Alias For "_SetFontBold" PUBLIC SubRoutine SetFontItalic(readonly ulong pCell, readonly boolean Italic ) Library "XlsWriter.dll" Alias For "_SetFontItalic" PUBLIC SubRoutine SetFontUnderline(readonly ulong pCell, readonly boolean underline ) Library "XlsWriter.dll" Alias For "_SetFontUnderline" PUBLIC SubRoutine SetFontStrikeout(readonly ulong pCell, readonly boolean strikeout ) Library "XlsWriter.dll" Alias For "_SetFontStrikeout" PUBLIC SubRoutine SetFormat(readonly ulong pCell, readonly string format ) Library "XlsWriter.dll" Alias For "_SetFormat" PUBLIC SubRoutine SetHAlignment(readonly ulong pCell, readonly int halignment ) Library "XlsWriter.dll" Alias For "_SetHAlignment" PUBLIC SubRoutine SetVAlignment(readonly ulong pCell, readonly int valignment) Library "XlsWriter.dll" Alias For "_SetVAlignment" PUBLIC SubRoutine SetTextColor(readonly ulong pCell, readonly long color) Library "XlsWriter.dll" Alias For "_SetTextColor" PUBLIC SubRoutine SetBackColor(readonly ulong pCell, readonly long color ) Library "XlsWriter.dll" Alias For "_SetBackColor_1" PUBLIC SubRoutine SetBackColor(readonly ulong pSheet, long row1, int column1 ,long row2, int column2, readonly long color ) Library "XlsWriter.dll" Alias For "_SetBackColor_2" PUBLIC SubRoutine SetTextWrap(readonly ulong pCell, readonly boolean wrap ) Library "XlsWriter.dll" Alias For "_SetTextWrap" PUBLIC SubRoutine SetBorder(readonly ulong pCell, readonly int style, readonly Long color ) Library "XlsWriter.dll" Alias For "_SetBorder_1" PUBLIC SubRoutine SetBorder(readonly ulong pCell, readonly int side, readonly int style , readonly Long color ) Library "XlsWriter.dll" Alias For "_SetBorder_2" PUBLIC SubRoutine SetBackColor(readonly ulong pSheet, long row1, int column1 ,long row2, int column2, readonly int style , readonly Long color ) Library "XlsWriter.dll" Alias For "_SetBorder_3" PUBLIC SubRoutine SetDefRowHeight(readonly ulong pSheet, readonly uint Height ) Library "XlsWriter.dll" Alias For "_SetDefRowHeight" PUBLIC SubRoutine SetDefColWidth(readonly ulong pSheet, readonly uint width ) Library "XlsWriter.dll" Alias For "_SetDefColWidth" PUBLIC SubRoutine SetRowHeight(readonly ulong pSheet, readonly long row,readonly uint Height) Library "XlsWriter.dll" Alias For "_SetRowHeight" PUBLIC SubRoutine SetColumnWidth(readonly ulong pSheet, readonly long column,readonly uint Width) Library "XlsWriter.dll" Alias For "_SetColumnWidth" PUBLIC SubRoutine SetPaperSize(readonly ulong pSheet, readonly int Papersize) Library "XlsWriter.dll" Alias For "_SetPaperSize" PUBLIC SubRoutine SetPrintCopies(readonly ulong pSheet, readonly int copies) Library "XlsWriter.dll" Alias For "_SetPrintCopies" PUBLIC SubRoutine SetMargin(readonly ulong pSheet, readonly double left, readonly double right ,readonly double top , readonly double bottom ) Library "XlsWriter.dll" Alias For "_SetMargin" PUBLIC SubRoutine SetOrientation(readonly ulong pSheet, readonly int Orientation) Library "XlsWriter.dll" Alias For "_SetOrientation" PUBLIC SubRoutine SetPrintColor(readonly ulong pSheet, readonly int printColor) Library "XlsWriter.dll" Alias For "_SetPrintColor" PUBLIC SubRoutine SetPrintScale(readonly ulong pSheet, readonly int Scale) Library "XlsWriter.dll" Alias For "_SetPrintScale" PUBLIC SubRoutine SetRepeatRows(readonly ulong pSheet, readonly long row1 ,readonly long row2 ) Library "XlsWriter.dll" Alias For "_SetRepeatRows" PUBLIC SubRoutine SetRepeatColumns(readonly ulong pSheet, readonly int column1 ,readonly int column2 ) Library "XlsWriter.dll" Alias For "_SetRepeatColumns" PUBLIC SubRoutine SetShowGridLines(readonly ulong pSheet, readonly boolean showgridLines ) Library "XlsWriter.dll" Alias For "_SetShowGridLines" PUBLIC SubRoutine SetShowZeroValues(readonly ulong pSheet, readonly boolean showgzeroValues ) Library "XlsWriter.dll" Alias For "_SetShowZeroValues" PUBLIC SubRoutine SetFreeze(readonly ulong pSheet, readonly long topRows, readonly long leftColumns ) Library "XlsWriter.dll" Alias For "_SetFreeze" PUBLIC SubRoutine AddHPageBreak(readonly ulong pSheet, readonly long row ) Library "XlsWriter.dll" Alias For "_AddHPageBreak" end prototypes type variables constant long DT_TOP = 0 constant long DT_LEFT= 0 constant long DT_CENTER = 1 constant long DT_RIGHT = 2 constant long DT_VCENTER = 4 constant long DT_BOTTOM = 8 constant long DT_WORDBREAK = 16 constant long DT_SINGLELINE = 32 constant long DT_EXPANDTABS = 64 constant long DT_TABSTOP = 128 constant long DT_NOCLIP = 256 constant long DT_EXTERNALLEADING = 512 constant long DT_CALCRECT = 1024 constant long DT_NOPREFIX = 2048 constant long DT_INTERNAL = 4096 constant LONG DT_NOFULLWIDTHCHARBREAK =524288 constant LONG ANSI_CHARSET =0 constant LONG DEFAULT_CHARSET =1 constant LONG GB2312_CHARSET =134 constant LONG CHINESEBIG5_CHARSET =136 constant long LOGPIXELSX =90 /* Logical pixels/inch in X */ constant long LOGPIXELSY =90 /* Logical pixels/inch in Y */ constant int halign_general = 0 constant int halign_Left = 1 constant int halign_center = 2 constant int halign_right =3 constant int valign_top = 0 constant int valign_center = 1 constant int valign_bottom =2 constant int border_left = 0 constant int border_right = 1 constant int border_top =2 constant int border_bottom =3 constant int borderstyle_none =0 constant int borderstyle_thin =1 constant int borderstyle_medinm =2 constant int borderstyle_dashed =3 constant int borderstyle_dotted =4 constant int borderstyle_thick =5 constant int borderstyle_double =6 constant int borderstyle_hair =7 ulong il_hModule Private: String is_Path ustr_Font istr_Fonts[] Double id_PBVer =0 INT ii_LOGPIXELSX INT ii_LOGPIXELSY String is_Decmial_Separator string is_Format_Decimal string is_Format_Current String is_Format_ShortDate String is_Format_LongDate String is_Format_Time end variables forward prototypes public function Double of_getpbver () public function string of_getapppath () public function string of_get_currentformat () public function unsignedlong of_getlocaleinfo (unsignedlong locale, unsignedlong lctype, ref string lplcdata, unsignedlong cchdata) public function unsignedlong of_createfont (unsignedlong h, unsignedlong w1, unsignedlong e, unsignedlong o, unsignedlong w2, unsignedlong i, unsignedlong u, unsignedlong s, unsignedlong c, unsignedlong op, unsignedlong cp, unsignedlong q, unsignedlong paf, string f) public function unsignedlong of_gettextextentpoint32 (unsignedlong hdc, string lpsz, unsignedlong cbstring, ref ustr_dw2xls_size lpsize) public function unsignedlong of_drawtext (unsignedlong hdc, string lpstr, long ncount, ref ustr_dw2xls_rect lprect, unsignedlong wformat) public function double of_cmtoinch (double ad_value) public function long of_cmtopixels (double ad_value) public function double of_inchtocm (double ad_value) public function long of_inchtopixels (double ad_value) public function double of_pixelstocm (long al_value) public function double of_pixelstoinch (long al_value) public function integer of_getfontsize (integer ai_fontheight, string as_units) public function integer of_getlogpixelsx () public function integer of_getlogpixelsy () public subroutine of_loadwriter () public subroutine of_reloadwriter () protected function long of_lastpos (string as_source, string as_target, long al_start) protected function long of_lastpos (string as_source, string as_target) public subroutine of_calctextrect (string as_text, string as_fontname, integer ai_fontsize, boolean ab_fontbold, long ai_width, long ai_height, string as_alignment, boolean ab_autoheight, ref integer ai_textwidth, ref integer ai_textheight, ref integer ai_spacecharwidth, ref integer ai_spacecharheight, ref boolean ab_wraptext) public function double of_getdoublevalue (datetime adt_value) public function double of_getdoublevalue (date ad_value) public function double of_getdoublevalue (time at_value) public function long of_getcolor (long al_color) public subroutine of_getlocaleinfo () public function String of_get_shortdateformat () public function String of_get_longdateformat () public function string of_get_timeformat () public function String of_get_decimalformat () public function String of_get_decmialseparator () end prototypes public function Double of_getpbver ();environment lenv_current IF id_PBVer =0 Then GetEnvironment(lenv_current) id_PBVer =lenv_current.PBMajorRevision IF lenv_current.PBMinorRevision=5 Then id_PBVer =id_PBVer +0.5 END IF END IF Return id_PBVer end function public function string of_getapppath ();string ls_Path ClassDefinition clsDef IF is_Path<>"" Then Return is_Path END IF IF Handle(GetApplication())=0 Then clsDef = This.ClassDefinition ls_Path =clsDef.LibraryName ELSE ls_Path=Space(255) IF OF_GetPBVer()>=10 Then GetModuleFileNameW(Handle(GetApplication()),ls_Path,255) ELSE GetModuleFileNameA(Handle(GetApplication()),ls_Path,255) END IF END IF is_Path=Left(ls_Path, OF_LastPos(ls_Path,"\")) IF Right(is_Path,1)<>"\" THEN is_Path="\" END IF Return is_Path end function public function string of_get_currentformat ();Return is_Format_Current end function public function unsignedlong of_getlocaleinfo (unsignedlong locale, unsignedlong lctype, ref string lplcdata, unsignedlong cchdata);IF OF_GetPBVer()>=10 Then RETURN GetLocaleInfoW(Locale , LCType , ref lpLCData ,cchData ) ELSE Return GetLocaleInfoA(Locale , LCType , ref lpLCData ,cchData ) END IF end function public function unsignedlong of_createfont (unsignedlong h, unsignedlong w1, unsignedlong e, unsignedlong o, unsignedlong w2, unsignedlong i, unsignedlong u, unsignedlong s, unsignedlong c, unsignedlong op, unsignedlong cp, unsignedlong q, unsignedlong paf, string f);IF OF_GetPBVer()>=10 Then Return CreateFontW( H, W1, E, O, W2, I, u, S, C, OP, CP, Q, PAF, F) ELSE Return CreateFontA( H, W1, E, O, W2, I, u, S, C, OP, CP, Q, PAF, F) END IF end function public function unsignedlong of_gettextextentpoint32 (unsignedlong hdc, string lpsz, unsignedlong cbstring, ref ustr_dw2xls_size lpsize);IF OF_GetPBVer()>=10 Then Return GetTextExtentPoint32W(hdc , lpsz , cbString ,ref lpSize ) ELSE Return GetTextExtentPoint32A(hdc , lpsz , cbString ,ref lpSize ) END IF end function public function unsignedlong of_drawtext (unsignedlong hdc, string lpstr, long ncount, ref ustr_dw2xls_rect lprect, unsignedlong wformat); IF OF_GetPBVer()>=10 Then Return DrawTextW( hdc, lpStr, nCount, ref lpRect, wFormat) ELSE Return DrawTextA( hdc, lpStr, nCount, ref lpRect, wFormat) END IF end function public function double of_cmtoinch (double ad_value);//把厘米转换为英寸 1 inch = 2.54 cm Return ad_Value / 2.54 end function public function long of_cmtopixels (double ad_value);//先转换为英寸，再转换为像素 //　1 inch =25.4 cm //　1 inch = 96 pixels Return Round( ad_Value * ii_LOGPIXELSY / 2.54 ,0 ) end function public function double of_inchtocm (double ad_value);Return ad_Value * 2.54 end function public function long of_inchtopixels (double ad_value);Return ad_Value * ii_LOGPIXELSY end function public function double of_pixelstocm (long al_value);//像素转换为厘米 Dec{3} ld_Value String ls_Value ld_Value=al_Value *2.54 / ii_LOGPIXELSY ls_Value = String(ld_Value,"0.000") IF Long(Right(ls_Value,2))<15 Then ld_Value =Truncate(ld_Value,1) END IF Return ld_Value end function public function double of_pixelstoinch (long al_value);Return al_Value / ii_LOGPIXELSY end function public function integer of_getfontsize (integer ai_fontheight, string as_units);IF as_units='0' Then ai_FontHeight = UnitsToPixels(ai_FontHeight, YUnitsToPixels!) ELSEIF as_units='2' Then ai_FontHeight = OF_InchToPixels(ai_FontHeight/1000 ) ELSEIF as_units='3' Then ai_FontHeight = OF_CMToPixels(ai_FontHeight /1000) END IF Return Int(ai_FontHeight *72 /ii_LOGPIXELSY) end function public function integer of_getlogpixelsx ();Return ii_LOGPIXELSX end function public function integer of_getlogpixelsy ();Return ii_LOGPIXELSY end function public subroutine of_loadwriter ();String ls_FileName ls_FileName = OF_GetAppPath()+"XlsWriter.dll" IF OF_GetPBVer()>=10 Then il_hModule = LoadLibraryW(ls_FileName) ELSE il_hModule = LoadLibraryA(ls_FileName) END IF end subroutine public subroutine of_reloadwriter ();IF il_hModule>0 Then FreeLibrary(il_hModule) il_hModule =0 END IF end subroutine protected function long of_lastpos (string as_source, string as_target, long al_start); Long ll_Cnt, ll_Pos //Check for Null Parameters. IF IsNull(as_source) or IsNull(as_target) or IsNull(al_start) Then SetNull(ll_Cnt) Return ll_Cnt End If //Check for an empty string If Len(as_Source) = 0 Then Return 0 End If // Check for the starting position, 0 means start at the end. If al_start=0 Then al_start=Len(as_Source) End If //Perform find For ll_Cnt = al_start to 1 Step -1 ll_Pos = Pos(as_Source, as_Target, ll_Cnt) If ll_Pos = ll_Cnt Then //String was found Return ll_Cnt End If Next //String was not found Return 0 end function protected function long of_lastpos (string as_source, string as_target);//不直接使用LastPos,是因为PB6.5版本不支持LastPos函数 Return of_LastPos (as_source, as_target, Len(as_Source)) end function public subroutine of_calctextrect (string as_text, string as_fontname, integer ai_fontsize, boolean ab_fontbold, long ai_width, long ai_height, string as_alignment, boolean ab_autoheight, ref integer ai_textwidth, ref integer ai_textheight, ref integer ai_spacecharwidth, ref integer ai_spacecharheight, ref boolean ab_wraptext);Int li uLong ll_hFont ,ll_hFont_Old uLong ll_hWnd, ll_hdc int li_FontWeight Long Foramt ustr_dw2xls_Size lstr_size ustr_dw2xls_Rect lstr_Rect n_dw2xls_winApi lnv_Api ai_Textwidth = 0 ai_TextHeight =0 ai_spacecharwidth = 0 ai_SpaceCharHeight = 0 ll_hWnd = 0 ll_hdc =GetDC(ll_hWnd) For li=1 To UpperBound(istr_Fonts) IF istr_Fonts[li].Name =as_FontName AND istr_Fonts[li].Size =ai_FontSize AND istr_Fonts[li].Bold =ab_FontBold Then ll_hFont = istr_Fonts[li].hFont ai_SpaceCharWidth = istr_Fonts[li].SpaceCharWidth ai_SpaceCharHeight = istr_Fonts[li].SpaceCharHeight Exit END IF Next IF ll_hFont =0 Then IF ab_FontBold Then li_FontWeight =700 ELSE li_FontWeight =400 END IF ll_hFont =OF_CreateFont( MulDiv( ai_FontSize , ii_LOGPIXELSY ,72) * -1, 0, 0, 0, li_FontWeight , 0, 0, 0, 0, 0 , 0, 0, 34, as_FontName ) ll_hFont_Old =SelectObject(ll_hdc, ll_hFont) //取空格的宽度 //GetTextExtentPoint32W(ll_hdc, " ", 1, ref lstr_size) //ai_SpaceCharWidth =PixelsToUnits( lstr_size.cx, XPixelsToUnits!) //ai_SpaceCharHeight = PixelsToUnits( lstr_size.cy, YPixelsToUnits!) lstr_Rect.Right = 1000 lstr_Rect.Bottom = 1000 OF_DrawText(ll_hdc, "A" , -1 ,ref lstr_Rect ,DT_CALCRECT ) ai_SpaceCharWidth =PixelsToUnits( lstr_Rect.Right - lstr_Rect.Left, XPixelsToUnits!) ai_SpaceCharHeight =PixelsToUnits( lstr_Rect.Bottom - lstr_Rect.Top, YPixelsToUnits!) li = UpperBound (istr_Fonts)+1 istr_Fonts[li].Name =as_FontName istr_Fonts[li].Size =ai_FontSize istr_Fonts[li].Bold =ab_FontBold istr_Fonts[li].hFont = ll_hFont istr_Fonts[li].SpaceCharWidth =ai_SpaceCharWidth istr_Fonts[li].SpaceCharHeight = ai_SpaceCharHeight ELSE ll_hFont_Old = SelectObject(ll_hdc, ll_hFont) END IF //计算绘制所需要的实际显示宽度和高度 Foramt = DT_CALCRECT +DT_WORDBREAK // +DT_NOCLIP IF as_Alignment='1' Then Foramt+=DT_RIGHT ELSEIF as_Alignment='2' Then Foramt+=DT_CENTER END IF lstr_Rect.Right = UnitsToPixels(ai_Width, XUnitsToPixels!) lstr_Rect.Bottom = UnitsToPixels(ai_Height, YUnitsToPixels!) OF_DrawText(ll_hdc, as_Text , -1 , ref lstr_Rect ,Foramt) ai_TextWidth =PixelsToUnits( lstr_Rect.Right - lstr_Rect.Left, XPixelsToUnits!) ai_TextHeight =PixelsToUnits( lstr_Rect.Bottom - lstr_Rect.Top, YPixelsToUnits!) IF ai_TextWidth<0 Then ai_TextWidth+=65535 END IF IF ai_TextHeight<0 Then ai_TextHeight+=65535 END IF IF ai_TextHeight>ai_Height AND ab_AutoHeight=False Then ai_TextHeight = ai_Height END IF IF ai_SpaceCharHeight>0 AND ai_TextHeight>0 Then ab_wrapText =Int(ai_TextHeight / ai_SpaceCharHeight)>1 END IF IF Not ab_wrapText Then IF Pos(as_Text,"~r")>0 Then ab_wrapText =TRUE ELSEIF Pos(as_Text,"~n")>0 Then ab_wrapText =TRUE END IF END IF SelectObject(ll_hdc,ll_hFont_Old) ReleaseDC(ll_hWnd,ll_hdc) end subroutine public function double of_getdoublevalue (datetime adt_value);time lt_time integer li_hour integer li_minute integer li_second lt_time = time(adt_value) li_hour = hour(lt_time) li_minute = minute(lt_time) li_second = second(lt_time) //有时time函数不能正确取得datime数据的time部分的值 IF li_hour>24 OR li_minute>60 OR li_second>60 Then li_hour =0 li_minute =0 li_second =0 END IF Return daysafter(1899-12-30,date(adt_value)) + (li_second + li_minute * 60 + li_hour * 3600) / (24 * 3600) end function public function double of_getdoublevalue (date ad_value); Return daysafter(1899-12-30,ad_value) end function public function double of_getdoublevalue (time at_value);integer li_hour integer li_minute integer li_second li_hour = hour(at_value) li_minute = minute(at_value) li_second = second(at_value) IF li_hour>24 OR li_minute>60 OR li_second>60 Then li_hour =0 li_minute =0 li_second =0 END IF Return (li_second + li_minute * 60 + li_hour * 3600) / (24 * 3600) end function public function long of_getcolor (long al_color);Long ll_Index LONG ll_mask = 16777216 LONG ll_col IF al_Color<0 Then Return 16777215 END IF IF al_Color<=16777215 OR al_Color=536870912 Then Return al_Color END IF IF al_color > ll_mask THEN ll_col = TRUNCATE(al_color / ll_mask, 0) CHOOSE CASE ll_col CASE 64 ll_Index = 5 CASE 2 ll_Index = 8 CASE 4 ll_Index = 15 CASE 16 ll_Index = 12 Case Else IF al_Color>=2147483648 Then ll_Index=al_color - 2147483648 ELSE ll_Index =al_color - 134217728 END IF END CHOOSE IF ll_Index<0 Then IF al_Color>536870912 Then Return 536870912 ELSE ll_col = al_Color - 16777215 IF ll_Col<16777215 Then Return ll_Col END IF END IF END IF END IF IF ll_Index<0 OR ll_Index>30 Then Return 536870912 END IF al_Color=GetSysColor(ll_Index ) Return al_Color end function public subroutine of_getlocaleinfo ();INT LOCALE_USER_DEFAULT=1024 INT LOCALE_SCURRENCY =20 //本位币货币符号 INT LOCALE_SMONDECIMALSEP=22 //货币小数点分割符 INT LOCALE_SMONTHOUSANDSEP =23 //千位分割符 INT LOCALE_ICURRDIGITS = 25 //小数位数 INT LOCALE_SINTLSYMBOL= 21 INT LOCALE_SMONGROUPING=24 //货币国际符号 INT LOCALE_SDATE = 30 INT LOCALE_STIME = 30 INT LOCALE_SSHORTDATE = 31 INT LOCALE_SLONGDATE =32 INT LOCALE_STIMEFORMAT = 4099 INT LOCALE_SDECIMAL = 14 INT LOCALE_IDIGITS =17 Int li_Len = 100 Int li_Digits String ls_Temp String ls_Format String ls_symbol String ls_SMONDECIMALSEP String ls_LOCALE_SMONTHOUSANDSEP //取数字的分隔符 ls_Temp = Space(li_Len) OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SDECIMAL, Ref ls_Temp, li_Len) is_Decmial_Separator=Trim(ls_Temp) //取数字的小数位数 ls_Temp = Space(li_Len) OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_IDIGITS, Ref ls_Temp, li_Len) li_digits=Long(Trim(ls_Temp)) IF li_digits>0 Then is_Format_Decimal ='0'+is_Decmial_Separator+Fill("0", li_digits) ELSE is_Format_Decimal="0" END IF //取金额格式 ls_Temp = Space(li_Len) OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SCURRENCY, Ref ls_Temp, li_Len) ls_symbol=Trim(ls_Temp) ls_Temp = Space(li_Len) OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_ICURRDIGITS, Ref ls_Temp, li_Len) li_digits=Long(Trim(ls_Temp)) ls_Temp = Space(li_Len) OF_GetLocaleInfo ( LOCALE_USER_DEFAULT,LOCALE_SMONTHOUSANDSEP, Ref ls_Temp, li_Len) ls_LOCALE_SMONTHOUSANDSEP=Trim(ls_Temp) ls_Temp = Space(li_Len) OF_GetLocaleInfo ( LOCALE_USER_DEFAULT,LOCALE_SMONDECIMALSEP, Ref ls_Temp, li_Len) ls_SMONDECIMALSEP= Trim(ls_Temp) IF li_digits>0 Then is_Format_Current = ls_symbol+"#"+ls_LOCALE_SMONTHOUSANDSEP+"##0"+ls_SMONDECIMALSEP+Fill("0",li_digits) ELSE is_Format_Current = ls_symbol+"#,##0" END IF //取日期格式 ls_Temp = Space(li_Len) OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SSHORTDATE, Ref ls_Temp, li_Len) is_Format_ShortDate = Trim(ls_Temp) IF is_Format_ShortDate="" Then OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SDATE, Ref ls_Temp, li_Len) is_Format_ShortDate = Trim(ls_Temp) END IF //时间格式 ls_Temp = Space(li_Len) OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_STIMEFORMAT, Ref ls_Temp, li_Len) is_Format_Time= Trim(ls_Temp) IF is_Format_ShortDate="" Then OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_STIME, Ref ls_Temp, li_Len) is_Format_Time = Trim(ls_Temp) END IF //长时间格式 ls_Temp = Space(li_Len) OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SLONGDATE, Ref ls_Temp, li_Len) is_Format_LongDate= Trim(ls_Temp) end subroutine public function String of_get_shortdateformat ();Return is_Format_ShortDate end function public function String of_get_longdateformat ();Return is_Format_LongDate end function public function string of_get_timeformat ();Return is_Format_Time end function public function String of_get_decimalformat ();Return is_Format_Decimal end function public function String of_get_decmialseparator ();Return is_Decmial_Separator end function on n_dw2xls_winapi.create call super::create TriggerEvent( this, "constructor" ) end on on n_dw2xls_winapi.destroy TriggerEvent( this, "destructor" ) call super::destroy end on event constructor;Long hdc hdc =GetDC(0) ii_LOGPIXELSX =GetDeviceCaps(hdc, LOGPIXELSX) ii_LOGPIXELSY= GetDeviceCaps(hdc , LOGPIXELSY) ReleaseDC(0,hdc) OF_GetLocaleInfo() end event