如何把窗体上的内容保存为JPG?(100分)(100分)

H

hying95

Unregistered / Unconfirmed
GUEST, unregistred user!
在窗体上放一个Panel1
在PANEL1上再放四个PANEL控件,然后再在四个PANEL控件上分别放4个IMAGE控件.
现在想把PANEL1上4个IMAGE1上的内容保存为JPG文件?
 
多动手!~
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure CaptureWindows(hWnd : THandle;
FileName : PChar;
bmpType : Boolean= True);
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.CaptureWindows(hWnd: THandle;FileName : PChar;
bmpType : Boolean= True);
var
TempCanvas : TCanvas;
TempBitmap : TBitmap;
TempJpeg : TJPEGImage;
WinRect, TempRect : TRect;
begin
if hWnd <= 0 then
Exit;
TempCanvas := TCanvas.Create;
TempBitmap := TBitmap.Create;
TempJpeg := TJPEGImage.Create;
try
try
TempCanvas.Handle := GetWindowDC(GetDesktopWindow);
GetWindowRect(hWnd, TempRect);
WinRect := Rect(0, 0, TempRect.Right - TempRect.Left,
TempRect.Bottom - TempRect.Top);
TempBitmap.Width := TempRect.Right - TempRect.Left;
TempBitmap.Height := TempRect.Bottom - TempRect.Top;
TempBitmap.Canvas.CopyRect(WinRect, TempCanvas, TempRect);
if bmpType then
TempBitmap.SaveToFile(FileName+'.bmp')
else
begin
//要引用jpeg
TempJpeg.Assign(TempBitmap);
TempJpeg.Compress;
TempJpeg.SaveToFile(FileName+'.jpg');
end;
except
on e: Exceptiondo
begin
Application.MessageBox(PChar('保存窗体图片失败,' + e.Message), '错误', MB_OK+MB_ICONERROR)
end;
end;
finally
TempJpeg.Free;
TempBitmap.Free;
TempCanvas.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CaptureWindows(Self.Handle, 'test');
end;

end.
 
to Dstorm
如果IMAGE上没有图片,可以保存成功.
如果有图片,保存后什么也没有,失败,不知为何?
 
不知道了,我这里都测试过了!~
IMAGE上有图片也可以~,
我代码的思路是:从当前整个屏幕DC,拷贝当前window的区域,再保存!~
 
如果在设计时,IMAGE上面就选了图片.保存可以.
如果通过打开文件对话框选择图片时,就保存不下来.
****************************
procedure TForm1.CaptureWindows(hWnd: THandle;FileName : PChar;
bmpType : Boolean= True);
var
TempCanvas : TCanvas;
TempBitmap : TBitmap;
TempJpeg : TJPEGImage;
WinRect, TempRect : TRect;
begin
if hWnd <= 0 then
Exit;
TempCanvas := TCanvas.Create;
TempBitmap := TBitmap.Create;
TempJpeg := TJPEGImage.Create;
try
try
TempCanvas.Handle := GetWindowDC(GetDesktopWindow);
GetWindowRect(hWnd, TempRect);
WinRect := Rect(0, 0, TempRect.Right - TempRect.Left,
TempRect.Bottom - TempRect.Top);
TempBitmap.Width := TempRect.Right - TempRect.Left;
TempBitmap.Height := TempRect.Bottom - TempRect.Top;
TempBitmap.Canvas.CopyRect(WinRect, TempCanvas, TempRect);
if bmpType then
TempBitmap.SaveToFile(FileName+'.bmp')
else
begin
//要引用jpeg
TempJpeg.Assign(TempBitmap);
TempJpeg.Compress;
TempJpeg.SaveToFile(FileName+'.jpg');
end;
except
on e: Exceptiondo
begin
Application.MessageBox('保存窗体图片失败', '错误', MB_OK+MB_ICONERROR)
end;
end;
finally
TempJpeg.Free;
TempBitmap.Free;
TempCanvas.Free;
end;
end;

procedure TForm1.N31Click(Sender: TObject);
begin
close
end;

procedure TForm1.N30Click(Sender: TObject);
begin
if not openpic.Execute then
exit;
openpic.Filter:='选择图片文件!';
image1.Picture.LoadFromFile(openpic.FileName);
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
with image1.Canvasdo
begin
font.Name:='宋体';
font.Style:=[fsBold];
font.Size:=25;
Font.Color:=clwhite;
Pen.Color:=clred;
Brush.Color:=clred;
PEN.Width:=2;
Ellipse(300,140,390,190);
TextOut(320,150,combobox1.Text);
end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
CaptureWindows(panel1.Handle, 'test',false);
end;
 
我使用下面的代码也可以保存为图片.但如果用打开文件对话框选择图片的话,同样保存失败,不知为何?
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
bmp:Tbitmap;
FB:TCanvas;
dc:HDC;
begin
bmp := TBitmap.Create;
bmp.Width := panel1.width;
bmp.Height := panel1.Height;
DC := GetDC (panel1.Handle);
FB := TCanvas.Create;
FB.Handle := DC;
bmp.Canvas.CopyRect (Rect(0, 0, panel1.Width, panel1.Height), FB,
Rect(0, 0, panel1.Width, panel1.Height));
FB.Free;
ReleaseDC (0, DC);
bmp.SaveToFile('1.bmp');
bmp.Free;
end;
 
我刚才测试动态加载图片-通过!~
你愿意的联系我:214660372
 
接受答案了.
 

Similar threads

回复
0
查看
521
不得闲
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
742
DelphiTeacher的专栏
D
D
回复
0
查看
686
DelphiTeacher的专栏
D
顶部