189 8069 5689
打开VS2005及以上版本，新建一个VB.NET语言的项目，然后点工具-升级VB6代码，把代码粘贴进去即可
为合川等地区用户提供了全套网页设计制作服务，及合川网站建设行业解决方案。主营业务为网站设计、成都网站设计、合川网站设计，以传统方式定制建设网站，并提供域名空间备案等一条龙服务，秉承以专业、用心的态度为用户提供真诚的服务。我们深信只要达到每一位用户的要求，就会得到认可，从而选择与我们长期合作。这样，我们也可以走得更远！
If DateTime.Now.Hour 6 And DateTime.Now.Hour 12 Then Me.Text = "上午好"
If DateTime.Now.Hour 12 And DateTime.Now.Hour 18 Then Me.Text = "下午好"
If DateTime.Now.Hour 18 And DateTime.Now.Hour 20 Then Me.Text = "晚上好"
用vb.net做的校友录……（附所有源代码）
来源：不详 作者 佚名 点击数：31 录入时间：07-12-17 15:21:39
想必大家都上过校友录吧，里面的功能虽然不是很强大，但是为我们这些毕业之后各奔西东的学子来说，到真是提供了一个好的聚集点，下面是我用vb.net做的校友录，当然也不能说是校友录了，只能说是我们班的学友录了：）不过只要你掌握了这种编程思想，校友录就不在话下了。这里我将重点谈一下关于管理员权限赋予。
以前有这个想法的时候，难就难在管理员身份的赋予上，开始想如果一般用户在被提升为管理员之后，我可以把他的信息转到另外一个表中，以后登陆的时候先检查manage表中是否有他就行了，这种办法我已经实现了，是不是有些笨……可是正在我要正式开工的时候，一个想法突然冒了出来，是什么呢？呵呵，就是在数据库中再增加一个字段了如果是第一次注册就让这个字段item(int)的值为0，要是被提升之后就update为1，班级创始人呢？当然了，在他申请时付给他一个班级id，然后先判断班级id为这个已经注册的人信息条数是否为0，如果是，那么就付给他item=2好了。下面的代码中，我没有实现这个功能，因为我做的是班友录的，当然了，我就是管理员喽：）
在这里，我使用的是checkboxlist(两个)，一个用来转换数据（visibe=fause），一个用来显示数据，还有一个checkbox用来写全部选中的事件。当然了还有两个按钮事件，一个是用来提升为管理员的，一个是用来降级为一般用户的，这两个按钮在判断为一般用户时
enable都是为fause的，只有当判断登录为管理员时才为true。当然了，如果你是班级创始人，是不可能被降级的：）
这里用来显示信息的我用的是一个datagrid，当判断为非管理员时，删除栏的visible将为fause，为管理员的时候，才为true，也就是说只有管理员才可以删除信息。而不是注册的用户是不能发言的所有的按钮控件的enable将都为fause。
代码如下：board.aspx
%@ Page Language="vb" AutoEventWireup="false" Codebehind="boaman.aspx.vb" Inherits="_99re1.boaman"%
!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
HTML
HEAD
title/title
meta content="Microsoft Visual Studio.NET 7.0" name="GENERATOR"
meta content="Visual Basic 7.0" name="CODE_LANGUAGE"
meta content="javascript" name="vs_defaultClientScript"
meta content="" name="vs_targetSchema"
/HEAD
body background="image/bg.gif" MS_POSITIONING="GridLayout"
form id="Form1" method="post" runat="server"
asp:checkbox id="yourcheck" style="Z-INDEX: 101; LEFT: 84px; POSITION: absolute; TOP: 71px" runat="server" Text="全部选中" AutoPostBack="True" ForeColor="SaddleBrown" Font-Bold="True"/asp:checkbox
asp:button id="Button1" style="Z-INDEX: 102; LEFT: 34px; POSITION: absolute; TOP: 43px" runat="server" Text="提升为管理员" Height="20px" Width="100px" BackColor="Gainsboro" BorderColor="Lavender" BorderWidth="2px" BorderStyle="Outset"/asp:button
asp:button id="Button2" style="Z-INDEX: 103; LEFT: 142px; POSITION: absolute; TOP: 43px" runat="server" Text="降级为一般用户" Height="20px" Width="100px" BackColor="Gainsboro" BorderColor="Lavender" BorderWidth="2px" BorderStyle="Outset"/asp:button
asp:checkboxlist id="CheckBoxList1" style="Z-INDEX: 104; LEFT: 14px; POSITION: absolute; TOP: 10px" runat="server" Visible="False"/asp:checkboxlist
asp:checkboxlist id="mycheck" style="Z-INDEX: 105; LEFT: 98px; POSITION: absolute; TOP: 99px" runat="server" ForeColor="Navy" Font-Size="X-Small"/asp:checkboxlist
asp:label id="Label1" style="Z-INDEX: 106; LEFT: 82px; POSITION: absolute; TOP: 14px" runat="server" ForeColor="Red" Font-Names="方正姚体"（已注册用户）/asp:label
asp:image id="Image1" style="Z-INDEX: 107; LEFT: 260px; POSITION: absolute; TOP: 180px" runat="server" Height="124px" Width="221px" ImageUrl="image/99re1-1.gif"/asp:image
asp:datagrid id="DataGrid1" style="Z-INDEX: 108; LEFT: 250px; POSITION: absolute; TOP: 83px" runat="server" Height="113px" Width="461px" BorderColor="#ffcc66" AutoGenerateColumns="False" HeaderStyle-Font-Size="9" HeaderStyle-HorizontalAlign="Center" HeaderStyle-ForeColor="red" HeaderStyle-Font-Bold="True"
Columns
asp:HyperLinkColumn ItemStyle-ForeColor="navy" ItemStyle-HorizontalAlign="Center" ItemStyle-Height="24" ItemStyle-Font-Size="9" DataNavigateUrlField="stu_id" DataNavigateUrlFormatString="querry.aspx?stu_id={0}" DataTextField="stu_id" HeaderText="学号"/asp:HyperLinkColumn
asp:BoundColumn ItemStyle-ForeColor="navy" ItemStyle-HorizontalAlign="Center" ItemStyle-Width="100" ItemStyle-Font-Size="9" DataField="tel" HeaderText="电话"/asp:BoundColumn
asp:BoundColumn ItemStyle-ForeColor="navy" ItemStyle-HorizontalAlign="Center" ItemStyle-Width="80" ItemStyle-Font-Size="9" DataField="oicq" HeaderText="OICQ"/asp:BoundColumn
asp:BoundColumn ItemStyle-ForeColor="navy" ItemStyle-HorizontalAlign="Center" ItemStyle-Width="140" ItemStyle-Font-Size="9" DataField="email" HeaderText="E-mail"/asp:BoundColumn
asp:BoundColumn ItemStyle-ForeColor="navy" ItemStyle-HorizontalAlign="Center" ItemStyle-Width="60" ItemStyle-Font-Size="9" DataField="point" HeaderText="登录次数"/asp:BoundColumn
/Columns
/asp:datagrid
/form
/body
/HTML
下面是codebehind中的内容：boaman.asp.vb
Imports System.Data
Imports System.Data.SqlClient
Public Class boaman
Inherits System.Web.UI.Page
Protected WithEvents yourcheck As System.Web.UI.WebControls.CheckBox
Protected WithEvents Button1 As System.Web.UI.WebControls.Button
Protected WithEvents CheckBoxList1 As System.Web.UI.WebControls.CheckBoxList
Protected WithEvents mycheck As System.Web.UI.WebControls.CheckBoxList
Protected WithEvents Label1 As System.Web.UI.WebControls.Label
Protected WithEvents Image1 As System.Web.UI.WebControls.Image
Protected WithEvents DataGrid1 As System.Web.UI.WebControls.DataGrid
Protected WithEvents Button2 As System.Web.UI.WebControls.Button
#Region " Web Form Designer Generated Code "
'This call is required by the Web Form Designer.
System.Diagnostics.DebuggerStepThrough() Private Sub InitializeComponent()
End Sub
Private Sub Page_Init(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Init
'CODEGEN: This method call is required by the Web Form Designer
'Do not modify it using the code editor.
InitializeComponent()
End Sub
#End Region
Dim conn As SqlConnection = New SqlConnection("server=lixinri;uid=sa;pwd=;database=99re1")
Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'////////////////////判断是否为过客
If Session("stu_id") = "" Then
Button1.Enabled = False : Button2.Enabled = False
'////////////////////调用check()事件
check()
Else
If Not IsPostBack Then
Dim sql As String = "select * from pwd where stu_id=@stu_id"
Dim comm As SqlCommand = New SqlCommand(sql, conn)
comm.Parameters.Add(New SqlParameter("@stu_id", SqlDbType.Int, 4))
comm.Parameters("@stu_id").Value = Session("stu_id")
Dim dr As SqlDataReader
conn.Open()
dr = comm.ExecuteReader
While dr.Read
If dr.Item("term") = "0" Then
'///////////////////判断是否为一般用户
dr.Close()
Button1.Enabled = False : Button2.Enabled = False
Dim sql_1 As String = "select a.stu_id as stu_id,a.term,b.name as name,b.tel as tel,b.call as oicq,b.point as point,b.email from pwd a,stu_base b where a.stu_id=b.stu_id"
Dim cmd As New SqlCommand(sql_1, conn)
dr = cmd.ExecuteReader
While dr.Read
If dr.Item("term") = "1" Then
mycheck.Items.Add("u" dr.Item("name") "/u" "font color=darkorange(管理员)/font")
ElseIf dr.Item("term") = "2" Then
mycheck.Items.Add("u" dr.Item("name") "/u" "font color=red(班级创始人)font")
Else
mycheck.Items.Add("u" dr.Item("name") "/u")
End If
CheckBoxList1.Items.Add(dr.Item("stu_id"))
End While
Else
'////////////////////判断是否为管理员
dr.Close()
Button1.Enabled = True : Button2.Enabled = True
Dim sql_1 As String = "select a.stu_id as stu_id,a.term,b.name as name,b.tel as tel,b.call as oicq,b.point as point,b.email from pwd a,stu_base b where a.stu_id=b.stu_id"
Dim cmd As New SqlCommand(sql_1, conn)
dr = cmd.ExecuteReader
While dr.Read
If dr.Item("term") = "1" Then
mycheck.Items.Add("u" dr.Item("name") "/u" "font color=darkorange(管理员)/font")
ElseIf dr.Item("term") = "2" Then
mycheck.Items.Add("u" dr.Item("name") "/u" "font color=red(班级创始人)font")
Else
mycheck.Items.Add("u" dr.Item("name") "/u")
End If
CheckBoxList1.Items.Add(dr.Item("stu_id"))
End While
End If
End While
dr.Close()
'////////////////////////取出数据，填充dataset
Dim mysql As String = "select a.stu_id as stu_id,a.term,b.name as name,b.tel as tel,b.call as oicq,b.point as point,b.email from pwd a,stu_base b where a.stu_id=b.stu_id"
comm = New SqlCommand(mysql, conn)
Dim mycomm As SqlDataAdapter = New SqlDataAdapter(mysql, conn)
Dim ds As DataSet = New DataSet()
mycomm.Fill(ds, "base")
DataGrid1.DataSource = ds.Tables("base").DefaultView
DataGrid1.DataBind()
End If
End If
End Sub
'///////////////////////书写check()事件
Sub check()
If Not IsPostBack Then
Dim mysql As String = "select a.stu_id as stu_id,a.term,b.name as name,b.tel as tel,b.call as oicq,b.point as point,b.email from pwd a,stu_base b where a.stu_id=b.stu_id"
Dim comm As New SqlCommand(mysql, conn)
Dim dr As SqlDataReader
conn.Open()
dr = comm.ExecuteReader
While dr.Read
If dr.Item("term") = "1" Then
mycheck.Items.Add("u" dr.Item("name") "/u" "font color=darkorange(管理员)/font")
ElseIf dr.Item("term") = "2" Then
mycheck.Items.Add("u" dr.Item("name") "/u" "font color=red(班级创始人)font")
Else
mycheck.Items.Add("u" dr.Item("name") "/u")
End If
CheckBoxList1.Items.Add(dr.Item("stu_id"))
End While
dr.Close()
Dim mycomm As SqlDataAdapter = New SqlDataAdapter(mysql, conn)
Dim ds As DataSet = New DataSet()
mycomm.Fill(ds, "base")
DataGrid1.DataSource = ds.Tables("base").DefaultView
DataGrid1.DataBind()
End If
End Sub
'/////////////////////填充yourcheck
Private Sub yourcheck_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles yourcheck.CheckedChanged
Dim i As Integer
For i = 0 To mycheck.Items.Count - 1
If yourcheck.Checked Then
mycheck.Items(i).Selected = True
Else
mycheck.Items(i).Selected = False
End If
Next
End Sub
'///////////////////////提升一般用户为管理员
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
conn.Open()
Dim i As Integer
For i = 0 To mycheck.Items.Count - 1
If mycheck.Items(i).Selected Then
Dim sql_1 As String = "update pwd set term=1 where stu_id=@stu_id and term=0"
Dim comm As SqlCommand = New SqlCommand(sql_1, conn)
comm.Parameters.Add(New SqlParameter("@stu_id", SqlDbType.Int, 4))
comm.Parameters("@stu_id").Value = CheckBoxList1.Items(i).Text
comm.ExecuteNonQuery()
End If
Next
Response.Redirect("boaman.aspx")
End Sub
'///////////////////////降级管理员为一般用户
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
conn.Open()
Dim i As Integer
For i = 0 To mycheck.Items.Count - 1
If mycheck.Items(i).Selected Then
Dim sql_1 As String = "update pwd set term=0 where stu_id=@stu_id and term=1"
Dim comm As SqlCommand = New SqlCommand(sql_1, conn)
comm.Parameters.Add(New SqlParameter("@stu_id", SqlDbType.Int, 4))
comm.Parameters("@stu_id").Value = CheckBoxList1.Items(i).Text
comm.ExecuteNonQuery()
End If
Next
Response.Redirect("boaman.aspx")
End Sub
End Class
当然了，这里面还有好多不足的地方，恳求高手批评指正。
校友录还有一些其它的功能就很简单了，这里就不再探讨了。
Delphi代码如下：
procedure TForm1.Button1Click(Sender: TObject);
var
购物总价:Integer;
折扣:Extended;
begin
购物总价:=StrToInt(Edit1.Text);
if 购物总价250 then
begin
折扣:=0;
end
else if 购物总价500 then
begin
折扣:=0.05;
end
else if 购物总价1000 then
begin
折扣:=0.075;
end
else if 购物总价2000 then
begin
折扣:=0.1;
end
{
此段的折扣是多少？
else if 购物总价3000 then
begin
折扣:=0.05;
end
}
else if 购物总价=3000 then
begin
折扣:=0.15;
end;
ShowMessage('您享受的折扣是：'+FloatToStr(折扣)
+' 原价：'+IntToStr(购物总价)
+' 折后总价：'+FloatToStr(购物总价*(1-折扣)));
end;
这个其实跟桃形或者心形（另一问题中提到的）其实是一个程序，改一下花瓣的半径就可以了。请看图
通过圆心的垂直线的距离为半径
圆心右侧垂直线的距离为半径
圆心左侧垂直线的距离为半径
过圆上左极点垂直线的距离为半径
与上次的桃形绘图的代码差异只有一句