问题:HBitmap转为TJpeg

Question

如下，将HBitmap转换为TJpeg文件，可是在24Bit的色率下却失败，请大家指点
function SaveBitmapToFile(hbm:HBITMAP;szFileName:PChar):Boolean;stdcall;
var
  bm : TBitmap;
  strFileName : string;
begin
  result := True;
  try
    bm := TBitmap.Create;
    try
      bm.Handle := hbm;
      strFileName := StrPas(szFileName);
      bm.SaveToFile(strFileName);
    except
      result := False;
    end
  finally
    bm.Free;
  end;
  SaveBitmapToFile:=result;
end;

Answer 1

你创建位图时就应该设定颜色位数：
    Bm:=TBitmap.Create;
    Bm.PixelFormat:=pf24bit;//24位色

Answer 2

用这种方式试试看：
MyBmp: TBitmap;
Myjpg: TJpegimage;
MyBmp := TBitmap.Create;
Myjpg := TJpegimage.Create;
Myjpg.Assign(MyBmp);
Myjpg.CompressionQuality := 70; {JPG文件压缩百分比设置,数字越大图像月清晰,但数据也越大}
Myjpg.free;
MyBmp.Free;

Answer 3

那么这段代码应该怎么克服呢？
如果我不知道颜色的位数，又该怎么获得呢？
function BitmapToJpeg(hbm:HBITMAP;szFileName:PChar;Quality:Integer):Boolean;stdcall;
var
  bm : TBitmap;
  jpg: tjpegimage;
  strFileName : string;
begin
  result := True;
  try
    bm := TBitmap.Create;
    jpg:=tjpegimage.Create;
    try
        bm.Handle:=hbm;
        bm.Dormant;
        jpg.Assign(bm);
        jpg.CompressionQuality := Quality;
        jpg.Compress;
        jpg.SaveToFile(szFileName);
    except
        result := False;
    end
  finally
        jpg.Free;
        bm.Free;
  end;
        BitmapToJpeg:=result;
end;

Answer 4

//==============================================================================
//转换JPG到BMP格式**************************************************************
//==============================================================================
procedure JPG2BMP(const Source, Target:string);
var JPG: TJpegImage;
    BMP: TBitmap;
begin
  BMP := TBitmap.Create;
  JPG := TJpegImage.Create;
  try
    JPG.LoadFromFile(Source);
    BMP.Assign(JPG);
    BMP.SaveToFile(Target);
  finally
    BMP.free;
    JPG.Free;
  end;
end;//==============================================================================
//转换BMP到JPG格式**************************************************************
//==============================================================================
procedure BMP2JPG(const Source, Target:string; const Scale: Byte);
var Image: TImage;
    JPG: TJpegImage;
begin
  Image := TImage.Create(Application);
  JPG := TJpegImage.Create;
  try
    Image.Picture.Bitmap.LoadFromFile(Source);
    JPG.Assign(Image.Picture.Bitmap);
    JPG.CompressionQuality := Scale;
    JPG.Compress;
    JPG.SaveToFile(Target);
  finally
    Image.free;
    JPG.Free;
  end;
end;

Answer 5

完整例子
unit BMP2JPG_Unit;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls ,jpeg, ComCtrls, filectrl, Menus;type
  TForm1 = class(TForm)
    SourceB: TButton;
    Source: TLabel;
    Target: TLabel;
    targetB: TButton;
    ConvertB: TButton;
    CQ: TTrackBar;
    CQL: TLabel;
    ListBox: TListBox;
    BRB: TButton;
    NOW: TCheckBox;
    Button1: TButton;
    USD: TCheckBox;
    StatusBar: TStatusBar;
    Label1: TLabel;
    Label2: TLabel;
    PopupMenu1: TPopupMenu;
    Addfiles1: TMenuItem;
    Remove1: TMenuItem;
    Convertthis1: TMenuItem;
    Batchrun1: TMenuItem;
    Removeall1: TMenuItem;
    procedure SourceBClick(Sender: TObject);
    procedure targetBClick(Sender: TObject);
    procedure ConvertBClick(Sender: TObject);
    procedure CQChange(Sender: TObject);
    procedure BRBClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Addfiles1Click(Sender: TObject);
    procedure Batchrun1Click(Sender: TObject);
    procedure Convertthis1Click(Sender: TObject);
    procedure Remove1Click(Sender: TObject);
    procedure ListBoxClick(Sender: TObject);
    procedure Removeall1Click(Sender: TObject);
  private
    { Private declarations }
    outputdir:string;
    total:word;
  public
    { Public declarations }
    procedure bmp2jpg(FromBMP,ToJPG:string;Quality:byte);
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.SourceBClick(Sender: TObject);
var op:topendialog;  count:integer;
begin
  op:=topendialog.Create(nil);
  op.Options:=[ofAllowMultiSelect,ofReadOnly,ofPathMustExist,ofFileMustExist];
  op.Filter:='*.bmp|*.bmp';
  op.Execute;
  if op.Files.Count>0 then
    begin
      listbox.Items.AddStrings(op.Files);
      source.Caption:=listbox.Items[0];
      total:=listbox.Items.Count;
      statusbar.Panels[0].Text:='Total file '+inttostr(total);
    end;
  op.Free;
end;procedure TForm1.targetBClick(Sender: TObject);
var op:tsavedialog;
begin
  op:=tsavedialog.Create(nil);
  op.Options:=[ofReadOnly,ofPathMustExist];
  op.DefaultExt:='jpg';
  op.Filter:='*.jpg|*.jpg';
  op.Execute;
  target.Caption:=op.FileName;
  op.Free;
