Проект в VB. 3. 1. Создать проект, который по нажатию кнопки будет прорисовывать сердце проколотое стрелой

@Qwert322 · Регистрация: 08.06.2016

Создать проект, который по нажатию кнопки будет прорисовывать сердце проколотое стрелой.
Заранее спасибо.

@~~Infinity20_5~~ · 18.06.2016, 15:54

Не по теме:

Преподаватель должен давать хоть какой-то прототип, иначе дети учатся воровать с детства (занимаются плагиатом).

Visual Basic

Option Explicit
Private Sub Command1_Click()
    Circle (2000, 2000), 1000, vbRed, 0#, 4
    Circle (4000, 2000), 1000, vbRed, 5.4, 3.2
    Line (1347, 2753)-(3000, 5000), vbRed
    Line (3000, 5000)-(4653, 2747), vbRed
    Line (5500, 1000)-(3100, 3000)
    Line (5700, 1000)-(5500, 1000)
    Line (5500, 800)-(5500, 1000)
    Line (2100, 3800)-(650, 5000)
    Line (850, 5000)-(650, 5000)
    Line (650, 4800)-(650, 5000)
End Sub

@fever brain · 18.06.2016, 16:28

Visual Basic

Option Explicit
Const r = 90
Dim WithEvents cb As CommandButton, img As Image, i&, w&, hh&, v
Sub EnCode()
    Dim b() As Byte, i&, f$, cd$: ReDim h$(9): On Error Resume Next
    ChDir App.Path: If Len(Dir("large_3.jpg")) > 0 Then GoTo 1
    h(0) = "526172211a0700cf907300000d000000000000001ade742090300011120000b4240000028b6574f4dcb1d2481d350b00200000006c617267655f332e6a706700b0a8d455101d5141089997c4d95f070853e0a82024384489f01c27501214892248d26c30871849d0505204041274830890111c0404f832458409f00c48b9478f9c7df3d545f7ce72bdae75f39ddcd6eb75bdd56b55757aaadf45eb7fcc5ef77755faef5aaabbafdfaeeb557d37d57db7cb87cb9400895545514400b7d800cdfad00e5cb248d507b6e6bfe8aa2a1c001b01fc9d0007c2df6c9bf94d7eab7418bfdd9fae51bf952f98f8f7ac848c7bf6bac88607c7dfe141463e3f01fd803f645bfb4c67f87f017f7ddbff75f7d618127f6b3ff161fa4bf6672e3004efbe05c6064605c67ed8c8d0d0c8d8e110e0e747a2384c40423c44524c5455cc5050585c685e59d2322dfe8981d18191a9b1b9c1b95979d9e9d823d34046e0bf74a16fbe86873efb25e6250459f7782ffec397da008c6c0320090e73ba9f9e88c580fdae5f7802ffd5c0c0b7fa003f89cf101fd5dc3437f98877f4a03917dd9f7581e7a808c73842ffa35fff47801723182431eb260c92acb38d751d498fbbf19e91b324da4b1275abcd8333f6876f07df8505254565869ce57e7f38404142434445464e4f5051525354555b5c5ded2f2fb030b4f71a9adb1b"
    h(1) = "5b9bddde1e5e823d857cf0f8a060a0e12161a37c9e58e8ff379e42465e63d5333537393b3d4b4d4e1ea2a6aaaeb3dd65ef116769f0b5b6bdbebfc0c1c2c3c4c5cbcccdcecf13a1a3a5a7b3b5b7b9bbbdbe2be9c1fb69ce70116ffb1fcee47fc3ceaf3ac2e35fcd7f4827ed411fdc3ceb0c92262c8d33ba92f53986c99379d9fa9d1323f5ad827e6bce754cd032cd367f6d5ff37ffadb7e0faf3fae7fb698a00780fd4e811fe67000c07047fcb91265f9403c06380a816e1856f43f1de714eda508017cd91d07e58cd2e2fb2625e5aabb8be88b4711c903475d498937d931c135e6e2b67d80e9952f581897ea95b5339c8a293732549e81fb887d26ddfba88a2131ac1dc0a6722b759fe276d7320875691a19331ba1ece264464049c0abd76a602dd9b7c556c5070e9295c399bb6fd6e4b9bb8e69ba1f79782784df5c1f8bf8dfbd4a94d1c75a633c7482444a2b57620f24ec7c05b88405a3a105bfa4c8c5f1f9d4bbe9948fb35585eeebe9beebc1a51836be6a7cdc47b5db9fb20edcb0ade32c323539d3d82470a11f8c10fd3bd4339c5a4f5e4eb9bd44ff280e8e642250d0a81092f6e4f155c9152c2b26250253ab18bbbf9fdf29e03fcf857dce76491e3c689e0e57a3752bf1aa769ae99e4c94bc57ede3962826479834c52b0341db94b0cb5822e276c291de7157562ff6c7d2956a138cf72b"
    h(2) = "ac6c64cf12ec4cb3da718a86bc8c9479942e40c0bda8dce4e248e9ec28c7c7f832f7d02227f7f1f74c003045e5e4d71baa28229fe81bdf472a4e293d316cf9a25e3f1f0ed9d27c4b343b3181141b3a3d2c30c16172c941fbc30f4a1cda8773844a35bfce68f352695df4c5d09b47486822ba20fb230edb76e7623df8487e449118fab58c19dc37a87612d680080016ad3fbbb28385f8b621b6b6c5d7dbd53d44954eaf31def10f9a616ee7b8dbe60fb484eee3e74027b454d38684e432bef52c843a2ca02bcf3c22503507891833cf3d12130121a641d4343c9b54522cca695a71b8c2c1843098242a74112925956944140158c8f701f89f9aa69ee50d8a3b1b3dbf781566e3d1d336694aad03995cc2b27be02ca7020cf077fb2c78974681f1c7eb0af3786f255cfb2f84e9047835db797f286c21058b2dd1c637ee30915a64e0cf351abb61b119fe1c4a4b2c82484b27e7c1c20a93cd358f16dbb45f3ff5cbf79b68b6ec87341c25e89ebbc86e3ca033727abbea5b53d8a237119ae4020678c666a88113195c4ea2b1b53e85fe7b6754a78663e8bc31b399a5435e52e062bf0526a4e6292218874a4616de3cee45660e9e74ab7db2e8a38286e6b68191be47c25e1d9155add15deb43a4bda33fde4a8ea8ae398abc6ac6778b61f9f9882055dd2c8b4b6003ed2ef73410cd6029a066cb173ca6"
    h(3) = "34a48b2ec5fbea84b47bebfeb6880f6434605ecaac7199010aceecf1262310ed6ace7180d402c22a232b25769e7758aaa7ab23ad264e3f6acb69c4de5d40e051af3a76bd5623deef8b686b88c2905decf1909756e699637526ee51b054369bb7ea566c4c39ae690e66098c2907081337cb701697a353da1b2d55ade934d946f89bba7234adbe675edd4460184cab0233f62609477178de3c001dfa9be7abe881cb515373ea9382ac967b9da913b42074b625492c42d8f11be74ba1b290759194625a7d4db1f8aad1d58a4ce2e9a4f0edb8abc548a5db772ef84822585b3dd7086b48df363c7644db77d487aea8fd9757c7563466d8409c4803bbde961ce055bf364638916cd044ec3c962fd5b41a749ebafe9cce03c0e19e4fad27b476dbb3144e49a231a3a48af15deee4cb57932444ea20f7c29f2706e8c32f95aa33de6731f81481849d2f61d1f0f4064e74290a1683d040787c2e37dcee48f1aa84974f0ad9e02ac54f8b748d5a573dfc53c834928eb9b1d1a9190b311a7c7dd6e9df6afca6550f12241def9c1b36a69834351ebe9f3cf3c0c62c1f2c84359a78581782f2179ed5ebf38cd7c080c6b5cfd7f14722e2f4f11690f0ea6124a6d5c338372d98cc5577ec77c9268e58ceb1ce044c491fcbcfb3b615bd254f8d433a4e5fdf9c85038f5d58b04aaf274e9962f3d3f53c93eef9baee"
    h(4) = "fb4ed80ee1eefc2c7ba7bfefd13468fc72cd3d5d8b7ec9c1fd2b80406b082a5bb469ddeccc5fd97448798c1e15dbd34d8d0197f4c06f7f2dbd722679021af51260895edc2423ca70579e5d3473389f5deba50959e447d20d36f3aae6e2e6f20b03a9eba44dbdba3731082deefc0f2536070a555727d7e5541b491feebf2cdfb8d09db8bf7565e5a1acf087d11935f01725340542eef52ad24a3346addcaba7f38dd75e66354b03ef32323669303fb7c72dcea492e2052cdf0ac077dcd4a5d507b060a5b6217c9c62da823ef4c8fa6b29d3e29763a643f4dc97b9cb3c9660696a45cbf049e5c1acfd21af9e1f0e3af23846c65f8707d5f0732fbb2c5e21e4dacf85023912617ce51590741f2a18bf412a3bb3e639ac2e53388ccf7d26af2615aeb34db3ad3f42f751a477ab50c6a86b71aa699aa6b9684944a78b24af923376aeb082c4a02a068d8055bb0609e1e19a16dd0d962e341b4015551f8637a3d2648b0032ef19e491f66f3a219a9a22cd066cc6e501744d46ac2638b30fe9f074b3e99dd47c9de2692a6358231a4621122a3f1dc0aad9cb6e9346315a14f5a596f50e3b0d1ecb5af6c7a7f2e44047244ca48759eb9c3ac2ee1bae7e6e0bf15696d5c3407496415455559abfadab5375daecf1a757ca5d91c606bbc408bacded7e4572fdb3dd1954bda0db282491ac25b4b68b5118a12c"
    h(5) = "25973048b8e6d72fb57f25e807ce04b0cc91ed5fe300b41873bc93e47fb808a0d3a5a07bc8d01de1c4e076172eb6b63f07586e49e1d6c4c5ef136622af58003085bbf7068c880ffbd51d610d197f84bd23f8a92f9c2c724c4d2511c8f8ba4fe59b2891f941afbabad36e67bbbc85faebc7e4f9f57834199b1715d581e71b92b056dda36d96dd7bbacf3c391c8f4046873ded4a93eff4b92b3f862f95aaa81f1ee1663c4d3dedf24931a64cc40cad8207d6aa1e2be99c099a7a0c37a29248ec4120d45b97da7bacc3c2ec8be00fa10f9d64e91074ce36e73cb5873a45e87912a37eb716e73146de96d943a7062b84d36abb0c167895df099b6b029dd79f1a0b03a3ed0010c6a3380aed865a3dd83d099c2e402862bb413c0803b12d62e98253a59b1e2991b55f76f47d843e3dc3bbb8b8e7b135a1a99339402433fdbaf187f3562dd9d5ae3d7b6e1b042745e9b2c77cf57ce61ba88dcc8e9f59be0baf90a064561ea3a50d26e85d5fa70066fe3ee834b75846c8c67fefc5f45cf7237313368e73473adfaa3bb690376d93a837843065205dd7fe69a08d1afce6782d0a3da765fe2b182d6585a3f8ae21ccd73d4f51085996fd91bd66801d89dbcefa2b012a4ae6699510d986e20e7b63afbd75517626766efb7527bb5055f9d83f9a42d2e2674a6823843f0c3c81a1d9e5bafc3eb67392534b6191"
    h(6) = "b22dd15f4f03b4c0f10fd0b33b1c6ec6e1df5e71baaf28aea5c91be20b964adce8d1e1eddf168b026338b5a9cffce7c54d18f916ec8d3946777f4f51f24025f6ddf6fdd8c6bde93f3e351b26545273c186ce89f0867c82a9e85db4c94a2024e5971793bad55b87c7483c304d0774f704970a4a2515ee100e4dce427d14593b4f4a83b38490996b966883c4ea4cce8f926cdbc21af258551b8c4c08d603d7d981932f7cb3928ad22f4e4d89055edbaf8f83da2086b64e391ef0228bad60be77a8192f5309497c85656a20d5ed31de77276bf07e7168d92961ab8a6e6c26c1ccb8395a3b4abb6013af70a6e30a9a1c7f2b5595bf5a8715d2e3600ab0ce4cd517a17700f1a96ceea74d71daaa9087fa1117fcba6c15909dfd67fba67157c3ab0843451792ae97a1bc1c61674cb6b2e20cdbc9d45eee98f74cf7d284c4c2d6c7c2469560828f402a5dd2ba6577d7e44127c0f407b6686db4a42d2353db9cd75d9af6193426c59d6d1ec52266b1d6d2220e4c4ea2e8fe55053aa98838fde38776c42aa8e02ec998cc397f2f554e757976e1681fbc527a73de4bce95e40efaaf4997d77319b5f530618f635d37b447f619addd20dd5eb9403747496c25a30e69c0123d8ef211be9ba0972cad2b3e6c867c4cf877cfe3092538b6ad2af7ba159604fa2ebf3e0488f8a1257e58566931ef3ccb2d661ebe39"
    h(7) = "1e39223e1549d54e2b3ccabb292a5012e937d6361f2a50dca1d97c8177c699228b678fd4c5ec4fd886d98285839a606a4ed37abf3519702ea663b705b69e87d04ba3cf5562785716ca106001c520656aad17365af7881ce320aefd3dc2ad989c356713a435a9ef21677e0a193fc930466030fb11270d731f9141bb8cfe86c313da12a851f729a198ef9fb8cc8769f382c5cd2df4ad10d8460f16e6db6384bebca1905a10a2c76bd7715e917d98be7e23cc8ec15da0d78c3b0ebeb6ef6760ecb9a42545611df4882add8e68be2d111f11b662b035ea6e133397adedf1bd86f1dea5a40fc07c49898444d270c7c1ca5883ad90fd5f07b5473162b93e0986b30200da161205051ef5f0fe5aa4aea21037ac1c73bca206c7bdf35697aee7d4c6e7b32a482db67336ea9175decc66122194676ceea789f54393479174f061e2fe6cb231d636b1ac8a4fd278dbacf7170746e480cbd26ebceda6ef54f93e074e476c7b5b350ab585f9abacfe3b2978fb92127f93de17b967e7194391e953415f5eeebb7aedadab9faad1e3b588575222b2b760904ea8170a193c5152aab008944aa8854b7ead14968785c1172f24ebb3094f1617b111aace29042e614689530d50d4b45fcad61acb4be8c0c260a04838f70d14add956c543d960b0e7369e4766ca247d10c8bd14a2252b55d1ba7959df6b0a3dee7fdcc3"
    h(8) = "e8f1393950d7e4387ea05f428c8d4bdd7bab30e1a2cbdca3f4086a79f5d2e84c6ba9526e05807a996d5d7a6c84e39753e946ba1c7c586c37fe9423ecaacc656e3886709a0410665f7f616a3848ca1ac4c5381c3b57e8602d504d514a415eb81f91fb93c1eacf8681450e5732551b96445ff413ea95b8a68bb6abb28c54f67060d9c97a09822ca7554dfc9cfd99d9f257c6d47977b2f24b39be15f67f3ca6ed8656bf45c12bab5db480fae9b2643123acb49e7bc6c557f8b5a82f03ccf4095fe5485f43f2ea42422cf23f529ca4a50ea7c78b889c6822ffe24809a0625135f45b83805b06be0c52dec60242112f6b078ab625e6f8709b3ced7377ecb42354e51e9cb9e5ebd9641cd8c788a1b4c50e6e524ac96d30fa43ad39a30fa80cb70bba30fb55d81e6de1bdc715ddc246943edcd2d221f8801035346edb4697b0a2d3b53992379cf7919aa2f76a094c5e8e8885be549bce4d41d0166312733221dfcbedd13bfd624bfd621b3a708fff5262795400249052db92c3399e3a14686019dc4b194ac53ef19546ca942c2a1c1d3c3d4f1f0397ee39660e02121cf62a58af2f7af0ea7fd70ff90a377ad617ca18394869eee70af5ed9f9d2ec4cde289870d1975e5c16eb7a3e7c2f756d8e9618a6f5fb4345332bf80b084dc9bd2917f133f389ccf34c36e102f571e18c635d71f780046910fe5db2b"
    h(9) = "797135f5e1a9e9d31c5b27a9e1a99ced8422199e09f69b3ddcbb234510b4235800146dd7d8808ece5fb334acf30c89d64b48b5c37ce005a931de39ba9b8fb06e6bdc4a8a9b2450ecab8efc9b24851ce5771b5a6b365feefd154e7ebc62432e9dcf1b1689ea507d5617f81a8f4361750f888d8b193eb5a618cc721124013b6134dccbe5fe926c8d3aced61c476d8fb1573d6d98e336380a8481d25e18100fdee89dab11b40101e5c4ffff7d03e6e6e6e6e6e6e6e6e6e6e6e6e6e6e6e6fe3f3ff080c43d7b00400700"
    h(0) = Join(h, vbNullString): ReDim b(Len(h(0)) / 2 - 1)
    For i = 0 To UBound(b): b(i) = CLng("&H" & Mid$(h(0), i * 2 + 1, 2))
    Next: Erase h: f = "tmpEnCoderArc.rar": i = FreeFile
    Open f$ For Binary As #i: Put #i, 1, b: Close #i
    Call CreateObject("WScript.Shell").Run("WinRAR x -y """ & f & "", 1, True): Kill f
