图片略缩图残影和批量改变图片大小问题 |
|
zyj_ayi
一般會員 發表:1 回覆:0 積分:0 註冊:2006-12-22 發送簡訊給我 |
寫個小程序,但有兩個問題沒解決,希望幫忙看看
問題有兩個1.在瀏覽圖片略縮圖的時候,在第二次載入圖片后,如果第二次圖片少于第一次的數量,則第二次載入后還殘有第一次的縮影,不 知道怎么解決.用imgSingle.Picture := nil;不成功 2.批量改變圖片大小問題.轉化后圖片個數和名字及其格式都正確但是卻顯示"無法預覽". 主要代碼如下 載入多幅圖片按鍵定義 procedure TMainForm.btnMultiOpenClick(Sender: TObject); var k : Integer; begin Button2Click(Self); multi := True; imgSingle.Visible := False; //imgSingle.picture.assign(nil); odFileSelect.Options := odFileSelect.Options [ofAllowMultiSelect]; flist := TStringList.Create; if odFileSelect.Execute then begin src := odFileSelect.FileName; flist := odFileSelect.Files; loadThumb(flist); for k := 0 to flist.Count-1 do begin src := flist.Strings[k]; if (ExtractFileExt(src)='.JPG') or (ExtractFileExt(src)='.jpg') then begin SpeedButton2.Enabled := False; SpeedButton1.Enabled := true; end; if (ExtractFileExt(src)='.BMP') or (ExtractFileExt(src)='.bmp') then begin SpeedButton1.Enabled := False; SpeedButton2.Enabled := true; end; end; lblFile.Caption := 'Image Tool'; pnlControl.Enabled := true; scbThumb.Visible := true; end; end; 産生略縮圖函數 procedure TMainForm.loadThumb(sl:Tstrings); var i,x,y : Integer; begin if sl.count > 0 then begin SetLength(img,sl.count); SetLength(pnl,sl.count); y:=-1; x :=0; selimg := TStringList.Create; for i := 0 to sl.count-1 do begin if FileExists(sl.Strings[i]) then begin if (i mod 4) = 0 then begin inc(y); x := 0; end; pnl[i] := TPanel.Create(Self); pnl[i].Parent := scbThumb; pnl[i].Height := 100; pnl[i].Width := 100; pnl[i].Top := y*100 y*5; pnl[i].Left := x*100 x*5; img[i] := TImage.Create(Self); img[i].Parent := pnl[i]; img[i].Align := alClient; img[i].Stretch := true; img[i].Proportional := true; img[i].Center := true; img[i].Picture.LoadFromFile(sl.Strings[i]); img[i].OnClick := ImgClick; img[i].Tag := i; inc(x); end; end; end; end; 改變圖片大小函數 function TMainForm.JResize(src1, dst: String): Boolean; var Bmp: TBitmap; Jpeg: TJpegImage; begin if (ExtractFileExt(src1)='.JPG') or (ExtractFileExt(src1) ='.jpg') then begin Jpeg := TJpegImage.Create; try Jpeg.LoadFromFile(src1); Bmp := TBitmap.Create; try Bmp.Width := StrToInt(edtNewWidth.Text); Bmp.Height := StrToInt(edtNewHeight.Text); Bmp.Canvas.StretchDraw(Rect(0, 0, Bmp.Width, Bmp.Height), Jpeg); Jpeg.Assign(Bmp); finally Bmp.Free; end; Jpeg.SaveToFile(dst); finally Jpeg.Free; Screen.Cursor := crDefault; end; end; if (ExtractFileExt(src1)='.BMP') or (ExtractFileExt(src1)='.bmp') then begin Bmp := TBitmap.Create; try Bmp.LoadFromFile(src1); try Bmp.Width := StrToInt(edtNewWidth.Text); Bmp.Height := StrToInt(edtNewHeight.Text); Bmp.Canvas.StretchDraw(Rect(0, 0, Bmp.Width, Bmp.Height), Bmp); Bmp.Assign(Bmp); finally Bmp.SaveToFile(dst); end; Bmp.Free; finally Screen.Cursor := crDefault; end; end; result := true; end; procedure TMainForm.rgSizeOptionClick(Sender: TObject); begin pnlNewDimPer.Enabled := (rgSizeOption.ItemIndex = 0); pnlNewDimPix.Enabled := (rgSizeOption.ItemIndex = 1); if pnlNewDimPer.Enabled then seNewWidthPerChange(Self) end; 改大小按鍵定義,紅色地方代碼就是批量改變大小 procedure TMainForm.Button1Click(Sender: TObject); var dst : string; j : Integer; begin //flist := TStringList.Create; if DirectoryExists(editbrowse.Text) then begin Screen.Cursor := crHourGlass; if not multi then begin dst := editbrowse.Text ExtractFileName(src); if src = dst then dst := editbrowse.Text 'Copy ' ExtractFileName(src); JResize(src,dst); end else begin ggProgress.MaxValue := flist.Count; for j := 0 to flist.Count-1 do begin src := flist.Strings[j]; dst := editbrowse.Text ExtractFileName(src); if src = dst then dst := editbrowse.Text 'Copy ' ExtractFileName(src); JResize(src,dst); ggProgress.Progress := j; end; ggProgress.Progress := ggProgress.MaxValue; end; ShowMessage('Image(s) Resized!'); ggProgress.Progress := 0; end; //flist.Free; if not DirectoryExists(editbrowse.Text) then ShowMessage('Can not find file!'); Screen.Cursor := crDefault; end; |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |