设为首页收藏一下又不会死！新人公告
切换到窄版

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

QQ登录

只需一步，快速开始

搜索
热搜: 下载 VB C 实现 编写
技术宅的结界»论坛 › 计算机技术 › 源码分享 › 【VB】某科学超电磁炮（入门向）
返回列表 发新帖
查看: 5974|回复: 4

【VB】某科学超电磁炮（入门向）

[复制链接]
0xAA55
发表于 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

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

  336. '更新颜色，使每个标签都使用设定的颜色
  337. Sub UpdateClr()

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

  341. '大字的颜色
  342. lblTexts(0).ForeColor = cmdColor2.BackColor
  343. lblTexts(1).ForeColor = cmdColor2.BackColor
  344. lblTexts(2).ForeColor = cmdColor2.BackColor
  345. lblTexts(3).ForeColor = cmdColor2.BackColor
  346. lblTexts(4).ForeColor = cmdColor2.BackColor
  347. lblTexts(5).ForeColor = cmdColor2.BackColor
  348. lblTexts(7).ForeColor = cmdColor2.BackColor
  349. lblTexts(8).ForeColor = cmdColor2.BackColor
  350. lblTexts(9).ForeColor = cmdColor2.BackColor

  352. '图片框的颜色
  353. picPreview.BackColor = cmdColor1.BackColor

  355. '那个背景色和前景色颠倒的字“超”
  356. lblTexts(6).ForeColor = cmdColor1.BackColor
  357. lblTexts(6).BackColor = cmdColor2.BackColor
  358. End Sub

  360. '选取颜色1，背景色
  361. Private Sub cmdColor1_Click()
  362. Dim DlgObj As Object
  363. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  364. DlgObj.Color = cmdColor1.BackColor
  365. DlgObj.ShowColor
  366. cmdColor1.BackColor = DlgObj.Color
  367. UpdateClr '选好颜色后更新那些字
  368. End Sub

  370. '选取颜色2，前景色
  371. Private Sub cmdColor2_Click()
  372. Dim DlgObj As Object
  373. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  374. DlgObj.Color = cmdColor2.BackColor
  375. DlgObj.ShowColor
  376. cmdColor2.BackColor = DlgObj.Color
  377. UpdateClr
  378. End Sub

  380. '选取字体
  381. Private Sub cmdFont_Click()
  382. Dim DlgObj As Object
  383. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  384. DlgObj.FontName = cmdFont.Caption
  385. DlgObj.ShowFont
  386. cmdFont.Caption = DlgObj.FontName

  388. Dim I&
  389. For I = 0 To lblTexts.UBound
  390.     With lblTexts(I).Font
  391.         .Name = DlgObj.FontName
  392.         .Italic = DlgObj.FontItalic
  393.         .Bold = DlgObj.FontBold
  394.         .Underline = DlgObj.FontUnderline
  395.     End With
  396. Next
  397. End Sub

  399. '双击小字的时候改变小字的字体
  400. Private Sub lblBottom_DblClick()
  401. Dim DlgObj As Object
  402. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  403. DlgObj.FontName = cmdFont.Caption
  404. DlgObj.ShowFont
  405. cmdFont.Caption = DlgObj.FontName

  407. With lblBottom.Font
  408.     .Name = DlgObj.FontName
  409.     .Italic = DlgObj.FontItalic
  410.     .Bold = DlgObj.FontBold
  411.     .Underline = DlgObj.FontUnderline
  412. End With
  413. End Sub

  415. '保存按钮
  416. Private Sub cmdSave_Click()
  417. Dim DlgObj As Object
  418. Set DlgObj = CreateObject("MSComDlg.CommonDialog")
  419. DlgObj.Filter = "24位BMP位图(*.bmp)|*.bmp|显示所有文件(*.*)|*.*"
  420. DlgObj.ShowSave '显示保存对话框
  421. If Len(DlgObj.FileName) Then SavePic DlgObj.FileName
  422. End Sub

  424. '恢复原始文本
  425. Private Sub cmdSetOrgText_Click()
  426. Text1.Text = "とある科学の超电磁炮"
  427. Text2.Text = "Railgun"
  428. End Sub

  430. '图片框按下按键后复制图片到剪贴板
  431. Private Sub picPreview_KeyDown(KeyCode As Integer, Shift As Integer)
  432. If (Shift And 2) And KeyCode = vbKeyC Then
  433.     CopyPic
  434. End If
  435. End Sub

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

  442. Private Sub lblBottom_Click()
  443. picPreview.SetFocus
  444. End Sub

  446. '修改文本的时候显示效果
  447. Private Sub Text1_Change()
  448. On Error Resume Next
  449. Dim I&, L&, T$
  450. T = Text1.Text
  451. L = Len(T)
  452. For I = 0 To lblTexts.UBound
  453.     lblTexts(I).Caption = Mid$(T, I + 1, 1)
  454.     If I >= L Then Exit For
  455. Next
  456. End Sub

  458. '这里是那行小字的显示
  459. Private Sub Text2_Change()
  460. On Error Resume Next
  461. Dim I&, L&, T$, TSet$
  462. T = Text2.Text
  463. L = Len(T)
  464. If L Then
  465.     For I = 0 To L
  466.         TSet = TSet & Mid$(T, I + 1, 1) & " " '每隔一个字符添加一个空格
  467.     Next
  468.     lblBottom.Caption = Left$(TSet, Len(TSet) - 1)
  469. Else
  470.     lblBottom.Caption = ""
  471. End If
  472. End Sub

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

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

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

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

  488. picPreview.Cls
  489. picPreview.AutoRedraw = False
  490. picPreview.Cls
  491. End Sub

  493. '复制图片
  494. Private Sub CopyPic()
  495. picPreview.AutoRedraw = True

  497. Dim PrvDC As Long
  498. PrvDC = GetDC(picPreview.hWnd)
  499. BitBlt picPreview.hdc, 0, 0, picPreview.ScaleWidth, picPreview.ScaleHeight, PrvDC, 0, 0, vbSrcCopy
  500. ReleaseDC picPreview.hWnd, PrvDC

  502. picPreview.Refresh
  503. Clipboard.SetData picPreview.Image, vbCFBitmap

  505. picPreview.Cls
  506. picPreview.AutoRedraw = False
  507. End Sub
复制代码
BIN下载： 某科学超电磁炮.7z (6.54 KB, 下载次数: 9)
SRC下载： 某科学超电磁炮SRC.7z (9.51 KB, 下载次数: 8)
科学超电磁炮, VB6, CreateObject, 公用对话框, COM

本帖被以下淘专辑推荐:

相关帖子
回复

使用道具 举报

Tao0Lu
发表于 2018-3-3 19:48:24 | 显示全部楼层
标签过分了
回复 赞！ 靠！

使用道具 举报

德小SHUO
发表于 2020-7-21 15:44:11 | 显示全部楼层
科学超电磁炮是竖着的
魔法禁书目录是横着的
回复 赞！ 靠！

使用道具 举报

xiawan
发表于 2022-5-9 16:19:59 | 显示全部楼层

楼主大能，感谢感谢
回复 赞！ 靠！

使用道具 举报

Golden Blonde
发表于 2022-5-9 17:35:36 | 显示全部楼层
卧槽，头一次知道可以用CreateObject的方式来调用公用对话框。

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

使用道具 举报

返回列表 发新帖

本版积分规则

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

GMT+8, 2024-11-23 17:41 , Processed in 0.040548 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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