| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1337 人关注过本帖
标题:我的一个小程序[贴图帮手]
只看楼主 加入收藏
griefforyou
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:3336
专家分:0
注 册:2004-4-15
收藏
 问题点数:0 回复次数:6 
我的一个小程序[贴图帮手]
[attach]54[/attach]
搜索更多相关主题的帖子: 贴图 
2004-04-22 23:25
griefforyou
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:3336
专家分:0
注 册:2004-4-15
收藏
得分:0 
:( 居然没人看

天津网站建设 http://www./
2004-04-26 15:28
griefforyou
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:3336
专家分:0
注 册:2004-4-15
收藏
得分:0 
主窗体的源代码

Option Explicit

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Const SWP_NOSIZE = &H1 Private Const SWP_NOMOVE = &H2 Private Const HWND_TOPMOST = -1 Private Const HWND_NOTOPMOST = -2

Private Sub Check1_Click() If Check1.Value = 1 Then Picture1.FontBold = True Else Picture1.FontBold = False End If End Sub

Private Sub Check2_Click() If Check2.Value = 1 Then Picture1.FontItalic = True Else Picture1.FontItalic = False End If End Sub

Private Sub Check3_Click() If Check3.Value = 1 Then SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Else SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE End If End Sub

Private Sub Command1_Click() On Error Resume Next Dim TxtWidth As Integer, TxtHeight As Integer Dim TxtColor As Long Dim i As Integer, j As Integer Dim tempStr As String Me.MousePointer = 11 With Picture1 If Not IsNumeric(Combo2.Text) Then MsgBox "字体大小错误!", vbInformation, "提示" Exit Sub Else .FontSize = Val(Combo2.Text) End If .Cls .AutoRedraw = True .FontName = Combo1.Text Picture1.Print Text1.Text TxtWidth = .TextWidth(Text1.Text) TxtHeight = .TextHeight(Text1.Text) End With Text2.Text = "" tempStr = "" For i = 0 To TxtHeight - 1 For j = 0 To TxtWidth - 1 TxtColor = GetPixel(Picture1.hdc, j, i) If TxtColor <> Picture1.BackColor Then tempStr = tempStr & Combo3.Text Else tempStr = tempStr & Combo4.Text End If Next tempStr = tempStr & vbCrLf Next Text2.Text = tempStr Me.MousePointer = 0 End Sub

Private Sub Command2_Click() Clipboard.Clear Clipboard.SetText Text2.Text End Sub

Private Sub Command3_Click() Unload Me End Sub

Private Sub Form_Load() On Error Resume Next Dim i As Integer Dim Str As String Picture1.BackColor = vbWhite Picture1.ForeColor = vbBlack For i = 0 To Screen.FontCount - 1 Combo1.AddItem Screen.Fonts(i) Next Combo1.Text = "宋体" Combo2.AddItem 9 Combo2.AddItem 10 Combo2.AddItem 12 Combo2.AddItem 15 Str = "§№☆★○●◎◇◆□■△▲※→←↑↓〓$£¥·?‖~《》「」『』〖〗【】 " For i = 1 To Len(Str) Combo3.AddItem Mid(Str, i, 1) Combo4.AddItem Mid(Str, i, 1) Next Combo3.Text = "★" Combo4.Text = " " Randomize End Sub

Private Sub Form_Resize() If Me.WindowState = 0 Then Me.Width = 6750 Me.Height = 6000 ElseIf Me.WindowState = 1 Then sysTrayOcx1.AddToTray Me Me.Hide End If End Sub

Private Sub sysTrayOcx1_DblClick(Button As Integer) Me.WindowState = 0 Me.Visible = True sysTrayOcx1.RemoveFromTray End Sub

Private Sub Timer1_Timer() Label9.Left = Label9.Left - 30 Label9.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255) If Label9.Left < -Label9.Width Then Label9.Left = 3165 End If End Sub


天津网站建设 http://www./
2004-04-26 20:40
headbegger
Rank: 1
等 级:新手上路
帖 子:8
专家分:0
注 册:2004-4-30
收藏
得分:0 

支持楼主,又学到不少

不解,生成的文本是在TEXT2中吗?那picture1控件有何用?不知道您设计的窗体是什么样的,能不能传上你的工程(不仅是代码)。

2004-04-30 23:13
tvrc200379
Rank: 1
等 级:新手上路
帖 子:351
专家分:0
注 册:2004-3-30
收藏
得分:0 
下了,看看!

我是灌水天堂的新版主,请新老用户来报道啊 (欢迎来灌水。。。) 哈哈哈。。。。 http://websx.home./bbs/list.asp?boardid=35
2004-05-03 15:55
tvrc200379
Rank: 1
等 级:新手上路
帖 子:351
专家分:0
注 册:2004-3-30
收藏
得分:0 
sysTrayOcx1是什么东东啊!

我是灌水天堂的新版主,请新老用户来报道啊 (欢迎来灌水。。。) 哈哈哈。。。。 http://websx.home./bbs/list.asp?boardid=35
2004-05-03 16:03
griefforyou
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:3336
专家分:0
注 册:2004-4-15
收藏
得分:0 

sysTrayOcx1是我自已写的系统栏控件,可以把窗体图标放到系统栏,还可以处理系统栏图标的事件!


天津网站建设 http://www./
2004-05-06 13:41
快速回复:我的一个小程序[贴图帮手]
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.020848 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved