BVB ソース・コード

類似単語ワードアート効果をコントロール. 表示する GlyphOutline.basソースコード

戻る ダウンロード類似単語ワードアート効果をコントロール.: 個別にダウンロードGlyphOutline.basソースコード - 全体をダウンロード類似単語ワードアート効果をコントロール.ソースコード - タイプ:.bas
  1. Attribute VB_Name = "GlyphOutline"
  2. Option Explicit
  3.  
  4. ' Notes:
  5. '   -GetOutline returns the outline upside down (as it is returned from the
  6. '    api function)
  7. '   -Polygon type TT_PRIM_CSPLINE is untested as I have no fonts that return
  8. '    this type. (Perhaps this is a Windows 2000 or better type only?)
  9.  
  10. ' These constants determine how many points are generated when a spline is
  11. ' encountered in a font.
  12. Private Const QSPLINE_COUNT As Long = 10
  13. Private Const CSPLINE_COUNT As Long = 18
  14.  
  15. Private Type POINTAPI
  16.    x As Long
  17.    y As Long
  18. End Type
  19.  
  20. Private Type RECT
  21.    Left As Long
  22.    Top As Long
  23.    Right As Long
  24.    Bottom As Long
  25. End Type
  26.  
  27. Private Type TEXTMETRIC
  28.    tmHeight As Long
  29.    tmAscent As Long
  30.    tmDescent As Long
  31.    tmInternalLeading As Long
  32.    tmExternalLeading As Long
  33.    tmAveCharWidth As Long
  34.    tmMaxCharWidth As Long
  35.    tmWeight As Long
  36.    tmOverhang As Long
  37.    tmDigitizedAspectX As Long
  38.    tmDigitizedAspectY As Long
  39.    tmFirstChar As Byte
  40.    tmLastChar As Byte
  41.    tmDefaultChar As Byte
  42.    tmBreakChar As Byte
  43.    tmItalic As Byte
  44.    tmUnderlined As Byte
  45.    tmStruckOut As Byte
  46.    tmPitchAndFamily As Byte
  47.    tmCharSet As Byte
  48. End Type
  49.  
  50. Private Type PANOSE
  51.    ulculture As Long
  52.    bFamilyType As Byte
  53.    bSerifStyle As Byte
  54.    bWeight As Byte
  55.    bProportion As Byte
  56.    bContrast As Byte
  57.    bStrokeVariation As Byte
  58.    bArmStyle As Byte
  59.    bLetterform As Byte
  60.    bMidline As Byte
  61.    bXHeight As Byte
  62. End Type
  63.  
  64.  
  65. Private Type OUTLINETEXTMETRIC
  66.    otmSize As Long
  67.    otmTextMetrics As TEXTMETRIC
  68.    otmFiller As Byte
  69.    otmPanoseNumber As PANOSE
  70.    otmfsSelection As Long
  71.    otmfsType As Long
  72.    otmsCharSlopeRise As Long
  73.    otmsCharSlopeRun As Long
  74.    otmItalicAngle As Long
  75.    otmEMSquare As Long
  76.    otmAscent As Long
  77.    otmDescent As Long
  78.    otmLineGap As Long
  79.    otmsCapEmHeight As Long
  80.    otmsXHeight As Long
  81.    otmrcFontBox As RECT
  82.    otmMacAscent As Long
  83.    otmMacDescent As Long
  84.    otmMacLineGap As Long
  85.    otmusMinimumPPEM As Long
  86.    otmptSubscriptSize As POINTAPI
  87.    otmptSubscriptOffset As POINTAPI
  88.    otmptSuperscriptSize As POINTAPI
  89.    otmptSuperscriptOffset As POINTAPI
  90.    otmsStrikeoutSize As Long
  91.    otmsStrikeoutPosition As Long
  92.    otmsUnderscorePosition As Long
  93.    otmsUnderscoreSize As Long
  94.    otmpFamilyName As Long 'String pointer
  95.   otmpFaceName As Long 'String pointer
  96.   otmpStyleName As Long 'String pointer
  97.   otmpFullName As Long 'String pointer
  98.   buffer As String * 256
  99. End Type
  100.  
  101. Private Declare Function GetOutlineTextMetrics Lib "gdi32" Alias "GetOutlineTextMetricsA" (ByVal hdc As Long, ByVal cbData As Long, lpotm As OUTLINETEXTMETRIC) As Long
  102.  
  103.  
  104. Private Type MAT2
  105.    eM11 As FIXED
  106.    eM12 As FIXED
  107.    eM21 As FIXED
  108.    eM22 As FIXED
  109. End Type
  110.  
  111.  
  112. Private Type GLYPHMETRICS
  113.    gmBlackBoxX As Long
  114.    gmBlackBoxY As Long
  115.    gmptGlyphOrigin As POINTAPI
  116.    gmCellIncX As Integer
  117.    gmCellIncY As Integer
  118. End Type
  119.  
  120.  
  121.  
  122. Private Declare Function GetGlyphOutline Lib "gdi32" Alias "GetGlyphOutlineA" (ByVal hdc As Long, ByVal uChar As Long, ByVal fuFormat As Long, lpgm As GLYPHMETRICS, ByVal cbBuffer As Long, lpBuffer As Any, lpmat2 As MAT2) As Long
  123. Private Const GGO_NATIVE = 2
  124. Private Const GGO_METRICS = 0
  125.  
  126.  
  127. ' These structures are not used directly, but are here
  128. ' for reference.
  129.  
  130. 'Private Type TTPOLYCURVE
  131. '   wType As Integer 'curve type.
  132. '   cpfx As Integer  'number of pointfx structures
  133. '   apfx As POINTFX
  134. 'End Type
  135.  
  136. 'Private Type TTPOLYGONHEADER
  137. '   cb As Long
  138. '   dwType As Long
  139. '   pfxStart As POINTFX
  140. 'End Type
  141.  
  142. 'Private Type POINTFX
  143. '   x As FIXED
  144. '   y As FIXED
  145. 'End Type
  146.  
  147. 'Private Type FIXED
  148. '   fract As Integer
  149. '   Value As Integer
  150. 'End Type
  151.  
  152.  
  153. Private Const TT_PRIM_CSPLINE As Long = &H3
  154. Private Const TT_PRIM_QSPLINE As Long = &H2
  155. Private Const TT_PRIM_LINE As Long = &H1
  156. Private Const TT_POLYGON_TYPE As Long = 24
  157.  
  158.  
  159. '/****************************************************************************
  160. ' *  FUNCTION   : IdentityMat
  161. ' *  PURPOSE    : Fill in matrix to be the identity matrix.
  162. ' *  RETURNS    : none.
  163. ' ****************************************************************************/
  164. Private Function IdentityMat() As MAT2
  165.    Static lpMat As MAT2
  166.    
  167.    If lpMat.eM11.Value = 0 Then
  168.       lpMat.eM11 = FixedFromDouble(1)
  169.       lpMat.eM12 = FixedFromDouble(0)
  170.       lpMat.eM21 = FixedFromDouble(0)
  171.       lpMat.eM22 = FixedFromDouble(1)
  172.    End If
  173.    
  174.    IdentityMat = lpMat
  175. End Function
  176.  
  177. '
  178. ' Returns unit size the font is defined in.  If 0 is returned
  179. ' then the font is not a truetype font and won't work with
  180. ' GetOutline.
  181. '
  182. Public Function GetEMUnit(ByVal hdc As Long) As Long
  183.    Dim tm As OUTLINETEXTMETRIC
  184.    
  185.    Call GetOutlineTextMetrics(hdc, Len(tm), tm)
  186.    GetEMUnit = Abs(tm.otmEMSquare)
  187. End Function
  188.  
  189. Public Sub GetOutline(ByVal hdc As Long, ByVal Letter As Long, x() As Double, y() As Double, pCount As Long, p() As Long, polyCount As Long)
  190.    Dim size As Long
  191.    Dim gm As GLYPHMETRICS
  192.    Dim buffer() As Long
  193.    
  194.    size = GetGlyphOutline(hdc, Letter, GGO_NATIVE, gm, 0, ByVal 0&, IdentityMat)
  195.    
  196.    If size > 0 Then
  197.       size = size \ 4&
  198.       ReDim buffer(0 To size)
  199.      
  200.       If GetGlyphOutline(hdc, Letter, GGO_NATIVE, gm, size * 4&, buffer(0), IdentityMat) > 0 Then
  201.          Call GetBufferOutline(buffer, x, y, pCount, p, polyCount)
  202.       End If
  203.    End If
  204. End Sub
  205.  
  206. ' This function gets the glyph outline data and calculates the number of points
  207. ' and polygons that will be generated when the outline polyline is generated.
  208. ' buffer() contains the glyph data.
  209. Public Sub GetOutlineCount(ByVal hdc As Long, ByVal Letter As Long, buffer() As Long, ByRef pCount As Long, ByRef polyCount As Long)
  210.    Dim size As Long
  211.    Dim gm As GLYPHMETRICS
  212.    Dim i As Long
  213.    Dim cb As Long
  214.    Dim cp As Long
  215.    
  216.    size = GetGlyphOutline(hdc, Letter, GGO_NATIVE, gm, 0, ByVal 0&, IdentityMat)
  217.    
  218.    If size > 0 Then
  219.       size = size \ 4&
  220.       ReDim buffer(0 To size)
  221.      
  222.       If GetGlyphOutline(hdc, Letter, GGO_NATIVE, gm, size * 4&, buffer(0), IdentityMat) > 0 Then
  223.          i = 0
  224.          Do
  225.             cb = i + buffer(i) \ 4 ' get the end of the polyline
  226.            i = i + 1
  227.            
  228.             If buffer(i) = TT_POLYGON_TYPE Then
  229.                ' this is a valid polygon
  230.               pCount = pCount + 1
  231.                i = i + 3
  232.                
  233.                ' count the elements of this polyline
  234.               Do While i < cb
  235.                   Select Case buffer(i) And &HF  'And &HFFFF0000
  236.                     Case TT_PRIM_CSPLINE:
  237.                         cp = buffer(i) \ &H10000
  238.                         i = i + 1 + cp * 2
  239.                         pCount = pCount + (((cp - 1) / 2) * (CSPLINE_COUNT - 1))
  240.                        
  241.                      Case TT_PRIM_QSPLINE:
  242.                         cp = buffer(i) \ &H10000
  243.                         i = i + 1 + cp * 2
  244.                         pCount = pCount + ((cp - 1) * (QSPLINE_COUNT - 1))
  245.                        
  246.                      Case TT_PRIM_LINE:
  247.                         ' Find the number of points in the line
  248.                        cp = buffer(i) \ &H10000
  249.                         i = i + 1 + cp * 2
  250.                         pCount = pCount + cp
  251.                        
  252.                        
  253.                      Case Else
  254.                         'Skip this record, we don't know
  255.                        'what to do with it.
  256.                        i = i + 1 + (buffer(i) And &HFFFF&)
  257.                   End Select
  258.                Loop
  259.            
  260.                ' get the last point (same as the first)
  261.               pCount = pCount + 1
  262.                
  263.                polyCount = polyCount + 1
  264.             Else
  265.                Erase buffer
  266.                Exit Sub
  267.             End If
  268.            
  269.          Loop While i < size
  270.       End If
  271.    End If
  272. End Sub
  273.  
  274.  
  275. ' Given a buffer as returned from GetGlyphOutline, this calculates the
  276. ' polyline that represents the letter.
  277. Public Sub GetBufferOutline(buffer() As Long, x() As Double, y() As Double, pCount As Long, p() As Long, polyCount As Long)
  278.    Dim size As Long
  279.    Dim i As Long
  280.    Dim cb As Long
  281.    Dim cp As Long
  282.    Dim x2 As Double
  283.    Dim y2 As Double
  284.    Dim x3 As Double
  285.    Dim y3 As Double
  286.    Dim X4 As Double
  287.    Dim Y4 As Double
  288.    Dim pStart As Long
  289.    Dim xStart As Double
  290.    Dim yStart As Double
  291.    
  292.    size = UBound(buffer)
  293.    
  294.    i = 0
  295.    Do
  296.       cb = i + buffer(i) \ 4 ' get the end of the polyline
  297.      i = i + 1
  298.      
  299.       If buffer(i) = TT_POLYGON_TYPE Then
  300.          ' this is a valid polygon
  301.         pStart = pCount
  302.          
  303.          
  304.          ' get the first point
  305.         i = i + 1
  306.          xStart = DoubleFromFixedAsLong(buffer(i))
  307.          x(pCount) = xStart
  308.          i = i + 1
  309.          yStart = DoubleFromFixedAsLong(buffer(i))
  310.          y(pCount) = yStart
  311.          i = i + 1
  312.          pCount = pCount + 1
  313.          
  314.          ' get the elements of this polyline
  315.         Do While i < cb
  316.             Select Case buffer(i) And &HF  'And &HFFFF0000
  317.               Case TT_PRIM_CSPLINE:
  318.                   cp = buffer(i) \ &H10000
  319.                  
  320.                   i = i + 1
  321.                   Do While cp > 0
  322.                      ' CubicBezier starts with the last good point
  323.                     ' so decrease the pCount by 1
  324.                     pCount = pCount - 1
  325.                      x2 = DoubleFromFixedAsLong(buffer(i))
  326.                      y2 = DoubleFromFixedAsLong(buffer(i + 1))
  327.                      
  328.                      x3 = DoubleFromFixedAsLong(buffer(i + 2))
  329.                      y3 = DoubleFromFixedAsLong(buffer(i + 3))
  330.                      
  331.                      X4 = DoubleFromFixedAsLong(buffer(i + 4))
  332.                      Y4 = DoubleFromFixedAsLong(buffer(i + 5))
  333.                      
  334.                      If cp > 3 Then
  335.                         X4 = (X4 + x3) / 2#
  336.                         Y4 = (Y4 + y3) / 2#
  337.                         i = i + 4
  338.                         cp = cp - 2
  339.                      Else
  340.                         i = i + 6
  341.                         cp = cp - 3
  342.                      End If
  343.                      
  344.                      Call CubicBezier(x, y, pCount, QSPLINE_COUNT, _
  345.                         x(pCount), y(pCount), x2, y2, x3, y3, X4, Y4)
  346.                      
  347.                   Loop
  348.                  
  349.  
  350.                  
  351.                Case TT_PRIM_QSPLINE:
  352.                   cp = buffer(i) \ &H10000
  353.                   i = i + 1
  354.                  
  355.                   Do While cp > 0
  356.                      ' QuadraticBezier starts with the last good point
  357.                     ' so decrease the pCount by 1
  358.                     pCount = pCount - 1
  359.                      x2 = DoubleFromFixedAsLong(buffer(i))
  360.                      y2 = DoubleFromFixedAsLong(buffer(i + 1))
  361.                      
  362.                      x3 = DoubleFromFixedAsLong(buffer(i + 2))
  363.                      y3 = DoubleFromFixedAsLong(buffer(i + 3))
  364.                      
  365.                      If cp > 2 Then
  366.                         x3 = (x3 + x2) / 2#
  367.                         y3 = (y3 + y2) / 2#
  368.                         i = i + 2
  369.                         cp = cp - 1
  370.                      Else
  371.                         i = i + 4
  372.                         cp = cp - 2
  373.                      End If
  374.                      
  375.                      Call QuadraticBezier(x, y, pCount, QSPLINE_COUNT, _
  376.                         x(pCount), y(pCount), x2, y2, x3, y3)
  377.                      
  378.                   Loop
  379.                  
  380.                  
  381.                Case TT_PRIM_LINE:
  382.                   ' Find the number of points in the line
  383.                  cp = buffer(i) \ &H10000
  384.                   i = i + 1
  385.                  
  386.                   Do While cp > 0
  387.                      x(pCount) = DoubleFromFixedAsLong(buffer(i))
  388.                      i = i + 1
  389.                      y(pCount) = DoubleFromFixedAsLong(buffer(i))
  390.                      i = i + 1
  391.                      pCount = pCount + 1
  392.                      cp = cp - 1
  393.                   Loop
  394.                  
  395.                Case Else
  396.                   'Skip this record, we don't know
  397.                  'what to do with it.
  398.                  i = i + 1 + (buffer(i) And &HFFFF&)
  399.             End Select
  400.          Loop
  401.      
  402.          ' get the last point (same as the first)
  403.         x(pCount) = xStart
  404.          y(pCount) = yStart
  405.          pCount = pCount + 1
  406.          
  407.          p(polyCount) = pCount - pStart
  408.          polyCount = polyCount + 1
  409.       Else
  410.          Exit Sub
  411.       End If
  412.      
  413.    Loop While i < size
  414.  
  415. End Sub
  416.  
  417.  
個別にダウンロードGlyphOutline.basソースコード - 全体をダウンロード類似単語ワードアート効果をコントロール.ソースコード
関連するソース/ソフトウェア:
Windows ツールバーを制御するプログラム、することができます. - ツール バーまたはスタート ボタンそれぞれ非表示、ツールバーのアイコン、タスクバーに隠すことができま... 2015-04-21
1 つは Windows のプロパティ ダイアログ ボックスが表示されますファイルを呼び出す. - 1 つは呼ぶ Windows のプロパティ ダイアログ ボックスが表示されます、元のファイルのプロパ... 2015-04-21
この COM コンポーネント プロパティ ページを実装して、[参照] ペインでは. - この COM コンポーネント プロパティ ページの実装があり、ブラウズ ウィンドウでポップアップ メ... 2015-04-21
IE のお気に入りのサイトが更新されているか確認してください. - プログラムはいくつかの IE のお気に入りのサイトが更新されているかどうかを確認してください、遅いが... 2015-04-21
ディスク上のショートカットをシェル関数の使用. - ディスクへのショートカットをシェル関数を使用します。 2015-04-21
「ドキュメント」メニューをオフに. - 「文書」メニューのショートカットをオフにし、ショートカットを追加 2015-04-21
サブカテゴリ (サブクラス) を通じてプログラム. - Windows のスタート メニュー、メニュー バーのようなショーの効果を達成するためにサブカテゴリ... 2015-04-21
簡単なサンプルを入力して、SQL を読み取る方法を示しています. - SQL Server の単純な例を入力して、データベースに画像を読み込む方法を示しています。Read... 2015-04-21
(プロセスを含む VB で書かれた、興味深いコントロール - 目は、カーソルを移動できます、VB を使用して書かれた興味深い (ソース コード例など)、コントロー... 2015-04-21
ダイヤルアップ接続を確立します。 - ダイヤルアップ接続を確立します。 2015-04-21
lombok - Java プログラミング言語に非常に辛い追加。 http://projectlo... 2017-01-03
labella.js - 重複なしタイムライン上でラベルを配置します。 http://twitter.gi... 2017-01-03
babel-handbook - 2017-01-03
data-science - 2017-01-03
liteide - LiteIDE は、単純なオープン ソース、クロスプラット フォーム行く IDE です。 2017-01-03
shower - シャワー HTML プレゼンテーション エンジン http://shwr.me 2017-01-03
ThinkUp - ThinkUp は Twitter、Facebook、Instagram の上とを超えて、あなたのソ... 2017-01-03
ES6-Learning - 2017-01-03
scribe - 筆記者は、多数のサーバーからリアルタイムでストリーミング配信ログ データを集約するためのサーバーです... 2017-01-03
assetic - PHP の資産管理 2017-01-03

 トップへ戻る