Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/GikoDataModule.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.46 by h677, Mon Aug 7 16:50:15 2006 UTC revision 1.47 by h677, Sat Aug 12 10:31:10 2006 UTC
# Line 227  type Line 227  type
227      VKRightAction: TAction;      VKRightAction: TAction;
228      VKLeftAction: TAction;      VKLeftAction: TAction;
229      StoredTaskTrayAction: TAction;      StoredTaskTrayAction: TAction;
230        AllImageLinkToClipbordAction: TAction;
231        NewImageLinkToClipBoardAction: TAction;
232          procedure EditNGActionExecute(Sender: TObject);          procedure EditNGActionExecute(Sender: TObject);
233          procedure ReloadActionExecute(Sender: TObject);          procedure ReloadActionExecute(Sender: TObject);
234          procedure GoFowardActionExecute(Sender: TObject);          procedure GoFowardActionExecute(Sender: TObject);
# Line 426  type Line 428  type
428      procedure StoredTaskTrayActionExecute(Sender: TObject);      procedure StoredTaskTrayActionExecute(Sender: TObject);
429      procedure LeftTabSelectActionUpdate(Sender: TObject);      procedure LeftTabSelectActionUpdate(Sender: TObject);
430      procedure RightmostTabSelectActionUpdate(Sender: TObject);      procedure RightmostTabSelectActionUpdate(Sender: TObject);
431        procedure NewImageLinkToClipBoardActionExecute(Sender: TObject);
432        procedure AllImageLinkToClipbordActionExecute(Sender: TObject);
433    private    private
434          { Private 宣言 }          { Private 宣言 }
435          procedure ClearResFilter;          procedure ClearResFilter;
# Line 443  type Line 447  type
447      procedure ClearNameTextAllEditor();      procedure ClearNameTextAllEditor();
448      procedure MoveURLWithHistory(URL : String);      procedure MoveURLWithHistory(URL : String);
449      procedure BackToHistory(item: TMoveHistoryItem);      procedure BackToHistory(item: TMoveHistoryItem);
450        function GetActiveThreadLinks : IHTMLElementCollection;
451        procedure GetImageLinkURLs(links : IHTMLElementCollection;
452            URLs : TStringList; const Start: Integer);
453    public    public
454          { Public 宣言 }          { Public 宣言 }
455          procedure RepaintStatusBar;          procedure RepaintStatusBar;
# Line 4216  begin Line 4223  begin
4223      StoredTaskTrayAction.Tag := -1;      StoredTaskTrayAction.Tag := -1;
4224  end;  end;
4225    
4226    {
4227    \breif  リンクイメージ取得
4228    イメージは,*.jpg, *.jpeg, *.gif, *.png
4229    }
4230    procedure TGikoDM.AllImageLinkToClipbordActionExecute(Sender: TObject);
4231    var
4232        links : IHTMLElementCollection;
4233        urls : TStringList;
4234    begin
4235        links := GetActiveThreadLinks;
4236        if (links <> nil) then begin
4237            urls := TStringList.Create;
4238            try
4239                GetImageLinkURLs(links, urls, 0);
4240                Clipboard.SetTextBuf(urls.GetText);
4241            finally
4242                urls.Free;
4243            end;
4244        end;
4245    end;
4246    
4247    {
4248    \breif  新着レスのリンクイメージ取得
4249    イメージは,*.jpg, *.jpeg, *.gif, *.png
4250    }
4251    procedure TGikoDM.NewImageLinkToClipBoardActionExecute(Sender: TObject);
4252    var
4253        links : IHTMLElementCollection;
4254        urls : TStringList;
4255        ThreadItem : TThreadItem;
4256    begin
4257        ThreadItem := GikoForm.GetActiveContent;
4258        links := GetActiveThreadLinks;
4259        if (ThreadItem <> nil) and (links <> nil) then begin
4260            urls := TStringList.Create;
4261            try
4262                GetImageLinkURLs(links, urls,
4263                    (ThreadItem.Count - ThreadItem.NewResCount + 1) );
4264                Clipboard.SetTextBuf(urls.GetText);
4265            finally
4266                urls.Free;
4267            end;
4268        end;
4269    end;
4270    {
4271    \brief  現在表示しているスレッドのすべてのリンクを取得する。
4272    \return IHTMLElementCollection  リンクのコレクション
4273    }
4274    function TGikoDM.GetActiveThreadLinks : IHTMLElementCollection;
4275    var
4276        browser : TWebBrowser;
4277    begin
4278        Result := nil;
4279        if (GikoForm.GetActiveContent <> nil) then begin
4280            if (GikoForm.BrowserTab.Tabs.Count > 0) and
4281                (GikoForm.BrowserTab.TabIndex >= 0) then begin
4282                browser := TBrowserRecord(GikoForm.BrowserTab.Tabs
4283                    .Objects[GikoForm.BrowserTab.TabIndex]).Browser;
4284                if (browser <> nil) then begin
4285                    try
4286                        Result := IHTMLDocument2(browser.Document).links;
4287                    except
4288                        Result := nil;
4289                    end;
4290                end;
4291    
4292            end;
4293        end;
4294    end;
4295    {
4296    \brief  イメージへのリンクのURLを取得する
4297    \param  links   取得するリンクの全体のコレクション
4298    \param  URLs    取得したURLの保存先
4299    \param  Start   設定したレス番号以降を取得( > 0)
4300    }
4301    procedure TGikoDM.GetImageLinkURLs(links : IHTMLElementCollection;
4302            URLs : TStringList; const Start: Integer);
4303    var
4304        index ,i : Integer;
4305        item : IHTMLElement;
4306        url, ext : string;
4307    begin
4308        if (links <> nil) then begin
4309            index := 0;
4310            for i := 0 to links.length - 1 do begin
4311                item := links.item(i, 0) as IHTMLElement;
4312                if (item <> nil) then begin
4313                    url := item.getAttribute('href', 0);
4314                    // レスの番号を更新
4315                    if (Pos('menu:', url) > 0) then begin
4316                        index := StrToInt64Def(
4317                            Copy(url, 5, Length(url)), index + 1
4318                        );
4319                    end else begin
4320                        // 開始レス番号以降かチェック
4321                        if (index >= Start) then begin
4322                            ext := ExtractFileExt( AnsiLowerCase(url) );
4323                            // jpg,jpeg,gif,pngをチェック
4324                            if (ext = '.jpg') or (ext = '.jpeg') or
4325                                (ext = '.gif') or (ext = '.png') then begin
4326                                urls.Add(url)
4327                            end;
4328                        end;
4329                    end;
4330                end;
4331            end;
4332        end;
4333    end;
4334    
4335  end.  end.
4336    

Legend:
Removed from v.1.46  
changed lines
  Added in v.1.47

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26