{melon} 半透明化 procedure TWriteForm.AlphaBlendCheckBoxClick(Sender: TObject); begin if AlphaBlendCheckBox.checked = true then begin WriteForm.AlphaBlend := True; WriteForm.AlphaBlendValue := 168; end else WriteForm.AlphaBlend := False; end; {/melon}
//rika 新着があったスレを開く if (0 < currentBoard.Items[i].itemCount) and (0 < currentBoard.Items[i].lines) and (currentBoard.Items[i].itemCount > currentBoard.Items[i].lines) then
begin for i := 0 to favorites.Count - 1 do begin if favorites.Items[i].name = 'hogehoge' then begin FavoriteView.Items.BeginUpdate; TObject(TFavoriteList(favorites.Items[i])).Free; FavoriteView.Items.EndUpdate; SaveFavorites(true); UpdateFavorites; UpdateFavoritesMenu; Break; end; end; end;
{nono} if not NavigateIntoView(URI, gtOther, true) then begin{*********} if Config.optUseViewer and TJpegForm.ExtCheck(URI) then begin Form := TJpegForm.Create(nil); SetJpegForm(Form); Form.Show; end else OpenByBrowser(URI); end; //if not NavigateIntoView(URI, gtOther, true, Config.oprUrlBgOpen) then // OpenByBrowser(URI); {/nono}
{-------------------------------------- あぼーん処理 --------------------------------------- 名前欄にレス番号表示(ポップアップ用) 理由等(引数指定)をメール欄に表示 --------------------------------------} procedure NG2(const strText:String); begin //ここから追加↓ if VisibleAbone then dest.DisableLink := True else //ここまで追加↑ begin if not Config.optAboneReason then {nono} begin NG; Exit; end;
うまく動かないよ。スキルあるお兄さん教えてください procedure TMainWnd.TextPopupOpenSelectionURLsClick(Sender: TObject); procedure SetJpegForm(Form: TJpegForm; URI: string); begin Form.URL := CutImenu(URI); Form.extBrowserSpecified := Config.extBrowserSpecified; Form.extBrowserPath := Config.extBrowserPath; if Config.netUseProxy then begin Form.ProxyServer := Config.netProxyServer; Form.ProxyPort := Config.netProxyPort; end; Form.SetThumbnailSize(Config.optThumbnailSize); Form.WindowFit := Config.optWindowFit; end; var viewItem: TViewItem; URI:String; URIs:TStringList; i:Integer; Form: TJpegForm; {$IFDEF IE} textRange: OleVariant; {$ENDIF} begin viewItem := GetActiveView; if viewItem = nil then exit; {$IFDEF IE} textRange := OleVariant(viewItem.browser.Document as IHTMLDocument2).selection; textRange := textRange.createRange(); if textRange.text = '' then Exit; URIs:=TStringList.Create; if Config.optUseViewer and TJpegForm.ExtCheck(textRange.text,URIs); //UImageViewer.ExtractURLs(textRange.text,URIs); {$ELSE} if viewItem.browser.Selection='' then exit; URIs:=TStringList.Create; if Config.optUseViewer and TJpegForm.ExtCheck(viewItem.browser.Selection,URIs); //UImageViewer.ExtractURLs(viewItem.browser.Selection,URIs); {$ENDIF} for i:=0 to URIs.Count-1 do begin URI:=UImageViewer.ProofURL(URIs[i]); if URI<>'' then if ImageViewConfig.OpenImagesOnly then begin if ImageViewConfig.ExamFileExt(URI) then ImageForm.GetImage(URI,viewItem); end else begin if not NavigateIntoView(URI, gtOther) then if not ImageForm.GetImage(URI,viewItem) then OpenByBrowser(URI); end; end; end;
procedure TWriteForm.BrowserStatusTextChange(Sender:TObject; AStatusText:string); begin if AStatusText<>'' then {184} //ちょっと見るでメール欄をポップアップ if chotto and (AnsiStartsStr('mailto:', AStatusText)) then （中略） procedure TWriteForm.BeforeNavigate(const URL: String; var Cancel: WordBool); {184} //相対アドレスはブラウザにまかせてます。 こんなのでいいんだろうか・・・。 （中略） {184} if chotto then URI := chottoRelative(URL) //184 （中略） {$ENDIF} end;
procedure TMainWnd.TaskTrayWndProc(var Msg: TMessage); begin try Case Msg.LParam of WM_LBUTTONUP: begin DeleteTaskBarIcon; ShowWindow(Application.Handle,SW_SHOW); Show; if Assigned(WriteForm) then WriteForm.MainWndOnShow; SetFocus; end; WM_RBUTTONUP: begin (* ここに書くといいです *) //DeleteTaskBarIcon; //Close; end; end;
>>659 procedure TMainWnd.KeywordExtraction(Sender: TObject; UseSelection: Boolean); var rc: integer; target:string; viewItem: TViewItem; BaseViewItem: TBaseViewItem; //追加 begin viewItem := GetActiveView; if (viewItem=nil) or(viewItem.thread=nil) then Exit; {追加} if UseSelection then begin if (PopupTextMenu.PopupComponent is THogeTextView) then BaseViewItem := GetViewOf(PopupTextMenu.PopupComponent) else BaseViewItem := viewItem end else BaseViewItem := viewItem; {/追加} if GrepDlg = nil then GrepDlg := TGrepDlg.Create(self); GrepDlg.Caption := 'レス抽出';
//viewItem := GetActiveView; //↓ if UseSelection then begin if (PopupTextMenu.PopupComponent is THogeTextView) then viewItem := GetViewOf(PopupTextMenu.PopupComponent) else viewItem := GetActiveView; end else viewItem := GetActiveView;
finalization // Dont Free. If shutdown is from another Init section, it can cause GPF when stack // tries to access it. App will kill it off anyways, so just let it leak // FreeAndNil(GStackCriticalSection);
procedure TMainWnd.UpdateTabTexts(refresh: boolean = false); （略） for i := 0 to viewList.Count -1 do if (viewList.Items[i].thread <> nil) then begin if (viewList.Count = 1) or (TabControl.TabWidth > 0) then begin if ((TabControl.Tabs.Strings[i] = '') or refresh) then TabControl.Tabs.Strings[i] := Copy(AnsiReplaceText(HTML2String(viewList.Items[i].thread.title), '&', '&&'), 1, 4095); end else TabControl.Tabs.Strings[i] := AnsiReplaceText(TabString(HTML2String(viewList.Items[i].thread.title)), '&', '&&'); end; （略）
制御文字ぜんぶ消していいかな？ procedure EraseChars(var s: string); var p1, p2, pe: pchar; begin UniqueString(s); p1:= pchar(s); p2:= p1; pe:= p1 + Length(s)-1; while p2 <= pe do begin if not (p2^ in [#0..#31,#127]) then begin p1^:= p2^; inc(p1); end; inc(p2); end; if p1 <> p2 then SetLength(s, p1 - pchar(s)); end;
あと、↓も function JBBSShitarabaHTMLLineToDatLine(line: string): string; （略 if idpos > 0 then begin i := idpos + 2; id := Copy(dateid, i, FindPos(' ', dateid, i) - i); idpos := Pos('<font size=1>', dateid); //←追加 Delete(dateid, idpos, High(integer)); dateid := dateid + 'ID:' + id; end;