1
End Sub
Private Sub cb_Click()
    img.Visible = 1
End Sub
Private Sub Form_Load()
    EnCode
    Set cb = Controls.Add("vb.CommandButton", "cb"): With cb
        .Move r, r
        .Caption = "Нарисовать сердце"
        .Visible = 1
    End With
    Set img = Controls.Add("vb.Image", "img"): With img
        .Stretch = 1
        .Picture = LoadPicture("large_3.jpg")
        .Move 0, 0, .Picture.Width * 2, .Picture.Height * 2
        w = .Width: w = w + (Width - ScaleWidth)
        hh = .Height: hh = hh + (Height - ScaleHeight)
    End With
End Sub
 
Private Sub Form_Resize()
    On Error Resume Next
    If WindowState = 2 Then WindowState = 0
    Width = w: Height = hh
End Sub

@~~Infinity20_5~~ · 18.06.2016, 21:57

Можно добавить на форму элемент Picture1 и двигаться дальше. Пока вношу небольшую лепту, чуть-чуть доработал стрелу.

Visual Basic

Option Explicit
 
Private Sub Command1_Click()
 
    Picture1.Circle (2000, 2000), 1000, vbRed, 0#, 4
    Picture1.Circle (4000, 2000), 1000, vbRed, 5.4, 3.3
    Picture1.Line (1347, 2753)-(3000, 5000), vbRed '
    Picture1.Line (3000, 5000)-(4653, 2747), vbRed '
    Picture1.Line (5500, 1000)-(3100, 3000) 'стрела до середины сердца
    
    Picture1.Line (5380, 800)-(5700, 600) ' соединение первой и второй стоек верхнего оперения оперения
    Picture1.Line (5380, 800)-(5100, 1350) ' первая стойка верхнего оперения
    Picture1.Line (5700, 600)-(5500, 1000) ' вторая стойка верхнего оперения
    
    Picture1.Line (5650, 1150)-(5900, 900) ' соединение первой и второй стоек нижнего оперения оперения
    Picture1.Line (5100, 1350)-(5650, 1150) ' первая стойка нижнего оперения
    Picture1.Line (5900, 900)-(5500, 1000) ' вторая стойка нижнего оперения оперения
    
    Picture1.Line (2100, 3800)-(650, 5000) 'стрела от середины сердца до наконечника
    Picture1.Line (1500, 4550)-(650, 5000) 'нижняя стойка наконечника
    Picture1.Line (1250, 4250)-(650, 5000) 'верхняя стойка наконечника
