お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"BitMapをスクランブルする"




  ゲーム用等、簡単にSusie Pluginが作れないように(笑)、Bitmapを暗号化とま
では行きませんがスクランブルして保存/復元します。
  非常に手抜きですが、速度とのトレードオフでこんなものでしょうか。64要素
のテーブルを用意して、ScanLineしたのをテーブル参照して入れ替えているだけ
です。適宜テーブルを変更して使用します。



unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
procedure ScrambleBitmap(bmpDst: TBitmap; bmpSrc: TBitmap );
var
  x,y,n,m: Integer;
  prgbDst, prgbSrc: ^Longint;
const
  tbl : array[0..63] of integer = (
  52, 19, 23,  7, 39, 41, 12, 51,
  26, 43, 56, 48,  0,  2, 42, 46,
  57,  9, 30, 58, 21, 61, 24, 14,
   4, 34, 20, 15, 36, 63,  6, 33,
  53, 25, 55, 62, 60, 11, 28, 17,
  18, 44,  1, 49, 47, 54, 40, 45,
  27, 10, 35, 16, 37, 50, 29,  8,
   5, 38, 31, 59, 22,  3, 13, 32
  );
begin
    bmpDst.PixelFormat := pf32Bit;
    bmpSrc.PixelFormat := pf32Bit;

    n := bmpSrc.Height div 64;

    for y := 0 to bmpSrc.height -1  do
    begin
      // コピー元のライン
      prgbSrc := bmpSrc.ScanLine[y];

      // コピー先のラインはスクランブルして
      m := y mod 64;
      begin
        if (y div 64) < n then
           prgbDst := bmpDst.ScanLine[(y div 64)*64 + tbl[m]]
        else
           prgbDst := bmpDst.ScanLine[y];
      end;

      for x := 0 to bmpSrc.width -1 do
      begin
        prgbDst^ := prgbSrc^;
        Inc(prgbDst);
        Inc(prgbSrc);
      end;
    end;
end;

procedure DeScrambleBitmap(bmpDst: TBitmap; bmpSrc: TBitmap );
var
  x,y,n,m: Integer;
  prgbDst, prgbSrc: ^Longint;
const
  tbl : array[0..63] of integer = (
  52, 19, 23,  7, 39, 41, 12, 51,
  26, 43, 56, 48,  0,  2, 42, 46,
  57,  9, 30, 58, 21, 61, 24, 14,
   4, 34, 20, 15, 36, 63,  6, 33,
  53, 25, 55, 62, 60, 11, 28, 17,
  18, 44,  1, 49, 47, 54, 40, 45,
  27, 10, 35, 16, 37, 50, 29,  8,
   5, 38, 31, 59, 22,  3, 13, 32
  );
begin
    bmpDst.PixelFormat := pf32Bit;
    bmpSrc.PixelFormat := pf32Bit;

    n := bmpSrc.Height div 64;
    for y := 0 to bmpSrc.height -1  do

    begin
      // スクランブル解除先ライン
      prgbDst := bmpDst.ScanLine[y];

      // スクランブルされているライン
      m := y mod 64;
      begin
       if (y div 64) < n then
           prgbSrc := bmpSrc.ScanLine[(y div 64)*64 + tbl[m]]
        else
           prgbSrc := bmpSrc.ScanLine[y];
      end;

      for x := 0 to bmpSrc.width -1 do
      begin
        prgbDst^ := prgbSrc^;
        Inc(prgbDst);
        Inc(prgbSrc);
      end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmpDst, bmpSrc: TBitmap;
begin
  bmpDst := TBitmap.Create;
  bmpSrc := TBitmap.Create;

  bmpSrc.LoadFromFile('c:\My Documents\face_s.bmp');
  Image1.Canvas.Draw(0,0, bmpSrc);
  bmpDst.LoadFromFile('c:\My Documents\face_s.bmp');

  ScrambleBitmap(bmpDst, bmpSrc);

  bmpDst.SaveToFile('c:\My Documents\face_s_scr.bmp');
  Image2.Canvas.Draw(0,0, bmpDst);

  bmpDst.Free;
  bmpSrc.Free;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  bmpDst, bmpSrc: TBitmap;
begin
  bmpDst := TBitmap.Create;
  bmpSrc := TBitmap.Create;

  bmpSrc.LoadFromFile('c:\My Documents\face_s_scr.bmp');
  bmpDst.LoadFromFile('c:\My Documents\face_s_scr.bmp');

  DeScrambleBitmap(bmpDst, bmpSrc);

  Image3.Canvas.Draw(0,0, bmpDst);
  bmpDst.SaveToFile('c:\My Documents\face_s_org.bmp');

  bmpDst.Free;
  bmpSrc.Free;

end;

end.


http://www.st.rim.or.jp/~toyozou/
                                     99/01/18(月) 21:06 とよぞう(PXW07530)

Original document by とよぞう        氏 ID:(PXW07530)


ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum