自己编的真正支持中文quickmark QR码PC端制作器,10月11日加写短信及图片颜色功能！

Jeffrey82

                               
登录/注册后可看大图

2006年10月11日新增写短信发送功能 , 及图片颜色功能

下载后解压缩到同一个目录中

运行前先将MW6Matrix字体文件拷贝到C:/WINDOWS/FONTS目录下才可运行

如果提示缺少OCX文件,请麻烦下载相应的OCX文件,放到C:\WINDOWS\system32就可以了

Psytec QR Code Editor制作的全是乱码，我这个制作的用手机能正确识别中文


这个程序是７月编的，后来失去兴趣了，就这样了，没有完善，也不高兴做成安装文件了

所以大家如果用的话，文件是要自己拷到相应位置，因为我用ＶＢ编的，可能有些系统没有ＯＣＸ控件，所以要下载一个，我已经传上来了

用ＱＵＩＣＫＭＡＲＫ绝对能正确识别中文，其他手机端不一定能用

[ 本帖最后由 Jeffrey82 于 2006-10-11 13:44 编辑 ]

Jeffrey82

                               
登录/注册后可看大图

                               
登录/注册后可看大图

                               
登录/注册后可看大图

                               
登录/注册后可看大图

                               
登录/注册后可看大图

开源

贴一些核心源码,有兴趣的可以研究一下

Private Declare Function ReleaseDC Lib "user32" _
  (ByVal hwnd As Long, _
  ByVal hdc As Long _
  ) As Long
Private Declare Function OpenClipboard Lib "user32" _
  (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" _
  (ByVal wFormat As Long, _
  ByVal hMem As Long _
  ) As Long
Private Declare Function SelectObject Lib "gdi32" _
  (ByVal hdc As Long, _
  ByVal hObject As Long _
  ) As Long
Private Declare Function DeleteDC Lib "gdi32" _
  (ByVal hdc As Long) As Long
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
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
  (ByVal lpDriverName As String, _
  ByVal lpDeviceName As String, _
  ByVal lpOutput As String, _
  lpInitData As Long _
  ) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
  (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
  (ByVal hdc As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long _
  ) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long


Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type


Private Declare Sub QRCodeEncode Lib "QRCodeFont.dll" _
(ByVal Message As String, ByVal Version As Integer, ByVal Level As Integer, ByVal Mask As Integer)

Private Declare Sub keybd_event Lib "user32" (ByVal bvk As Byte, ByVal bscan As Byte, ByVal dwflags As Long, ByVal dwextrainfo As Long)
Private Const keyeventf_keyup = &H2



Private Declare Function QRCodeGetRows Lib "QRCodeFont.dll" () As Integer
Private Declare Function QRCodeGetCols Lib "QRCodeFont.dll" () As Integer
Private Declare Function QRCodeGetCharAt Lib "QRCodeFont.dll" (ByVal RowIndex As Integer, ByVal ColIndex As Integer) As Integer

'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wmsg As Long, ByVal wParam As Long, ByVal IParam As String) As Long

'__________________________________________________________________________
Private Sub Command1_Click()
  Message = Text1.Text
  ' Version
  Version = cbxVersion.ListIndex

  ' Level
  ' 0: L - recovery rate 7%
  ' 1: M - recovery rate 15%
  ' 2: Q - recovery rate 25%
  ' 3: H - recovery rate 30%
  Level = cbxLevel.ListIndex

  ' Mask
  Mask = cbxMask.ListIndex
  
  Call QRCodeEncode(Message, Version, Level, Mask)

  txtQRCode.Text = ""
  txtQRCode.F
  txtQRCode.FontSize = CInt(cbxFontSize.Text)
  
  ' how many rows?
  RowCount = QRCodeGetRows
  
  ' how many characters in one row?
  ColCount = QRCodeGetCols
  
  ' produce string for QRCode font
  EncodedMsg = vbCrLf
  For I = 1 To RowCount
    For J = 1 To ColCount
        EncodedMsg = EncodedMsg & Chr(QRCodeGetCharAt(I - 1, J - 1))
    Next J
    EncodedMsg = EncodedMsg & vbCrLf
  Next I
  txtQRCode.Text = EncodedMsg

End Sub

[ 本帖最后由 Jeffrey82 于 2006-10-12 12:53 编辑 ]

Jeffrey82

为什么能支持中文,我的思路是这样的
I = Len(TmpTxt.Text)
For J = 1 To I
  Sr = Mid(TmpTxt.Text, J, 1)
  Adodc1.RecordSource = "select * from b1 where gb=" + "'" + Sr + "'"
  Adodc1.Refresh
  If Adodc1.Recordset.RecordCount <= 0 Then
  Text1.Text = Sc
  Else


  Sc = Sc + Adodc1.Recordset.Fields("jis").Value
  Text1.Text = Sc
  End If
Next J

kidsun7

对编程不了解.支持你.QuickMark 官网的QR码不支持中文吗?好像我试了.可以的啊?

Jeffrey82

原帖由 kidsun7 于 2006-10-3 09:21 发表
对编程不了解.支持你.QuickMark 官网的QR码不支持中文吗?好像我试了.可以的啊?

我说的是PC端,他们官方没有PC端吧,呵呵,一时兴趣编的

当然,他们官方网站做出来的当然最好

没有说话

。。。好深奥，只能顶下大虾了

9000

我太P服你了，我找了很多方式解决这个问题，但都没有你完美，看来还得依赖编程

Jeffrey82

之前我也是找了很多方法都不行,后来索性自己编一个算了

9000

有一点小建议！不能直接发短信，要先通过发电子邮件再复制，有点麻烦！还有不能发给不支持繁体的手机，不然全是乱码，比如我遇到的联想V510！人家不知道我发的什么东东！

9000

我原来用了，个转码软件进行中转，输完文字后，按一个快捷键，转成SHIFT JIS
但日文里头有些中文汉字没有！而且不能直接发短信，就没有用了！用的还是WEB在线版

Jeffrey82

原帖由 9000 于 2006-10-3 10:06 发表
有一点小建议！不能直接发短信，要先通过发电子邮件再复制，有点麻烦！还有不能发给不支持繁体的手机，不然全是乱码，比如我遇到的联想V510！人家不知道我发的什么东东！

等有时间再加个写短信的功能

不支持繁体没办法

因为ＱＲ码的国际标准是日文ＳＨＩＦＴ－ＪＩＳ码，我就是利用里面有相应的中文汉字，转换成中文只有繁体，解决不了啊

segalgx

支持兄弟

西门之客

LZ自己编写的？

Jeffrey82

原帖由 西门之客 于 2006-10-3 10:37 发表
LZ自己编写的？

标题已经写得很清楚了吧

kaneyet

呵呵，支持啊！！原来论坛还是好兴旺的！！！！:lol

clouse003

很厉害啊,LZ

gbluo324

支持楼主!

theozjy123

有是牛人一个~~~~强顶中~~~~~~~~

pcibm-2006

rtttttttttttttttttttttttttyu

pcibm-2006

不能用，说运行错误“380”