End Sub

@~~Infinity20_5~~ · 18.06.2016, 23:29

Вот здесь, на Вольфраме — очень много "графиков сердца" http://www.wolframalpha-ru.com... -post.html
1) plot x^2+(y-sqrt(|x|))^2=1
2) real plot sqrt(cos(x))*cos(200x)+sqrt(abs(x))-pi/4)*(4-x^2)^0.01, x=-2..2
3) real plot[sqrt(1-(abs(x)-1)^2), arccos(1-abs(x))-pi], x=-pi..pi
4) cotour plot x^2+((y+2.5)/3-sqrt(|x|))^2-1
5) plot x=16sin^3t, y=13cost-5cos2t-2cos3t-cos4t
6) plot r=2-2sin(theta)+sin(theta)sqrt(|cos(theta)|)/(sin(theta)+1.4)

Но, боюсь, у меня ничего не получится, возможно — устал за сегодня.

Пожалуйста, помогите, кто понимает.

@~~Infinity20_5~~ · 19.06.2016, 11:31

Сам толком ничего не знаю, по-своему развлекаюсь с Visual Basic 6.0

Не по теме:

Вроде как в США показания в суде воспитателей дошкольных учреждений подвергаются большому сомнению, поскольку они чуть ли не официально признаны недееспособными. Считается, они, поэтому — легко находят с подопечными младенцами общий язык.
Так и у меня со студентами. Рыбак рыбака — видит издалека.

