Проги під заказ і проги по натхненню.
Як і раніше, я іноді пишу десктопні проги під заказ. Наприклад у минулому році я написав безліч програм під заказ, наприклад - Конструктор PDF-схем. Складська прога на WCF-сервісах зі сканером.. Таких прог було багато, більшість з них я взагалі ніяк не описую тут на сайті, ось наприклад від цієї проги залишився тільки скрин.
Десктопні проги писати настільки легко (поріняно з cайтами), що я могу їх писати навіть безкоштовно, для якихось своїх власних потреб. Нище ви можете побачити три мої проги, що я написав у 2016-му році для себе особисто, по натхненню, тобто безкоштовно.
1. Freelancer
![](/FreelanceParser/FreelancerParser-1_1.gif)
Що ми можемо побачити на скрині вище? Головно вікно цієї проги зліва. На ньому можна задати фрилансерскі біржі, на яких потрібно шукати закази на програмування. У вікні по центру ви можете побачити мої спеціальності (перераховані по пріоритету) - це 34 програмісткі спеціальності, з декількох тисяч існуючих. Класіфікатори існуючих спеціальностей програмістів розташовані справа, та справа знизу. Вони теж постійно поповнюються.
Задачі на програмування викачуються з фрілансерских бірж, класифікуються і відображаються у єдиній табличці, з якої дуже зручно відповідати замовнику.
![](/FreelanceParser/FreelancerParser-2_1.gif)
І, як и завжди - я покажу якусь частку кода цієї проги - код форми відображення даних. Сама форма виглядає ось так:
![](/FreelanceParser/FreelancerParser-3_1.gif)
А код цієї форми виглядає ось так:
1: Public Class CheckForm
2:
3: Dim db1 As ParserDBDataContext
4: Dim Projects As System.Collections.Generic.List(Of Freelancer.AllProject)
5: Dim TypeOfSort As Integer = 0
6: Dim MaxBids As Integer = 20
7: Dim MinSumm As Integer = 100
8:
9: Private Sub LoadForm_Load(sender As Object, e As System.EventArgs) Handles Me.Load
10: db1 = New ParserDBDataContext
11: Projects = (From X In db1.AllProjects Select X Order By X.ToMySkill, X.i Where X.Checked Is Nothing And X.BidCount < MaxBids And X.Summ >= MinSumm).ToList
12: RowCountToolStripLabel.Text = Projects.Count
13: DataGridView1.AutoGenerateColumns = False
14: DataGridView1.Columns(1).DataPropertyName = "Summ"
15: DataGridView1.Columns(2).DataPropertyName = "TimeType"
16: DataGridView1.Columns(3).DataPropertyName = "HourLeft"
17: DataGridView1.Columns(4).DataPropertyName = "BidCount"
18: DataGridView1.Columns(5).DataPropertyName = "Country"
19: DataGridView1.Columns(6).DataPropertyName = "Category"
20: DataGridView1.Columns(7).DataPropertyName = "Title"
21: DataGridView1.Columns(8).DataPropertyName = "TXT"
22: DataGridView1.DataSource = Projects
23: End Sub
24:
25: Private Sub DataGridView1_DataBindingComplete(sender As Object, e As System.Windows.Forms.DataGridViewBindingCompleteEventArgs) Handles DataGridView1.DataBindingComplete
26:
27: For i As Integer = 0 To Projects.Count - 1
28: DataGridView1.Rows(i).Cells(0).ToolTipText = Projects(i).i
29: DataGridView1.Rows(i).Cells(1).ToolTipText = Projects(i).Category
30: DataGridView1.Rows(i).Cells(2).ToolTipText = Projects(i).Category
31: DataGridView1.Rows(i).Cells(3).ToolTipText = Projects(i).Category
32: DataGridView1.Rows(i).Cells(4).ToolTipText = Projects(i).Category
33: DataGridView1.Rows(i).Cells(5).ToolTipText = Projects(i).Country
34: DataGridView1.Rows(i).Cells(6).ToolTipText = DataGridView1.Rows(i).Cells(5).Value
35: '
36: Dim Style1 = New DataGridViewCellStyle()
37: Dim Blue As Integer = CInt(DataGridView1.Rows(i).Cells(3).Value) * 10
38: If Blue > 255 Then Blue = 255
39: Style1.BackColor = Color.FromArgb(255, 255, Blue)
40: DataGridView1.Rows(i).Cells(3).Style = Style1
41: '
42: Dim Style2 = New DataGridViewCellStyle()
43: Dim Red As Integer = 350 - CInt(DataGridView1.Rows(i).Cells(1).Value)
44: If Red > 255 Then
45: Red = 255
46: ElseIf Red < 0 Then
47: Red = 0
48: End If
49: Style2.BackColor = Color.FromArgb(Red, 255, 255)
50: DataGridView1.Rows(i).Cells(1).Style = Style2
51: '
52: Dim Style3 = New DataGridViewCellStyle()
53: Dim Green As Integer = CInt(DataGridView1.Rows(i).Cells(4).Value) * 20
54: If Green > 255 Then Green = 255
55: Style3.BackColor = Color.FromArgb(255, Green, 255)
56: DataGridView1.Rows(i).Cells(4).Style = Style3
57: '
58: Dim Style4 = New DataGridViewCellStyle()
59: Dim Style41 = New DataGridViewCellStyle()
60: Style41.BackColor = Color.FromArgb(0, 255, 0)
61: Dim Style42 = New DataGridViewCellStyle()
62: Style42.BackColor = Color.FromArgb(0, 0, 255)
63: If Projects(i).ProjectType = 2 Then
64: DataGridView1.Rows(i).Cells(0).Style = Style41
65: ElseIf Projects(i).ProjectType = 1 Then
66: DataGridView1.Rows(i).Cells(0).Style = Style42
67: End If
68: Next
69: End Sub
70:
71:
72: Private Sub DataGridView1_CellContentDoubleClick(sender As System.Object, e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DataGridView1.CellContentDoubleClick
73: If e.RowIndex >= 0 And e.ColumnIndex >= 6 Then
74: Process.Start(Projects(e.RowIndex).URL)
75: ElseIf e.RowIndex = -1 And e.ColumnIndex <= 6 Then
76: Rebind(e.ColumnIndex)
77: Else
78: ParsePage(e.RowIndex)
79: End If
80: End Sub
81:
82: Private Sub DelToolStripButton1_Click(sender As System.Object, e As System.EventArgs) Handles DelToolStripButton1.Click
83: For i As Integer = 0 To DataGridView1.Rows.Count - 1
84: Dim Check1 As Boolean = Convert.ToBoolean(CType(DataGridView1.Rows(i).Cells(0), DataGridViewCheckBoxCell).Value)
85: If Check1 Then
86: Debug.Print(i)
87: Dim DelNum As Integer = CInt(DataGridView1.Rows(i).Cells(0).ToolTipText)
88: Dim DelOne = (From X In db1.AllProjects Select X Where X.i = DelNum).ToList
89: If DelOne.Count > 0 Then
90: DelOne(0).Checked = 1
91: db1.SubmitChanges()
92: End If
93: End If
94: Next
95: db1.SubmitChanges()
96: Rebind(TypeOfSort)
97: Exit Sub
98: End Sub
99:
100: Sub Rebind(ColumnIndex As Integer)
101: Dim CurCursor = Me.Cursor
102: Me.Cursor = Cursors.WaitCursor
103: Select Case ColumnIndex
104: Case 0
105: Projects = (From X In db1.AllProjects Select X Order By X.ToMySkill, X.i Where X.Checked Is Nothing And X.BidCount < MaxBids And X.Summ >= MinSumm).ToList
106: TypeOfSort = 0
107: Case 1
108: Projects = (From X In db1.AllProjects Select X Order By X.Summ Where X.Checked Is Nothing And X.BidCount < MaxBids And X.Summ >= MinSumm).ToList
109: TypeOfSort = 1
110: Case 2
111: Projects = (From X In db1.AllProjects Select X Order By X.TimeType Where X.Checked Is Nothing And X.BidCount < MaxBids And X.Summ >= MinSumm).ToList
112: TypeOfSort = 2
113: Case 3
114: Projects = (From X In db1.AllProjects Select X Order By X.HourLeft Where X.Checked Is Nothing And X.BidCount < MaxBids And X.Summ >= MinSumm).ToList
115: TypeOfSort = 3
116: Case 4
117: Projects = (From X In db1.AllProjects Select X Order By X.BidCount Where X.Checked Is Nothing And X.BidCount < MaxBids And X.Summ >= MinSumm).ToList
118: TypeOfSort = 4
119: Case 5
120: Projects = (From X In db1.AllProjects Select X Order By X.Country Where X.Checked Is Nothing And X.BidCount < MaxBids And X.Summ >= MinSumm).ToList
121: TypeOfSort = 5
122: Case 6
123: Projects = (From X In db1.AllProjects Select X Order By X.Category Where X.Checked Is Nothing And X.BidCount < MaxBids And X.Summ >= MinSumm).ToList
124: TypeOfSort = 6
125: End Select
126: DataGridView1.DataSource = Projects
127: RowCountToolStripLabel.Text = Projects.Count
128: Me.Cursor = CurCursor
129: End Sub
130:
131: Function ParseRestTime(One As String) As String
132: Dim Pos3 As Integer = One(8).ToString.IndexOf(">")
133: Dim Pos4 As Integer = One(8).ToString.IndexOf("<", Pos3)
134: Return One.Substring(Pos3, Pos4 - Pos3)
135: End Function
136:
137: Private Sub MaxBidsToolStripTextBox1_TextChanged(sender As Object, e As System.EventArgs) Handles MaxBidsToolStripTextBox1.TextChanged
138: If Integer.TryParse(MaxBidsToolStripTextBox1.Text, MaxBids) And Integer.TryParse(MinSummToolStripTextBox1.Text, MinSumm) Then
139: If DataGridView1.DataSource IsNot Nothing Then
140: Rebind(TypeOfSort)
141: End If
142: End If
143: End Sub
144:
145: Private Sub MinSummToolStripTextBox1_TextChanged(sender As Object, e As System.EventArgs) Handles MinSummToolStripTextBox1.TextChanged
146: If Integer.TryParse(MaxBidsToolStripTextBox1.Text, MaxBids) And Integer.TryParse(MinSummToolStripTextBox1.Text, MinSumm) Then
147: If DataGridView1.DataSource IsNot Nothing Then
148: Rebind(TypeOfSort)
149: End If
150: End If
151: End Sub
152:
153: End Class
2. MyVideoArchive
Я опишу тут ще одну свою прогу, призначення якої було таке - побудувати віртуальний архів, бо я маю дуже багато відео-аудіо файлів, які зберігаються у різних місцях і у декількох екземплярів. Для цих відео-аудіо я би хотів мати віртуальний архів, як я його називаю. Тобто один віртуальнийфайл має две, чи може бути навіть три копії у різних місцях. Таким чином зайві копії можна почистити, якщо потрібно кудись поїхати, то легко знайти потрібний діск з даними. Також е величезна кількість якихось бекапів, фото, інсталяцій. Щоб швидко у цьому зорієнтуватися мені і була потрібна ця прога.
Вона працювала мабуть тиждень, поки не обійшла всі мої носії даних. Як ви можете побачити на скрінах, у мене знайшлося 1 мільйон 363 тисячі 375 медіа файлів. По кожному з них потім я прогнав FFMPEG та записав результат у базу.
Зрозуміло, що всі ці файли зберігаються не на локальному комп'ютері, а у локальній мережі та десь у інтернеті. Доступ до своїх архівів у інтернеті я зробив приконективши архіви по FTP.
![](/FreelanceParser/MyArchive-7_1.gif)
![](/FreelanceParser/MyArchive-8_1.gif)
![](/FreelanceParser/MyArchive-9_1.gif)
![](/FreelanceParser/MyArchive-10_1.gif)
Якогось цікавого коду тут немає, але для навчання юних програмістів я покажу невеличкий фрагмент мойого коду, який викликає консольний FFMPEG у Windows-applications. Для цього при старті виконується ось такий код:
1: Private Sub btStart_Click(sender As System.Object, e As System.EventArgs) Handles btStart.Click
2: AllocConsole()
3: ...
4: End Sub
5:
6: <Runtime.InteropServices.DllImport("kernel32.dll", SetLastError:=True)> _
7: Private Shared Function AllocConsole() As <Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.Bool)> Boolean
8: 'https://msdn.microsoft.com/en-us/library/windows/desktop/ms681944(v=vs.85).aspx
9: End Function
А потім у цьому віконці відпрацьовує FFMPEG
1: Module ProbeFunc
2:
3: Dim db1 As New MyArchiveDB.MyArchiveEntities
4:
5: Sub GetProbe(FullName_StartsWith As String)
6: db1.CommandTimeout = 1000
7: Dim Count As Integer
8: Dim Recs = (From X In db1.Dirs Select X Where X.Len IsNot Nothing And X.FullName.StartsWith(FullName_StartsWith) And X.Probe Is Nothing And Not X.FName.EndsWith(".bat")).ToList
9: For Each One In Recs
10: Count = Count + 1
11: Console.WriteLine(Count.ToString & " " & One.FullName)
12: Using ts1 As New ProbeWin(One.FullName)
13: ts1.GetProbe()
14: Dim Str1 As String = ts1.GetResult
15: If Str1 <> "" Then
16: One.Probe = Str1
17: db1.SaveChanges()
18: Console.WriteLine(Str1)
19: End If
20: End Using
21: Next
22: Console.WriteLine("GetProbe step ended.")
23: End Sub
24:
25: Sub ParseProbe(FullName_StartsWith As String)
26: db1.CommandTimeout = 1000
27: Dim Count As Integer
28: Dim Recs = (From X In db1.Dirs Select X Where X.Probe IsNot Nothing And X.Duration Is Nothing And X.FullName.StartsWith(FullName_StartsWith)).ToList
29: For Each One In Recs
30: Count = Count + 1
31: Console.WriteLine(Count.ToString & " " & One.FullName)
32: Dim Dur As Decimal = GetDuration(One.Probe)
33: If Dur > 1 Then
34: One.Duration = Int64.Parse(Math.Round(Dur, 0))
35: Console.WriteLine(One.Duration)
36: End If
37: Next
38: db1.SaveChanges()
39: Console.WriteLine("ParseProbe step ended.")
40: End Sub
41:
42: Function GetDuration(input As String) As Decimal
43: Dim pattern As String = "\bduration=\d+.\d+\b"
44: Dim match As System.Text.RegularExpressions.Match = System.Text.RegularExpressions.Regex.Match(input, pattern, System.Text.RegularExpressions.RegexOptions.None)
45: If match.Success Then
46: 'Value: "duration=1.400000"
47: Return Decimal.Parse(match.Value.Replace("duration=", ""))
48: End If
49: Return 0
50: End Function
51: End Module
52: '[STREAM]
53: 'index=0
54: 'codec_name=h264
55: 'codec_long_name=H.264 / AVC / MPEG-4 AVC / MPEG-4 part 10
56: 'profile=High
57: 'codec_type=video
58: 'codec_time_base=1001/48000
59: 'codec_tag_string=[0][0][0][0]
60: 'codec_tag=0x0000
61: 'width=1920
62: 'height=804
63: 'has_b_frames=2
64: 'sample_aspect_ratio=1:1
65: 'display_aspect_ratio=160:67
66: 'pix_fmt=yuv420p
67: 'level=41
68: 'color_range=N/A
69: 'color_space=unknown
70: 'timecode=N/A
71: 'id=N/A
72: 'r_frame_rate=24000/1001
73: 'avg_frame_rate=24000/1001
74: 'time_base=1/1000
75: 'start_pts=0
76: 'start_time=0.000000
77: 'duration_ts=N/A
78: 'duration=N/A
79: 'bit_rate=N/A
80: 'max_bit_rate=N/A
81: 'bits_per_raw_sample=8
82: 'nb_frames=N/A
83: 'nb_read_frames=N/A
84: 'nb_read_packets=N/A
85: 'DISPOSITION:default=1
86: 'DISPOSITION:dub=0
87: 'DISPOSITION:original=0
88: 'DISPOSITION:comment=0
89: 'DISPOSITION:lyrics=0
90: 'DISPOSITION:karaoke=0
91: 'DISPOSITION:forced=0
92: 'DISPOSITION:hearing_impaired=0
93: 'DISPOSITION:visual_impaired=0
94: 'DISPOSITION:clean_effects=0
95: 'DISPOSITION:attached_pic=0
96: 'TAG:language=eng
97: 'TAG:BPS=2850885
98: 'TAG:BPS-eng=2850885
99: 'TAG:DURATION=02:21:18.762000000
100: 'TAG:DURATION-eng=02:21:18.762000000
101: 'TAG:NUMBER_OF_FRAMES=203287
102: 'TAG:NUMBER_OF_FRAMES-eng=203287
103: 'TAG:NUMBER_OF_BYTES=3021497325
104: 'TAG:NUMBER_OF_BYTES-eng=3021497325
105: 'TAG:_STATISTICS_WRITING_APP=mkvmerge v7.7.0 ('Six Voices') 32bit built on Feb 28 2015 23:23:00
106: 'TAG:_STATISTICS_WRITING_APP-eng=mkvmerge v7.7.0 ('Six Voices') 32bit built on Feb 28 2015 23:23:00
107: 'TAG:_STATISTICS_WRITING_DATE_UTC=2015-09-09 04:37:52
108: 'TAG:_STATISTICS_WRITING_DATE_UTC-eng=2015-09-09 04:37:52
109: 'TAG:_STATISTICS_TAGS=BPS DURATION NUMBER_OF_FRAMES NUMBER_OF_BYTES
110: 'TAG:_STATISTICS_TAGS-eng=BPS DURATION NUMBER_OF_FRAMES NUMBER_OF_BYTES
111: '[/STREAM]
112: '[STREAM]
113: 'index=1
114: 'codec_name=dca
115: 'codec_long_name=DCA (DTS Coherent Acoustics)
116: 'profile=DTS
117: 'codec_type=audio
118: 'codec_time_base=1/48000
119: 'codec_tag_string=[0][0][0][0]
120: 'codec_tag=0x0000
121: 'sample_fmt=fltp
122: 'sample_rate=48000
123: 'channels=6
124: 'channel_layout=5.1(side)
125: 'bits_per_sample=0
126: 'id=N/A
127: 'r_frame_rate=0/0
128: 'avg_frame_rate=0/0
129: 'time_base=1/1000
130: 'start_pts=0
131: 'start_time=0.000000
132: 'duration_ts=N/A
133: 'duration=N/A
134: 'bit_rate=768000
135: 'max_bit_rate=N/A
136: 'bits_per_raw_sample=N/A
137: 'nb_frames=N/A
138: 'nb_read_frames=N/A
139: 'nb_read_packets=N/A
140: 'DISPOSITION:default=1
141: 'DISPOSITION:dub=0
142: 'DISPOSITION:original=0
143: 'DISPOSITION:comment=0
144: 'DISPOSITION:lyrics=0
145: 'DISPOSITION:karaoke=0
146: 'DISPOSITION:forced=0
147: 'DISPOSITION:hearing_impaired=0
148: 'DISPOSITION:visual_impaired=0
149: 'DISPOSITION:clean_effects=0
150: 'DISPOSITION:attached_pic=0
151: 'TAG:language=eng
152: 'TAG:BPS=754499
153: 'TAG:BPS-eng=754499
154: 'TAG:DURATION=02:21:18.059000000
155: 'TAG:DURATION-eng=02:21:18.059000000
156: 'TAG:NUMBER_OF_FRAMES=794818
157: 'TAG:NUMBER_OF_FRAMES-eng=794818
158: 'TAG:NUMBER_OF_BYTES=799586908
159: 'TAG:NUMBER_OF_BYTES-eng=799586908
160: 'TAG:_STATISTICS_WRITING_APP=mkvmerge v7.7.0 ('Six Voices') 32bit built on Feb 28 2015 23:23:00
161: 'TAG:_STATISTICS_WRITING_APP-eng=mkvmerge v7.7.0 ('Six Voices') 32bit built on Feb 28 2015 23:23:00
162: 'TAG:_STATISTICS_WRITING_DATE_UTC=2015-09-09 04:37:52
163: 'TAG:_STATISTICS_WRITING_DATE_UTC-eng=2015-09-09 04:37:52
164: 'TAG:_STATISTICS_TAGS=BPS DURATION NUMBER_OF_FRAMES NUMBER_OF_BYTES
165: 'TAG:_STATISTICS_TAGS-eng=BPS DURATION NUMBER_OF_FRAMES NUMBER_OF_BYTES
166: '[/STREAM]
167: '[FORMAT]
168: 'filename=\\192.168.0.7\Volume_1\ART-Films\Avengers Age of Ultron 2015 1080p BRRip x264 DTS-JYK\Avengers Age of Ultron 2015 1080p BRRip x264 DTS-JYK.mkv
169: 'nb_streams=2
170: 'nb_programs=0
171: 'format_name=matroska,webm
172: 'format_long_name=Matroska / WebM
173: 'start_time=0.000000
174: 'duration=8478.762000
175: 'size=3823463298
176: 'bit_rate=3607567
177: 'probe_score=100
178: 'TAG:encoder=libebml v1.3.1 + libmatroska v1.4.2
179: 'TAG:creation_time=2015-09-09 04:37:52
180: '[/FORMAT]
181: '
3. Stock Teacher
Цю прогу я зробив, трохи переробивши одну з своїх комерційних прог, вважуючи, що мені це буде неодноразово потрібно робити якісь торговельні проги.
Ця прога потребує ось такі дані Nasdaq (які я отримав від клієнта). Прога завантажує ці дані один за другим (за потребою) у базу.
1: CREATE TABLE [dbo].[Data](
2: [i] [int] IDENTITY(1,1) NOT NULL,
3: [Company] [nvarchar](50) NOT NULL,
4: [Date] [datetime] NOT NULL,
5: [Open] [money] NOT NULL,
6: [High] [money] NOT NULL,
7: [Low] [money] NOT NULL,
8: [Close] [money] NOT NULL,
9: [Volume] [bigint] NOT NULL,
10: CONSTRAINT [PK_Data] PRIMARY KEY CLUSTERED
11: (
12: [i] ASC
13: )WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON) ON [PRIMARY]
14: ) ON [PRIMARY]
15:
16: GO
І далі можна тренуватися, як грати на біржі.
Отже почнемо з опису проекту. Проєкт має три лінка на сторонні бібліотеки Install-Package TA-Lib, AutoClosingMessageBox, EntityFramework й мапер бази у проєкт.
![](/FreelanceParser/Stock-4_1.png)
Спочатку я опишу невеличку допоміжну форму Help, вона має один RichTextBox, який зберігає текст з описом правил застосування MACD для гри. У мене описано достатньо цікавих можливостей RichtextBox, наприклад RichTextBox Editor for various purposes with row numbering and searching.. А у цьому випадку я додав у RichtextBox світлину з ресурсів проекта:
1: Public Class HelpForm
2:
3: 'insert Image from resource
4: Private Sub HelpForm_Load(sender As Object, e As EventArgs) Handles Me.Load
5: Dim HelpImage As System.Drawing.Image = My.Resources.Macd
6: Clipboard.SetDataObject(HelpImage)
7: Dim ImageFormat = DataFormats.GetFormat(DataFormats.Bitmap)
8: RichTextBox1.Select(RichTextBox1.Text.Length - 1, 0)
9: RichTextBox1.ScrollToCaret()
10: RichTextBox1.Paste(ImageFormat)
11: RichTextBox1.ReadOnly = True
12: End Sub
13:
14: 'and than prevent copypaste
15: Private Const CopyKey As Keys = Keys.Control Or Keys.C
16: Private Const PasteKey As Keys = Keys.Control Or Keys.V
17: Protected Overrides Function ProcessCmdKey(ByRef msg As Message, ByVal keyData As Keys) As Boolean
18: If (keyData = CopyKey) OrElse (keyData = PasteKey) Then
19: Return True
20: Else
21: Return MyBase.ProcessCmdKey(msg, keyData)
22: End If
23: End Function
24:
25: End Class
Тепер головна форма. Ось імена контролів на неї.
![](/FreelanceParser/Stock-5_1.png)
І ось нарешті код форми.
1: Imports TicTacTec.TA.Library
2:
3: Public Class Start
4:
5: Dim Db1 As New MacdTestEntities
6: Dim Ret1 As List(Of Macdres)
7: Dim DatumList As List(Of Datum)
8: Dim Companies As New List(Of String)
9:
10: Private Sub Start_Load(sender As Object, e As System.EventArgs) Handles Me.Load
11: Dim GroupResult = Db1.Data.GroupBy(Function(Y) New With {Key Y.Company}).ToList
12: GroupResult.ForEach(Sub(X) Companies.Add(X.Key.Company))
13: CompanyComboBox.DataSource = Companies
14: End Sub
15:
16: Private Sub LoadDataButton_Click(sender As Object, e As EventArgs) Handles LoadDataButton.Click
17: OpenFileDialog1.Title = "Please Select a Nasdaq historical data"
18: OpenFileDialog1.RestoreDirectory = True
19: OpenFileDialog1.Filter = "txt files (*.txt)|*.txt|All files (*.*)|*.*"
20: OpenFileDialog1.FilterIndex = 1
21: OpenFileDialog1.ShowDialog()
22: End Sub
23:
24: Private Sub OpenFileDialog1_FileOk(sender As Object, e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk
25: Dim FileArr1() As String = OpenFileDialog1.FileNames
26: Dim NewCompanyName As String
27: Dim RowCount As Integer
28: For Each One In FileArr1
29: If My.Computer.FileSystem.FileExists(One) Then
30: Dim Full1 As String = My.Computer.FileSystem.ReadAllText(One)
31: Dim Rdr1 As New IO.StringReader(Full1)
32: Do While Rdr1.Read > 0
33: Dim Arr1() As String = Rdr1.ReadLine.Split(",")
34: If Arr1.Length = 7 Then
35: If RowCount = 0 Then NewCompanyName = Arr1(0)
36: Dim En = New System.Globalization.CultureInfo("en-US")
37: Db1.Data.Add(New Datum With {.Date = DateTime.Parse(Arr1(1), En), .Company = Arr1(0), .Open = Arr1(2), .High = Arr1(3), .Low = Arr1(4), .Close = Arr1(5), .Volume = Arr1(6)})
38: RowCount += 1
39: End If
40: Loop
41: Db1.SaveChanges()
42: End If
43: Next
44: AutoClosingMessageBox.Show(RowCount & " records loaded")
45: Companies.Add(NewCompanyName)
46: CompanyComboBox.DataSource = Nothing
47: CompanyComboBox.DataSource = Companies
48: CompanyComboBox.Refresh()
49: End Sub
50:
51: Dim InputArrLowNumber As Integer
52: Dim InputArrHighNumber As Integer
53: Private Sub CompanyComboBox_SelectedValueChanged(sender As Object, e As EventArgs) Handles CompanyComboBox.SelectedValueChanged
54: Try
55: InputArrLowNumber = Db1.Data.Where(Function(X) X.Company = CompanyComboBox.Text).Min(Function(Y) Y.i)
56: InputArrHighNumber = Db1.Data.Where(Function(X) X.Company = CompanyComboBox.Text).Max(Function(Y) Y.i)
57: Catch x As InvalidOperationException
58: 'empty ComboBox1.Text in initial start
59: End Try
60: DatumList = Db1.Data.Where(Function(X) X.i >= InputArrLowNumber And X.i <= InputArrHighNumber).ToList
61: If DatumList IsNot Nothing Then
62: Ret1 = TA_MACDTest(1, InputArrHighNumber - InputArrLowNumber, GetInputArray(1, InputArrHighNumber - InputArrLowNumber, DatumList), CInt(FastNumericUpDown.Text), CInt(SlowNumericUpDown.Text), CInt(SignalNumericUpDown.Text))
63: If Ret1 IsNot Nothing Then
64: PrepareArray()
65: DataScaleNumericUpDown.Value = DataScaleY
66: MacdScaleNumericUpDown.Value = MacdScaleY
67: Panel1.Refresh()
68: End If
69: End If
70: End Sub
71:
72:
73: Private Sub MacdSetComboBox_SelectedValueChanged(sender As Object, e As EventArgs) Handles MacdSetComboBox.SelectedValueChanged
74: Dim Arr1() As String = MacdSetComboBox.Text.Split("-")
75: FastNumericUpDown.Value = CInt(Arr1(0))
76: SlowNumericUpDown.Value = CInt(Arr1(1))
77: SignalNumericUpDown.Value = CInt(Arr1(2))
78: End Sub
79:
80: Private Sub Recalculate_Value(sender As Object, e As EventArgs) Handles FastNumericUpDown.ValueChanged,
81: SlowNumericUpDown.ValueChanged,
82: SignalNumericUpDown.ValueChanged,
83: MacdScaleNumericUpDown.ValueChanged,
84: DataScaleNumericUpDown.ValueChanged,
85: Panel1.Resize
86: SignalDaysLabel.Text = "Signal = Exp(" & SignalNumericUpDown.Value & " days)"
87: MacdDaysLabel.Text = "Macd = Exp(" & SlowNumericUpDown.Value & " days) - Exp(" & FastNumericUpDown.Value & " days)"
88: If DatumList IsNot Nothing Then
89: Ret1 = TA_MACDTest(1, InputArrHighNumber - InputArrLowNumber, GetInputArray(1, InputArrHighNumber - InputArrLowNumber, DatumList), CInt(FastNumericUpDown.Text), CInt(SlowNumericUpDown.Text), CInt(SignalNumericUpDown.Text))
90: If Ret1 IsNot Nothing Then
91: PrepareArray()
92: Panel1.Refresh()
93: End If
94: End If
95: End Sub
96:
97: Private Sub Move_Value(sender As Object, e As EventArgs) Handles MoveMacdNumericUpDown.ValueChanged,
98: MoveSignalNumericUpDown.ValueChanged,
99: MoveHistNumericUpDown.ValueChanged
100: Panel1.Refresh()
101: End Sub
102:
103: Public Function GetInputArray(startIdx As Integer, endIdx As Integer, InputValues As List(Of Datum)) As Double()
104: Dim i As Integer = 1
105: Dim newInputValues As Double() = New Double(InputValues.Count() - 1) {}
106: Dim intItr As Integer = 0
107: For Each objValue As Stock.Datum In InputValues
108: newInputValues(intItr) = Convert.ToDouble(objValue.Close)
109: intItr = intItr + 1
110: Next
111: Return newInputValues
112: End Function
113:
114: Public Function TA_MACDTest(StartIdx As Integer, EndIdx As Integer, InputValues As Double(), FastEMAPeriods As Integer, SlowEMAPeriods As Integer, SignalEMAPeriods As Integer) As List(Of Macdres)
115:
116: Dim OutBegIdx As Integer
117: Dim OutNBElement As Integer
118:
119: Dim OutMACD As Double() = New Double(EndIdx - StartIdx) {}
120: Dim OutMACDSignal As Double() = New Double(EndIdx - StartIdx) {}
121: Dim OutMACDHist As Double() = New Double(EndIdx - StartIdx) {}
122:
123: Try
124: Dim Res As Core.RetCode = Core.Macd(StartIdx, EndIdx - 1, InputValues, FastEMAPeriods, SlowEMAPeriods, SignalEMAPeriods, OutBegIdx, OutNBElement, OutMACD, OutMACDSignal, OutMACDHist)
125: Dim Res1 = New List(Of Macdres)(EndIdx - StartIdx + 1)
126: For j As Integer = 0 To EndIdx - StartIdx
127: Dim Macdres As New Macdres()
128: Macdres.Index = j
129: If j > OutBegIdx Then
130: Macdres.Macd = OutMACD(j - OutBegIdx)
131: Macdres.Signal = OutMACDSignal(j - OutBegIdx)
132: Macdres.MacdHistogram = OutMACDHist(j - OutBegIdx)
133: End If
134: Res1.Add(Macdres)
135: Next
136: Return Res1
137:
138: Catch ex As Exception
139: AutoClosingMessageBox.Show("Calculation error")
140: End Try
141: End Function
142:
143: 'Protected Overrides Sub OnPaint(e As PaintEventArgs)
144: 'for all form
145: 'End Sub
146:
147: Dim ArrClose() As Double
148: Dim ArrHigh() As Double
149: Dim ArrLow() As Double
150: Dim ArrMacd() As Double
151: Dim ArrSignal() As Double
152: Dim ArrMacdHistogram() As Double
153: Dim DataScaleY As Single
154: Dim MacdScaleY As Single
155: Sub PrepareArray()
156: ArrMacd = (From X In Ret1 Select X.Macd).ToArray
157: ArrSignal = (From X In Ret1 Select X.Signal).ToArray
158: ArrMacdHistogram = (From X In Ret1 Select X.MacdHistogram).ToArray
159: ArrClose = (From X In DatumList Select Double.Parse(X.Close)).ToArray
160: ArrHigh = (From X In DatumList Select Double.Parse(X.High)).ToArray
161: ArrLow = (From X In DatumList Select Double.Parse(X.Low)).ToArray
162: '
163: Dim DataYwin As Single = Panel1.Size.Height - DataLabel.Location.Y 'размер поля графика
164: DataScaleY = DataYwin / (ArrHigh.Max - ArrLow.Min) 'поинтов формы / единицу данных
165: '
166: Dim MacdYwin As Single = MacdLabel.Location.Y 'размер поля графика
167: MacdScaleY = MacdYwin / (ArrMacd.Max - ArrMacd.Min) 'поинтов формы / единицу данных
168: End Sub
169:
170: Dim StartX As Integer = 100
171: Private Sub Panel1_Paint(sender As Object, e As PaintEventArgs) Handles Panel1.Paint
172: MyBase.OnPaint(e)
173: Try
174: DrawAxis(e, StartX, MacdLabel.Location.Y + MoveMacdNumericUpDown.Value, StartX + ArrMacd.Length, MacdLabel.Location.Y + MoveMacdNumericUpDown.Value)
175: DrawAxis(e, StartX, SignalLabel.Location.Y + MoveSignalNumericUpDown.Value, StartX + ArrMacd.Length, SignalLabel.Location.Y + MoveSignalNumericUpDown.Value)
176: DrawAxis(e, StartX, MacdHistogramLabel.Location.Y + MoveHistNumericUpDown.Value, StartX + ArrMacd.Length, MacdHistogramLabel.Location.Y + MoveHistNumericUpDown.Value)
177: For X = 0 To ArrClose.Length - 1
178: If X Mod 10 = 0 Then
179: DrawAxis(e, StartX + X, Panel1.Height, StartX + X, Panel1.Height + ArrHigh.Max - ArrLow.Max * DataScaleNumericUpDown.Value)
180: DrawAxis(e, StartX + X, MacdLabel.Location.Y + ArrMacd.Min * MacdScaleNumericUpDown.Value + MoveMacdNumericUpDown.Value, StartX + X, MacdLabel.Location.Y + ArrMacd.Max * MacdScaleNumericUpDown.Value + MoveMacdNumericUpDown.Value)
181: DrawAxis(e, StartX + X, SignalLabel.Location.Y + ArrSignal.Min * MacdScaleNumericUpDown.Value + MoveSignalNumericUpDown.Value, StartX + X, SignalLabel.Location.Y + ArrSignal.Max * MacdScaleNumericUpDown.Value + MoveSignalNumericUpDown.Value)
182: DrawAxis(e, StartX + X, MacdHistogramLabel.Location.Y + ArrMacdHistogram.Min * MacdScaleNumericUpDown.Value + MoveHistNumericUpDown.Value, StartX + X, MacdHistogramLabel.Location.Y + ArrMacdHistogram.Max * MacdScaleNumericUpDown.Value + MoveHistNumericUpDown.Value)
183: End If
184: Next
185:
186: DrawArrToPanel(ArrClose, e, Brushes.Red, 3, DataScaleNumericUpDown.Value, StartX, Panel1.Height + ArrHigh.Max)
187: DrawArrToPanel(ArrHigh, e, Brushes.DarkRed, 2, DataScaleNumericUpDown.Value, StartX, Panel1.Height + ArrHigh.Max)
188: DrawArrToPanel(ArrLow, e, Brushes.Magenta, 2, DataScaleNumericUpDown.Value, StartX, Panel1.Height + ArrHigh.Max)
189: '
190: DrawArrToPanel(ArrMacd, e, Brushes.Black, 3, MacdScaleNumericUpDown.Value, StartX, MacdLabel.Location.Y + MoveMacdNumericUpDown.Value)
191: DrawArrToPanel(ArrSignal, e, Brushes.Black, 3, MacdScaleNumericUpDown.Value, StartX, SignalLabel.Location.Y + MoveSignalNumericUpDown.Value)
192: DrawArrToPanel(ArrMacdHistogram, e, Brushes.Black, 3, MacdScaleNumericUpDown.Value, StartX, MacdHistogramLabel.Location.Y + MoveHistNumericUpDown.Value)
193: Catch ex As Exception
194:
195: End Try
196: End Sub
197:
198: Sub DrawAxis(e As PaintEventArgs, StartX As Integer, StartY As Integer, EndX As Integer, EndY As Integer)
199: e.Graphics.DrawLine(New Pen(Color.White), StartX, StartY, EndX, EndY)
200: End Sub
201:
202: Sub DrawArrToPanel(Arr1 As Double(), e As PaintEventArgs, Brush As System.Drawing.Brush, BrushSize As Integer, Scale As Decimal, StartX As Integer, StartY As Integer)
203: For i As Integer = 0 To Arr1.Length - 1
204: e.Graphics.FillRectangle(Brush, CSng(StartX + i), CSng(StartY - Arr1(i) * Scale), CSng(BrushSize), CSng(BrushSize))
205: Next
206: End Sub
207:
208: Private Sub HelpButton_Click(sender As Object, e As EventArgs) Handles HelpButton.Click
209: Dim H As New HelpForm
210: H.Show()
211: End Sub
212: End Class
213:
214:
215: Public Class Macdres
216: Property Index As Integer
217: Property Macd As Double
218: Property Signal As Double
219: Property MacdHistogram As Double
220: End Class
![](http://forum.vb-net.com/GetTopicCount.png?id=1A38226F-AA41-41D5-A4DE-CAE07A6BEEDB)
<SITEMAP> <MVC> <ASP> <NET> <DATA> <KIOSK> <FLEX> <SQL> <NOTES> <LINUX> <MONO> <FREEWARE> <DOCS> <ENG> <CHAT ME> <ABOUT ME> < THANKS ME> |