TextOutのXOR描画 (ID:39490)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

ちょっと分かりにくいと思ったので、サンプルを書いてみました。
フォームに適当なコントロールを貼り付けた後、フォーム上でMouseDown,MouseMoveしてみてください。
反転描画ということなので全てのGUIコントロールに対して色の反転した文字を上乗せする形にしてあります。
そもそも、テキスト描画にxor無いですよね？
ちなみに、この方法なら画像でも反転描画が可能ですので応用が効くと思います。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg;

type
  TForm1 = class(TForm)
    Edit1: TEdit;      //描画確認用
    Button1: TButton;  //描画確認用
    Image1: TImage;    //描画確認用
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
    fDC:HDC;
    fDrawPos:TPoint;
  public
    { Public 宣言 }
    fBitmapA:TBitmap; //背景バッファ
    fBitmapB:TBitmap; //実際に描画されるイメージ
    fBitmapC:TBitmap; //テキストを描画したイメージ
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function AddRect(aRectA,aRectB:TRect):TRect;
begin
  Result.Top := aRectA.Top;
  if Result.Top > aRectA.Bottom    then Result.Top := aRectA.Bottom;
  if Result.Top > aRectB.Top       then Result.Top := aRectB.Top;
  if Result.Top > aRectB.Bottom    then Result.Top := aRectB.Bottom;
  Result.Left := aRectA.Left;
  if Result.Left > aRectA.Right    then Result.Top := aRectA.Right;
  if Result.Left > aRectB.Left     then Result.Left := aRectB.Left;
  if Result.Left > aRectB.Right    then Result.Top := aRectB.Right;
  Result.Bottom := aRectA.Bottom;
  if Result.Bottom < aRectA.Top    then Result.Bottom := aRectA.Top;
  if Result.Bottom < aRectB.Bottom then Result.Bottom := aRectB.Bottom;
  if Result.Bottom < aRectB.Top    then Result.Bottom := aRectB.Top;
  Result.Right := aRectA.Right;
  if Result.Right < aRectA.Left    then Result.Right := aRectA.Left;
  if Result.Right < aRectB.Right   then Result.Right := aRectB.Right;
  if Result.Right < aRectB.Left    then Result.Right := aRectB.Left;
end;

procedure XORDraw(var aBackBmp,aTxtBmp:TBitmap);
var
  pT,pB:PByte;
  i: Integer;
begin
  pT := aTxtBmp.ScanLine[aTxtBmp.Height-1];
  pB := aBackBmp.ScanLine[aBackBmp.Height-1];
  for i := 0 to aTxtBmp.Height*aTxtBmp.Width*4 - 1 do
  begin
    if pT^ < 255 then
      pB^ := pB^ - Round(((pB^-128)*2) * ((255-pT^)/255));
    inc(pB); inc(pT);
  end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  str:string;
  r:TRect;
begin
  fDC := GetDCEx(Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS or DCX_LOCKWINDOWUPDATE);
  fBitmapA := TBitmap.Create;
  fBitmapA.SetSize(Width,Height);
  BitBlt(fBitmapA.Canvas.Handle,0,0,Width,Height,fDC,0,0,SRCCOPY);
  fBitmapB := TBitmap.Create;
  fBitmapB.SetSize(Width,Height);
  BitBlt(fBitmapB.Canvas.Handle,0,0,Width,Height,fDC,0,0,SRCCOPY);
  fBitmapB.Canvas.Brush.Style := bsClear;
  str := 'けせらせら';
  fBitmapC := TBitmap.Create;
  fBitmapC.PixelFormat := pf32bit;
  fBitmapC.Canvas.Font.Size := 30;
  r := Rect(0,0,0,0);
  Windows.DrawText(fBitmapC.Canvas.Handle,str,Length(str),&r,DT_CALCRECT );
  fBitmapC.SetSize(r.Right,r.Bottom);
  Windows.DrawText(fBitmapC.Canvas.Handle,str,Length(str),&r,0);
  FormMouseMove(Self,Shift,X,Y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  aBMP:TBitmap;
  r:TRect;
begin
  if fDC <> 0 then
  begin
    r := AddRect(Rect(X,Y,X+fBitmapC.Width,Y+fBitmapC.Height),
                 Rect(fDrawPos.X,fDrawPos.Y,fDrawPos.X+fBitmapC.Width,fDrawPos.Y+fBitmapC.Height));
    BitBlt(fBitmapB.Canvas.Handle,fDrawPos.X,fDrawPos.Y,fBitmapC.Width,fBitmapC.Height,
      fBitmapA.Canvas.Handle,fDrawPos.X,fDrawPos.Y,SRCCOPY);
    aBMP := TBitmap.Create;
    aBMP.PixelFormat := pf32bit;
    aBMP.SetSize(fBitmapC.Width,fBitmapC.Height);
    BitBlt(aBMP.Canvas.Handle,0,0,aBMP.Width,aBMP.Height,fBitmapA.Canvas.Handle,X,Y,SRCCOPY);
    XORDraw(aBMP,fBitmapC);
    BitBlt(fBitmapB.Canvas.Handle,X,Y,fBitmapC.Width,fBitmapC.Height,aBMP.Canvas.Handle,0,0,SRCCOPY);
    BitBlt(fDC,r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top,fBitmapB.Canvas.Handle,r.Left,r.Top,SRCCOPY);
    fDrawPos := Point(X,Y);
    aBMP.Free;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  BitBlt(fDC,0,0,Width,Height,fBitmapA.Canvas.Handle,0,0,SRCCOPY);
  ReleaseDC(Handle,fDC);
  fBitmapA.Free;
  fBitmapB.Free;
  fBitmapC.Free;
  fDC := 0;
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る