procedure TWebModule_rpt.WebModule_rptWebActionItem_imageAction(
Sender: TObject
Request: TWebRequest
Response: TWebResponse;
var Handled: Boolean);
var
FileName: string;
Jpg: TJPEGImage;
s: TMemoryStream;
Bmp: TBitmap;
idx: integer;
MyImg: TDicomImage;
begin
try
FileName := trim(Request.QueryFields.Values['FileName']);
idx := strtoint(trim(Request.QueryFields.Values['idx']));
MyImg := TDicomImage.Create(false);
MyImg.FileImport(FileName, '', '', false);
if idx < MyImg.Frames.Count then
begin
Bmp := MyImg.Frames.Items[idx].BitMap;
S := TMemoryStream.Create;
Jpg := TJPEGImage.Create;
Jpg.Assign(Bmp);
jpg.SaveToStream(s);
Response.ContentType := 'image/jpeg';
s.Position := 0;
Response.ContentStream := s;
freeandnil(Jpg);
end
else
begin
S := TMemoryStream.Create;
Jpg := TJPEGImage.Create;
Bmp := TBitmap.Create;
Bmp.Width := 10;
bmp.Height := 10;
//bmp.Canvas.TextOut(1,1,'无影像文件');
Jpg.Assign(Bmp);
jpg.SaveToStream(s);
Response.ContentType := 'image/jpeg';
s.Position := 0;
Response.ContentStream := s;
freeandnil(Jpg);
freeandnil(Bmp);
end;
if MyImg <> nil then
freeandnil(MyImg);
except
on E: Exception do
begin
S := TMemoryStream.Create;
Jpg := TJPEGImage.Create;
Bmp := TBitmap.Create;
Bmp.Width := 64;
bmp.Height := 64;
bmp.Canvas.TextOut(1,1,e.Message);
Jpg.Assign(Bmp);
jpg.SaveToStream(s);
Response.ContentType := 'image/jpeg';
s.Position := 0;
Response.ContentStream := s;
freeandnil(Jpg);
freeandnil(Bmp)
end;
end;
end;
