n_dw2xls_winapi.sru 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732
  1. $PBExportHeader$n_dw2xls_winapi.sru
  2. forward
  3. global type n_dw2xls_winapi from nonvisualobject
  4. end type
  5. type ustr_font from structure within n_dw2xls_winapi
  6. end type
  7. end forward
  8. type ustr_font from structure
  9. unsignedlong hfont
  10. string name
  11. integer size
  12. boolean bold
  13. integer spacecharwidth
  14. integer spacecharheight
  15. end type
  16. global type n_dw2xls_winapi from nonvisualobject
  17. end type
  18. global n_dw2xls_winapi n_dw2xls_winapi
  19. type prototypes
  20. FUNCTION ulong LoadLibraryA( string lpLibFileName) LIBRARY "kernel32.dll" ALIAS FOR "LoadLibraryA"
  21. FUNCTION ulong LoadLibraryW( string lpLibFileName) LIBRARY "kernel32.dll" ALIAS FOR "LoadLibraryW"
  22. FUNCTION ulong FreeLibrary(ulong hLibModule) LIBRARY "kernel32.dll"
  23. Function uint GetModuleFileNameW(ulong hModule,ref string lpFilename,ulong nSize) Library "kernel32.dll"
  24. Function uint GetModuleFileNameA(ulong hModule,ref string lpFilename,ulong nSize) Library "kernel32.dll"
  25. FUNCTION ulong GetLocaleInfoA(ulong Locale,ulong LCType,ref string lpLCData,ulong cchData) LIBRARY "kernel32.dll"
  26. FUNCTION ulong GetLocaleInfoW(ulong Locale,ulong LCType,ref string lpLCData,ulong cchData) LIBRARY "kernel32.dll"
  27. FUNCTION ulong GetSysColor (integer index) library "USER32.DLL" alias for "GetSysColor"
  28. Function ulong GetTextExtentPoint32W(ulong hdc, string lpsz,ulong cbString,ref ustr_dw2xls_Size lpSize) library "gdi32.dll"
  29. Function ulong GetTextExtentPoint32A(ulong hdc, string lpsz,ulong cbString,ref ustr_dw2xls_Size lpSize) library "gdi32.dll"
  30. Function ulong ReleaseDC(ulong hwnd,ulong hdc) library "user32.dll"
  31. Function ulong GetDC(ulong hwnd) library "user32.dll"
  32. Function ulong SelectObject(ulong hdc,ulong hObject) library "gdi32.dll"
  33. 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"
  34. 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"
  35. Function ulong CreateCompatibleDC(ulong hdc) library "gdi32.dll"
  36. function long MulDiv ( long l1,long l2, long d1) library 'kernel32.dll'
  37. function int GetDeviceCaps(ulong hdc, int nIndex) library "gdi32"
  38. Function ulong DeleteObject(ulong hObject) library "gdi32.dll"
  39. Function ulong DrawTextW(ulong hdc, string lpStr, long nCount, ref ustr_dw2xls_Rect lpRect, ulong wFormat) library "user32.dll"
  40. Function ulong DrawTextA(ulong hdc, string lpStr, long nCount, ref ustr_dw2xls_Rect lpRect, ulong wFormat) library "user32.dll"
  41. PUBLIC Function ULONG AddWorkBook() Library "XlsWriter.dll" Alias For "_AddWorkBook"
  42. PUBLIC Function ULONG AddWorkSheet(readonly ulong wb, readonly string SheetName ) Library "XlsWriter.dll" Alias For "_AddWorkSheet"
  43. PUBLIC Function int SaveWorkBook(readonly ulong wb, readonly string FileName ) Library "XlsWriter.dll" Alias For "_SaveWorkBook"
  44. PUBLIC Function int DestroyWorkBook( ulong wb) Library "XlsWriter.dll" Alias For "_DestroyWorkBook"
  45. PUBLIC Function ULONG GetCell(readonly ulong pSheet, long Row, int Column) Library "XlsWriter.dll" Alias For "_GetCell"
  46. PUBLIC Function Int GetXF(readonly ulong pCell ) Library "XlsWriter.dll" Alias For "_GetXF"
  47. PUBLIC SubRoutine SetLicense(readonly string CompanyName ,readonly string LicenseCode ) Library "XlsWriter.dll" Alias For "_SetLicense"
  48. PUBLIC SubRoutine SetDefFontName( readonly string FontName ) Library "XlsWriter.dll" Alias For "_SetDefFontName"
  49. PUBLIC SubRoutine SetDefFontSize( readonly uint FontSize ) Library "XlsWriter.dll" Alias For "_SetDefFontSize"
  50. PUBLIC SubRoutine SetProgress( readonly ulong hwnd ) Library "XlsWriter.dll" Alias For "_SetProgress"
  51. PUBLIC SubRoutine SetValue(readonly ulong pCell, readonly string Value ) Library "XlsWriter.dll" Alias For "_SetValue_String"
  52. PUBLIC SubRoutine SetValue(readonly ulong pCell, readonly double Value ) Library "XlsWriter.dll" Alias For "_SetValue_Double"
  53. PUBLIC SubRoutine MergeCells(readonly ulong pSheet, long row1, int column1 ,long row2, int column2 ) Library "XlsWriter.dll" Alias For "_MergeCells"
  54. PUBLIC SubRoutine SetXF(readonly ulong pCell, int xfIndex ) Library "XlsWriter.dll" Alias For "_SetXF"
  55. PUBLIC SubRoutine SetFontName(readonly ulong pCell, readonly string Name ) Library "XlsWriter.dll" Alias For "_SetFontName"
  56. PUBLIC SubRoutine SetFontSize(readonly ulong pCell, readonly int size ) Library "XlsWriter.dll" Alias For "_SetFontSize"
  57. PUBLIC SubRoutine SetFontBold(readonly ulong pCell, readonly boolean bold ) Library "XlsWriter.dll" Alias For "_SetFontBold"
  58. PUBLIC SubRoutine SetFontItalic(readonly ulong pCell, readonly boolean Italic ) Library "XlsWriter.dll" Alias For "_SetFontItalic"
  59. PUBLIC SubRoutine SetFontUnderline(readonly ulong pCell, readonly boolean underline ) Library "XlsWriter.dll" Alias For "_SetFontUnderline"
  60. PUBLIC SubRoutine SetFontStrikeout(readonly ulong pCell, readonly boolean strikeout ) Library "XlsWriter.dll" Alias For "_SetFontStrikeout"
  61. PUBLIC SubRoutine SetFormat(readonly ulong pCell, readonly string format ) Library "XlsWriter.dll" Alias For "_SetFormat"
  62. PUBLIC SubRoutine SetHAlignment(readonly ulong pCell, readonly int halignment ) Library "XlsWriter.dll" Alias For "_SetHAlignment"
  63. PUBLIC SubRoutine SetVAlignment(readonly ulong pCell, readonly int valignment) Library "XlsWriter.dll" Alias For "_SetVAlignment"
  64. PUBLIC SubRoutine SetTextColor(readonly ulong pCell, readonly long color) Library "XlsWriter.dll" Alias For "_SetTextColor"
  65. PUBLIC SubRoutine SetBackColor(readonly ulong pCell, readonly long color ) Library "XlsWriter.dll" Alias For "_SetBackColor_1"
  66. PUBLIC SubRoutine SetBackColor(readonly ulong pSheet, long row1, int column1 ,long row2, int column2, readonly long color ) Library "XlsWriter.dll" Alias For "_SetBackColor_2"
  67. PUBLIC SubRoutine SetTextWrap(readonly ulong pCell, readonly boolean wrap ) Library "XlsWriter.dll" Alias For "_SetTextWrap"
  68. PUBLIC SubRoutine SetBorder(readonly ulong pCell, readonly int style, readonly Long color ) Library "XlsWriter.dll" Alias For "_SetBorder_1"
  69. PUBLIC SubRoutine SetBorder(readonly ulong pCell, readonly int side, readonly int style , readonly Long color ) Library "XlsWriter.dll" Alias For "_SetBorder_2"
  70. 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"
  71. PUBLIC SubRoutine SetDefRowHeight(readonly ulong pSheet, readonly uint Height ) Library "XlsWriter.dll" Alias For "_SetDefRowHeight"
  72. PUBLIC SubRoutine SetDefColWidth(readonly ulong pSheet, readonly uint width ) Library "XlsWriter.dll" Alias For "_SetDefColWidth"
  73. PUBLIC SubRoutine SetRowHeight(readonly ulong pSheet, readonly long row,readonly uint Height) Library "XlsWriter.dll" Alias For "_SetRowHeight"
  74. PUBLIC SubRoutine SetColumnWidth(readonly ulong pSheet, readonly long column,readonly uint Width) Library "XlsWriter.dll" Alias For "_SetColumnWidth"
  75. PUBLIC SubRoutine SetPaperSize(readonly ulong pSheet, readonly int Papersize) Library "XlsWriter.dll" Alias For "_SetPaperSize"
  76. PUBLIC SubRoutine SetPrintCopies(readonly ulong pSheet, readonly int copies) Library "XlsWriter.dll" Alias For "_SetPrintCopies"
  77. PUBLIC SubRoutine SetMargin(readonly ulong pSheet, readonly double left, readonly double right ,readonly double top , readonly double bottom ) Library "XlsWriter.dll" Alias For "_SetMargin"
  78. PUBLIC SubRoutine SetOrientation(readonly ulong pSheet, readonly int Orientation) Library "XlsWriter.dll" Alias For "_SetOrientation"
  79. PUBLIC SubRoutine SetPrintColor(readonly ulong pSheet, readonly int printColor) Library "XlsWriter.dll" Alias For "_SetPrintColor"
  80. PUBLIC SubRoutine SetPrintScale(readonly ulong pSheet, readonly int Scale) Library "XlsWriter.dll" Alias For "_SetPrintScale"
  81. PUBLIC SubRoutine SetRepeatRows(readonly ulong pSheet, readonly long row1 ,readonly long row2 ) Library "XlsWriter.dll" Alias For "_SetRepeatRows"
  82. PUBLIC SubRoutine SetRepeatColumns(readonly ulong pSheet, readonly int column1 ,readonly int column2 ) Library "XlsWriter.dll" Alias For "_SetRepeatColumns"
  83. PUBLIC SubRoutine SetShowGridLines(readonly ulong pSheet, readonly boolean showgridLines ) Library "XlsWriter.dll" Alias For "_SetShowGridLines"
  84. PUBLIC SubRoutine SetShowZeroValues(readonly ulong pSheet, readonly boolean showgzeroValues ) Library "XlsWriter.dll" Alias For "_SetShowZeroValues"
  85. PUBLIC SubRoutine SetFreeze(readonly ulong pSheet, readonly long topRows, readonly long leftColumns ) Library "XlsWriter.dll" Alias For "_SetFreeze"
  86. PUBLIC SubRoutine AddHPageBreak(readonly ulong pSheet, readonly long row ) Library "XlsWriter.dll" Alias For "_AddHPageBreak"
  87. end prototypes
  88. type variables
  89. constant long DT_TOP = 0
  90. constant long DT_LEFT= 0
  91. constant long DT_CENTER = 1
  92. constant long DT_RIGHT = 2
  93. constant long DT_VCENTER = 4
  94. constant long DT_BOTTOM = 8
  95. constant long DT_WORDBREAK = 16
  96. constant long DT_SINGLELINE = 32
  97. constant long DT_EXPANDTABS = 64
  98. constant long DT_TABSTOP = 128
  99. constant long DT_NOCLIP = 256
  100. constant long DT_EXTERNALLEADING = 512
  101. constant long DT_CALCRECT = 1024
  102. constant long DT_NOPREFIX = 2048
  103. constant long DT_INTERNAL = 4096
  104. constant LONG DT_NOFULLWIDTHCHARBREAK =524288
  105. constant LONG ANSI_CHARSET =0
  106. constant LONG DEFAULT_CHARSET =1
  107. constant LONG GB2312_CHARSET =134
  108. constant LONG CHINESEBIG5_CHARSET =136
  109. constant long LOGPIXELSX =90 /* Logical pixels/inch in X */
  110. constant long LOGPIXELSY =90 /* Logical pixels/inch in Y */
  111. constant int halign_general = 0
  112. constant int halign_Left = 1
  113. constant int halign_center = 2
  114. constant int halign_right =3
  115. constant int valign_top = 0
  116. constant int valign_center = 1
  117. constant int valign_bottom =2
  118. constant int border_left = 0
  119. constant int border_right = 1
  120. constant int border_top =2
  121. constant int border_bottom =3
  122. constant int borderstyle_none =0
  123. constant int borderstyle_thin =1
  124. constant int borderstyle_medinm =2
  125. constant int borderstyle_dashed =3
  126. constant int borderstyle_dotted =4
  127. constant int borderstyle_thick =5
  128. constant int borderstyle_double =6
  129. constant int borderstyle_hair =7
  130. ulong il_hModule
  131. Private:
  132. String is_Path
  133. ustr_Font istr_Fonts[]
  134. Double id_PBVer =0
  135. INT ii_LOGPIXELSX
  136. INT ii_LOGPIXELSY
  137. String is_Decmial_Separator
  138. string is_Format_Decimal
  139. string is_Format_Current
  140. String is_Format_ShortDate
  141. String is_Format_LongDate
  142. String is_Format_Time
  143. end variables
  144. forward prototypes
  145. public function Double of_getpbver ()
  146. public function string of_getapppath ()
  147. public function string of_get_currentformat ()
  148. public function unsignedlong of_getlocaleinfo (unsignedlong locale, unsignedlong lctype, ref string lplcdata, unsignedlong cchdata)
  149. 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)
  150. public function unsignedlong of_gettextextentpoint32 (unsignedlong hdc, string lpsz, unsignedlong cbstring, ref ustr_dw2xls_size lpsize)
  151. public function unsignedlong of_drawtext (unsignedlong hdc, string lpstr, long ncount, ref ustr_dw2xls_rect lprect, unsignedlong wformat)
  152. public function double of_cmtoinch (double ad_value)
  153. public function long of_cmtopixels (double ad_value)
  154. public function double of_inchtocm (double ad_value)
  155. public function long of_inchtopixels (double ad_value)
  156. public function double of_pixelstocm (long al_value)
  157. public function double of_pixelstoinch (long al_value)
  158. public function integer of_getfontsize (integer ai_fontheight, string as_units)
  159. public function integer of_getlogpixelsx ()
  160. public function integer of_getlogpixelsy ()
  161. public subroutine of_loadwriter ()
  162. public subroutine of_reloadwriter ()
  163. protected function long of_lastpos (string as_source, string as_target, long al_start)
  164. protected function long of_lastpos (string as_source, string as_target)
  165. 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)
  166. public function double of_getdoublevalue (datetime adt_value)
  167. public function double of_getdoublevalue (date ad_value)
  168. public function double of_getdoublevalue (time at_value)
  169. public function long of_getcolor (long al_color)
  170. public subroutine of_getlocaleinfo ()
  171. public function String of_get_shortdateformat ()
  172. public function String of_get_longdateformat ()
  173. public function string of_get_timeformat ()
  174. public function String of_get_decimalformat ()
  175. public function String of_get_decmialseparator ()
  176. end prototypes
  177. public function Double of_getpbver ();environment lenv_current
  178. IF id_PBVer =0 Then
  179. GetEnvironment(lenv_current)
  180. id_PBVer =lenv_current.PBMajorRevision
  181. IF lenv_current.PBMinorRevision=5 Then
  182. id_PBVer =id_PBVer +0.5
  183. END IF
  184. END IF
  185. Return id_PBVer
  186. end function
  187. public function string of_getapppath ();string ls_Path
  188. ClassDefinition clsDef
  189. IF is_Path<>"" Then
  190. Return is_Path
  191. END IF
  192. IF Handle(GetApplication())=0 Then
  193. clsDef = This.ClassDefinition
  194. ls_Path =clsDef.LibraryName
  195. ELSE
  196. ls_Path=Space(255)
  197. IF OF_GetPBVer()>=10 Then
  198. GetModuleFileNameW(Handle(GetApplication()),ls_Path,255)
  199. ELSE
  200. GetModuleFileNameA(Handle(GetApplication()),ls_Path,255)
  201. END IF
  202. END IF
  203. is_Path=Left(ls_Path, OF_LastPos(ls_Path,"\"))
  204. IF Right(is_Path,1)<>"\" THEN
  205. is_Path="\"
  206. END IF
  207. Return is_Path
  208. end function
  209. public function string of_get_currentformat ();Return is_Format_Current
  210. end function
  211. public function unsignedlong of_getlocaleinfo (unsignedlong locale, unsignedlong lctype, ref string lplcdata, unsignedlong cchdata);IF OF_GetPBVer()>=10 Then
  212. RETURN GetLocaleInfoW(Locale , LCType , ref lpLCData ,cchData )
  213. ELSE
  214. Return GetLocaleInfoA(Locale , LCType , ref lpLCData ,cchData )
  215. END IF
  216. end function
  217. 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
  218. Return CreateFontW( H, W1, E, O, W2, I, u, S, C, OP, CP, Q, PAF, F)
  219. ELSE
  220. Return CreateFontA( H, W1, E, O, W2, I, u, S, C, OP, CP, Q, PAF, F)
  221. END IF
  222. end function
  223. public function unsignedlong of_gettextextentpoint32 (unsignedlong hdc, string lpsz, unsignedlong cbstring, ref ustr_dw2xls_size lpsize);IF OF_GetPBVer()>=10 Then
  224. Return GetTextExtentPoint32W(hdc , lpsz , cbString ,ref lpSize )
  225. ELSE
  226. Return GetTextExtentPoint32A(hdc , lpsz , cbString ,ref lpSize )
  227. END IF
  228. end function
  229. public function unsignedlong of_drawtext (unsignedlong hdc, string lpstr, long ncount, ref ustr_dw2xls_rect lprect, unsignedlong wformat);
  230. IF OF_GetPBVer()>=10 Then
  231. Return DrawTextW( hdc, lpStr, nCount, ref lpRect, wFormat)
  232. ELSE
  233. Return DrawTextA( hdc, lpStr, nCount, ref lpRect, wFormat)
  234. END IF
  235. end function
  236. public function double of_cmtoinch (double ad_value);//把厘米转换为英寸 1 inch = 2.54 cm
  237. Return ad_Value / 2.54
  238. end function
  239. public function long of_cmtopixels (double ad_value);//先转换为英寸,再转换为像素
  240. // 1 inch =25.4 cm
  241. // 1 inch = 96 pixels
  242. Return Round( ad_Value * ii_LOGPIXELSY / 2.54 ,0 )
  243. end function
  244. public function double of_inchtocm (double ad_value);Return ad_Value * 2.54
  245. end function
  246. public function long of_inchtopixels (double ad_value);Return ad_Value * ii_LOGPIXELSY
  247. end function
  248. public function double of_pixelstocm (long al_value);//像素转换为厘米
  249. Dec{3} ld_Value
  250. String ls_Value
  251. ld_Value=al_Value *2.54 / ii_LOGPIXELSY
  252. ls_Value = String(ld_Value,"0.000")
  253. IF Long(Right(ls_Value,2))<15 Then
  254. ld_Value =Truncate(ld_Value,1)
  255. END IF
  256. Return ld_Value
  257. end function
  258. public function double of_pixelstoinch (long al_value);Return al_Value / ii_LOGPIXELSY
  259. end function
  260. public function integer of_getfontsize (integer ai_fontheight, string as_units);IF as_units='0' Then
  261. ai_FontHeight = UnitsToPixels(ai_FontHeight, YUnitsToPixels!)
  262. ELSEIF as_units='2' Then
  263. ai_FontHeight = OF_InchToPixels(ai_FontHeight/1000 )
  264. ELSEIF as_units='3' Then
  265. ai_FontHeight = OF_CMToPixels(ai_FontHeight /1000)
  266. END IF
  267. Return Int(ai_FontHeight *72 /ii_LOGPIXELSY)
  268. end function
  269. public function integer of_getlogpixelsx ();Return ii_LOGPIXELSX
  270. end function
  271. public function integer of_getlogpixelsy ();Return ii_LOGPIXELSY
  272. end function
  273. public subroutine of_loadwriter ();String ls_FileName
  274. ls_FileName = OF_GetAppPath()+"XlsWriter.dll"
  275. IF OF_GetPBVer()>=10 Then
  276. il_hModule = LoadLibraryW(ls_FileName)
  277. ELSE
  278. il_hModule = LoadLibraryA(ls_FileName)
  279. END IF
  280. end subroutine
  281. public subroutine of_reloadwriter ();IF il_hModule>0 Then
  282. FreeLibrary(il_hModule)
  283. il_hModule =0
  284. END IF
  285. end subroutine
  286. protected function long of_lastpos (string as_source, string as_target, long al_start);
  287. Long ll_Cnt, ll_Pos
  288. //Check for Null Parameters.
  289. IF IsNull(as_source) or IsNull(as_target) or IsNull(al_start) Then
  290. SetNull(ll_Cnt)
  291. Return ll_Cnt
  292. End If
  293. //Check for an empty string
  294. If Len(as_Source) = 0 Then
  295. Return 0
  296. End If
  297. // Check for the starting position, 0 means start at the end.
  298. If al_start=0 Then
  299. al_start=Len(as_Source)
  300. End If
  301. //Perform find
  302. For ll_Cnt = al_start to 1 Step -1
  303. ll_Pos = Pos(as_Source, as_Target, ll_Cnt)
  304. If ll_Pos = ll_Cnt Then
  305. //String was found
  306. Return ll_Cnt
  307. End If
  308. Next
  309. //String was not found
  310. Return 0
  311. end function
  312. protected function long of_lastpos (string as_source, string as_target);//不直接使用LastPos,是因为PB6.5版本不支持LastPos函数
  313. Return of_LastPos (as_source, as_target, Len(as_Source))
  314. end function
  315. 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
  316. uLong ll_hFont ,ll_hFont_Old
  317. uLong ll_hWnd, ll_hdc
  318. int li_FontWeight
  319. Long Foramt
  320. ustr_dw2xls_Size lstr_size
  321. ustr_dw2xls_Rect lstr_Rect
  322. n_dw2xls_winApi lnv_Api
  323. ai_Textwidth = 0
  324. ai_TextHeight =0
  325. ai_spacecharwidth = 0
  326. ai_SpaceCharHeight = 0
  327. ll_hWnd = 0
  328. ll_hdc =GetDC(ll_hWnd)
  329. For li=1 To UpperBound(istr_Fonts)
  330. IF istr_Fonts[li].Name =as_FontName AND istr_Fonts[li].Size =ai_FontSize AND istr_Fonts[li].Bold =ab_FontBold Then
  331. ll_hFont = istr_Fonts[li].hFont
  332. ai_SpaceCharWidth = istr_Fonts[li].SpaceCharWidth
  333. ai_SpaceCharHeight = istr_Fonts[li].SpaceCharHeight
  334. Exit
  335. END IF
  336. Next
  337. IF ll_hFont =0 Then
  338. IF ab_FontBold Then
  339. li_FontWeight =700
  340. ELSE
  341. li_FontWeight =400
  342. END IF
  343. 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 )
  344. ll_hFont_Old =SelectObject(ll_hdc, ll_hFont)
  345. //取空格的宽度
  346. //GetTextExtentPoint32W(ll_hdc, " ", 1, ref lstr_size)
  347. //ai_SpaceCharWidth =PixelsToUnits( lstr_size.cx, XPixelsToUnits!)
  348. //ai_SpaceCharHeight = PixelsToUnits( lstr_size.cy, YPixelsToUnits!)
  349. lstr_Rect.Right = 1000
  350. lstr_Rect.Bottom = 1000
  351. OF_DrawText(ll_hdc, "A" , -1 ,ref lstr_Rect ,DT_CALCRECT )
  352. ai_SpaceCharWidth =PixelsToUnits( lstr_Rect.Right - lstr_Rect.Left, XPixelsToUnits!)
  353. ai_SpaceCharHeight =PixelsToUnits( lstr_Rect.Bottom - lstr_Rect.Top, YPixelsToUnits!)
  354. li = UpperBound (istr_Fonts)+1
  355. istr_Fonts[li].Name =as_FontName
  356. istr_Fonts[li].Size =ai_FontSize
  357. istr_Fonts[li].Bold =ab_FontBold
  358. istr_Fonts[li].hFont = ll_hFont
  359. istr_Fonts[li].SpaceCharWidth =ai_SpaceCharWidth
  360. istr_Fonts[li].SpaceCharHeight = ai_SpaceCharHeight
  361. ELSE
  362. ll_hFont_Old = SelectObject(ll_hdc, ll_hFont)
  363. END IF
  364. //计算绘制所需要的实际显示宽度和高度
  365. Foramt = DT_CALCRECT +DT_WORDBREAK // +DT_NOCLIP
  366. IF as_Alignment='1' Then
  367. Foramt+=DT_RIGHT
  368. ELSEIF as_Alignment='2' Then
  369. Foramt+=DT_CENTER
  370. END IF
  371. lstr_Rect.Right = UnitsToPixels(ai_Width, XUnitsToPixels!)
  372. lstr_Rect.Bottom = UnitsToPixels(ai_Height, YUnitsToPixels!)
  373. OF_DrawText(ll_hdc, as_Text , -1 , ref lstr_Rect ,Foramt)
  374. ai_TextWidth =PixelsToUnits( lstr_Rect.Right - lstr_Rect.Left, XPixelsToUnits!)
  375. ai_TextHeight =PixelsToUnits( lstr_Rect.Bottom - lstr_Rect.Top, YPixelsToUnits!)
  376. IF ai_TextWidth<0 Then
  377. ai_TextWidth+=65535
  378. END IF
  379. IF ai_TextHeight<0 Then
  380. ai_TextHeight+=65535
  381. END IF
  382. IF ai_TextHeight>ai_Height AND ab_AutoHeight=False Then
  383. ai_TextHeight = ai_Height
  384. END IF
  385. IF ai_SpaceCharHeight>0 AND ai_TextHeight>0 Then
  386. ab_wrapText =Int(ai_TextHeight / ai_SpaceCharHeight)>1
  387. END IF
  388. IF Not ab_wrapText Then
  389. IF Pos(as_Text,"~r")>0 Then
  390. ab_wrapText =TRUE
  391. ELSEIF Pos(as_Text,"~n")>0 Then
  392. ab_wrapText =TRUE
  393. END IF
  394. END IF
  395. SelectObject(ll_hdc,ll_hFont_Old)
  396. ReleaseDC(ll_hWnd,ll_hdc)
  397. end subroutine
  398. public function double of_getdoublevalue (datetime adt_value);time lt_time
  399. integer li_hour
  400. integer li_minute
  401. integer li_second
  402. lt_time = time(adt_value)
  403. li_hour = hour(lt_time)
  404. li_minute = minute(lt_time)
  405. li_second = second(lt_time)
  406. //有时time函数不能正确取得datime数据的time部分的值
  407. IF li_hour>24 OR li_minute>60 OR li_second>60 Then
  408. li_hour =0
  409. li_minute =0
  410. li_second =0
  411. END IF
  412. Return daysafter(1899-12-30,date(adt_value)) + (li_second + li_minute * 60 + li_hour * 3600) / (24 * 3600)
  413. end function
  414. public function double of_getdoublevalue (date ad_value);
  415. Return daysafter(1899-12-30,ad_value)
  416. end function
  417. public function double of_getdoublevalue (time at_value);integer li_hour
  418. integer li_minute
  419. integer li_second
  420. li_hour = hour(at_value)
  421. li_minute = minute(at_value)
  422. li_second = second(at_value)
  423. IF li_hour>24 OR li_minute>60 OR li_second>60 Then
  424. li_hour =0
  425. li_minute =0
  426. li_second =0
  427. END IF
  428. Return (li_second + li_minute * 60 + li_hour * 3600) / (24 * 3600)
  429. end function
  430. public function long of_getcolor (long al_color);Long ll_Index
  431. LONG ll_mask = 16777216
  432. LONG ll_col
  433. IF al_Color<0 Then
  434. Return 16777215
  435. END IF
  436. IF al_Color<=16777215 OR al_Color=536870912 Then
  437. Return al_Color
  438. END IF
  439. IF al_color > ll_mask THEN
  440. ll_col = TRUNCATE(al_color / ll_mask, 0)
  441. CHOOSE CASE ll_col
  442. CASE 64
  443. ll_Index = 5
  444. CASE 2
  445. ll_Index = 8
  446. CASE 4
  447. ll_Index = 15
  448. CASE 16
  449. ll_Index = 12
  450. Case Else
  451. IF al_Color>=2147483648 Then
  452. ll_Index=al_color - 2147483648
  453. ELSE
  454. ll_Index =al_color - 134217728
  455. END IF
  456. END CHOOSE
  457. IF ll_Index<0 Then
  458. IF al_Color>536870912 Then
  459. Return 536870912
  460. ELSE
  461. ll_col = al_Color - 16777215
  462. IF ll_Col<16777215 Then
  463. Return ll_Col
  464. END IF
  465. END IF
  466. END IF
  467. END IF
  468. IF ll_Index<0 OR ll_Index>30 Then
  469. Return 536870912
  470. END IF
  471. al_Color=GetSysColor(ll_Index )
  472. Return al_Color
  473. end function
  474. public subroutine of_getlocaleinfo ();INT LOCALE_USER_DEFAULT=1024
  475. INT LOCALE_SCURRENCY =20 //本位币货币符号
  476. INT LOCALE_SMONDECIMALSEP=22 //货币小数点分割符
  477. INT LOCALE_SMONTHOUSANDSEP =23 //千位分割符
  478. INT LOCALE_ICURRDIGITS = 25 //小数位数
  479. INT LOCALE_SINTLSYMBOL= 21
  480. INT LOCALE_SMONGROUPING=24 //货币国际符号
  481. INT LOCALE_SDATE = 30
  482. INT LOCALE_STIME = 30
  483. INT LOCALE_SSHORTDATE = 31
  484. INT LOCALE_SLONGDATE =32
  485. INT LOCALE_STIMEFORMAT = 4099
  486. INT LOCALE_SDECIMAL = 14
  487. INT LOCALE_IDIGITS =17
  488. Int li_Len = 100
  489. Int li_Digits
  490. String ls_Temp
  491. String ls_Format
  492. String ls_symbol
  493. String ls_SMONDECIMALSEP
  494. String ls_LOCALE_SMONTHOUSANDSEP
  495. //取数字的分隔符
  496. ls_Temp = Space(li_Len)
  497. OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SDECIMAL, Ref ls_Temp, li_Len)
  498. is_Decmial_Separator=Trim(ls_Temp)
  499. //取数字的小数位数
  500. ls_Temp = Space(li_Len)
  501. OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_IDIGITS, Ref ls_Temp, li_Len)
  502. li_digits=Long(Trim(ls_Temp))
  503. IF li_digits>0 Then
  504. is_Format_Decimal ='0'+is_Decmial_Separator+Fill("0", li_digits)
  505. ELSE
  506. is_Format_Decimal="0"
  507. END IF
  508. //取金额格式
  509. ls_Temp = Space(li_Len)
  510. OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SCURRENCY, Ref ls_Temp, li_Len)
  511. ls_symbol=Trim(ls_Temp)
  512. ls_Temp = Space(li_Len)
  513. OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_ICURRDIGITS, Ref ls_Temp, li_Len)
  514. li_digits=Long(Trim(ls_Temp))
  515. ls_Temp = Space(li_Len)
  516. OF_GetLocaleInfo ( LOCALE_USER_DEFAULT,LOCALE_SMONTHOUSANDSEP, Ref ls_Temp, li_Len)
  517. ls_LOCALE_SMONTHOUSANDSEP=Trim(ls_Temp)
  518. ls_Temp = Space(li_Len)
  519. OF_GetLocaleInfo ( LOCALE_USER_DEFAULT,LOCALE_SMONDECIMALSEP, Ref ls_Temp, li_Len)
  520. ls_SMONDECIMALSEP= Trim(ls_Temp)
  521. IF li_digits>0 Then
  522. is_Format_Current = ls_symbol+"#"+ls_LOCALE_SMONTHOUSANDSEP+"##0"+ls_SMONDECIMALSEP+Fill("0",li_digits)
  523. ELSE
  524. is_Format_Current = ls_symbol+"#,##0"
  525. END IF
  526. //取日期格式
  527. ls_Temp = Space(li_Len)
  528. OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SSHORTDATE, Ref ls_Temp, li_Len)
  529. is_Format_ShortDate = Trim(ls_Temp)
  530. IF is_Format_ShortDate="" Then
  531. OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SDATE, Ref ls_Temp, li_Len)
  532. is_Format_ShortDate = Trim(ls_Temp)
  533. END IF
  534. //时间格式
  535. ls_Temp = Space(li_Len)
  536. OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_STIMEFORMAT, Ref ls_Temp, li_Len)
  537. is_Format_Time= Trim(ls_Temp)
  538. IF is_Format_ShortDate="" Then
  539. OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_STIME, Ref ls_Temp, li_Len)
  540. is_Format_Time = Trim(ls_Temp)
  541. END IF
  542. //长时间格式
  543. ls_Temp = Space(li_Len)
  544. OF_GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SLONGDATE, Ref ls_Temp, li_Len)
  545. is_Format_LongDate= Trim(ls_Temp)
  546. end subroutine
  547. public function String of_get_shortdateformat ();Return is_Format_ShortDate
  548. end function
  549. public function String of_get_longdateformat ();Return is_Format_LongDate
  550. end function
  551. public function string of_get_timeformat ();Return is_Format_Time
  552. end function
  553. public function String of_get_decimalformat ();Return is_Format_Decimal
  554. end function
  555. public function String of_get_decmialseparator ();Return is_Decmial_Separator
  556. end function
  557. on n_dw2xls_winapi.create
  558. call super::create
  559. TriggerEvent( this, "constructor" )
  560. end on
  561. on n_dw2xls_winapi.destroy
  562. TriggerEvent( this, "destructor" )
  563. call super::destroy
  564. end on
  565. event constructor;Long hdc
  566. hdc =GetDC(0)
  567. ii_LOGPIXELSX =GetDeviceCaps(hdc, LOGPIXELSX)
  568. ii_LOGPIXELSY= GetDeviceCaps(hdc , LOGPIXELSY)
  569. ReleaseDC(0,hdc)
  570. OF_GetLocaleInfo()
  571. end event