Форма44

Visual Basic

Option Explicit
 
Private Sub Command1_Click()
AutoRedraw = True
'Picture1.Scale (?, ?)-(?, ?) ' не знаю, что такое? Пользоваться не умею.
Picture1.DrawWidth = 5
'Picture1.FillStyle = 0 ' только догадываюсь, что это как бы заливка
'Picture1.BackColor = QBColor(3) ' только догадываюсь, что это подложка
 
    Picture1.Circle (2000, 2000), 1000, vbRed, 0#, 4
    Picture1.Circle (4000, 2000), 1000, vbRed, 5.4, 3.3
    Picture1.Line (1347, 2753)-(3000, 5000), vbRed '
    Picture1.Line (3000, 5000)-(4653, 2747), vbRed '
 
    Picture1.Line (5500, 1000)-(3100, 3000) ' стрела от оперения до середины сердца
    
    Picture1.Line (5380, 800)-(5700, 600) ' соединение первой и второй стоек верхнего оперения 
    Picture1.Line (5380, 800)-(5100, 1350) ' первая стойка верхнего оперения
    Picture1.Line (5700, 600)-(5500, 1000) ' вторая стойка верхнего оперения
    
    Picture1.Line (5650, 1150)-(5900, 900) ' соединение первой и второй стоек нижнего оперения 
    Picture1.Line (5100, 1350)-(5650, 1150) ' первая стойка нижнего оперения
    Picture1.Line (5900, 900)-(5500, 1000) ' вторая стойка нижнего оперения 
    
    Picture1.Line (2100, 3800)-(650, 5000) ' стрела от середины сердца до наконечника
    Picture1.Line (1500, 4550)-(650, 5000) ' нижняя стойка наконечника
    Picture1.Line (1250, 4250)-(650, 5000) ' верхняя стойка наконечника
End Sub

Форма 52

Visual Basic

Option Explicit
 
Private Sub Command1_Click()
Picture1.Scale (-225, 225)-(225, -225)
Picture1.DrawWidth = 5
Picture1.FillStyle = 0
Picture1.Circle (50, -80), 50, vbRed, 1.6, 3.2
Picture1.Circle (-50, -80), 50, vbRed, 6.25, 1.6
Picture1.Circle (49, 48), 50, vbRed, 4.7, 3.15
Picture1.Circle (-48, 48), 50, vbRed, 6.2, 4.7
End Sub

@fever brain · 19.06.2016, 17:48

Не по теме:

Ну вот получается же, молодец. Я тоже когда-то начинал с рисуночков, отрезками и дугами рисовал различные узоры

@~~Infinity20_5~~ · 19.06.2016, 23:25

Catstail!
Пожалуйста, помогите если сможете. Никак не могу нарисовать "график сердца по картинке из Вольфрама", смотрите выше. Исходная формула: x^2+(y-sqrt(|x|))^2=1

Для меня это очень важно и увлекательно.
Код сердца:

Visual Basic

Option Explicit
Private Sub Command1_Click()
' [url]http://festival.1september.ru/articles/413294/[/url]
 Dim SngX As Single, Y As Single, BytI As Integer  ' SngX –абсцисса точки, у - ордината
 Dim pi As Double, X As Single
  'Задание масштаба и новой системы координат
 Picture1.Scale (-2, 2)-(2, -2)
 ' Построение графика функции
 For SngX = -1 To 1 Step 0.01
 Y = Sqr(Abs(X)) + (1 - X ^ 2) ^ 0.5
 'X ^ 2 + (Y - Sqr(Abs(X)))^ 2 = 1 ' Вычисление ординаты у
 Picture1.PSet (SngX, Y), vbBlue ' Рисуем точку
 Next SngX
 'Рисуем ось Х
 Picture1.Line (-2, 0)-(2, 0)
 For BytI = -2 To 2
 Picture1.PSet (BytI, 0) ' Рисуем масштаб на оси Х
 Picture1.Print BytI; ' Подписываем; масштаб
 Next BytI
 'Ось Y
 Picture1.Line (0, 2)-(0, -2)
 For BytI = -2 To 2
 Picture1.PSet (0, BytI) ' Рисуем масштаб на оси У
 Picture1.Print BytI; ' Подписываем; масштаб
 Next BytI
 End Sub

