MessageDlg 跟 ShowMessage 的怪問題 |
|
缺席
|
|
wscken
初階會員   發表：28 回覆：75 積分：45 註冊：2003-08-05 發送簡訊給我 |
|
|
Stallion
版主 發表：52 回覆：1600 積分：1995 註冊：2004-09-15 發送簡訊給我 |
|
|
system
一般會員   發表：0 回覆：4 積分：0 註冊：2007-05-31 發送簡訊給我 |
|
|
wscken
初階會員 發表：28 回覆：75 積分：45 註冊：2003-08-05 發送簡訊給我 |
抱歉，說的不清不楚，
程式碼，我整各貼上來好了，除了主要的，就是用了站長分享的 http://delphi.ktop.com.tw/board.php?cid=31&fid=79&tid=76536 <textarea class="delphi" rows="15" cols="70" name="code">unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ImgList, shlobj, Menus, ExtCtrls, StdCtrls, ComCtrls, IdHTTP; type TForm1 = class(TForm) Panel1: TPanel; Lab_File: TLabel; Btn_GetDir: TButton; Ed_File: TEdit; GroupBox1: TGroupBox; ListView_DownloadProgress: TListView; ImageList1: TImageList; Lab_Path: TLabel; OpenDialog1: TOpenDialog; Btn_GetFile: TButton; Ed_Dir: TEdit; StatusBar1: TStatusBar; ProgressBar1: TProgressBar; Btn_StartDownload: TButton; Btn_StopDownload: TButton; PM_About: TPopupMenu; N1: TMenuItem; N3: TMenuItem; N4: TMenuItem; Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure Btn_GetFileClick(Sender: TObject); procedure Btn_GetDirClick(Sender: TObject); procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); procedure FormDestroy(Sender: TObject); procedure Btn_StartDownloadClick(Sender: TObject); procedure Btn_StopDownloadClick(Sender: TObject); procedure N1Click(Sender: TObject); procedure N4Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Timer1Timer(Sender: TObject); private //--- 設定下方狀態列的文字 --- procedure SetSBPanel(); //--- 下載檔案 --- function DownloadFile(const FURL, LocalFileName: string): Boolean; //--- 更新 ListView 的內容資料 --- procedure ListView_DownloadProgress_ReNew(Sender: TObject); //--- 下載檔案開始 --- procedure StartDownloadClick(Sender: TObject); public { Public declarations } end; var Form1: TForm1; //--- 選擇檔案目錄 --- function selectdir(): string; //--- 字串分割陣列 --- function SplitString(const Source,ch:string): TStringList; implementation uses UnitMyThread; {$R *.dfm} { TForm1 } var FileUrl: TStringList; //檔案URL列表 FileCount: Integer; //檔案數量 DownloadCount: Integer; //下載數量 DownloadNow: Boolean; //是否正在下載 StopProcess: Boolean; //是否中斷程式下載 procedure TForm1.FormCreate(Sender: TObject); var ProgressBarStyle:integer; pc:pchar; strtitle:string; isfound:hwnd; begin //--- 開啟先檢查是否有相同程式，然後處理進度條 --- getmem(pc,255); strtitle:=application.Title; application.title:='WobyPic'; strpcopy(pc,strtitle); isfound:=findwindow(nil,pc); Application.Title:=strtitle; if isfound<>0 then begin showwindow(isfound,SW_RESTORE); application.Terminate; end; freemem(pc); //將狀態欄的第二塊面板設為的自繪（即psOwnerDraw） StatusBar1.Panels[1].Style := psOwnerDraw; //將ProgressBar放入狀態欄 ProgressBar1.Parent := StatusBar1; //去除狀態欄的邊框，這樣就與狀態欄溶為一體了 ProgressBarStyle := GetWindowLong(ProgressBar1.Handle,GWL_EXSTYLE); ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE; SetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle); DownloadNow := false; StopProcess := false; end; procedure TForm1.Btn_GetFileClick(Sender: TObject); var InFile: TextFile; InString: String; begin //--- 選擇檔案 --- OpenDialog1.Execute(); Ed_File.Text := OpenDialog1.FileName; //選擇好檔案，嚐試匯入的動作。 if FileExists(Ed_File.Text) then begin AssignFile(InFile,Ed_File.Text); //確定存在就開啟檔案 Reset(InFile); Readln(InFile,InString); CloseFile(InFile); //讀取完後關閉檔案 FileUrl := SplitString(InString,','); FileCount := FileUrl.Count - 1 ; //最後一個是空白字串，直接去掉 DownloadCount := 0; //目前下載的個數 SetSBPanel(); MyThread(ListView_DownloadProgress_ReNew,nil); end; end; procedure TForm1.Btn_GetDirClick(Sender: TObject); var tmpDir: String; begin //--- 選擇路徑 --- tmpDir := selectdir(); If not (tmpDir='') Then Ed_Dir.Text := tmpDir; end; procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); begin //--- 畫ProgressBar用的 --- if Panel = StatusBar.Panels[1] then with ProgressBar1 do begin Top := Rect.Top; Left := Rect.Left; Width := Rect.Right - Rect.Left - 15; Height := Rect.Bottom - Rect.Top; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin FileUrl.Free; end; procedure TForm1.Btn_StartDownloadClick(Sender: TObject); begin //--- 下載檔案前的檢查 --- if FileCount=0 then begin MessageDlg('請選擇 您要匯入的檔案!', mtWarning, [mbOK], 0); exit; end; if (Ed_Dir.Text='') then begin MessageDlg('請選擇 您的存檔路徑!', mtWarning, [mbOK], 0); exit; end; //檢查完成,都通過就開始準備下載的動作 MyThread(StartDownloadClick,nil); end; procedure TForm1.Btn_StopDownloadClick(Sender: TObject); begin //--- 停只下載動作用按鍵 --- StopProcess := True; end; procedure TForm1.N1Click(Sender: TObject); begin // end; procedure TForm1.N4Click(Sender: TObject); begin // Application.Terminate ; self.close; end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if (DownloadNow) then begin CanClose := False; StopProcess := True; MessageDlg('下載正在執行中，請稍等程序停止。', mtInformation, [mbOK], 0); Timer1.Interval := 100; end else begin CanClose := True; end; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; procedure TForm1.Timer1Timer(Sender: TObject); begin if (DownloadNow = false) Then self.close; end; //////////////////////////////////////////////////////////////////////////////// procedure TForm1.SetSBPanel(); begin //--- 設定下方的狀態列 --- //(目前第幾個/總共幾個) StatusBar1.Panels[0].Text := IntToStr(DownloadCount) ' / ' IntToStr(FileCount); //ProgressBar目前的進度 ProgressBar1.Position:=round((DownloadCount/FileCount)*100); if (DownloadCount=FileCount) then ProgressBar1.Position:=0; end; function TForm1.DownloadFile(const FURL, LocalFileName: string): Boolean; var http: TIdHTTP; MemStream: TFileStream; Options: TIdHTTPOptions; DownloadOk: Boolean; begin //--- 下載檔案 --- DownloadOk := True; //開始沒有錯誤產生 http := TIdHTTP.Create;//創建TIdHTTP組件。 try MemStream := TFileStream.Create(LocalFileName, fmCreate);//創建本地文件流。 try http.ConnectTimeout := 30000;//設置http連接超時時間。這裡可以按照您的需求自己設定。 http.ReadTimeout := 120000;//設置讀取http超時時間。 http.Request.UserAgent := 'Mozilla/4.0 (compatible; MSIE 5.00; Windows 98)';//仿造IE進行下載。 http.HandleRedirects := True;//允許服務器發送跳轉Response后，IdHTTP自動下載新地址。 if hoForceEncodeParams in http.HTTPOptions then //這個代碼是取消IdHTTP自己對URL的編碼功能，因?FURL可能傳入已經編碼過的URL地址。 //如果您的FURL參數中，傳入的字符串未做URLEncode的話，這個If和一下的begin end之間的代碼可以註釋掉。 begin Options := http.HTTPOptions; Exclude(Options, hoForceEncodeParams); http.HTTPOptions := Options; end; try http.Get(FURL, MemStream);//執行下載。 except DownloadOk := false; end; finally MemStream.Free; end; finally http.Free; end; Result := DownloadOk; end; procedure TForm1.ListView_DownloadProgress_ReNew(Sender: TObject); var i: Integer; TaskItem: TListItem; tmpStringList: TStringList; dFileSource, dFileDest, dFileName: String; //檔案來源,目的地,名稱 begin //--- 更新 ListView 的內容資料 --- Btn_GetFile.Enabled := False; Btn_StartDownload.Enabled := False; ListView_DownloadProgress.Clear; for i := 0 to FileCount-1 do begin //取出原始的檔名 tmpStringList := SplitString(FileUrl.Strings[i],'/'); dFileName := tmpStringList.Strings[tmpStringList.Count-1]; dFileSource := FileUrl.Strings[i]; dFileDest := dFileName; tmpStringList.Free; TaskItem := ListView_DownloadProgress.Items.Add; TaskItem.ImageIndex := 0; TaskItem.Caption := IntToStr(i 1); TaskItem.SubItems.Add(dFileSource); TaskItem.SubItems.Add(dFileDest); TaskItem.SubItems.Add('準備下載中..'); //ListView_DownloadProgress.Perform(WM_VSCROLL,SB_LINEDOWN ,i 1); //移到新增的目標 DownloadCount := DownloadCount 1; SetSBPanel(); end; Btn_GetFile.Enabled := True; Btn_StartDownload.Enabled := True; end; procedure TForm1.StartDownloadClick(Sender: TObject); var i, DCountOk, DCountErr: Integer; TaskItem: TListItem; tmpStringList: TStringList; dFileSource, dFileDest, dFileDestTmp, dFileName: String; //檔案來源,目的地,名稱 begin //--- 下載檔案開始 --- DownloadNow := True ; DCountOk := 0; DCountErr := 0; DownloadCount := 0; SetSBPanel(); Form1.Btn_GetDir.Enabled := False; Form1.Btn_GetFile.Enabled := False; Form1.Btn_StartDownload.Enabled := False; Form1.Btn_StopDownload.Enabled := True; for i := 0 to FileCount-1 do begin if (StopProcess =True) Then Break; //取出原始的檔名 tmpStringList := SplitString(FileUrl.Strings[i],'/'); dFileName := tmpStringList.Strings[tmpStringList.Count-1]; dFileSource := FileUrl.Strings[i]; dFileDest := Ed_Dir.Text '/' dFileName; dFileDestTmp := Ed_Dir.Text '/' dFileName '.ptmp'; tmpStringList.Free; if i > 10 then ListView_DownloadProgress.Perform(WM_VSCROLL,SB_LINEDOWN ,i 10); //移動List到新增的目標 //更新List資訊，然後下載檔案。 TaskItem := ListView_DownloadProgress.FindCaption(0,IntToStr(i 1),true,true,true); if not(TaskItem=nil) then begin TaskItem.ImageIndex := 1; TaskItem.SubItems.BeginUpdate; TaskItem.SubItems.Clear; TaskItem.SubItems.Add(dFileSource); TaskItem.SubItems.Add(dFileDest); TaskItem.SubItems.Add('下載中...'); TaskItem.SubItems.EndUpdate; TaskItem.SubItems.BeginUpdate; if (DownloadFile(dFileSource,dFileDestTmp))then begin TaskItem.ImageIndex := 2; TaskItem.SubItems.Clear; TaskItem.SubItems.Add(dFileSource); TaskItem.SubItems.Add(dFileDest); TaskItem.SubItems.Add('下載完成。'); RenameFile(dFileDestTmp,dFileDest); //下載成功就改副檔名。 DCountOk := DCountOk 1; end else begin TaskItem.ImageIndex := 3; TaskItem.SubItems.Clear; TaskItem.SubItems.Add(dFileSource); TaskItem.SubItems.Add(dFileDest); TaskItem.SubItems.Add('錯誤。'); DeleteFile(dFileDestTmp); //下載失敗就刪除Tmp檔案。 DCountErr := DCountErr 1; end; TaskItem.SubItems.EndUpdate; end; DownloadCount := DownloadCount 1; SetSBPanel(); end; MessageDlg('下載完成，共有' IntToStr(DownloadCount) '個檔案，成功' IntToStr(DCountOk) '個，失敗' IntToStr(DCountErr) '個。', mtInformation, [mbOK], 0); // ShowMessage('下載完成，共有' IntToStr(DownloadCount) '個檔案，成功' IntToStr(DCountOk) '個，失敗' IntToStr(DCountErr) '個。'); Form1.Btn_GetDir.Enabled := True; Form1.Btn_GetFile.Enabled := True; Form1.Btn_StartDownload.Enabled := True; Form1.Btn_StopDownload.Enabled := false; DownloadNow := false ; end; //////////////////////////////////////////////////////////////////////////////// function selectdir(): string; var Info: TBrowseInfo; IDList: pItemIDList; Buffer: PChar; begin //--- 選擇資料夾路徑用，如果取消取返回空白，否則返回選中的路徑 --- result:=''; Buffer := StrAlloc(MAX_PATH); with Info do begin hwndOwner := application.mainform.Handle; //目錄對話方塊所屬的視窗控制碼 pidlRoot := nil; //起始位置，預設是我的電腦 pszDisplayName := Buffer; //用於存放選擇目錄的指標 lpszTitle := '請選擇路徑:'; //對話方塊提示資訊 ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE; //選擇參數，此處表示顯示目錄和文件，如果只顯示目錄則將後一個去掉即可 lpfn := nil; //指定回調函數指標 lParam := 0; //傳遞給回調函數參數 IDList := SHBrowseForFolder(Info); //讀取目錄資訊 end; if IDList <> nil then begin SHGetPathFromIDList(IDList, Buffer); //將目錄資訊轉化成路徑字串 result := strpas(Buffer); end; StrDispose(buffer); end; function SplitString(const Source, ch: string): TStringList; var temp: String; i: Integer; begin //--- 依照給定的條件來分割字串 --- Result := TStringList.Create; //如果是空自符串則返回空列表 if Source = '' then exit; temp := Source; i := pos(ch,Source); while i<>0 do begin Result.add(copy(temp,0,i-1)); Delete(temp,1,i); i := pos(ch,temp); end; Result.add(temp); end; end. </textarea> 程式主要是載入文字檔，然後文字檔裡面的是像 URL,URL,URL, <-這樣的格式 然後下載ＵＲＬ下來，基本上比如說，選好文字檔案，選好資料夾，按下開始下載，成功後， 第二次按下開始下載，完成的時候就會跳出告訴使用者下載幾個，失敗幾各，那時候就會有錯誤的對話框框出現， 不知道這樣講清不清楚 @.@" |
|
wscken
初階會員 發表：28 回覆：75 積分：45 註冊：2003-08-05 發送簡訊給我 |
http://delphi.ktop.com.tw/board.php?cid=168&fid=913&tid=84343
我在這篇看到說 ShowMessage這個方法在thread中就不是安全的。所以通常我們在thread中會使用MessageBox來取代。但若真的要用ShowMessage呢? 請在thread中寫一個方法，如ShowMsg( )，然後加入ShowMessage("test")，然用用Synchronize(ShowMsg); 一切就正常了! 所以我把我的對話視窗改成MessageBox ,一些怪問題就解決了.... 雖然還是不了解為什麼@.@"
編輯記錄
wscken 重新編輯於 2007-06-01 16:18:51， 註解 無‧
|
|
syntax
尊榮會員 發表：26 回覆：1139 積分：1258 註冊：2002-04-23 發送簡訊給我 |
不瞭解，就去學，看 Thread 怎麼用
===================引 用 wscken 文 章=================== http://delphi.ktop.com.tw/board.php?cid=168&fid=913&tid=84343 我在這篇看到說 ShowMessage這個方法在thread中就不是安全的。所以通常我們在thread中會使用MessageBox來取代。但若真的要用ShowMessage呢? 請在thread中寫一個方法，如ShowMsg( )，然後加入ShowMessage("test")，然用用Synchronize(ShowMsg); 一切就正常了! 所以我把我的對話視窗改成MessageBox ,一些怪問題就解決了.... 雖然還是不了解為什麼@.@" |
發表時間：2007-05-31 16:37:37
IP:210.243.xxx.xxx 訂閱
系統時間：2024-05-05 12:12:35
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |