

                         VBForums -    ̳ 


                         .       
               


      VBForums-̳: HTTP://vbforums.yeah.net
         
               ύʼ: VBForums@usa.net?Subject=VBForums

         нϵ: ympang@bigfoot.com?subject=VBForumsĽ



:
    ĻʵĳһLABELSHAPEؼ(ɫ)˸Ч? 
    Ƕ̵߳.
                                    - Bill

ѡ:

                        Ǭ ¡WinnerPro     

                 йк֧ -    

----    һ  , װ  Ǭ ¡WinnerPro V3.01a  Ʊ    , 
 û   װ     ,   ͨ Internet   һ Щ    
 ,        ת  ΪWinnerPro   .ʤ   ȴ,  ,
     WinnerPro  ʷ   װ   ,  Ultraedit,  
  Ҫ            ,    Visual Basic С 
 ,  ,OK ! 

---- ͨ    ,     E_mail    ,  Internet  
Ʊ   ,  ֮    ,     . 

---- WinnerPro       : 

---- 1,     : 

---- · : 

---- c:\ml30\data\shase\day(  ) 

---- c:\ml30\data\sznse\day(  ) 

----   : 

----  Ʊ  +".day" :"500001.day","0021.day". 

----    : ÿ   ¼  ʮ     ,   :1,   2, 
  3,   4,    5,    6,     7,    8, 
   9, 10,  . ÿ    Ϊ       ,  :  
 ʽ ΪYYYYMMDD, :19980507,   ,   ,   ,    Ϊ ʵ
   1000 ,      ǧ Ԫ Ϊ  λ,    100  Ϊ 
λ. 

---- 2,     : 

----   : 

---- c:\ml30\data\shase\sse20a.dat( ծ ȯ) 

---- c:\ml30\data\shase\sse21a.dat(  ) 

---- c:\ml30\data\sznse\sse22a.dat(  ) 

----    : 

---- ÿ   ¼       ,   :1,  ʶ1( ծ ȯ ȡ 
"0",   ȡ"1",   ȡ"2") 2,  Ʊ  (6   , :"500001"
,"0021 ") 3,  Ʊ  (8   ) 4,  ʶ2( ָ  ȡ  "0",  Ʊ 
ȡ"1") 5,  ʶ3( ָ  ȡ2     0,  Ʊ ȡ1) 

---- Դ    ͨ       ȡ,     
mailto:listserv@city.online.sh.cn  һ  дsubscribe s-fin ȡ  
,  ţmailto:qs-fin@city.online.sh.cn,  ȥ      
ftp://ftp.city.online.sh.cn/s-fin/   ȡ. 

---- VB ת       £ 

Private Type ssefile             
    bz1 As String * 1
    dh As String * 6
    mc As String * 8
    bz2 As String * 1
    bz3 As Integer
End Type
Dim sse0num As Integer
Dim sse0last As Long
Dim sse0posi As Long
Dim sse2num As Integer
Dim sse2last As Long
Dim sse2posi As Long
Dim sselen As Integer
Dim sse As ssefile

Private Type szsrc       Դ      
    mc As String * 8
    dh As String * 7
    zspj As String * 7
    kpj As String * 7
    zgj As String * 7
    zdj As String * 7
    zxj As String * 7
    sd As String * 8
    cjl As String * 9
    cjje As String * 10
    qt1 As String * 2
End Type
Dim srcnum As Integer
Dim srcposi As Long
Dim srclast As Long
Dim srclen As Integer

Private Type desfile            '         
    rq As Long
    kpj As Long
    zgj As Long
    zdj As Long
    spj As Long
    cjje As Long
    cjl As Long
    z1 As Long
    z2 As Long
    z3 As Long
End Type
Dim desrec As desfile
Dim desnum As Integer
Dim desposi As Long
Dim deslast As Long
Dim deslen As Integer

Dim fname As String
Dim srq As String * 8
Dim startrq As Long
Dim findok As Integer
Dim dhnum As Long
Dim coun As Long
Dim Default As String * 1
Dim tmpnum As Integer
Dim posi As Long

Private Sub Command1_Click()
' ת   
    Dim srcrec As szsrc
        srclen = Len(srcrec)
    deslen = Len(desrec)
    sselen = Len(sse)
    desrec.z1 = 0
    desrec.z2 = 0
    desrec.z3 = 0
    coun = 0
    Default = "Y"
    Text1.Text = Text1.Text + File1.filename + Chr(13) + Chr(10)
     srq = "19" + Left(File1.filename, 6)
   startrq = Val(srq)
If UCase(InputBox("  :" + srq + Chr(13) + Chr(10)
+ "  ȷ (y/n)?", , Default, 50, 50)) <> "Y" Then
        Text1.Text = Text1.Text + "    !" + Chr(13) + Chr(10)
        Exit Sub
    End If
    Text1.Text = " "
    Text1.Text = Text1.Text + Str(startrq) + Chr(13) + Chr(10)
    If Len(srq) <> 8 Or startrq < 19980119 Then
        Text1.Text = Text1.Text + "    !" + Chr(13) + Chr(10)
        Exit Sub
    End If
    Text1.Text = "   ת   ..." + Chr(13) + Chr(10)
    srcnum = FreeFile
    ChDrive (Drive1.Drive)
    ChDir (Dir1.Path)
    Open File1.filename For Random As srcnum Len = srclen
    srclast = LOF(srcnum) / srclen
    sse2num = FreeFile
    ChDrive ("d:")
    ChDir ("d:\ml30\data\sznse")
    Open "d:\ml30\data\sznse\sse22a.dat" For Random As sse2num Len = sselen
    sse2posi = 1
    For srcposi = 1 To srclast
        Get srcnum, srcposi, srcrec
        dhnum = Val(srcrec.dh)
        If dhnum < 9000 Then
            sse.bz2 = "1"
            sse.bz3 = 1
            Else
                sse.bz2 = "0"
                sse.bz3 = 0
         End If
If dhnum > 4000 Or dhnum < 1000 Then
        sse.bz1 = "2"
        sse.dh = Right("0000" + Trim(Str(dhnum)), 4) + "  "
        sse.mc = Trim(srcrec.mc)
        Put sse2num, sse2posi, sse
        sse2posi = sse2posi + 1
        fname = "d:\ml30\data\sznse\day\" + Trim(sse.dh) + ".day"
        desnum = FreeFile
        ChDrive ("d:")
        ChDir ("d:\ml30\data\sznse\day")
        Open fname For Random As desnum Len = deslen
        deslast = LOF(desnum) / deslen
        If deslast > 0 Then
            Get desnum, deslast, desrec
        End If
        desrec.spj = CLng(CCur(srcrec.zxj) * 1000)
        desrec.zgj = CLng(CCur(srcrec.zgj) * 1000)
        desrec.zdj = CLng(CCur(srcrec.zdj) * 1000)
        desrec.kpj = CLng(CCur(srcrec.kpj) * 1000)
        desrec.cjl = CLng(srcrec.cjl)
        desrec.cjje = CLng(srcrec.cjje) * 10
    If desrec.zgj <> 0 And (deslast < 1 Or desrec.rq < startrq) Then
        desrec.rq = startrq
        deslast = deslast + 1
        Put desnum, deslast, desrec
        coun = coun + 1
        Text1.Text = "   ת   " + Chr(13) + Chr(10)
        Text1.Text = Text1.Text + Right(fname, 8) + Chr(13) + Chr(10)
    End If
    Close desnum
End If
    Next
    Close srcnum
    Close sse2num
    ChDrive (Drive1.Drive)
    ChDir (Dir1.Path)
    Name File1.filename As Trim(File1.filename) + ".bak"
    Text1.Text = File1.filename + " ת    !" + Chr(13) + Chr(10)
Text1.Text = Text1.Text + " ת  " + Str(coun) +
"   ¼" + Chr(13) + Chr(10)
End Sub


==========================================================================
ѡ

           Visual Basic         ʵ  
                       
                           
                       
                       
----   ż  ڡ     硷    һ ƪ   
VISUAL FOXPRO  ʵ           £   
     ԭ   Visual Basic4.0 Ҳ  д  һ  
             ˵ Microsoft   
         ԣ  ͬ     ͼ    
棨GUI                ͬ 
      ȡ     ʹ         
Ա     ʹ   ͬ Microsoft        
Ӧ           ֲ      ڡ ͬ
ʱ         ѧ ϰ        ͨ  
á 

----            ͨ    ǩLABEL 
  ǰ          ɡ   ǰ    
     ʱ   ǩ    ǰ      ã Ҳ 
     ͨ   ǰ       ͬ  ɫ  ֵ 
ʵ ֡ ɫ  RGB    Visual Foxpro Ҳ    
   ʱ            RGB   ֵ
    ʹ     ǰ   ֮  䣬 ʵ     
  Ŀ ġ 

----   Visual Basic4.0  д          
ܣ1       룬    ɫ    
256*256*256 ֣   ֻ ѡ     ɫ   ɫ   
2   ʱ    С     ʱ     С 
⣬     ʵ      ȫ    Visual C
Visual Java        ֲ 

---- һ.  Visual Basic 4.0      һ   壬 Ĭ
 ΪFORM1 

---- .           £ 

NAMEDEMO
    CAPTIONVB ʵ        
    BACKCOLOR&H00C0C0C0%,    Ϊ  ɫ

---- .   DEMO         , 
General-declaration      ɫ   RGB 

    Dim r As Integer
    Dim g As Integer
    Din b As Integer 

---- . Form-load        ɫ   ֵ,   
ɫ 

    Private Sub Form_Load()
    r = 192
    g = 192
    b = 192
    End Sub  

---- .   DEMO    һ  ǩ       £

    NAMELABEL1  
    CAPTION     Ͷ ծ ȯ   ϵ ͳ
    AUTOSIZETRUE   ʵ      
    BACKSTYLE0-TRANSPARENT  ͸ 
    FONT   Ϊ  飬  С ѡ  Ϊ8

---- .        ʱ          
ܣ    £ 

    NAMEOUTTIMER
    INTERVAL50   һ    һ Σ ɫ    һ Ρ

---- .    һ   ʱ       ܣ 

    NAMEINTIMER
    INTERVAL50

---- . OUTTIMER TIMER         룺 

Private Sub Outtimer_Timer()
If r < 255 Then
r = r + 1
Else
r = 255
End If
If g > 3 Then
g = g - 3
Else: g = 0
End If
If b > 3 Then
b = b - 3
Else: b = 0
End If
Label1.FontSize = Label1.FontSize + 0.75
Label1.ForeColor = RGB(r, g, b)
If Label1.FontSize >= 72 Then
Outtimer.Enabled = False
Intimer.Enabled = True
End If
End Sub

---- . INTIMER       룺 

Private Sub Intimer_Timer()
If r > 192 Then
r = r - 1
Else
r = 192
End If
If g < 192 Then
g = g + 3
Else: g = 192
End If
If b < 192 Then
b = b + 3
Else: b = 192
End If
Label1.FontSize = Label1.FontSize - 0.75
Label1.ForeColor = RGB(r, g, b)
If Label1.FontSize <= 8 Then
Intimer.Enabled = False
Outtimer.Enabled = True
End If
End Sub

----             Ť     
  ڡ     Ͷ ֤ ȯ   ϵ ͳ     С 
  ǳ     ʾ            С
ʱ      ʧ    ֮ У ʵ       
ܡ 

==========================================================================
˶ http://server.com/WebApps/mail-list-unsubscribe.cgi?id=4093