@~~Infinity20_5~~ · 20.06.2016, 11:47

Помогите, пожалуйста, не могу никак совместить верхнюю и нижнюю части сердца на одном графике.

Visual Basic

Option Explicit
Private Sub Command1_Click()
' [url]http://festival.1september.ru/articles/413294/[/url]
' [url]http://www.wolframalpha-ru.com/2012/03/blog-post.html[/url]
 
 Dim SngX As Single, Y As Single, BytI As Integer  'SngX –абсцисса точки, у - ордината
 Me.AutoRedraw = True
 Me.DrawWidth = 3
  'Задание масштаба и новой системы координат
 Picture1.Scale (-2, 2)-(2, -2)
 'Построение графика функции
 For SngX = -1 To 1 Step 0.01
 Y = Sqr(Abs(SngX)) + (1 - (SngX) ^ 2) ^ 0.5 ' верхняя часть сердца
 Y = Sqr(Abs(SngX)) - (1 - (SngX) ^ 2) ^ 0.5 ' нижняя часть сердца
 ' как совместить обе части сердца на графике?
 'X ^ 2 + (Y - Sqr(Abs(X)))^ 2 = 1 - исходная формула на Вольфраме
 'Вычисление ординаты у
 Picture1.PSet (SngX, Y), vbRed 'Рисуем точку
 Next SngX
 'Рисуем ось Х
 Picture1.Line (-2, 0)-(2, 0)
 For BytI = -2 To 2
 Picture1.PSet (BytI, 0) 'Рисуем масштаб на оси Х
 Picture1.Print BytI; 'Подписываем; масштаб
 Next BytI
 'Ось Y
 Picture1.Line (0, 2)-(0, -2)
 For BytI = -2 To 2
 Picture1.PSet (0, BytI) 'Рисуем масштаб на оси У
 Picture1.Print BytI; 'Подписываем; масштаб
 Next BytI
 End Sub

