4日目 CopyFromBitmapのバグ?

本当はバグかどうか分からいけど、なんだか動作がおかしい。たぶん自分がTbitmapの初期化について何か間違った理解をしているんだと思うけど。

とりあえずの対応策として

http://qc.embarcadero.com/wc/qcmain.aspx?d=111324 より

procedure CopyFromBitmapNew(const Source, Dest: TBitmap; SrcRect: TRect; DstX, DstY: Integer);
var
  I: Integer;
  S, D: TBitmapData;
  DstR: TRect;
  MaxWidth : integer;
  MaxHeight: Integer;
begin
  if Dest.Map(TMapAccess.maWrite, D) then
  begin
    if Source.Map(TMapAccess.maRead, S) then
    begin
      if (DstX = 0) and (DstY = 0) and (SrcRect.Left = 0) and (SrcRect.Top = 0) and (SrcRect.Width = Dest.Width) and
         (SrcRect.Height = Dest.Height) and (D.Pitch = S.Pitch) then
        Move(S.Data^, D.Data^, D.Pitch * Dest.Height)
      else
      begin
        IntersectRect(SrcRect, Rect(0, 0, Source.Width, Source.Height));
        DstR := Rect(DstX, DstY, DstX + SrcRect.Width, DstY + SrcRect.Height);
        IntersectRect(DstR, Rect(0, 0, Dest.Width, Dest.Height));
        if (DstR.Width = SrcRect.Width) and (DstR.Height = SrcRect.Height) then
        begin
          MaxHeight := Min(SrcRect.Bottom - 1, Dest.Height - DstY - 1);
          for I := SrcRect.Top to MaxHeight do
          begin
            MaxWidth := Min(SrcRect.Width, Dest.Width - DstX);
            Move(PAlphaColorArray(S.Data)[SrcRect.Left + (I * (S.Pitch div 4))],
              PAlphaColorArray(D.Data)[DstY*Dest.Width + (I - SrcRect.Top) * (D.Pitch div 4) + DstX], MaxWidth * 4);
          end;
        end;
      end;
      Source.Unmap(S);
    end;
    Dest.Unmap(D);
  end;
end;

コメントを残す

メールアドレスが公開されることはありません。


3 × = 二十 七

次のHTML タグと属性が使えます: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>