找回密码
 立即注册→加入我们

QQ登录

只需一步,快速开始

搜索
热搜: 下载 VB C 实现 编写
查看: 5443|回复: 4

【VB】某科学超电磁炮(入门向)

[复制链接]

1109

主题

1649

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24180 个
贡献
46222 次
宅之契约
0 份
在线时间
2294 小时
注册时间
2014-1-26
发表于 2014-11-5 20:52:37 | 显示全部楼层 |阅读模式

欢迎访问技术宅的结界,请注册或者登录吧。

您需要 登录 才可以下载或查看,没有账号?立即注册→加入我们

×
20141023235622.png
其中的文字是可以改变的,比如“とある科学の超电磁炮”“とある定時の超級冒泡”“とある特別の作死技巧”,修改文本框的文本就能看到其中的文字发生改变。
此外颜色也可以修改的,点左下角的两个按钮就可以改变颜色了。点“宋体”按钮还可以改变字体。但是我拖拉Label控件的时候就是针对宋体进行修改的,改成别的字体不一定好看。
20141105202704.png 20141105202732.png
产生图片后,点“存储”就能将其保存为24位色的BMP。鼠标点击图片然后按下Ctrl+C就能直接复制图像到剪贴板,然后就能在QQ的聊天窗口里按Ctrl+V粘贴,就能发送了。是不是很方便?

这个程序是用VB写的。入门向的程序。代码很简单。
其实重点在于它对CreateObject这个VB函数的使用。VB使用这个函数进行COM类的使用。对于这个函数的资料一般不多,因为我们可以用别的方式达到目的,比如用API,或者换别的语言编程等。然而研究VB的这个还是比较有意义的——能更好地使用VB了。相比较而言使用API会略微降低代码可读性。
这里放出部分代码示例。大家可以看到CreateObject还是相当方便的——就是没有自动提示功能令人厌烦!不过MSDN都能找到资料。

公用文件对话框:
  1. Dim DlgObj As Object
  2. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  3. DlgObj.Filter = "24位BMP位图(*.bmp)|*.bmp|显示所有文件(*.*)|*.*" '文件扩展名,用|隔开,一般是“提示|扩展名|提示|扩展名|提示|扩展名……”等方式。
  4. DlgObj.ShowSave '如果是打开文件就用ShowOpen,如果是保存文件就用ShowSave
  5. If Len(DlgObj.FileName) Then MsgBox "保存到" & DlgObj.FileName
复制代码
公用字体对话框:
  1. Dim DlgObj As Object
  2. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  3. DlgObj.FontName = cmdFont.Caption
  4. DlgObj.ShowFont
  5. MsgBox "字体:" & DlgObj.FontName
  6. MsgBox "是否斜体:" & DlgObj.FontItalic
  7. MsgBox "是否粗体:" & DlgObj.FontBold
  8. MsgBox "是否下划线:" & DlgObj.FontUnderline
复制代码
公用颜色对话框:
  1. Dim DlgObj As Object
  2. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  3. DlgObj.Color = cmdColor1.BackColor
  4. DlgObj.ShowColor
  5. MsgBox "颜色值:" & Hex$(DlgObj.Color)
复制代码
其实我喜欢VB的一个地方就是——它一般不使用方括号用作表达式,而是用圆括号,因此在发帖的时候就不会因为方括号导致论坛解析帖子内容出现BUG。典型的例子是C语言经常出现“[i]”这种使用数组元素的方式,对于论坛这是“斜体”([i]中间是斜体内容[/i])就会导致帖子很不好看。。
但是从各种方面来说C的可读性、可移植性和灵活性都很高。但是我一般不会使用C语言写这样的程序,因为嫌麻烦。
20141105204823.png
源代码:
  1. VERSION 5.00
  2. Begin VB.Form frmMain
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "某科学超电磁炮"
  5.    ClientHeight    =   3855
  6.    ClientLeft      =   45
  7.    ClientTop       =   375
  8.    ClientWidth     =   4095
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   257
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   273
  15.    StartUpPosition =   3  '窗口缺省
  16.    Begin VB.CommandButton cmdSave
  17.       Caption         =   "存储(&S)"
  18.       Height          =   495
  19.       Left            =   2520
  20.       TabIndex        =   19
  21.       Top             =   3240
  22.       Width           =   1455
  23.    End
  24.    Begin VB.CommandButton cmdFont
  25.       Caption         =   "宋体"
  26.       Height          =   495
  27.       Left            =   1320
  28.       TabIndex        =   18
  29.       Top             =   3240
  30.       Width           =   1095
  31.    End
  32.    Begin VB.CommandButton cmdSetOrgText
  33.       Caption         =   "恢复原始文本(&R)"
  34.       Height          =   375
  35.       Left            =   2280
  36.       TabIndex        =   17
  37.       Top             =   240
  38.       Width           =   1695
  39.    End
  40.    Begin VB.CommandButton cmdColor2
  41.       BackColor       =   &H8000000D&
  42.       Height          =   495
  43.       Left            =   720
  44.       Style           =   1  'Graphical
  45.       TabIndex        =   16
  46.       Top             =   3240
  47.       Width           =   495
  48.    End
  49.    Begin VB.CommandButton cmdColor1
  50.       BackColor       =   &H80000005&
  51.       Height          =   495
  52.       Left            =   120
  53.       Style           =   1  'Graphical
  54.       TabIndex        =   15
  55.       Top             =   3240
  56.       Width           =   495
  57.    End
  58.    Begin VB.TextBox Text2
  59.       Height          =   270
  60.       Left            =   120
  61.       TabIndex        =   14
  62.       Text            =   "Railgun"
  63.       Top             =   720
  64.       Width           =   3855
  65.    End
  66.    Begin VB.TextBox Text1
  67.       Height          =   270
  68.       Left            =   120
  69.       TabIndex        =   13
  70.       Text            =   "とある科学の超电磁炮"
  71.       Top             =   360
  72.       Width           =   2055
  73.    End
  74.    Begin VB.PictureBox picPreview
  75.       BackColor       =   &H80000005&
  76.       Height          =   2055
  77.       Left            =   120
  78.       ScaleHeight     =   133
  79.       ScaleMode       =   3  'Pixel
  80.       ScaleWidth      =   253
  81.       TabIndex        =   0
  82.       Top             =   1080
  83.       Width           =   3855
  84.       Begin VB.Label lblBottom
  85.          AutoSize        =   -1  'True
  86.          BackStyle       =   0  'Transparent
  87.          Caption         =   "R a i l g u n"
  88.          BeginProperty Font
  89.             Name            =   "宋体"
  90.             Size            =   9
  91.             Charset         =   134
  92.             Weight          =   700
  93.             Underline       =   0   'False
  94.             Italic          =   0   'False
  95.             Strikethrough   =   0   'False
  96.          EndProperty
  97.          Height          =   180
  98.          Left            =   1320
  99.          TabIndex        =   11
  100.          Top             =   1770
  101.          Width           =   1365
  102.       End
  103.       Begin VB.Label lblTexts
  104.          AutoSize        =   -1  'True
  105.          BackStyle       =   0  'Transparent
  106.          Caption         =   "炮"
  107.          BeginProperty Font
  108.             Name            =   "宋体"
  109.             Size            =   56.25
  110.             Charset         =   134
  111.             Weight          =   400
  112.             Underline       =   0   'False
  113.             Italic          =   0   'False
  114.             Strikethrough   =   0   'False
  115.          EndProperty
  116.          Height          =   1125
  117.          Index           =   9
  118.          Left            =   2640
  119.          TabIndex        =   10
  120.          Top             =   840
  121.          Width           =   1125
  122.       End
  123.       Begin VB.Label lblTexts
  124.          AutoSize        =   -1  'True
  125.          BackStyle       =   0  'Transparent
  126.          Caption         =   "磁"
  127.          BeginProperty Font
  128.             Name            =   "宋体"
  129.             Size            =   48
  130.             Charset         =   134
  131.             Weight          =   400
  132.             Underline       =   0   'False
  133.             Italic          =   0   'False
  134.             Strikethrough   =   0   'False
  135.          EndProperty
  136.          Height          =   960
  137.          Index           =   8
  138.          Left            =   1800
  139.          TabIndex        =   9
  140.          Top             =   840
  141.          Width           =   960
  142.       End
  143.       Begin VB.Label lblTexts
  144.          AutoSize        =   -1  'True
  145.          BackStyle       =   0  'Transparent
  146.          Caption         =   "电"
  147.          BeginProperty Font
  148.             Name            =   "宋体"
  149.             Size            =   36
  150.             Charset         =   134
  151.             Weight          =   400
  152.             Underline       =   0   'False
  153.             Italic          =   0   'False
  154.             Strikethrough   =   0   'False
  155.          EndProperty
  156.          Height          =   720
  157.          Index           =   7
  158.          Left            =   1200
  159.          TabIndex        =   8
  160.          Top             =   960
  161.          Width           =   720
  162.       End
  163.       Begin VB.Label lblTexts
  164.          AutoSize        =   -1  'True
  165.          BackColor       =   &H80000012&
  166.          Caption         =   "超"
  167.          BeginProperty Font
  168.             Name            =   "宋体"
  169.             Size            =   48
  170.             Charset         =   134
  171.             Weight          =   400
  172.             Underline       =   0   'False
  173.             Italic          =   0   'False
  174.             Strikethrough   =   0   'False
  175.          EndProperty
  176.          ForeColor       =   &H80000005&
  177.          Height          =   960
  178.          Index           =   6
  179.          Left            =   240
  180.          TabIndex        =   7
  181.          Top             =   960
  182.          Width           =   960
  183.       End
  184.       Begin VB.Label lblTexts
  185.          AutoSize        =   -1  'True
  186.          BackStyle       =   0  'Transparent
  187.          Caption         =   "の"
  188.          BeginProperty Font
  189.             Name            =   "宋体"
  190.             Size            =   36
  191.             Charset         =   134
  192.             Weight          =   400
  193.             Underline       =   0   'False
  194.             Italic          =   0   'False
  195.             Strikethrough   =   0   'False
  196.          EndProperty
  197.          Height          =   720
  198.          Index           =   5
  199.          Left            =   2880
  200.          TabIndex        =   6
  201.          Top             =   240
  202.          Width           =   720
  203.       End
  204.       Begin VB.Label lblTexts
  205.          AutoSize        =   -1  'True
  206.          BackStyle       =   0  'Transparent
  207.          Caption         =   "学"
  208.          BeginProperty Font
  209.             Name            =   "宋体"
  210.             Size            =   36
  211.             Charset         =   134
  212.             Weight          =   400
  213.             Underline       =   0   'False
  214.             Italic          =   0   'False
  215.             Strikethrough   =   0   'False
  216.          EndProperty
  217.          Height          =   720
  218.          Index           =   4
  219.          Left            =   2280
  220.          TabIndex        =   5
  221.          Top             =   240
  222.          Width           =   720
  223.       End
  224.       Begin VB.Label lblTexts
  225.          AutoSize        =   -1  'True
  226.          BackStyle       =   0  'Transparent
  227.          Caption         =   "科"
  228.          BeginProperty Font
  229.             Name            =   "宋体"
  230.             Size            =   48
  231.             Charset         =   134
  232.             Weight          =   400
  233.             Underline       =   0   'False
  234.             Italic          =   0   'False
  235.             Strikethrough   =   0   'False
  236.          EndProperty
  237.          Height          =   960
  238.          Index           =   3
  239.          Left            =   1380
  240.          TabIndex        =   4
  241.          Top             =   0
  242.          Width           =   960
  243.       End
  244.       Begin VB.Label lblTexts
  245.          AutoSize        =   -1  'True
  246.          BackStyle       =   0  'Transparent
  247.          Caption         =   "る"
  248.          BeginProperty Font
  249.             Name            =   "宋体"
  250.             Size            =   27.75
  251.             Charset         =   134
  252.             Weight          =   400
  253.             Underline       =   0   'False
  254.             Italic          =   0   'False
  255.             Strikethrough   =   0   'False
  256.          EndProperty
  257.          Height          =   555
  258.          Index           =   2
  259.          Left            =   1020
  260.          TabIndex        =   3
  261.          Top             =   120
  262.          Width           =   555
  263.       End
  264.       Begin VB.Label lblTexts
  265.          AutoSize        =   -1  'True
  266.          BackStyle       =   0  'Transparent
  267.          Caption         =   "あ"
  268.          BeginProperty Font
  269.             Name            =   "宋体"
  270.             Size            =   36
  271.             Charset         =   134
  272.             Weight          =   400
  273.             Underline       =   0   'False
  274.             Italic          =   0   'False
  275.             Strikethrough   =   0   'False
  276.          EndProperty
  277.          Height          =   720
  278.          Index           =   1
  279.          Left            =   600
  280.          TabIndex        =   2
  281.          Top             =   240
  282.          Width           =   720
  283.       End
  284.       Begin VB.Label lblTexts
  285.          AutoSize        =   -1  'True
  286.          BackStyle       =   0  'Transparent
  287.          Caption         =   "と"
  288.          BeginProperty Font
  289.             Name            =   "宋体"
  290.             Size            =   56.25
  291.             Charset         =   134
  292.             Weight          =   400
  293.             Underline       =   0   'False
  294.             Italic          =   0   'False
  295.             Strikethrough   =   0   'False
  296.          EndProperty
  297.          Height          =   1125
  298.          Index           =   0
  299.          Left            =   -120
  300.          TabIndex        =   1
  301.          Top             =   -120
  302.          Width           =   1125
  303.       End
  304.    End
  305.    Begin VB.Label lblText
  306.       AutoSize        =   -1  'True
  307.       Caption         =   "文本:"
  308.       Height          =   180
  309.       Left            =   120
  310.       TabIndex        =   12
  311.       Top             =   120
  312.       Width           =   540
  313.    End
  314. End
  315. Attribute VB_Name = "frmMain"
  316. Attribute VB_GlobalNameSpace = False
  317. Attribute VB_Creatable = False
  318. Attribute VB_PredeclaredId = True
  319. Attribute VB_Exposed = False
  320. '==============================================================================
  321. '作者:0xAA55
  322. '论坛:[url]http://www.0xaa55.com/[/url]
  323. '版权所有(C) 2013-2014 技术宅的结界
  324. '请保留原作者信息,否则视为侵权
  325. '------------------------------------------------------------------------------
  326. Option Explicit
  327. Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
  328. Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
  329. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

  330. '窗口加载
  331. Private Sub Form_Load()
  332. UpdateClr
  333. End Sub

  334. '更新颜色,使每个标签都使用设定的颜色
  335. Sub UpdateClr()

  336. lblBottom.ForeColor = cmdColor2.BackColor '小字的颜色

  337. '大字的颜色
  338. lblTexts(0).ForeColor = cmdColor2.BackColor
  339. lblTexts(1).ForeColor = cmdColor2.BackColor
  340. lblTexts(2).ForeColor = cmdColor2.BackColor
  341. lblTexts(3).ForeColor = cmdColor2.BackColor
  342. lblTexts(4).ForeColor = cmdColor2.BackColor
  343. lblTexts(5).ForeColor = cmdColor2.BackColor
  344. lblTexts(7).ForeColor = cmdColor2.BackColor
  345. lblTexts(8).ForeColor = cmdColor2.BackColor
  346. lblTexts(9).ForeColor = cmdColor2.BackColor

  347. '图片框的颜色
  348. picPreview.BackColor = cmdColor1.BackColor

  349. '那个背景色和前景色颠倒的字“超”
  350. lblTexts(6).ForeColor = cmdColor1.BackColor
  351. lblTexts(6).BackColor = cmdColor2.BackColor
  352. End Sub

  353. '选取颜色1,背景色
  354. Private Sub cmdColor1_Click()
  355. Dim DlgObj As Object
  356. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  357. DlgObj.Color = cmdColor1.BackColor
  358. DlgObj.ShowColor
  359. cmdColor1.BackColor = DlgObj.Color
  360. UpdateClr '选好颜色后更新那些字
  361. End Sub

  362. '选取颜色2,前景色
  363. Private Sub cmdColor2_Click()
  364. Dim DlgObj As Object
  365. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  366. DlgObj.Color = cmdColor2.BackColor
  367. DlgObj.ShowColor
  368. cmdColor2.BackColor = DlgObj.Color
  369. UpdateClr
  370. End Sub

  371. '选取字体
  372. Private Sub cmdFont_Click()
  373. Dim DlgObj As Object
  374. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  375. DlgObj.FontName = cmdFont.Caption
  376. DlgObj.ShowFont
  377. cmdFont.Caption = DlgObj.FontName

  378. Dim I&
  379. For I = 0 To lblTexts.UBound
  380.     With lblTexts(I).Font
  381.         .Name = DlgObj.FontName
  382.         .Italic = DlgObj.FontItalic
  383.         .Bold = DlgObj.FontBold
  384.         .Underline = DlgObj.FontUnderline
  385.     End With
  386. Next
  387. End Sub

  388. '双击小字的时候改变小字的字体
  389. Private Sub lblBottom_DblClick()
  390. Dim DlgObj As Object
  391. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  392. DlgObj.FontName = cmdFont.Caption
  393. DlgObj.ShowFont
  394. cmdFont.Caption = DlgObj.FontName

  395. With lblBottom.Font
  396.     .Name = DlgObj.FontName
  397.     .Italic = DlgObj.FontItalic
  398.     .Bold = DlgObj.FontBold
  399.     .Underline = DlgObj.FontUnderline
  400. End With
  401. End Sub

  402. '保存按钮
  403. Private Sub cmdSave_Click()
  404. Dim DlgObj As Object
  405. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  406. DlgObj.Filter = "24位BMP位图(*.bmp)|*.bmp|显示所有文件(*.*)|*.*"
  407. DlgObj.ShowSave '显示保存对话框
  408. If Len(DlgObj.FileName) Then SavePic DlgObj.FileName
  409. End Sub

  410. '恢复原始文本
  411. Private Sub cmdSetOrgText_Click()
  412. Text1.Text = "とある科学の超电磁炮"
  413. Text2.Text = "Railgun"
  414. End Sub

  415. '图片框按下按键后复制图片到剪贴板
  416. Private Sub picPreview_KeyDown(KeyCode As Integer, Shift As Integer)
  417. If (Shift And 2) And KeyCode = vbKeyC Then
  418.     CopyPic
  419. End If
  420. End Sub

  421. '这些字被点中的时候,把焦点设置给图片框,以便于接收Ctrl+C的按键
  422. Private Sub lblTexts_Click(Index As Integer)
  423. picPreview.SetFocus
  424. End Sub

  425. Private Sub lblBottom_Click()
  426. picPreview.SetFocus
  427. End Sub

  428. '修改文本的时候显示效果
  429. Private Sub Text1_Change()
  430. On Error Resume Next
  431. Dim I&, L&, T$
  432. T = Text1.Text
  433. L = Len(T)
  434. For I = 0 To lblTexts.UBound
  435.     lblTexts(I).Caption = Mid$(T, I + 1, 1)
  436.     If I >= L Then Exit For
  437. Next
  438. End Sub

  439. '这里是那行小字的显示
  440. Private Sub Text2_Change()
  441. On Error Resume Next
  442. Dim I&, L&, T$, TSet$
  443. T = Text2.Text
  444. L = Len(T)
  445. If L Then
  446.     For I = 0 To L
  447.         TSet = TSet & Mid$(T, I + 1, 1) & " " '每隔一个字符添加一个空格
  448.     Next
  449.     lblBottom.Caption = Left$(TSet, Len(TSet) - 1)
  450. Else
  451.     lblBottom.Caption = ""
  452. End If
  453. End Sub

  454. '保存图片
  455. Sub SavePic(ByVal Path$)
  456. picPreview.AutoRedraw = True '让图片框拥有后台缓冲区,这样就能使用VB自带的SavePicture保存图片了

  457. Dim PrvDC As Long
  458. PrvDC = GetDC(picPreview.hWnd) '表面的hDC

  459. '将看到的内容画到图片框的后台缓冲区中
  460. BitBlt picPreview.hdc, 0, 0, picPreview.ScaleWidth, picPreview.ScaleHeight, PrvDC, 0, 0, vbSrcCopy
  461. ReleaseDC picPreview.hWnd, PrvDC

  462. picPreview.Refresh '这行代码大概可有可无,刷新一下比较好
  463. SavePicture picPreview.Image, Path '保存缓冲区的图片

  464. picPreview.Cls
  465. picPreview.AutoRedraw = False
  466. picPreview.Cls
  467. End Sub

  468. '复制图片
  469. Private Sub CopyPic()
  470. picPreview.AutoRedraw = True

  471. Dim PrvDC As Long
  472. PrvDC = GetDC(picPreview.hWnd)
  473. BitBlt picPreview.hdc, 0, 0, picPreview.ScaleWidth, picPreview.ScaleHeight, PrvDC, 0, 0, vbSrcCopy
  474. ReleaseDC picPreview.hWnd, PrvDC

  475. picPreview.Refresh
  476. Clipboard.SetData picPreview.Image, vbCFBitmap

  477. picPreview.Cls
  478. picPreview.AutoRedraw = False
  479. End Sub
