svnno****@sourc*****
svnno****@sourc*****
2011年 1月 6日 (木) 22:04:29 JST
Revision: 1327
http://sourceforge.jp/projects/tween/svn/view?view=rev&revision=1327
Author: anis774
Date: 2011-01-06 22:04:29 +0900 (Thu, 06 Jan 2011)
Log Message:
-----------
もう眠いよパトラッシュ…
Modified Paths:
--------------
branches/OperationClean/Tween/PostBrowser.vb
branches/OperationClean/Tween/PostView.vb
-------------- next part --------------
Modified: branches/OperationClean/Tween/PostBrowser.vb
===================================================================
--- branches/OperationClean/Tween/PostBrowser.vb 2011-01-06 08:01:31 UTC (rev 1326)
+++ branches/OperationClean/Tween/PostBrowser.vb 2011-01-06 13:04:29 UTC (rev 1327)
@@ -1,5 +1,7 @@
Imports System.Text.RegularExpressions
Imports System.Text
+Imports System.Web
+Imports System.Reflection
Public Class PostBrowser
Private Const detailHtmlFormatMono1 As String = "<html><head><style type=""text/css""><!-- pre {font-family: """
@@ -168,4 +170,105 @@
Public Function createDetailHtml(ByVal orgdata As String) As String
Return Me.detailHtmlFormatHeader + orgdata + Me.detailHtmlFormatFooter
End Function
+
+ Private Sub PostBrowser_Navigated(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserNavigatedEventArgs) Handles WebBrowser1.Navigated
+ If e.Url.AbsoluteUri <> "about:blank" Then
+ Me.Post = Me.Post
+ Dim hoge = Me.OpenUriAsync
+ hoge(e.Url.OriginalString) 'wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
+ End If
+ End Sub
+
+ Private Sub PostBrowser_Navigating(ByVal sender As System.Object, ByVal e As System.Windows.Forms.WebBrowserNavigatingEventArgs) Handles WebBrowser1.Navigating
+ If e.Url.Scheme = "data" Then
+ Me.StatusText = Me.WebBrowser1.StatusText.Replace("&", "&&")
+ ElseIf e.Url.AbsoluteUri <> "about:blank" Then
+ e.Cancel = True
+
+ If e.Url.AbsoluteUri.StartsWith("http://twitter.com/search?q=%23") OrElse _
+ e.Url.AbsoluteUri.StartsWith("https://twitter.com/search?q=%23") Then
+ 'ハッシュタグの場合は、タブで開く
+ Dim urlStr As String = HttpUtility.UrlDecode(e.Url.AbsoluteUri)
+ Dim hash As String = urlStr.Substring(urlStr.IndexOf("#"))
+ HashSupl.AddItem(hash)
+ HashMgr.AddHashToHistory(hash.Trim, False)
+ Dim hoge = Me.AddNewTabForSearch
+ hoge(hash)
+ Exit Sub
+ Else
+ Dim m As Match = Regex.Match(e.Url.AbsoluteUri, "^https?://twitter.com/(#!/)?(?<name>[a-zA-Z0-9_]+)$")
+ If m.Success AndAlso IsTwitterId(m.Result("${name}")) Then
+ Dim hoge = Me.AddNewTabForUserTimeline
+ hoge(m.Result("${name}"))
+ Else
+ Dim hoge = Me.OpenUriAsync
+ hoge(e.Url.OriginalString)
+ End If
+ End If
+ End If
+ End Sub
+
+ Private Sub PostBrowser_StatusTextChanged(ByVal sender As Object, ByVal e As EventArgs) Handles WebBrowser1.StatusTextChanged
+ If Me.WebBrowser1.StatusText.StartsWith("http") OrElse Me.WebBrowser1.StatusText.StartsWith("ftp") _
+ OrElse Me.WebBrowser1.StatusText.StartsWith("data") Then
+ Me.StatusText = Me.WebBrowser1.StatusText.Replace("&", "&&")
+ End If
+ End Sub
+
+ Private Sub ScrollDownPostBrowser(ByVal forward As Boolean)
+ Dim doc As HtmlDocument = Me.WebBrowser1.Document
+ If doc Is Nothing Then Exit Sub
+ If doc.Body Is Nothing Then Exit Sub
+
+ If forward Then
+ doc.Body.ScrollTop += AppendSettingDialog.Instance.FontDetail.Height
+ Else
+ doc.Body.ScrollTop -= AppendSettingDialog.Instance.FontDetail.Height
+ End If
+ End Sub
+
+ Private Sub PageDownPostBrowser(ByVal forward As Boolean)
+ Dim doc As HtmlDocument = Me.WebBrowser1.Document
+ If doc Is Nothing Then Exit Sub
+ If doc.Body Is Nothing Then Exit Sub
+
+ If forward Then
+ doc.Body.ScrollTop += Me.WebBrowser1.ClientRectangle.Height - AppendSettingDialog.Instance.FontDetail.Height
+ Else
+ doc.Body.ScrollTop -= Me.WebBrowser1.ClientRectangle.Height - AppendSettingDialog.Instance.FontDetail.Height
+ End If
+ End Sub
+
+ Public Function WebBrowser_GetSelectionText(ByRef ComponentInstance As WebBrowser) As String
+ '発言詳細で「選択文字列をコピー」を行う
+ 'WebBrowserコンポーネントのインスタンスを渡す
+ Dim typ As Type = ComponentInstance.ActiveXInstance.GetType()
+ Dim _SelObj As Object = typ.InvokeMember("selection", BindingFlags.GetProperty, Nothing, ComponentInstance.Document.DomDocument, Nothing)
+ Dim _objRange As Object = _SelObj.GetType().InvokeMember("createRange", BindingFlags.InvokeMethod, Nothing, _SelObj, Nothing)
+ Return DirectCast(_objRange.GetType().InvokeMember("text", BindingFlags.GetProperty, Nothing, _objRange, Nothing), String)
+ End Function
+
+ Public Event StatusTextChanged(ByVal sender As Object, ByVal e As EventArgs)
+
+ Private _statusText As String
+ Public Property StatusText() As String
+ Get
+ Return _statusText
+ End Get
+ Private Set(ByVal value As String)
+ Dim needRaiseEvent As Boolean = Me._statusText <> value
+ _statusText = value
+ If needRaiseEvent Then
+ RaiseEvent StatusTextChanged(Me, EventArgs.Empty)
+ End If
+ End Set
+ End Property
+
+
+ Public Property OpenUriAsync As Action(Of String)
+ Public Property HashSupl As AtIdSupplement
+ Public Property HashMgr As HashtagManage
+ Public Property AddNewTabForSearch As Action(Of String)
+ Public Property IsTwitterId As Func(Of String, Boolean)
+ Public Property AddNewTabForUserTimeline As Action(Of String)
End Class
Modified: branches/OperationClean/Tween/PostView.vb
===================================================================
--- branches/OperationClean/Tween/PostView.vb 2011-01-06 08:01:31 UTC (rev 1326)
+++ branches/OperationClean/Tween/PostView.vb 2011-01-06 13:04:29 UTC (rev 1327)
@@ -70,8 +70,45 @@
End Get
End Property
+ Private Sub SourceLinkLabel_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles SourceLinkLabel.LinkClicked
+ Dim link As String = CType(SourceLinkLabel.Tag, String)
+ If Not String.IsNullOrEmpty(link) Then
+ Dim hoge = Me.OpenUriAsync
+ hoge(link)
+ End If
+ End Sub
+
+ Private Sub SourceLinkLabel_MouseEnter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SourceLinkLabel.MouseEnter
+ Dim link As String = CType(SourceLinkLabel.Tag, String)
+ If Not String.IsNullOrEmpty(link) Then
+ Me.StatusText = link
+ End If
+ End Sub
+
+ Private Sub SourceLinkLabel_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SourceLinkLabel.MouseLeave
+ Me.StatusText = String.Empty
+ End Sub
+
+ Public Event StatusTextChanged(ByVal sender As Object, ByVal e As EventArgs)
+
+ Private _statusText As String
+ Public Property StatusText() As String
+ Get
+ Return _statusText
+ End Get
+ Private Set(ByVal value As String)
+ Dim needRaiseEvent As Boolean = _statusText <> value
+ _statusText = value
+ If needRaiseEvent Then
+ RaiseEvent StatusTextChanged(Me, EventArgs.Empty)
+ End If
+ End Set
+ End Property
+
+
Public Property OneWayLoveColor As Color
Public Property RetweetColor As Color
Public Property FavoriteColor As Color
Public Property Thumbnail As Thumbnail
+ Public Property OpenUriAsync As Action(Of String)
End Class