この発言に対し以下のコメントが寄せられています

#01418　Satobe          さん　RE:謎全さんのTJPEGField互換コンポ(のつも




  
  

  謎の全知師さん作の TJPEGField と互換のコンポのつもりです。
  Delphi6 Paradox形式のデータベースで動作を確認しています。
  以下のソースを適当なパッケージに入れてコンパイル・インストール
  して下さい。

  なお、謎の全知師さんからソースを譲り受けたわけではありませんので
  以下は私のオリジナルソースです。
  そのため、謎の全知師さん作の TJPEGField と完全互換でない部分が
  あるかも知れません。
  ＃必要なら自分で修正してね...(^^;

unit JPEGFld;

interface

uses Classes, DB, DBTables, Graphics, Jpeg;

type
  TJPEGField = class(TGraphicField)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    procedure Assign(Source: TPersistent); override;
  end;

implementation

type
  //Db.pasでローカルに定義されている
  TGraphicHeader = record
    Count: Word;                { Fixed at 1 }
    HType: Word;                { Fixed at $0100 }
    Size: Longint;              { Size not including header }
  end;

procedure TJPEGField.AssignTo(Dest: TPersistent);
var
  BlobStream: TBlobStream;
  Size: Longint;
  Header: TGraphicHeader;
  JPEG: TJPEGImage;
begin
  if Dest is TJPEGImage then begin
    BlobStream := TBlobStream.Create(Self, bmRead);
    try
      Size := BlobStream.Size;
      if Size >= SizeOf(TGraphicHeader) then begin
        BlobStream.Read(Header, SizeOf(Header));
        if (Header.Count = 1) and (Header.HType = $0200) then begin
          //JPEG画像のようだ
        //BlobStream.Position := SizeOf(Header);
          TJPEGImage(Dest).LoadFromStream(BlobStream);
          Exit;
        end;
      end;
    finally
      BlobStream.Free;
    end;
  end;
  if Dest is TPicture then begin
    BlobStream := TBlobStream.Create(Self, bmRead);
    try
      Size := BlobStream.Size;
      if Size >= SizeOf(TGraphicHeader) then begin
        BlobStream.Read(Header, SizeOf(Header));
        if (Header.Count = 1) and (Header.HType = $0200) then begin
          //JPEG画像のようだ
          JPEG := TJPEGImage.Create;
          try
          //BlobStream.Position := SizeOf(Header);
            JPEG.LoadFromStream(BlobStream);
            TPicture(Dest).Assign(JPEG);
            Exit;
          finally
            JPEG.Free;
          end;
        end;
      end;
    finally
      BlobStream.Free;
    end;
  end;

  inherited AssignTo(Dest);
end;

procedure TJPEGField.Assign(Source: TPersistent);
var
  Header: TGraphicHeader;
  BlobStream: TBlobStream;
begin
  if Source is TJPEGImage then begin
    BlobStream := TBlobStream.Create(Self, bmWrite);
    try
      Header.Count := 1;
      Header.HType := $0200;
      Header.Size := 0;
      BlobStream.Write(Header, SizeOf(Header));
      TJPEGImage(Source).SaveToStream(BlobStream);
      Header.Size := BlobStream.Position - SizeOf(Header);
      BlobStream.Position := 0;
      BlobStream.Write(Header, SizeOf(Header));
    finally
      BlobStream.Free;
    end;
    Exit;
  end;

  inherited Assign(Source);
end;

procedure SetDefaultFieldClasses;
type
  PInteger = ^Integer;
var
  p: Pointer;
begin
  //D3,D4,D5ならば↓
  //DefaultFieldClasses[ftGraphic] := TJPEGField;
  p := @DefaultFieldClasses[ftGraphic];
  PInteger(p)^ := Integer(TJPEGField);
end;

initialization
  RegisterClass(TJPEGField);
  SetDefaultFieldClasses;
end.
                                 02/02/22(金) 12:50 Satobe(JCG00336)
 


Original document by Satobe          氏 ID:(JCG00336)

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