(NET) NET (2016)

Проги під заказ і проги по натхненню.

Як і раніше, я іноді пишу десктопні проги під заказ. Наприклад у минулому році я написав безліч програм під заказ, наприклад - Конструктор 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 ( )
<00>  <01>  <02>  <03>  <04>  <05>  <06>  <07>  <08>  <09>  <10>  <11>  <12>  <13>  <14>  <15>  <16>  <17>  <18>  <19>  <20>  <21
Link to this page: http://www.vb-net.com/FreelanceParser/index.htm
<SITEMAP>  <MVC>  <ASP>  <NET>  <DATA>  <KIOSK>  <FLEX>  <SQL>  <NOTES>  <LINUX>  <MONO>  <FREEWARE>  <DOCS>  <ENG>  <CHAT ME>  <ABOUT ME>  < THANKS ME>