图像移动及保存时出的问题

Question

下面这段程序是小弟做的一个
ImgD可在ImgMain上移动并将最终结果存为BMP的小程序
不知为什么
这个移动总是时行时不行
而且保存的图片是一塌糊涂
保存后ImgD上的图全变瘦了-------------------------------------------------procedure TMainForm.ImgDMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbLeft then
    begin
      OriginD.X:=X;
      OriginD.Y:=Y;
      ImgDLeft:=ImgD.Left;
      ImgDLeft:=ImgD.Top;
      StatusBar.Panels.Items[0].Text:=' X: '+IntToStr(X)+' Y: '+IntToStr(Y);
      //使ImgDay可动
      canmoveD:=True;
    end;
end;procedure TMainForm.ImgDMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if canmoveD then
    begin
      ImgD.Left:=ImgDLeft+(X-OriginD.X);
      ImgD.Top:=ImgDTop+(Y-OriginD.Y);
      StatusBar.Panels.Items[0].Text:=' X: '+IntToStr(X)+' Y: '+IntToStr(Y);
    end;
end;procedure TMainForm.ImgDMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar.Panels.Items[0].Text:='';
  canmoveD:=False;
end;procedure TMainForm.SpeedButton6Click(Sender: TObject);
begin
  ImgMain.Canvas.CopyRect(Rect(ImgD.Left,ImgD.Top,ImgD.Height,ImgD.Width),ImgD.Canvas,Rect(0,0,ImgD.Height,ImgD.Top));
  ImgMain.Picture.SaveToFile('c:\Temp.bmp');
end;
--------------------请问：
该怎么办啊？
谢谢

Answer 1

当然不行了，必需用‘流’来打开：
打开文件：
olecontainer1.CreateObjectFromFile('C:\lsz\guangpan\zhijiaguicheng\94\qqq.doc'，false);保存到数据库：
var
  Stream1:TBlobStream;
begin
  olecontainer1.CreateObjectFromFile('C:\lsz\guangpan\zhijiaguicheng\94\qqq.doc'，false);  
  Stream1:= TBlobStream.Create(Table1Notes, bmwrite);
  OleContainer1。SavetoStream(Stream1);
  Table1.post;
 end;从数据库加载：
var
  Stream1:TBlobStream;
begin
  Stream1:= TBlobStream.Create(Table1Notes, bmRead);
  OleContainer1.LoadFromStream(Stream1);
  OleContainer1.run;
end;注意：只有用OleContainer1。SavetoStream(Stream1);的数据流才能用
OleContainer1.LoadFromStream(Stream1); 打开，其他的比如用 TfileStream
保存进数据库的是不能直接打开的。
如果是图片：
  procedure TForm1.Button1Click(Sender: TObject);
  begin
    Image1.Picture.Bitmap.Assign(Table1Bitmap);
  end;  procedure TForm1.Button2Click(Sender: TObject);
  var
    B: TBitmap;
  begin
    B := TBitmap.Create;
    try
      B.Assign(Table1Bitmap);
      Image1.Picture.Bitmap.Assign(B);
    finally
      B.Free;
    end;
  end;
  procedure TForm1.Button1Click(Sender: TObject);
  var
    C: TClipboard;
  begin
    C := TClipboard.Create;
    try
      if Clipboard.HasFormat(CF_BITMAP) then        DBImage1.PasteFromClipboard
      else
        ShowMessage('Clipboard does not contain a bitmap!');
    finally
      C.Free;
    end;
  end;
  procedure TForm1.Button2Click(Sender: TObject);
  begin
    Table1Bitmap.LoadFromFile(
      'c:\delphi\images\splash\16color\construc.bmp');
  end;procedure TForm1.Button3Click(Sender: TObject);
  var
    B: TBitmap;
  begin
    B := TBitmap.Create;
    try
      B.LoadFromFile('c:\delphi\images\splash\16color\athena.bmp');
      DBImage1.Picture.Assign(B);
    finally
      B.Free;
    end;
  end;
///////////////////////////////////////////////////////////
var
  st: TStringStream;
begin
  st := tstringstream.create('');
  bitmap.savetostream(st);
  query1.sql.text := 'insert into table Image_field values :bmp';
  query1.parambyname('bmp').asblob := st.datastring;
  query1.execsql;
  st.free;
end;
////////////////////////////////////////////////////////////////////////
unit Unit1; interface {$IFDEF WIN32} 
  uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
      Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, Db, 
      DBTables; 
{$ELSE} 
uses 
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
  Forms, Dialogs, DBTables, DB, Grids, DBGrids, ExtCtrls, StdCtrls; 
{$ENDIF} type 
  TForm1 = class(TForm) 
    Table1: TTable; 
    DataSource1: TDataSource; 
    DBGrid1: TDBGrid; 
    Image1: TImage; 
    Button1: TButton; 
    Table1Name: TStringField; 
    Table1WMF: TBlobField; 
    OpenDialog1: TOpenDialog; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure DataSource1DataChange(Sender: TObject; Field: TField); 
  private 
    { Private declarations } 
    FileName : string; {Used to hold a temp file name} 
    procedure LoadWMFFromDatabase; {loads a WMF from the database} 
  public 
    { Public declarations } 
  end; var 
  Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); 
begin 
 {Used for loading metafiles} 
  OpenDialog1.Filter := 'Metafiles (*.wmf)|*.wmf'; 
  OpenDialog1.Options := [ofHideReadOnly, ofNoChangeDir]; 
  Image1.Stretch := true; 
end; procedure TForm1.FormDestroy(Sender: TObject); 
begin 
 {Erase the temp file if it exists} 
  if FileName <> '' then 
    DeleteFile(FileName); 