end;procedure TForm1.ConvertBClick(Sender: TObject);
var s:string;
begin
  if now.Checked and fileexists(target.Caption) then exit;
  statusbar.Panels[0].Text:='Converting...';
  statusbar.Panels[1].Text:='Current file :'+extractfilename(source.Caption);
  sourceb.Enabled:=false;
  targetb.Enabled:=false;
  cq.Enabled:=false;
  convertb.Enabled:=false;
  if not directoryexists(target.Caption) then
    begin
      s:=source.Caption;
      target.Caption:=extractfilepath(s);
      s:=extractfilename(s);
      s:=copy(s,1,pos('.',s));
      target.Caption:=target.Caption+s+'jpg';
    end;
  bmp2jpg(source.Caption,target.Caption,cq.Position);
  sourceb.Enabled:=true;
  targetb.Enabled:=true;
  cq.Enabled:=true;
  convertb.Enabled:=true;
  statusbar.Panels[0].Text:='Ready';
  statusbar.Panels[1].Text:='';
end;procedure TForm1.CQChange(Sender: TObject);
begin
  cql.Caption:='Compress Qualify '+ inttostr(cq.Position);
end;procedure TForm1.BRBClick(Sender: TObject);
var count:integer; s:string;
begin
  if listbox.Items.Count=0 then exit;
  SourceB.Enabled:=false;
  TargetB.Enabled:=false;
  ConvertB.Enabled:=false;
  if BRB.Caption='Cancel' then
    begin
      BRB.Caption:='Batch Run';
      SourceB.Enabled:=true;
      TargetB.Enabled:=true;
      ConvertB.Enabled:=true;
      total:=listbox.Items.Count;
      statusbar.Panels[1].Text:='Total file '+inttostr(total);
      statusbar.Panels[0].Text:='Total file '+inttostr(total);
    end  else
  BRB.Caption:='Cancel';
  for count:=0 to listbox.Items.Count-1 do
    begin
      S:=listbox.Items[0];
      Source.Caption:=s;
      if (usd.Checked) or (outputdir='')
        then  target.Caption:=extractfilepath(s)
        else  begin
                if not directoryexists(outputdir) then exit;
                if length(outputdir)=3
                  then target.Caption:=outputdir
                  else target.Caption:=outputdir+'\';
              end;
      s:=extractfilename(s);
      s:=copy(s,1,pos('.',s));
      target.Caption:=target.Caption+s+'jpg';
      if now.Checked and fileexists(target.Caption) then continue;
      Application.ProcessMessages;
      if BRB.Caption='Batch Run' then exit;
      statusbar.Panels[0].Text:='Converting...'+' ('+inttostr(count+1)+'/'+inttostr(total)+')';
      statusbar.Panels[1].Text:='Current file :'+extractfilename(source.Caption);
      bmp2jpg(source.Caption,target.Caption,cq.Position);
      listbox.Items.Delete(0);
    end;
  SourceB.Enabled:=true;
  TargetB.Enabled:=true;
  ConvertB.Enabled:=true;
  BRB.Caption:='Batch Run';
  statusbar.Panels[0].Text:='Ready';
  statusbar.Panels[1].Text:='';
end;procedure TForm1.bmp2jpg(FromBMP, ToJPG: string;Quality:byte);
var jpg:tjpegimage;bmp:tbitmap;
begin
  if not fileexists(FromBMP) then exit;
  try
  bmp:=tbitmap.Create;
  bmp.LoadFromFile(FromBMP);
  jpg:=tjpegimage.Create;
  jpg.Assign(bmp);
  jpg.CompressionQuality:=Quality;
  jpg.Compress;
  jpg.SaveToFile(ToJPG);
  finally
  bmp.Free;
  jpg.Free;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  cql.Caption:='Compress Qualify '+ inttostr(cq.Position);
  outputdir:='';
  statusbar.Panels[0].Text:='Ready';
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  selectdirectory('Select a output directory','',outputdir);
  target.caption:=outputdir;
  if directoryexists(outputdir)
    then usd.Checked:=true
    else usd.Checked:=false;
end;procedure TForm1.Addfiles1Click(Sender: TObject);
begin
  SourceBClick(nil);
end;procedure TForm1.Batchrun1Click(Sender: TObject);
begin
  BRBClick(nil);
end;procedure TForm1.Convertthis1Click(Sender: TObject);
begin
  ConvertBClick(nil);
end;procedure TForm1.Remove1Click(Sender: TObject);
begin
  Listbox.DeleteSelected;
  statusbar.Panels[0].Text:='Total file '+inttostr(total);
end;procedure TForm1.ListBoxClick(Sender: TObject);
begin
  if listbox.SelCount>0 then
    begin
      Source.Caption:=ListBox.Items[Listbox.ItemIndex];
      Statusbar.Panels[1].Text:='Current select file '+Extractfilename(Source.Caption);
    end;
end;procedure TForm1.Removeall1Click(Sender: TObject);
begin
  listbox.Clear;
  statusbar.Panels[0].Text:='Ready';
end;end.

Answer 6

>> 如果我不知道颜色的位数，又该怎么获得呢？GetObject

Answer 7

我问题的意思是直接将HBitmap转换到JPEG文件，而不是把bitmap位图文件转换。
大哥帮忙！