@~~Infinity20_5~~ · 20.06.2016, 13:27

Наконец построил "график сердца"! Бейсик, почти бухгалтер — признаёт только цифры.
Поэтому указал ему отдельно: Y1 As Single, Y2 As Single.
А потом закомментировал построение осей координат. Мешают лирике и романтике!

Visual Basic

Option Explicit
Private Sub Command1_Click()
' [url]http://festival.1september.ru/articles/413294/[/url]
' [url]http://www.wolframalpha-ru.com/2012/03/blog-post.html[/url]
 
 Dim SngX As Single, Y1 As Single, Y2 As Single, BytI As Integer  'SngX –абсцисса точки, у - ордината
 Me.AutoRedraw = True
 Me.DrawWidth = 3
  'Задание масштаба и новой системы координат
 Picture1.Scale (-2, 2)-(2, -2)
 'Построение графика функции
 For SngX = -1 To 1 Step 0.01
 Y1 = Sqr(Abs(SngX)) + (1 - (SngX) ^ 2) ^ 0.5 ' верхняя часть сердца
  Y2 = Sqr(Abs(SngX)) - (1 - (SngX) ^ 2) ^ 0.5 ' нижняя часть сердца
 ' как совместить обе части сердца на графике?
 'X ^ 2 + (Y - Sqr(Abs(X)))^ 2 = 1 - исходная формула на Вольфраме
 'Вычисление ординаты у
  Picture1.PSet (SngX, Y2), vbRed 'Рисуем точку
 Picture1.PSet (SngX, Y1), vbRed 'Рисуем точку
 Next SngX
 'Рисуем ось Х
 'Picture1.Line (-2, 0)-(2, 0)
 'For BytI = -2 To 2
 'Picture1.PSet (BytI, 0) 'Рисуем масштаб на оси Х
 'Picture1.Print BytI; 'Подписываем; масштаб
 'Next BytI
 'Ось Y
 'Picture1.Line (0, 2)-(0, -2)
 'For BytI = -2 To 2
 'Picture1.PSet (0, BytI) 'Рисуем масштаб на оси У
 'Picture1.Print BytI; 'Подписываем; масштаб
 'Next BytI
 End Sub

@Catstail · 20.06.2016, 15:10

Не понимаю, в чем трудность... Запусти и попробуй поменять размеры формы:

