Проги під заказ і проги по натхненню.
Як і раніше, я іноді пишу десктопні проги під заказ. Наприклад у минулому році я написав безліч програм під заказ, наприклад - Конструктор PDF-схем. Складська прога на WCF-сервісах зі сканером.. Таких прог було багато, більшість з них я взагалі ніяк не описую тут на сайті, ось наприклад від цієї проги залишився тільки скрин.
Десктопні проги писати настільки легко (поріняно з cайтами), що я могу їх писати навіть безкоштовно, для якихось своїх власних потреб. Нище ви можете побачити три мої проги, що я написав у 2016-му році для себе особисто, по натхненню, тобто безкоштовно.
1. Freelancer
Що ми можемо побачити на скрині вище? Головно вікно цієї проги зліва. На ньому можна задати фрилансерскі біржі, на яких потрібно шукати закази на програмування. У вікні по центру ви можете побачити мої спеціальності (перераховані по пріоритету) - це 34 програмісткі спеціальності, з декількох тисяч існуючих. Класіфікатори існуючих спеціальностей програмістів розташовані справа, та справа знизу. Вони теж постійно поповнюються.
Задачі на програмування викачуються з фрілансерских бірж, класифікуються і відображаються у єдиній табличці, з якої дуже зручно відповідати замовнику.
І, як и завжди - я покажу якусь частку кода цієї проги - код форми відображення даних. Сама форма виглядає ось так:
А код цієї форми виглядає ось так:
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.
Якогось цікавого коду тут немає, але для навчання юних програмістів я покажу невеличкий фрагмент мойого коду, який викликає консольний 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 й мапер бази у проєкт.
Спочатку я опишу невеличку допоміжну форму 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
Тепер головна форма. Ось імена контролів на неї.
І ось нарешті код форми.
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
Comments (
)
)
Link to this page:
//www.vb-net.com/FreelanceParser/index.htm
|
|