Delphi Tips & Tricks

type
  TRGBStr =record
   B, G, R: Byte;
end;

  TRGBArray =array [0..100000000] of TRGBStr;
  PRGBArray =^TRGBArray;

//値を0〜255に収める為のヘルパー関数
function InByte(const aValue:Integer): Byte;
var
  val: Byte;
begin
  if aValue > 255 then val :=255
  else if aValue < 0 then val :=0
  else val :=aValue;
  Result :=val;
end;

{ComoseBitmap 2枚のビットマップを合成する
 BaseBM ･･･描画の台になるビットマップ
 DrawBM ･･･BaseBMの上に重ね合わせるビットマップ
 X, Y   ･･･DrawBMを描画するBaseBM上の座標
 Alpha  ･･･DrawBMの不透明度}
function ComposeBitmap(BaseBM, DrawBM: TBitmap;
                        X, Y: integer;
                        Alpha: Byte): TBitmap;
var
  PBase, PDraw:  array of PRGBArray; //スキャンラインのキャッシュ用ポインタ配列
  NewBM, CutBase, CutDraw: TBitmap;
  Row, Col, CutWidth, CutHeight: integer;
  R1, G1, B1,        //重ね合わせるビットマップのRGB値
  R2, G2, B2: Byte;  //ベースとなるビットマップのRGB値
  Rect1, Rect2: TRect;
begin
  NewBM :=TBitmap.Create;
  try
    NewBM.Assign(BaseBM);

  Result :=NewBM;
  Rect1 :=Rect(0, 0, BaseBM.Width, BaseBM.Height);
  if not PtinRect(Rect1, Point(X, Y)) then
  begin
    ShowMessage('描画開始座標がベースとなるビットマップの範囲外です。');
    Exit;
  end;

　　//合成する範囲の矩形を計算
    if NewBM.Width < X + DrawBM.Width then
      CutWidth :=NewBM.Width
    else
      CutWidth :=X + DrawBM.Width;

    if NewBM.Height < Y + DrawBM.Height  then
      CutHeight :=NewBM.Height
    else
      CutHeight :=Y + DrawBM.Height;
    
    Rect1 :=Rect(X, Y, CutWidth, CutHeight);
    Rect2 :=Rect(0, 0,
                 Rect1.Right- Rect1.Left,
                 Rect1.Bottom - Rect1.Top);
    CutBase :=TBitmap.Create;
    CutDraw :=TBitmap.Create;
    try
      CutBase.Width :=Rect2.Right;
      CutBase.Height:=Rect2.Bottom;
      CutBase.PixelFormat :=pf24bit;
      CutDraw.Width :=Rect2.Right;
      CutDraw.Height:=Rect2.Bottom;
      CutDraw.PixelFormat :=pf24bit;

      CutBase.Canvas.CopyRect(Rect(0, 0, CutBase.Width, CutBase.Height),
                              NewBM.Canvas, Rect1);
      CutDraw.Canvas.CopyRect(Rect2, DrawBM.Canvas, Rect2);

      GetMem(PBase, CutBase.Height * Sizeof(PTriplearray));
      GetMem(PDraw, CutDraw.Height * Sizeof(PTriplearray));
      try
        //ScanLineをキャッシュ
        for Col :=0 to CutBase.Height -1 do
         PBase[Col] :=CutBase.ScanLine[Col];
        for Col :=0 to CutDraw.Height -1 do
         PDraw[Col] :=CutDraw.ScanLine[Col];

        for Col :=0 to CutBase.Height -1 do
        begin
          for Row :=0 to CutBase.Width -1 do
          begin
            R2 := PBase[Col][Row].R;
            G2 := PBase[Col][Row].G;
            B2 := PBase[Col][Row].B;
            R1 := PDraw[Col][Row].R;
            G1 := PDraw[Col][Row].G;
            B1 := PDraw[Col][Row].B;
            PBase[Col][Row].R  := ( (R1 - R2) * Alpha div 255 + R2);
            PBase[Col][Row].G  := ( (G1 - G2) * Alpha div 255 + G2);
            PBase[Col][Row].B  := ( (B1 - B2) * Alpha div 255 + B2);
          end;
        end;
        NewBM.Canvas.CopyRect(Rect1, CutBase.Canvas, Rect2);
        Result :=NewBM;
      finally
       FreeMem(PBase);
       FreeMem(PDraw);
      end;
    finally
      CutBase.Free;
      CutDraw.Free;
    end;
  except
    NewBM.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  NewBM, BaseBM, DrawBM: TBitmap;
begin
  BaseBM :=TBitmap.Create;
  DrawBM :=TBitmap.Create;
  try
    BaseBM.LoadFromFile('C:\1.bmp');
    DrawBM.LoadFromFile('C:\2.bmp');

    FillChar(NewBM, Sizeof(TBitmap), 0);
    NewBM :=ComposeBitmap(BaseBM, DrawBM, 50, 50, 127);
    try
      Canvas.Draw(20, 20, NewBM);
    finally
      NewBM.Free;
    end;
  finally
    BaseBM.Free;
    DrawBM.Free;
  end;
end;