@Catstail · 20.06.2016, 15:26

Только сворачивать не надо - будет "плюшка"...

@~~Infinity20_5~~ · 20.06.2016, 15:52

Сообщение от Catstail

Только сворачивать не надо - будет "плюшка"...

Catstail
Спасибо, но плюшка не получится. Там, во вложении, находятся разноцветные прямоугольники, включая файл.ехе, из темы Нарисовать на форме множество прямоугольников произвольного размера

Возможно, Вы хотели вложить рисунок сердца?

@Catstail · 20.06.2016, 16:26

Сообщение от Infinity20_5

Там, во вложении, находятся разноцветные прямоугольники, включая файл.ехе, из темы Нарисовать на форме множество прямоугольников произвольного размера

- ничего подобного. Там проект, содержащий рисунок сердца. Проверил еще раз.

@~~Infinity20_5~~ · 21.06.2016, 01:46

Сообщение от Catstail

Там проект, содержащий рисунок сердца. Проверил еще раз.

Прошу прощения. Погорячился, открыл у себя в 'Загрузках' по ошибке, ранее скаченные 'прямоугольники' — и понёс вздор: про неправильное вложение.

@Qwert322 0 / 0 / 0 Регистрация: 08.06.2016 Сообщений: 5
		1
	Проект в VB. 3. 1. Создать проект, который по нажатию кнопки будет прорисовывать сердце проколотое стрелой 18.06.2016, 02:20. Показов 2685. Ответов 14 Метки нет (Все метки) Создать проект, который по нажатию кнопки будет прорисовывать сердце проколотое стрелой. Заранее спасибо. 0

@~~Infinity20_5~~ Заблокирован
	18.06.2016, 23:29	5
	Вот здесь, на Вольфраме — очень много "графиков сердца" http://www.wolframalpha-ru.com... -post.html 1) plot x^2+(y-sqrt(\|x\|))^2=1 2) real plot sqrt(cos(x))cos(200x)+sqrt(abs(x))-pi/4)(4-x^2)^0.01, x=-2..2 3) real plot[sqrt(1-(abs(x)-1)^2), arccos(1-abs(x))-pi], x=-pi..pi 4) cotour plot x^2+((y+2.5)/3-sqrt(\|x\|))^2-1 5) plot x=16sin^3t, y=13cost-5cos2t-2cos3t-cos4t 6) plot r=2-2sin(theta)+sin(theta)sqrt(\|cos(theta)\|)/(sin(theta)+1.4) Но, боюсь, у меня ничего не получится, возможно — устал за сегодня. Пожалуйста, помогите, кто понимает. Миниатюры 0

@fever brain
	19.06.2016, 17:48 #7
	Не по теме: Ну вот получается же, молодец. Я тоже когда-то начинал с рисуночков, отрезками и дугами рисовал различные узоры 0

@Catstail Модератор 34183 / 19078 / 4017 Регистрация: 12.02.2012 Сообщений: 31,960 Записей в блоге: 13
	20.06.2016, 15:26	12
	Только сворачивать не надо - будет "плюшка"... 0

@~~Infinity20_5~~ Заблокирован
	20.06.2016, 15:52	13
	Сообщение от Catstail Только сворачивать не надо - будет "плюшка"... Catstail Спасибо, но плюшка не получится. Там, во вложении, находятся разноцветные прямоугольники, включая файл.ехе, из темы Нарисовать на форме множество прямоугольников произвольного размера Возможно, Вы хотели вложить рисунок сердца? 0

@Catstail Модератор 34183 / 19078 / 4017 Регистрация: 12.02.2012 Сообщений: 31,960 Записей в блоге: 13
	20.06.2016, 16:26	14
	Сообщение от Infinity20_5 Там, во вложении, находятся разноцветные прямоугольники, включая файл.ехе, из темы Нарисовать на форме множество прямоугольников произвольного размера - ничего подобного. Там проект, содержащий рисунок сердца. Проверил еще раз. 0

@~~Infinity20_5~~ Заблокирован
	21.06.2016, 01:46	15
	Сообщение от Catstail Там проект, содержащий рисунок сердца. Проверил еще раз. Прошу прощения. Погорячился, открыл у себя в 'Загрузках' по ошибке, ранее скаченные 'прямоугольники' — и понёс вздор: про неправильное вложение. 0