复制代码
BIN下载: 某科学超电磁炮.7z (6.54 KB, 下载次数: 8)
SRC下载: 某科学超电磁炮SRC.7z (9.51 KB, 下载次数: 5)

本帖被以下淘专辑推荐:

回复

使用道具 举报

12

主题

35

回帖

959

积分

用户组: 大·技术宅

UID
3517
精华
1
威望
36 点
宅币
802 个
贡献
33 次
宅之契约
0 份
在线时间
207 小时
注册时间
2018-3-2
发表于 2018-3-3 19:48:24 | 显示全部楼层
标签过分了
回复 赞! 靠!

使用道具 举报

4

主题

28

回帖

289

积分

用户组: 中·技术宅

UID
5449
精华
0
威望
6 点
宅币
245 个
贡献
0 次
宅之契约
0 份
在线时间
42 小时
注册时间
2019-12-13
发表于 2020-7-21 15:44:11 | 显示全部楼层
科学超电磁炮是竖着的
魔法禁书目录是横着的
回复 赞! 靠!

使用道具 举报

1

主题

157

回帖

605

积分

用户组: 大·技术宅

UID
7535
精华
0
威望
0 点
宅币
447 个
贡献
0 次
宅之契约
0 份
在线时间
68 小时
注册时间
2021-10-16
发表于 2022-5-9 16:19:59 | 显示全部楼层

楼主大能,感谢感谢
回复 赞! 靠!

使用道具 举报

55

主题

271

回帖

9330

积分

用户组: 管理员

UID
77
精华
16
威望
237 点
宅币
8199 个
贡献
251 次
宅之契约
0 份
在线时间
253 小时
注册时间
2014-2-22
发表于 2022-5-9 17:35:36 | 显示全部楼层
卧槽,头一次知道可以用CreateObject的方式来调用公用对话框。

不过每次看到CreateObject就会想起ObCreateObject。
回复 赞! 靠!

使用道具 举报

QQ|Archiver|小黑屋|技术宅的结界 ( 滇ICP备16008837号 )|网站地图

GMT+8, 2024-3-29 19:28 , Processed in 0.047446 second(s), 37 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表