Foxtable所有范例代码

更新时间：2024-01-29 18:41:01 阅读量：教育文库文档下载

说明：文章内容仅供预览，部分内容可能不全。下载后的文档，内容与下面显示的完全一致。下载之前请确认下面内容是否您想要的，是否完整无缺。

foxmail邮箱推荐度：
相关推荐

=====Excel图表.foxdb=====

项目事件

AfterOpenProject

Forms(\图表设置\

计划管理

表事件

窗口表事件

窗口与控件事件

图表设置_AfterLoad

Dim x,y As String Dim i As Integer

For Each c As Col In Currenttable.Cols If c.Visible Then i = i + 1

If c.Datacol.IsNumeric Then

y = y & \【\】\ Else

x = x & \【\】\ End If End If Next

e.Form.Controls(\e.Form.Controls(\

图表设置_Button1_Click

exStr = \图表区\

Forms(\图表外观\

图表设置_Button2_Click

exStr = \绘图区\

Forms(\图表外观\

图表设置_Button3_Click

exStr = \图例\

Forms(\图表外观\

图表设置_Button4_Click

exStr = \标题\

Forms(\图表外观\

图表设置_Button5_Click

'对数据列验证

Dim y As String = e.Form.Controls(\Dim x As String = e.Form.Controls(\If y = \

MessageBox.Show(\数据系列中的数值轴(Y)必须设置! \信息提示\ Return Else

If e.Form.Controls(\

MessageBox.Show(\数值轴(Y)不能全部设置为次坐标轴! \信息提示\ Return End If End If

Dim ksl,jsl As Integer 'x轴的起始列与结束列 If x <> \

Dim xs As String() = x.Split(\

If xs.Length > 1 '如果x轴有多列 Dim xsn(xs.Length-1) As Integer

For n As Integer = 0 To xs.Length - 1

xsn(n) = xs(n).SubString(1,xs(n).LastIndexOf(\】\ Next

Array.Sort(xsn) '得到各列的序号,并排序 For n As Integer = 1 To xsn.Length - 1 If xsn(n) - xsn(n-1) > 1

MessageBox.Show(\如果X轴的分类列有多个, 那么它必须是连续的! \信息提示\ Return End If Next

ksl = xsn(0)

jsl = xsn(xsn.Length-1) Else

ksl = x.SubString(1,x.LastIndexOf(\】\ jsl = ksl End If End If

'定义Excel

Dim f As String = ProjectPath & \数据.xls\Dim t As Table = CurrentTable Dim flg As New SaveExcelFlags flg.CellStyle = True

t.SaveExcel(f,t.Name,flg) '导出数据到指定文件 Dim App As New MSExcel.Application App.DisplayAlerts = False

Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(f) Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)

Dim i As Integer = e.Form.Controls(\指定大小 Dim j As Integer = e.Form.Controls(\

Dim rg As MSExcel.Range = Ws.Cells(t.HeaderRows + t.Rows.Count,1)

Dim Co As MSExcel.ChartObject = Ws.ChartObjects.Add(rg.Left,rg.Top,i,j) '在最末行的第一个单元格处生成图表

Ws.DrawingObjects(1).Shadow = e.Form.Controls(\阴影 Ws.DrawingObjects(1).RoundedCorners = e.Form.Controls(\圆角 Dim Cht As MSExcel.Chart = Co.Chart

Functions.Execute(\图表区\设置图表区外观,此行不能放到后面,否则将

替代其它对象的设置

'图表类型并指定y轴和绘图方式 Cht.ChartType =

Functions.Execute(\).Value)

Dim cs As String() = y.Split(\Dim lh As Integer Dim ar As String

Dim first As Integer = CurrentTable.HeaderRows + 1 '数据记录的起始行 Dim last As Integer = CurrentTable.HeaderRows + CurrentTable.Rows.Count '数据记录的结束行 For Each c As String In cs

lh = c.SubString(1,c.LastIndexOf(\】\

ar = ar & \Functions.Execute(\Next

ar = ar.Trim(\rg = Ws.Range(ar)

If e.Form.Controls(\饼图\ Dim ars As String() = ar.Split(\ If ars.Length > 1 Then rg = Ws.Range(ars(0)) End If End If

If e.Form.Controls(\

Cht.SetSourceData(rg,MSExcel.XlRowCol.xlColumns) '数据产生自列 Else

Cht.SetSourceData(rg,MSExcel.XlRowCol.xlRows) '数据产生于行 End If

Functions.Execute(\绘图区\绘图区的外观设置 '指定x轴的分类列区域 Dim xbz As String If x <> \

xbz = \ If e.Form.Controls(\合并单元格 For m As Integer = jsl To ksl Step -1 Dim hh As Integer = first

For n As Integer = first+1 To last+1

If Ws.Cells(n,m).Value <> Ws.Cells(hh,m).Value Then rg = Ws.Range(Ws.Cells(hh,m),Ws.Cells(n-1,m)) If m = ksl Then rg.Merge

rg.VerticalAlignment = MSExcel.Constants.xlCenter hh = n

Elseif Ws.Cells(n,m-1).Value = Ws.Cells(hh,m-1).Value Then rg.Merge

rg.VerticalAlignment = MSExcel.Constants.xlCenter hh = n End If End If Next Next End If End If

'设置每个数据系列

Dim czb As String = e.Form.Controls(\

Dim czbs As New List(Of String) '次坐标轴集合 If czb > \

czbs.AddRange(czb.Split(\End If

Dim s As MSExcel.Series

Dim ys As Integer = 15 '颜色序号从15开始 For n As Integer = 1 To cs.Length

If e.Form.Controls(\饼图\ If n > 1 Then Exit For End If End If

s = Cht.SeriesCollection(n) If x <> \

s.XValues = xbz '指定对应的x轴 End If

s.Name = cs(n-1).SubString(cs(n-1).LastIndexOf(\】\系列名称 If czbs.Contains(cs(n-1)) '如果在次坐标集合中找到对应的内容 s.AxisGroup = 2 End If

Functions.Execute(\数据系列_\ ys = ys+3 Next

'设置坐标轴

If e.Form.Controls(\饼图\ Dim y1min,y1max,y2min,y2max As Integer '设置刻度 If czb > \如果有主轴和次轴就要分别设置 ar = \

Dim br As String

Dim lst1() As String = e.Form.Controls(\ Dim lst2() As String = e.Form.Controls(\ For Each c As String In lst1

lh = c.SubString(1,c.LastIndexOf(\】\

ar = ar & \Functions.Execute(\ Next

For Each c As String In lst2

lh = c.SubString(1,c.LastIndexOf(\】\

br = br & \Functions.Execute(\ Next

rg = Ws.Range(ar.Trim(\

y1min = App.WorksheetFunction.Min(rg) y1max = App.WorksheetFunction.Max(rg) With Cht.Axes(MSExcel.XlAxisType.xlValue) .MinimumScale = y1min .MaximumScale = y1max End With

rg = Ws.Range(br.Trim(\

y2min = App.WorksheetFunction.Min(rg) y2max = App.WorksheetFunction.Max(rg)

With Cht.Axes(MSExcel.XlAxisType.xlValue,2) .MinimumScale = y2min .MaximumScale = y2max End With

Else '否则只要设置主轴刻度

y1min = App.WorksheetFunction.Min(Ws.Range(ar)) y1max = App.WorksheetFunction.Max(Ws.Range(ar)) With Cht.Axes(MSExcel.XlAxisType.xlValue) .MinimumScale = y1min .MaximumScale = y1max End With End If

If e.Form.Controls(\ With Cht.Axes(MSExcel.XlAxisType.xlCategory) '设置X轴标题网格 .HasTitle = True

.AxisTitle.Text = e.Form.Controls(\

.HasMajorGridlines = e.Form.Controls(\ .HasMinorGridlines = e.Form.Controls(\ End With End If

If e.Form.Controls(\ With Cht.Axes(MSExcel.XlAxisType.xlValue,1) '设置Y主轴标题网格 .HasTitle = True

.AxisTitle.Text = e.Form.Controls(\

.HasMajorGridlines = e.Form.Controls(\ .HasMinorGridlines = e.Form.Controls(\ End With End If

If e.Form.Controls(\e.Form.Controls(\

With Cht.Axes(MSExcel.XlAxisType.xlValue,2) '设置Y次轴标题网格 .HasTitle = True

.AxisTitle.Text = e.Form.Controls(\ End With End If End If '图例

Dim sfxs As Boolean = e.Form.Controls(\Cht.HasLegend = sfxs If sfxs Then

Functions.Execute(\图例\End If '标题

sfxs = e.Form.Controls(\Cht.HasTitle = sfxs If sfxs Then

Functions.Execute(\标题\End If '显示表格

sfxs = e.Form.Controls(\Cht.Hasdatatable = sfxs App.Visible = True

图表设置_Button6_Click

Dim cb As WinForm.CheckedComboBox = e.Form.Controls(\Dim tblx As String = e.Form.Controls(\

If tblx.Contains(\三维\饼图\圆柱\圆锥\棱锥\

cb.Enabled = False cb.Value = \Else

cb.Enabled = True End If '数据系列

Dim z As String = e.Form.Controls(\Dim zs As String() If z > \

zs = z.Split(\ If zs.Length > 1 Then

cb.ComboList = z.Replace(\ Else

cb.Value = \ End If Else

cb.Value = \End If

Dim c As String = cb.Value If c > \

e.Form.Controls(\ zs = z.Split(\所有数据列集合 Dim zls As New List(Of String) zls.AddRange(zs)

Dim cs As String() = c.Split(\次轴数据列集合 Dim cls As New List(Of String) cls.AddRange(cs)

For i As Integer = 0 To cls.Count - 1 Dim va As String = cls(i) If zls.Contains(va) Then zls.Remove(va) Else

cls.Remove(va) End If Next

Dim zxx As String If zls.Count > 0 Then

For Each cn As String In zls zxx = zxx & \ Next

zxx = zxx.Trim(\ End If

e.Form.Controls(\ zxx = \

If cls.Count > 0 Then

For Each cn As String In cls zxx = zxx & \ Next

zxx = zxx.Trim(\ End If

e.Form.Controls(\Else

If z > \

e.Form.Controls(\ End If

e.Form.Controls(\ e.Form.Controls(\End If

图表设置_Button7_Click

e.Form.Close

图表设置_CheckBox11_CheckedChanged

e.Form.Controls(\e.Form.Controls(\e.Form.Controls(\

图表设置_CheckBox3_CheckedChanged

e.Form.Controls(\

图表设置_CheckBox4_CheckedChanged

e.Form.Controls(\

图表设置_CheckBox6_CheckedChanged

e.Form.Controls(\e.Form.Controls(\e.Form.Controls(\

图表设置_CheckBox9_CheckedChanged

e.Form.Controls(\

图表设置_CheckedComboBox1_TextChanged

e.Form.Controls(\

图表设置_CheckedComboBox2_TextChanged

Dim cb As WinForm.CheckBox = e.Form.Controls(\cb.Enabled = False cb.Checked = False

Dim xx As String = e.Sender.Value If xx <> \

cb.Enabled = True cb.Checked = True End If

图表设置_CheckedComboBox3_TextChanged

e.Form.Controls(\

图表设置_ComboBox1_ValueChanged

Dim lst As String = Functions.Execute(\e.Form.Controls(\

Dim lsts As String() = lst.Split(\

e.Form.Controls(\

图表设置_ComboBox2_ValueChanged

e.Form.Controls(\

图表设置_ListBox1_DoubleClick

Dim v As String = e.Sender.Value If v > \

v = v.SubString(v.IndexOf(\】\ exStr = \数据系列_\ Forms(\图表数据系列\End If

图表设置_ListBox2_DoubleClick

Dim v As String = e.Sender.Value If v > \

v = v.SubString(v.IndexOf(\】\ exStr = \数据系列_\ Forms(\图表数据系列\End If

图表数据系列_AfterLoad

Dim lx As String = exStr

If lx.SubString(0,1) = \如果是主轴的数据系列,不允许设置类型 e.Form.Controls(\

If Forms(\图表设置\饼图\ e.Form.Controls(\ End If End If

lx = lx.SubString(lx.IndexOf(\

e.Form.Text = \数据系列【\】格式设置\

Dim f As String = ProjectPath & \数据系列_\If FileSys.FileExists(f) Then

Dim vs As String() = FileSys.ReadAllText(f).Split(\ㄉ\ Dim v As String = vs(1) vs = v.Split(\ '系列名称

e.Form.Controls(\ '图表类型

Dim lxs As String() = Functions.Execute(\ e.Form.Controls(\ e.Form.Controls(\ '数据标签

e.Form.Controls(\ e.Form.Controls(\ e.Form.Controls(\ '分色显示

e.Form.Controls(\Else

e.Form.Controls(\

End If

If e.Form.Controls(\ e.Form.Controls(\End If

图表数据系列_Button1_Click

Forms(\图表外观\

图表数据系列_Button2_Click

Dim xlmc As String = e.Form.Controls(\If xlmc = \

MessageBox.Show(\数据系列名称不能为空! \信息提示\ Return

Elseif xlmc.Contains(\

MessageBox.Show(\数据系列名称中不能包含半角逗号! \信息提示\ Return End If

Dim tblx As Integer =

Functions.Execute(\).Value)

Dim flmc As Boolean = e.Form.Controls(\Dim sz As Boolean = e.Form.Controls(\Dim bfb As Boolean = e.Form.Controls(\Dim fs As Boolean = e.Form.Controls(\'保存设置

Dim str As String = xlmc & \

Dim f As String = ProjectPath & \保存文件名 If Not FileSys.FileExists(f) Then

If Not FileSys.DirectoryExists(ProjectPath & \ FileSys.CreateDirectory(ProjectPath & \ End If

str = \宋体,0,9,0,0,0,0,0,0,0,3,255,255,255,False,True,4,False,13,False,,,靠右ㄉ\Else

Dim vs As String() = FileSys.ReadAllText(f).Split(\ㄉ\ Dim qtz As String = vs(0) str = qtz & \ㄉ\End If

FileSys.WriteAllText(f,str,False) e.Form.Close

图表数据系列_Button3_Click

e.Form.Close

图表数据系列_ComboBox1_ValueChanged

Dim lst As String = Functions.Execute(\Dim lsts As String() = lst.Split(\lst = \

For Each l As String In lsts

If Not l.Contains(\三维\

lst = lst & \ End If Next

lst = lst.Trim(\

e.Form.Controls(\lsts = lst.Split(\

e.Form.Controls(\

图表外观_AfterLoad

Dim lx As String = exStr

e.Form.Text = \【\】项目设置\If lx.Contains(\数据系列\

e.Form.Text = \【\】项目设置\ lx = lx.SubString(1) End If

If lx = \绘图区\

e.Form.Controls(\End If

If lx <> \标题\

e.Form.Controls(\End If

If lx <> \图例\

e.Form.Controls(\End If

Dim f As String = ProjectPath & \If FileSys.FileExists(f) Then

Dim vs As String() = FileSys.ReadAllText(f).Split(\ If lx.Contains(\数据系列\

vs = FileSys.ReadAllText(f).Split(\ㄉ\ Dim szz As String = vs(0) vs = szz.Split(\ End If '字体

Dim zt1 As String = vs(0) Dim zt2 As FontStyle = vs(1) Dim zt3 As Integer = vs(2)

e.Form.Controls(\

e.Form.Controls(\ '边框样式

Dim ss As String() = e.Form.Controls(\ e.Form.Controls(\ '边框颜色

e.Form.Controls(\ '边框粗细

ss = e.Form.Controls(\ e.Form.Controls(\ '填充颜色

e.Form.Controls(\ '是否启用填充效果

e.Form.Controls(\ '渐变方向

e.Form.Controls(\

ss = e.Form.Controls(\ If vs(16) = 7 Then

e.Form.Controls(\中心辐射\ Else

e.Form.Controls(\ End If '纹理图案

e.Form.Controls(\

ss = e.Form.Controls(\ e.Form.Controls(\ '背景图片

e.Form.Controls(\ e.Form.Controls(\ '标题

e.Form.Controls(\ '图例

e.Form.Controls(\End If

图表外观_Button1_Click

e.Form.Close

图表外观_Button2_Click

Dim s As New Windows.Forms.FontDialog s.ShowColor = True

s.Font = e.Form.Controls(\

s.Color = e.Form.Controls(\If s.ShowDialog = DialogResult.OK Then

e.Form.Controls(\

e.Form.Controls(\End If

图表外观_Button4_Click

Dim style,weight,gradient,texture As Integer Dim r1,g1,b1,r2,g2,b2,r3,g3,b3 As Integer '字体设置

Dim fn As String = e.Form.Controls(\Dim fs As Integer = e.Form.Controls(\Dim fsize As Integer = e.Form.Controls(\Dim RGBColor As Color = e.Form.Controls(\r1 = RGBColor.R g1 = RGBColor.G b1 = RGBColor.B '边框样式

Select e.Form.Controls(\ Case \无\ style = 0 Case \实线\ style = 1 Case \不连续线\ style = 2

Case \单点连续线\ style = 3

Case \单点单线结合\

style = 4

Case \双点单线结合\ style = 5 End Select '边框颜色

RGBColor = e.Form.Controls(\r2 = RGBColor.R g2 = RGBColor.G b2 = RGBColor.B '边框粗细

Select e.Form.Controls(\ Case \最细\ weight = 1 Case \细\

weight = 2 Case \中等\ weight = 3 Case \粗\

weight = 4 End Select '填充颜色

RGBColor = e.Form.Controls(\r3 = RGBColor.R g3 = RGBColor.G b3 = RGBColor.B '渐变方向

Select e.Form.Controls(\ Case \水平\

gradient = 1 Case \垂直\

gradient = 2 Case \斜上\

gradient = 3 Case \斜下\

gradient = 4 Case \角部辐射\ gradient = 5 Case \中心辐射\ gradient = 7 End Select '纹理图案

Select e.Form.Controls(\ Case \纸莎草纸\ texture = 1 Case \画布\

texture = 2 Case \斜纹布\ texture = 3 Case \编织物\ texture = 4 Case \水滴\

texture = 5 Case \纸袋\

texture = 6 Case \鱼类化石\

texture = 7 Case \沙滩\

texture = 8 Case \绿色大理石\ texture = 9 Case \白色大理石\ texture = 10 Case \褐色大理石\ texture = 11 Case \花岗岩\ texture = 12 Case \新闻纸\ texture = 13 Case \再生纸\ texture = 14 Case \羊皮纸\ texture = 15 Case \信纸\

texture = 16 Case \蓝色面巾纸\ texture = 17 Case \粉色面巾纸\ texture = 18 Case \紫色网格\ texture = 19 Case \花束\

texture = 20 Case \软木塞\ texture = 21 Case \胡桃\

texture = 22 Case \栎木\

texture = 23 Case \深色木质\ texture = 24 End Select '其它设置

Dim sfxg As Boolean = e.Form.Controls(\Dim rd1 As Boolean = e.Form.Controls(\Dim rd2 As Boolean = e.Form.Controls(\Dim rd3 As Boolean = e.Form.Controls(\Dim f As String = e.Form.Controls(\Dim bt As String = e.Form.Controls(\Dim wz As String = e.Form.Controls(\'保存设置

Dim str As String = fn & \\\

\f = ProjectPath & \检查路径是否存在 If Not FileSys.DirectoryExists(f) Then FileSys.CreateDirectory(f) End If

Dim lx As String = exStr

f = f & \保存文件名

If lx.Contains(\数据系列\

f = f.Replace(lx,lx.SubString(1)) str = str & \ㄉ\

If FileSys.FileExists(f) Then

Dim vs As String() = FileSys.ReadAllText(f).Split(\ㄉ\ Dim qtz As String = vs(1) str = str & qtz End If End If

FileSys.WriteAllText(f,str,False) e.Form.Close

图表外观_CheckBox1_CheckedChanged

e.Form.Controls(\

图表外观_RadioButton1_CheckedChanged

e.Form.Controls(\

图表外观_RadioButton2_CheckedChanged

e.Form.Controls(\

图表外观_RadioButton3_CheckedChanged

e.Form.Controls(\

图表外观_TextBox2_DoubleClick

Dim f As New OpenFileDialog

f.Filter= \图片文件|*.jpg;*.bmp;*.gif\If f.ShowDialog = DialogResult.Ok Then

e.Form.Controls(\End If

自定义函数

App_ChartNum

Dim tblx As String Select Case Args(0) Case 51

tblx = \柱形图,簇状柱形图\ Case 52

tblx = \柱形图,堆积柱形图\ Case 53

tblx = \柱形图,百分比堆积柱形图\ Case 57

tblx = \条形图,簇状条形图\ Case 58

tblx = \条形图,堆积条形图\ Case 59

tblx = \条形图,百分比堆积条形图\ Case 4

tblx = \折线图,折线图\ Case 65

tblx = \折线图,数据点折线图\ Case 63

tblx = \折线图,堆积折线图\ Case 66

tblx = \折线图,堆积数据点折线图\ Case 64

tblx = \折线图,百分比堆积折线图\ Case 67

tblx = \折线图,百分比堆积数据点折线图\ Case 1

tblx = \面积图,面积图\ Case 76

tblx = \面积图,堆积面积图\ Case 77

tblx = \面积图,百分比堆积面积图\End Select Return tblx

App_Charts

Dim lst As String Select Case Args(0) Case \柱形图\

Case \折线图\

App_ChartType

Dim tblx As Integer Select Case Args(0) Case \柱形图\

Select Case Args(1)

Case \簇状柱形图\ tblx = 51

Case \三维簇状柱形图\ tblx = 54 Case \堆积柱形图\ tblx = 52

Case \三维堆积柱形图\ tblx = 55

Case \百分比堆积柱形图\ tblx = 53

Case \三维百分比堆积柱形图\ tblx = 56 Case \三维柱形图\ tblx = -4100 End Select Case \条形图\

Select Case Args(1) Case \簇状条形图\ tblx = 57

Case \三维簇状条形图\ tblx = 60 Case \堆积条形图\ tblx = 58

Case \三维堆积条形图\ tblx = 61

Case \百分比堆积条形图\ tblx = 59

Case \三维百分比堆积条形图\ tblx = 62 End Select Case \折线图\

Select Case Args(1) Case \折线图\ tblx = 4

Case \数据点折线图\ tblx = 65 Case \堆积折线图\ tblx = 63

Case \堆积数据点折线图\ tblx = 66

Case \百分比堆积折线图\ tblx = 64

Case \百分比堆积数据点折线图\ tblx = 67 Case \三维折线图\ tblx = -4101 End Select Case \饼图\

Select Case Args(1) Case \饼图\ tblx = 5

Case \分离型饼图\ tblx = 69 Case \三维饼图\ tblx = -4102

Case \三维分离型饼图\ tblx = 70 Case \复合饼图\ tblx = 68 Case \复合条饼图\ tblx = 71 End Select Case \面积图\

Select Case Args(1) Case \面积图\ tblx = 1

Case \三维面积图\ tblx = -4098 Case \堆积面积图\ tblx = 76

Case \三维堆积面积图\ tblx = 78

Case \百分比堆积面积图\ tblx = 77

Case \三维百分比堆积面积图\ tblx = 79 End Select Case \圆柱图\

Select Case Args(1) Case \柱形圆柱图\ tblx = 92 Case \条形圆柱图\ tblx = 95

Case \堆积柱形圆柱图\ tblx = 93

Case \堆积条形圆柱图\ tblx = 96

Case \百分比堆积柱形圆柱图\ tblx = 94

Case \百分比堆积条形圆柱图\ tblx = 97

Case \三维柱形圆柱图\ tblx = 98 End Select Case \圆锥图\

Select Case Args(1) Case \柱形圆锥图\ tblx = 99 Case \条形圆锥图\ tblx = 102

Case \堆积柱形圆锥图\ tblx = 100

Case \堆积条形圆锥图\ tblx = 103

Case \百分比堆积柱形圆锥图\ tblx = 101

Case \百分比堆积条形圆锥图\ tblx = 104

Case \三维柱形圆锥图\ tblx = 105

End Select Case \棱锥图\

Select Case Args(1) Case \柱形棱锥图\ tblx = 106 Case \条形棱锥图\ tblx = 109

Case \堆积柱形棱锥图\ tblx = 107

Case \堆积条形棱锥图\ tblx = 110

Case \百分比堆积柱形棱锥图\ tblx = 108

Case \百分比堆积条形棱锥图\ tblx = 111

Case \三维柱形棱锥图\ tblx = 112 End Select End Select Return tblx

App_ColChr

Dim ColumnNum As Integer = Args(0) Dim First,Last As Integer Dim Result As String If ColumnNum < 1 Then ColumnNum = 1

Elseif ColumnNum > 256 Then ColumnNum = 256 End If

First = Int(ColumnNum / 27)

Last = ColumnNum - (First * 26) If First > 0 Then

Result = Chr(First + 64) End If

If Last > 0 Then

Result = Result & Chr(Last + 64) End If

Return Result

App_Series

'0-参数文件名 1-WorkBook对象 2-SeriesCollection对象 3-字体颜色序号 4-边框颜色序号 5-填充颜色序号 Dim f As String = ProjectPath & \If Not FileSys.FileExists(f) Then Return Nothing End If

Dim Wb As MSExcel.WorkBook = Args(1) Dim s As MSExcel.Series = Args(2)

Dim vs As String() = FileSys.ReadAllText(f).Split(\ㄉ\Dim ss As String() = vs(1).Split(\s.Name = ss(0) '系列名称

If s.AxisGroup = 2 Then '次轴的图表类型 s.ChartType = ss(1)

End If

s.Parent.VaryByCategories = ss(5) '是否依数据点分色(返回的父级对象为ChartGroup) Dim sjbz As String = \

If ss(2)=True Or ss(3)=True Or ss(4)=True Then '如果显示数据标志

s.ApplyDataLabels(AutoText:=True,ShowCategoryName:=ss(2),ShowValue:=ss(3),ShowPercentage:=ss(4)) If ss(4) Then '如果显示百分比

s.DataLabels.NumberFormat = \ End If sjbz = \End If

Functions.Execute(\数据系列_\

App_Wgsz

'0-参数文件名 1-WorkBook对象 2-Chart对象或Series对象 3-字体颜色序号 4-边框颜色序号 5-填充颜色序号

Dim f As String = Args(0)

If Args(0).Contains(\数据系列\ f = Args(0).SubString(1) End If

f = ProjectPath & \If Not FileSys.FileExists(f) Then Return Nothing End If

Dim Wb As MSExcel.WorkBook = Args(1) Dim Cs As Object = Args(2) Dim Oj As Object Select Case Args(0) Case \图表区\

Oj = Cs.ChartArea Case \绘图区\

Oj = Cs.PlotArea Case \图例\

Oj = Cs.Legend Case \标题\

Oj = Cs.ChartTitle Case \次轴\ Oj = Cs End Select '字体

Dim vs As String() = FileSys.ReadAllText(f).Split(\Dim yn As String = \

If Args(0).Contains(\数据系列\ If Args(0).SubString(0,1) = \ yn = \ Else

vs = FileSys.ReadAllText(f).Split(\ㄉ\ vs = vs(0).Split(\ Oj = Cs.DataLabels End If End If

If Args(0) <> \绘图区\ With Oj.Font

.Name = vs(0)

If vs(1) = 1 Then '粗体 .Bold = True

Elseif vs(1) = 2 Then '斜体 .Italic = True

Elseif vs(1) = 3 Then '粗斜体 .Bold = True .Italic = True End If

.Size = vs(2)

Wb.Colors(Args(3)) = RGB(vs(3),vs(4),vs(5)) .ColorIndex = Args(3) End With End If

'设置边框和填充

If Args(0).Contains(\数据系列\ Oj = Cs End If '边框

If vs(6) > 0 Then With Oj.Border

.LineStyle = vs(6)

Wb.Colors(Args(4)) = RGB(vs(7),vs(8),vs(9)) .ColorIndex = Args(4) .Weight = vs(10) End With End If '填充 yn = \

If Args(0).Contains(\数据系列\

Dim ss As String() = FileSys.ReadAllText(f).Split(\ㄉ\ ss = ss(1).Split(\次轴的折线图不能填充

If Oj.AxisGroup = 2 And (ss(1)=4 Or ss(1)=63 Or ss(1)=64 Or ss(1)=65 Or ss(1)=66 Or ss(1)=67) Then

yn = \ End If End If

If yn = \

Wb.Colors(Args(5)) = RGB(vs(11),vs(12),vs(13)) If vs(14) Then

If vs(15) Then

Oj.Fill.OneColorGradient(vs(16),1,1) Oj.Fill.ForeColor.SchemeColor = Args(5) End If

If vs(17) Then

Oj.Fill.PresetTextured(vs(18)) End If

If vs(19) And vs(20) <> \

If FileSys.FileExists(vs(20)) Then Oj.Fill.UserPicture(vs(20)) End If End If

Oj.Fill.Visible = True Else

Oj.Interior.ColorIndex = Args(5) End If

End If '标题内容

If Args(0) = \标题\ Oj.Text = vs(21) End If '图例位置

If Args(0) = \图例\ Select Case vs(22) Case \底部\

Oj.Position = MSExcel.XlLegendPosition.xlLegendPositionBottom Case \右上角\

Oj.Position = MSExcel.XlLegendPosition.xlLegendPositionCorner Case \靠上\

Oj.Position = MSExcel.XlLegendPosition.xlLegendPositionTop Case \靠右\

Oj.Position = MSExcel.XlLegendPosition.xlLegendPositionRight Case \靠左\

Oj.Position = MSExcel.XlLegendPosition.xlLegendPositionLeft End Select End If

全局代码

Public exStr As String = \绘图区\

菜单事件

======================================= =====Excel报表.Foxdb=====

项目事件

MainTableChanged

Static i As Integer '定义静态变量i

If MainTable.Name = \统计表\如果进入的是统计表 If i = 0 Then '加入i等于0 i = 1 '那么将i的值设为1

Forms(\窗口1\打开窗口 End If

Forms(\窗口1\Else

Forms(\窗口1\End If

计划管理

表事件

窗口表事件

窗口与控件事件

窗口1_AfterLoad

Dim Chart As WinForm.Chart '定义一个图表变量

Dim Series As WinForm.ChartSeries '定义一个图系变量 Chart= e.Form.Controls(\引用窗口中的图表 Chart.DataSource = \统计表\设置绑定表

Chart.SeriesList.Clear() '清除图表原来的图系 Series = Chart.SeriesList.Add() '增加一个图系 Series.X.DataField = \产品\轴绑定到产品列 Series.Y.DataField = \数量\轴绑定到数量列

窗口1_Button1_Click

Dim b As New XLS.Book

Dim t As Table = Tables(\统计表\Dim s As XLS.Sheet = b.Sheets(0)

Dim Chart As WinForm.Chart = Forms(\窗口1\For c As Integer = 0 To t.Cols.Count -1 '添加列标题 s(0, c).Value = t.Cols(c).Name Next

For r As Integer = 0 To t.Rows.Count - 1 '填入数据 For c As Integer = 0 To t.Cols.Count -1 s(r +1, c).Value = t.rows(r)(c) Next Next

'插入图表

s(t.rows.Count + 2,1).Value = New XLS.Picture(Chart.Image,0,0,422,258) b.Save(\Dim Proc As New Process

Proc.File = \Proc.Start()

自定义函数

全局代码

菜单事件

======================================= =====SQL与自动输入.Foxdb=====

项目事件

AfterOpenProject

Dim cmd As New SQLCommand Dim dt As DataTable

cmd.ConnectionName = \行政区域\

cmd.CommandText = \省市 From {行政区域}\dt = cmd.ExecuteReader

Tables(\客户\省市\省市\

BeforeConnectOuterDataSource

If e.name = \行政区域\

e.ConnectionString = \行政区域.mdb;Persist Security Info=False\

End if

计划管理

表事件

客户_PrepareEdit

If e.IsFocusCell Then '如果是焦点单元格

If e.Col.Name = \县市\如果正在编辑的是县市列 Dim cmd As New SQLCommand Dim dt As DataTable

cmd.ConnectionName = \行政区域\

cmd.CommandText = \县市 From {行政区域} Where [省市] = '\省市\& \

dt = cmd.ExecuteReader

e.Col.Combolist = dt.GetComboListString(\县市\ End If End If

客户_DataColChanged

If e.DataCol.Name = \省市\县市\ Dim cmd As New SQLCommand Dim dt As DataTable

Dim dr As DataRow = e.DataRow cmd.ConnectionName = \行政区域\

cmd.CommandText = \行政区域} Where [省市] = '\省市\县市] = '\& dr(\县市\ dt = cmd.ExecuteReader

If dt.DataRows.Count > 0 Then

dr(\区号\区号\ dr(\邮编\邮编\ Else

dr(\区号\ dr(\邮编\ End If End If

窗口表事件

窗口与控件事件

自定义函数

全局代码

菜单事件

======================================= =====下拉目录树.foxdb=====

项目事件

AfterOpenProject

Tables(\客户\县市\窗口1\Forms(\窗口2\

计划管理

表事件

窗口表事件

窗口与控件事件

Button1_Click

Dim trv As WinForm.TreeView = e.Form.Controls(\trv.BuildTree(\行政区域\省市|县市\

TreeView1_NodeMouseClick

If e.Node.Level = 1 Then '如果单击的是第二层节点 Dim ps() As String = e.Node.FullPath.Split(\ Dim tr As Row = Tables(\客户\

Dim dr As DataRow = DataTables(\行政区域\省市 = '\县市 = '\& \

If dr IsNot Nothing Then '如果在行政区域表找到对应的行,则将此行的值写入客户表的当前行. tr(\省市\省市\ tr(\县市\县市\ tr(\区号\区号\ tr(\邮编\邮编\

e.Form.DropDownBox.Value = tr(\县市\'这行不是多余的,省略此行,无法在表中正常使用此下拉窗口输入数据. End If

e.Form.DropDownBox.CloseDropdown() End If

窗口1_AfterLoad

Dim trv As WinForm.TreeView = e.Form.Controls(\trv.BuildTree(\行政区域\省市|县市\

窗口2_Button1_Click

With Tables(\客户\

.Position = .Position - 1 End With

窗口2_Button2_Click

With Tables(\客户\

.Position = .Position + 1 End With

窗口2_Button3_Click

Tables(\客户\

窗口2_Button4_Click

With Tables(\客户\

If .Current IsNot Nothing Then .Current.Delete End If End With

自定义函数

全局代码

菜单事件

======================================= =====下拉窗口演示.Foxdb=====

项目事件

AfterOpenProject

Tables(\表A\第一列\窗口1\Tables(\表A\第二列\窗口2\Tables(\表A\第三列\窗口4\Forms(\窗口3\

计划管理

表事件

窗口表事件

窗口与控件事件

Button1_Click

For Each ctl As WinForm.Control In e.Form.Controls '遍历所有控件

If TypeOf ctl Is WinForm.RadioButton Then '如果此控件是RadionButton(单选框) Dim rdo As WinForm.RadioButton = ctl If rdo.Checked Then '如果已经选中

e.Form.DropDownBox.Value = rdo.Text '将此单选框的文本赋值给下拉组合框 e.Form.DropDownBox.CloseDropdown() '关闭下拉窗口 Exit For End If End If Next

Button1_Click

e.Form.DropDownBox.CloseDropdown()

Button2_Click

e.Form.DropDownBox.CloseDropdown(False)

Button2_Click

e.Form.DropDownBox.CloseDropDown() '关闭下拉窗口

窗口1_Click

With e.Form.DropDownBox

If TypeOf e.Sender Is WinForm.RadioButton Then '如果此控件是RadionButton(单选框) .Value = e.Sender.Text .CloseDropDown() End If End With

窗口1_DropDownOpened

Dim Val As String = e.Form.DropdownBox.Text

For Each ctl As WinForm.Control In e.Form.Controls '遍历所有控件

If TypeOf ctl Is WinForm.RadioButton Then '如果此控件是RadionButton(单选框) Dim rdo As WinForm.RadioButton = ctl

If rdo.Text = Val Then '如果此单选框的文本等于下拉组合框的文本 rdo.Checked = True '则选中此单选框 Exit For End If End If Next

窗口2_DropDownOpened

Dim Val As String = e.Form.DropdownBox.Text

For Each ctl As WinForm.Control In e.Form.Controls '遍历所有控件

If TypeOf ctl Is WinForm.RadioButton Then '如果此控件是RadionButton(单选框) Dim rdo As WinForm.RadioButton = ctl

If rdo.Text = Val Then '如果此单选框的文本等于下拉组合框的文本 rdo.Checked = True '则选中此单选框 Exit For End If End If Next

窗口4_DropDownClosed

If e.Selected Then

Dim tx As WinForm.TextBox = e.Form.Controls(\ e.Form.DropDownBox.Value = tx.Value End If

窗口4_DropDownOpened

Dim tx As WinForm.TextBox = e.Form.Controls(\tx.Value = e.Form.DropDownBox.value tx.Select()

自定义函数

全局代码

菜单事件

======================================= =====专业报表.Foxdb=====

项目事件

计划管理

表事件

窗口表事件

窗口与控件事件

自定义函数

全局代码

菜单事件

======================================= =====代码优化.foxdb=====

项目事件

BeforeCloseProject

e.SkipSave = True

计划管理

表事件

窗口表事件

窗口与控件事件

窗口1_Button1_Click

Dim st As Date = Date.Now()

Dim dic As New Dictionary(of DataRow, String) Dim drs As List(of DataRow)

For Each dr1 As DataRow In DataTables(\表A\ Dim Filter As String

Filter = \项目 = '\项目\日期 <= #\日期\ dic.Add(dr1, DataTables(\表A\支出)\Next

For Each dr As DataRow In dic.Keys dr(\累计支出\Next

MessageBox.show(\执行时间: \

窗口1_Button2_Click

Dim st As Date = Date.Now()

Dim dic As New Dictionary(of DataRow, String) Dim drs As List(of DataRow)

For Each dr1 As DataRow In DataTables(\表A\ Dim dv As Date = dr1(\日期\ Dim sm As Double = 0

drs = DataTables(\表A\项目 = '\项目\日期\ For Each dr2 As DataRow In drs If dr2(\日期\ sm = sm + dr2(\支出\ Else

Exit For End If Next

dic.Add(dr1, sm) Next

For Each dr As DataRow In dic.Keys dr(\累计支出\Next

MessageBox.show(\执行时间: \

窗口1_Button3_Click

Dim st As Date = Date.Now()

Dim drs As List(of DataRow) = DataTables(\表A\项目, 日期\drs(0)(\累计支出\支出\For i As Integer = 1 To drs.Count - 1

If drs(i)(\项目\项目\

drs(i)(\累计支出\累计支出\支出\ Else

drs(i)(\累计支出\支出\ End If Next

MessageBox.Show(\执行时间:\

自定义函数

全局代码

菜单事件

======================================= =====会计科目.foxdb=====

项目事件

计划管理

表事件

窗口表事件

窗口与控件事件

窗口1_AfterLoad

Dim tr As WinForm.TreeView = e.Form.Controls(\Dim nd As WinForm.TreeNode

Dim dt As DataTable = DataTables(\会计科目\tr.StopRedraw() tr.Nodes.Clear

tr.Nodes.Add(\全部\

For Each dr As DataRow In dt.datarows

If dr.IsNull(\科目代码\科目代码\

nd = tr.Nodes.Add(dr(\科目代码\科目代码\科目名称\ Functions.Execute(\ End If Next

tr.ResumeRedraw()

窗口1_TreeView1_NodeMouseDoubleClick

Dim trv As WinForm.TreeView = e.Form.Controls(\If e.Node.Name = \全部\

Tables(\会计科目\Else

Tables(\会计科目\科目代码 Like '\End If

窗口2_AfterLoad

Dim tr As WinForm.TreeView = e.Form.Controls(\

Dim rts() As String = {\全部\资产\负债\权益\成本\损益\Dim nd As WinForm.TreeNode

Dim dt As DataTable = DataTables(\会计科目\tr.StopRedraw() tr.Nodes.Clear

For Each rt As String In rts tr.Nodes.Add(rt) Next

For Each dr As DataRow In dt.datarows

If dr.IsNull(\科目代码\科目代码\ Dim i As Integer = CInt(dr(\科目代码\

nd = tr.Nodes(i).Nodes.Add(dr(\科目代码\科目代码\科目名称\ Functions.Execute(\ End If Next

tr.ResumeRedraw()

窗口2_TreeView1_NodeMouseDoubleClick

Dim trv As WinForm.TreeView = e.Form.Controls(\If e.Node.Level = 0

If e.Node.Name = \全部\

Tables(\会计科目\ Else

Tables(\会计科目\科目代码 Like '\

End If Else

Tables(\会计科目\科目代码 Like '\End If

窗口3_Button1_Click

Forms(\窗口2\Forms(\窗口1\

窗口3_Button2_Click

Forms(\窗口1\Forms(\窗口2\

自定义函数

AddChildren

Dim nd As WinForm.TreeNode = args(0) Dim dt As DataTable = args(1)

For Each dr As DataRow In dt.DataRows Dim km As String = dr(\科目代码\

If km.StartsWith(nd.name) AndAlso km.Length = nd.Name.Length + 2 Then

Dim cd As Winform.TreeNode = nd.Nodes.Add(km,km & \科目名称\ Functions.Execute(\ End If Next

全局代码

菜单事件

======================================= =====传统编辑方式.Foxdb=====

项目事件

AfterOpenProject

MessageBox.Show(\提示: 双击行打开编辑窗口!\提示\

计划管理

表事件

员工_PrepareEdit

e.Cancel = True

员工_DoubleClick

Forms(\编辑窗口\

窗口表事件

窗口与控件事件

编辑窗口_BeforeClose

If Tables(\员工\如果当前行已经修改过 e.Cancel = True End If

编辑窗口_Button1_Click

With Tables(\员工\

If .Current.DataRow.RowState = DataRowState.Unchanged Then '如果当前行未曾修改 .Position = .Position - 1 End If End With

编辑窗口_Button2_Click

With Tables(\员工\

If .Current.DataRow.RowState = DataRowState.Unchanged Then '如果当前行未曾修改 .Position = .Position + 1 End If End With

编辑窗口_Button3_Click

With Tables(\员工\

If .Current.DataRow.RowState = DataRowState.Unchanged Then '如果当前行未曾修改 .Position = 0 End If End With

编辑窗口_Button4_Click

With Tables(\员工\

If .Current.DataRow.RowState = DataRowState.Unchanged Then '如果当前行未曾修改 .Position = .Rows.Count - 1 End If End With

编辑窗口_Button5_Click

Tables(\员工\

编辑窗口_Button6_Click

With Tables(\员工\

If .Current.DataRow.RowState = DataRowState.Unchanged Then '如果当前行未曾修改 Tables(\员工\ End If End With

编辑窗口_Button7_Click

Tables(\员工\

编辑窗口_Button8_Click

Tables(\员工\

自定义函数

全局代码

菜单事件

======================================= =====关联与表达式的综合示例.foxdb=====

项目事件

计划管理

表事件

窗口表事件

窗口与控件事件

自定义函数

全局代码

菜单事件

======================================= =====关联演示.Foxdb=====

项目事件

计划管理

表事件

产品_AfterLoadTableSetting

e.Table.Cols(\单价\产品\

窗口表事件

窗口与控件事件

自定义函数

全局代码

菜单事件

======================================= =====关联表的数据引用和统计.foxdb=====

项目事件

计划管理

表事件

产品_DataColChanged

Select Case e.DataCol.Name Case \单价\

Dim drs As List(of DataRow) = e.DataRow.GetChildRows(\订单\获得此产品所有订单 For Each dr As DataRow In drs

If dr.Locked = False '如果此订单表没有锁定 dr(\单价\单价\ End If Next

Case \产品编号\

Dim drs As List(of DataRow) = e.DataRow.GetChildRows(\订单\获得此产品所有订单 Dim val As Double

For Each dr As DataRow In drs

If dr(\已付款\如果此订单已经付款 val = val + dr(\金额\ End If Next

e.DataRow(\已收款金额\End Select

订单_DataColChanged

Select Case e.DataCol.Name Case \产品编号\

Dim pr As DataRow

If e.NewValue Is Nothing Then e.DataRow(\单价\ Else

pr = e.DataRow.GetParentRow(\产品\ If pr IsNot Nothing Then

e.DataRow(\单价\单价\

If e.OldValue <> e.NewValue Then '如果新旧产品编号不同

DataTables(\产品\产品编号\重算新产品的销售数量和金额

End If End If End If

If e.OldValue IsNot Nothing AndAlso e.OldValue <> e.NewValue Then '如果原产品编号不为空,且和新产品编号不同.

pr = DataTables(\产品\产品编号] = \ If pr IsNot Nothing Then

DataTables(\产品\产品编号\重算原产品的销售数量和金额

End If

Case \数量\折扣\已付款\单价\ If e.OldValue <> e.NewValue Then

Dim pr As DataRow = e.DataRow.GetParentRow(\产品\ If pr IsNot Nothing Then

DataTables(\产品\产品编号\ End If End If End Select

订单_DataRowDeleting

e.DataRow(\数量\

窗口表事件

窗口与控件事件

自定义函数

全局代码

菜单事件

======================================= =====分页加载.Foxdb=====

项目事件

AfterOpenProject

With DataTables(\订单\

.LoadFilter = \一定要清除加载条件 .LoadTop = 20 .LoadPage = 0 .Load() End With

BeforeLoadInnerTable

If e.DataTableName = \订单\ e.Filter = \End If

计划管理

表事件

窗口表事件

窗口与控件事件

窗口1_Button1_Click

With DataTables(\订单\

If .LoadPage <> 0 Then .LoadTop = 20 .LoadPage = 0 .Load End If End With

窗口1_Button2_Click

With DataTables(\订单\

If .LoadPage < .TotalPages - 1 Then .LoadPage = .LoadPage + 1 .Load() End If End With

窗口1_Button3_Click

With DataTables(\订单\ If .LoadPage > 0 Then

.LoadPage = .LoadPage - 1 .Load() End If End With

窗口1_Button4_Click

With DataTables(\订单\

If .LoadPage < .TotalPages - 1 Then .LoadPage = .TotalPages - 1 .Load() End If End With

自定义函数

全局代码

菜单事件

======================================= =====动态加载数据(外部数据源).Foxdb=====

项目事件

BeforeConnectOuterDataSource

If e.Name = \

e.ConnectionString = \订单.mdb;Persist Security Info=False\End If

BeforeLoadOuterTable

If e.DataTableName = \订单\

e.SelectString = \订单 Where 编号 < 0\End If

计划管理

表事件

窗口表事件

窗口与控件事件

窗口1_AfterLoad

Dim cmd As New SQLCommand Dim dt As DataTable

cmd.ConnectionName = \

cmd.CommandText = \产品,客户 From 订单\dt = cmd.ExecuteReader()

Dim trv As WinForm.TreeView = e.Form.Controls(\trv.BuildDataTree(dt, \产品\客户\

窗口1_TreeView1_NodeMouseDoubleClick

Dim Value()As String Dim Filter As string

Value = e.Node.FullPath.Split(\Select Case e.Node.Level Case 0

Filter =\产品] = '\ Case 1

Filter =\产品] = '\客户] = '\End Select

DataTables(\订单\DataTables(\订单\

自定义函数

全局代码

菜单事件

======================================= =====动态加载演示.Foxdb=====

项目事件

BeforeLoadInnerTable

If e.DataTableName = \订单\ e.Filter = \End If

计划管理

表事件

窗口表事件

窗口与控件事件

窗口1_AfterLoad

Dim cmd As New SQLCommand Dim dt As DataTable

cmd.CommandText = \产品,客户 From {订单}\dt = cmd.ExecuteReader()

Dim trv As WinForm.TreeView = e.Form.Controls(\trv.BuildDataTree(dt, \产品\客户\

窗口1_TreeView1_NodeMouseDoubleClick

Dim Value()As String Dim Filter As string

Value = e.Node.FullPath.Split(\Select Case e.Node.Level Case 0

Filter =\产品] = '\ Case 1

Filter =\产品] = '\客户] = '\End Select

DataTables(\订单\DataTables(\订单\

自定义函数

全局代码

菜单事件

======================================= =====动态目录树列表.Foxdb=====

项目事件

MainTableChanged

If MainTable.Name = \客户\ Dim tb As New DropTreeBuilder

tb.SourceTable = DataTables(\行政区域\指定目录树表 tb.TreeCols = \省|县市\指定用于生成目录树的列 tb.SourceCols = \省|县市|区号|邮编\指定数据来源列 tb.ReceiveCols = \省|县市|区号|邮编\指定数据接收列 Tables(\客户\省\End If

计划管理

表事件

窗口表事件

窗口与控件事件

自定义函数

全局代码

菜单事件

======================================= =====单元格绘图.Foxdb=====

项目事件

计划管理

表事件

表A_DrawCell '''

If e.Col.Name = \进度\进度\ e.StartDraw()

Dim Width As Integer = (e.Width - 2 )* e.Row(\进度\ If e.Row(\进度\

e.Graphics.FillRectangle(Brushes.Green,e.x + 1,e.y + 1, Width, e.Height - 2) Else

e.Graphics.FillRectangle(Brushes.Red,e.x + 1,e.y + 1, Width, e.Height - 2) End If

e.EndDraw() End If

窗口表事件

窗口与控件事件

自定义函数

全局代码

菜单事件

======================================= =====可视化授权.Foxdb=====

项目事件

LoadUserSetting

For Each t As Table In Tables '显示所有表和列 t.Visible = True t.AllowEdit = true

For Each c As Col In t.Cols c.Visible = True

c.AllowEdit = True Next Next

Tables(\授权表\If User.Type <> UserTypeEnum.User Then Return End If

For Each dr As DataRow In DataTables(\授权表\用户名 = '\ If dr.IsNull(\列名\

For each t As Table In Tables

If t.DataTable.Name = dr(\表名\ t.Visible = Not dr(\不可见\

t.AllowEdit = Not dr(\不可编辑\ End If Next Else

For each t As Table In Tables

If t.DataTable.Name = dr(\表名\ For Each c as Col In t.Cols

If c.Name = dr(\列名\

c.Visible = Not dr(\不可见\ c.AllowEdit = Not dr(\不可编辑\ End If Next End If Next End if Next

计划管理

表事件

授权表_PrepareEdit

If e.Col.Name = \列名\

Dim s As String = e.Row(\表名\

If s > \ Dim t As Table = Tables(s) s = \

For Each c As Col In t.Cols s = s & \ Next

e.Col.ComboList = s End If End If

窗口表事件

窗口与控件事件

自定义函数

全局代码

菜单事件

======================================= =====基本功能介绍.Foxdb=====

项目事件

计划管理

表事件

窗口表事件

窗口与控件事件

窗口1_AfterLoad

Dim Lines() As String = FileSys.ReadAllText(ApplicationPath &

\Dim tv As WinForm.TreeView = e.Form.Controls(\Dim nd As WinForm.TreeNode

For i As Integer = 0 To Lines.Length - 1 Dim s As String = Lines(i)

Dim l As Integer = s.Length - s.Trim(vbtab).Length Dim p() As String = s.Trim(vbtab).Split(\ If l = 0 Then

nd = tv.Nodes.Add(p(1),p(0)) Else

If l = nd.Level + 1 Then

nd = nd.nodes.Add(p(1),p(0)) Elseif l = nd.level Then

nd = nd.ParentNode.Nodes.Add(p(1), p(0)) Else Do

nd = nd.ParentNode

If nd.Level = l - 1 Then

nd = nd.Nodes.Add(p(1), p(0)) Exit Do End If Loop End If End If

If p.length = 3 Then

nd.IconFile = \ Else

nd.IconFile = \ End If Next

tv.Nodes(0).Expand()

Dim wb As WinForm.WebBrowser = e.Form.Controls(\wb.Address = ApplicationPath & \

窗口1_TreeView1_AfterSelectNode

Dim wb As WinForm.WebBrowser = e.Form.Controls(\

If e.Node.Name > \

wb.Address = \End If

自定义函数

全局代码

菜单事件

======================================= =====基本功能演示.Foxdb=====

项目事件

AfterOpenProject '''

Forms(\导航\

Tables(\员工\MainTable = Tables(\订单\MessageBox.Show(\提示:\& vbcrlf & vbcrlf & \、请通过左侧窗口的任务栏，选择要演示的功能。\vbcrlf & _

\、每个演示都会在底端打开一个窗口，介绍正在演示的功能。\& vbcrlf & \、本文件专用于演示，所以默认不保存修改。\功能演示\

BeforeLoadInnerTable

If e.DataTableName = \动态加载\ e.Filter = \End If

MainTableChanging

If e.NewTableName <> \员工\ MarkModifedCell = False End If

If e.OldTableName = \统计表1\ Forms(\返回\End If

MainTableChanged

If MainTable.Name <> \级联列表\

Tables(\级联列表\省\行政区域\省\End If

BeforeCloseProject

e.SkipSave = True

计划管理

表事件

单元格绘图_DrawCell

If e.Col.Name = \进度\进度\ e.StartDraw()

Dim Width As Integer = (e.Width - 2 ) * e.Row(\进度\

e.Graphics.FillRectangle(Brushes.Red,e.x + 1,e.y + 1, Width, e.Height - 2) If e.Row.IsNull(\进度\ e.Text = e.Row(\进度\ End If

If e.Row(\进度\ e.Style = \ End If

e.EndDraw() End If

学生成绩_DrawCell

If MarkCell Then

Select Case e.Col.Name Case \语文\数学\

Dim v As Double = Val(e.Text) If v < 90 Then

e.Style = \不及格\ End If

Case \英语\化学\物理\

Dim v As Double = Val(e.Text) If v < 60 Then

e.Style = \不及格\ End If Case \总分\

Dim v As Double = Val(e.Text) If v < 400 Then

e.Style = \总分不及格\ End If End Select End If

成绩分布_DataColChanged

Dim dr As DataRow = e.DataRow

Dim dt As DataTable =DataTables(\学生成绩\

If e.DataCol.Name = \科目\科目\ dr(\最高分\科目\ dr(\最低分\科目\ dr(\平均分\科目\

dr(\分布_60分以下\姓名)\科目\

dr(\分布_60分以上\姓名)\科目\科目\70\

dr(\分布_70分以上\姓名)\科目\科目\80\

dr(\分布_80分以上\姓名)\科目\科目\90\

dr(\分布_90分以上\姓名)\科目\科目\100\

dr(\分布_100分以上\姓名)\科目\科目\

< 110\

dr(\分布_110分以上\姓名)\科目\科目\< 120\

dr(\分布_120分以上\姓名)\科目\科目\< 130\

dr(\分布_130分以上\姓名)\科目\ Select Case dr(\科目\

Case \语文\数学\英语\

dr(\优秀率\= dt.Compute(\姓名)\dr(\科目\& \>= 140\/ dt.Compute(\姓名)\

dr(\及格率\姓名)\科目\姓名)\

Case \物理\化学\

dr(\优秀率\姓名)\科目\姓名)\

dr(\及格率\姓名)\科目\姓名)\

End Select End If

流水账一_DataColChanged

Select Case e.DataCol.Name Case \收入\支出\ Dim dr As DataRow

Dim drs As List(of DataRow)

dr = e.DataTable.Find(\找出上一行

If dr Is Nothing Then '如果没有上一行,说明本行就是第一行

e.DataRow(\余额\收入\支出\ dr = e.DataRow End If

drs = e.DataTable.Select(\ For i As Integer = 1 To drs.Count - 1 '重算余下行的余额

drs(i)(\余额\余额\收入\支出\ Next End Select

流水账一_AfterMoveRow

Dim Key As Decimal Dim Index As Integer Dim dc As DataCol

Index = Math.Min(e.OldIndex, e.NewIndex) Key = e.Table.Rows(Index)(\dc = e.Table.datatable.DataCols(\收入\

dc.RaiseDataColChanged(\

流水账二_DataColChanged

Select Case e.DataCol.Name Case \产品\入库\出库\ Dim dr As DataRow

Dim mr As DataRow = e.DataRow Dim drs As List(of DataRow)

dr = e.DataTable.Find(\产品] = '\产品\\

If dr Is Nothing Then '如果没有上一行,说明本行就是同产品的第一行 mr(\库存\入库\出库\ dr = mr End If

drs = e.DataTable.Select(\产品] = '\产品\

For i As Integer = 1 To drs.Count - 1 '重算余下行的余额

drs(i)(\库存\库存\入库\出库\ Next End Select

流水账二_AfterMoveRow

Dim Key As Decimal Dim Index As Integer Dim Filter As String Dim r As Row

Index = Math.Min(e.OldIndex, e.NewIndex) Key = e.Table.Rows(Index)(\r = e.Table.Rows(e.NewIndex)

Filter = \产品] = '\产品\e.Table.DataTable.DataCols(\入库\

级联列表_PrepareEdit

If e.IsFocusCell AndAlso e.Col.Name = \县市\

e.Col.Combolist = DataTables(\行政区域\县市\\省] = '\e.Row(\省\& \End If

级联列表_DataColChanged

'如果刚刚输入的是省市或县市列

If e.DataCol.Name = \省\县市\ Dim dr As DataRow Dim Filter As String

Filter = \省] = '\省\县市] = '\县市\ dr = DataTables(\行政区域\在行政区域表查找所输入省市和县市的行 If dr IsNot Nothing Then '如果找到

'将找到行的区号和邮编内容填入到正在输入的行中 e.DataRow(\区号\区号\ e.DataRow(\邮编\邮编\ Else

'否则清除区号和邮编两列的内容 e.DataRow(\区号\ e.DataRow(\邮编\ End If End If

窗口表事件

_Table1_PositionChanged

Dim r As Row = e.Table.Current

Dim pbx As WinForm.PictureBox = Forms(\下拉窗口\Dim tbx As WinForm.TextBox = Forms(\下拉窗口\pbx.Image = GetImage(r(\照片\tbx.value = r(\备注\

_Table1_DoubleClick

Dim dr As Row = Tables(\下拉窗口_Table1\With Forms(\下拉窗口\ If dr IsNot Nothing Then .Value = dr(\姓名\ End If

.CloseDropDown() End With

窗口与控件事件

A多种统计_AfterLoad

For Each frm As WinForm.Form In Forms '关闭本表其他窗口

If frm.TableName = e.Form.TableName Andalso frm.Opened Then If frm.Name <> e.Form.Name Then frm.Close End If End If Next

Dim t As Table = Tables(\学生成绩\t.StopRedraw() t.ClearSubtotal() t.ResumeRedraw()

A多种统计_Button1_Click '''

Dim g As New GroupTableBuilder(\统计表1\学生成绩\g.Groups.AddDef(\班级\

g.Totals.AddDef(\语文\语文_平均分\g.Totals.AddDef(\语文\语文_最高分\g.Totals.AddDef(\语文\语文_最低分\g.Totals.AddDef(\数学\数学_平均分\g.Totals.AddDef(\数学\数学_最高分\g.Totals.AddDef(\数学\数学_最低分\g.Totals.AddDef(\英语\英语_平均分\g.Totals.AddDef(\英语\英语_最高分\g.Totals.AddDef(\英语\英语_最低分\g.Totals.AddDef(\化学\化学_平均分\g.Totals.AddDef(\化学\化学_最高分\g.Totals.AddDef(\化学\化学_最低分\g.Totals.AddDef(\物理\物理_平均分\g.Totals.AddDef(\物理\物理_最高分\g.Totals.AddDef(\物理\物理_最低分\g.Totals.AddDef(\总分\总分_平均分\g.Totals.AddDef(\总分\总分_最高分\g.Totals.AddDef(\总分\总分_最低分\

g.Decimals = 2 g.Build()

Tables(\统计表1\MainTable = Tables(\统计表1\With Forms(\返回\

.OpenTo(\统计表1\

.Controls(\学生成绩\

.Controls(\提示：统计各科目的最高分、最低分和平均分。\ .Controls(\返回成绩表\End With

MainTable.Focus()

A分组统计_AfterLoad

For Each frm As WinForm.Form In Forms '关闭本表其他窗口

If frm.TableName = e.Form.TableName Andalso frm.Opened Then If frm.Name <> \导航\ frm.Close End If End If Next

With Tables(\订单\ .StopRedraw() .Filter = \

.ClearSubtotal() .ResumeRedraw() End With

A分组统计_Button1_Click '''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\产品\g.Totals.AddDef(\数量\g.Totals.AddDef(\金额\g.VerticalTotal = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\提示: 不同产品的销售数量和金额。\MainTable.Focus()

A分组统计_Button2_Click '''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\客户\g.Totals.AddDef(\数量\g.Totals.AddDef(\金额\g.VerticalTotal = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\提示: 不同客户的订购数量和金额。\MainTable.Focus()

A分组统计_Button3_Click

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\日期\年\g.Groups.AddDef(\日期\月\g.Totals.AddDef(\数量\g.Totals.AddDef(\金额\g.VerticalTotal = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\提示: 每月销售数量和金额.\MainTable.Focus()

A分组统计_Button4_Click '''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\产品\

g.Groups.AddDef(\日期\年\g.Totals.AddDef(\数量\g.Totals.AddDef(\金额\g.VerticalTotal = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\提示: 按年汇总不同产品的销售数量和金额。\MainTable.ShowCell(0, 0) '显示第一行 MainTable.Focus()

A分组统计_Button6_Click '''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\产品\

g.Groups.AddDef(\日期\年\

g.Groups.AddDef(\日期\季度\g.Totals.AddDef(\数量\g.Totals.AddDef(\金额\g.VerticalTotal = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\提示: 按季度统计产品的销售数量和金额。\MainTable.ShowCell(0, 0) '显示第一行 MainTable.Focus()

A分组统计_Button7_Click

'''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\客户\g.Groups.AddDef(\产品\g.Totals.AddDef(\数量\g.VerticalTotal = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\提示: 每个客户订购不同产品的数量和金额。\MainTable.ShowCell(0, 0) '显示第一行 MainTable.Focus()

A环比分析_AfterLoad

For Each frm As WinForm.Form In Forms '关闭本表其他窗口

If frm.TableName = e.Form.TableName Andalso frm.Opened Then If frm.Name <> \导航\ frm.Close End If End If Next

With Tables(\订单\ .StopRedraw() .Filter = \

.ClearSubtotal() .ResumeRedraw() End With

A环比分析_Button1_Click '''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\日期\年\g.Totals.AddDef(\数量\g.CircleGrowth = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\提示: 各年的产品销量，以及相对上年的环比增长率。\MainTable.Focus()

A环比分析_Button2_Click '''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\日期\年\g.Groups.AddDef(\日期\月\g.Totals.AddDef(\数量\g.CircleGrowth = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\提示: 各月的产品销量，以及相对上月的环比增长率。\MainTable.Focus()

MainTable.ShowCell(0,0)

A环比分析_Button3_Click '''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\日期\年\g.Groups.AddDef(\日期\季度\g.Totals.AddDef(\数量\g.CircleGrowth = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\= \提示: 各季度的产品销量，以及相对上季度的环比增长率。\MainTable.Focus()

A环比分析_Button4_Click '''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\产品\

g.Groups.AddDef(\日期\年\g.Groups.AddDef(\日期\季度\g.Totals.AddDef(\数量\g.CircleGrowth = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\提示: 各产品在每季度的销量，以及相对上季度的环比增长率。\

MainTable.Focus()

MainTable.ShowCell(0,0)

A环比分析_Button5_Click '''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\日期\年\g.Groups.AddDef(\日期\季\g.Totals.AddDef(\数量\销量_值\g.Totals.AddDef(\金额\金额_值\g.CircleGrowth = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\提示: 按季度统计产品销量和金额，以及相对上季度的环比增长率。\

MainTable.Focus()

A环比分析_Button6_Click '''

Dim g As New GroupTableBuilder(\统计表1\订单\g.Groups.AddDef(\产品\

g.Groups.AddDef(\日期\年\g.Groups.AddDef(\日期\月\g.Totals.AddDef(\数量\g.CircleGrowth = True g.Build()

MainTable = Tables(\统计表1\

Forms(\返回\统计表1\

Forms(\返回\= \提示: 各产品在每月的销量，以及相对上月的环比增长率。\MainTable.Focus()

MainTable.ShowCell(0,0)

A截止统计_AfterLoad