end; {This function gets a temporary file name form the system} 
function GetTemporaryFileName : string; 
{$IFNDEF WIN32} 
  const MAX_PATH = 144; 
{$ENDIF} 
var 
 {$IFDEF WIN32} 
  lpPathBuffer : PChar; 
 {$ENDIF} 
  lpbuffer : PChar; 
begin 
 {Get the file name buffer} 
  GetMem(lpBuffer, MAX_PATH); 
 {$IFDEF WIN32} 
 {Get the temp path buffer} 
  GetMem(lpPathBuffer, MAX_PATH); 
 {Get the temp path} 
  GetTempPath(MAX_PATH, lpPathBuffer); 
 {Get the temp file name} 
  GetTempFileName(lpPathBuffer, 
                  'tmp', 
                  0, 
                  lpBuffer); 
 {Free the temp path buffer} 
  FreeMem(lpPathBuffer, MAX_PATH); 
 {$ELSE} 
 {Get the temp file name} 
  GetTempFileName(GetTempDrive('C'), 
                  'tmp', 
                  0, 
                  lpBuffer); 
 {$ENDIF} 
 {Create a pascal string containg} 
 {the  temp file name and return it} 
  result := StrPas(lpBuffer); 
 {Free the file name buffer} 
  FreeMem(lpBuffer, MAX_PATH); 
end; procedure TForm1.LoadWMFFromDatabase; 
var 
  FileStream: TFileStream; {a temp file} 
  BlobStream: TBlobStream; {the WMF Blob} 
begin 
  Image1.Picture.Metafile.Assign(nil); 
 {Create a blob stream for the WMF blob} 
  BlobStream := TBlobStream.Create(Table1WMF, bmRead); 
  if BlobStream.Size = 0 then begin 
   BlobStream.Free; 
   Exit; 
  end; 
 {if we have a temp file then erase it} 
  if FileName <> '' then 
    DeleteFile(FileName); 
 {Get a temp file name} 
  FileName := GetTemporaryFileName; 
 {Create a temp file stream} 
  FileStream := TFileStream.Create(FileName, 
                                   fmCreate or fmOpenWrite); 
 {Copy the blob to the temp file} 
  FileStream.CopyFrom(BlobStream, BlobStream.Size); 
 {Free the streams} 
  FileStream.Free; 
  BlobStream.Free; 
 {Dispaly the image} 
  Image1.Picture.Metafile.LoadFromFile(FileName); 
end; {Save a wmf file to the database} 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  FileStream: TFileStream; {to load the wmf file} 
  BlobStream: TBlobStream; {to save to the blob} 
begin 
 {Allow the button to repaint} 
  Application.ProcessMessages; 
  if OpenDialog1.Execute then begin 
   {Turn off the button} 
    Button1.Enabled := false; 
   {Assign the avi file name to read} 
    FileStream := TFileStream.Create(OpenDialog1.FileName, 
                                     fmOpenRead); 
    Table1.Edit; 
   {Create a BlobStream for the field Table1WMF} 
    BlobStream := TBlobStream.Create(Table1WMF, bmReadWrite); 
   {Seek to the Begginning of the stream} 
    BlobStream.Seek(0, soFromBeginning); 
   {Delete any data that may be there} 
    BlobStream.Truncate; 
   {Copy from the FileStream to the BlobStream} 
    BlobStream.CopyFrom(FileStream, FileStream.Size); 
   {Free the streams} 
    FileStream.Free; 
    BlobStream.Free; 
   {Post the record} 
    Table1.Post; 
   {Load the metafile in to a TImage} 
    LoadWMFFromDatabase; 
   {Enable the button} 
    Button1.Enabled := true; 
  end; 
end; procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField); 
begin 
  if (Sender as TDataSource).State = dsBrowse then 
    LoadWMFFromDatabase; 
end; end. 

Answer 2

procedure TfrmFireDeploy.imgBestMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if p_drag then
  begin
    imgBest.Left := imgBest.Left - (p_oldx - X);
    imgBest.Top := imgBest.Top - (p_oldy -Y);
  end;
end;procedure TfrmFireDeploy.imgBestMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ImgbestWidth, ImgBestHeight: integer;
begin
  if button = mbLeft then
  begin
    screen.Cursor := crSizeAll;
    p_drag := true;
    //没有经过拖动
    if not p_zoom then
    begin
      ImgbestWidth := ImgBest.Width;
      ImgBestHeight := ImgBest.Height;
      imgBest.Align := alNone;
      imgBest.AutoSize := true;
      imgbest.Left := round((ImgbestWidth - imgbest.Width)/2);
      imgbest.Top := round((ImgBestHeight - imgbest.Height)/2);
      //记录控件位置
      p_oldx := x + round((imgbest.Width - ImgbestWidth)/2);
      p_oldY := y + round((imgbest.Height - ImgBestHeight)/2);
      //拖动标记
      p_zoom := true;
    end
    else
    begin
      p_oldx := x;
      p_oldY := y;
    end;
  end;
end;procedure TfrmFireDeploy.imgBestMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if button= mbLeft then
  begin
    p_drag := false;
    if imgbest.Left > Panel15.Width - 100 then
      imgbest.left := panel15.width - 100
    else if imgbest.Left + imgbest.Width < 100 then
      imgbest.Left := 100 - imgbest.Width;
    if imgbest.Top > panel15.Height - 50 then
      imgbest.Top := panel15.Height - 50
    else if imgbest.Top + imgbest.Height < 50 then
      imgbest.Top := 50 - imgbest.Height;
    screen.Cursor := crDefault;
  end;
end;

Answer 3

回cg1120(代码最优化－§帮助那些值得帮助的人§) 的话AotuSize是设为True了