Форум программистов [Powered by Invision Power Board]

Код

unit DwgPreview;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ExtCtrls;

type
  TDwgPreview = class(TImage)
  private
    FFileName: string;
    procedure SetFileName(Value: string);
    procedure ImportDwgThumbnail(DWGFileName: string);
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property FileName: string read FFileName write SetFileName;
  end;

procedure Register;

implementation

constructor TDwgPreview.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TDwgPreview.Destroy;
begin
  inherited Destroy;
end;

procedure TDwgPreview.SetFileName(Value: string);
begin
  FFileName := Value;
  ImportDwgThumbnail(pchar(Value));
end;

procedure TDwgPreview.ImportDwgThumbnail(DWGFileName: string);
const
  ImageSentinel: array[0..15] of Byte =
  ($1F, $25, $6D, $07, $D4, $36, $28, $28, $9D, $57, $CA, $3F, $9D, $44, $10,
    $2B);
type
  TDwgFileHeader = packed record
    Signature: array[0..5] of Char;
    Unused: array[0..6] of Char;
    ImageSeek: LongInt;
  end;
var
  DwgFile: file;
  StoreFileMode: Byte;
  DwgFileHeader: TDwgFileHeader;
  DwgSentinelData: array[0..15] of Byte;

  function LoadBMPData(const BitmapInfo: PBitmapInfo): Boolean;
  var
    BitmapHandle: HBITMAP;
    Bits: Pointer;
    NumColors: Integer;
    DC: HDC;

    function GetDInColors(BitCount: Word): Integer;
    begin
      case BitCount of
        1, 4, 8: Result := 1 shl BitCount;
      else
        Result := 0;
      end;
    end;

  begin
    Result := False;
    DC := GetDC(0);
    if DC = 0 then
      Exit;
    try
      with BitmapInfo^ do
      begin
        NumColors := GetDInColors(bmiHeader.biBitCount);
        Bits := Pointer(Longint(BitmapInfo) + SizeOf(bmiHeader) + NumColors *
          SizeOf(TRGBQuad));
      end;
      BitmapHandle := CreateDIBitmap(DC, BitmapInfo.bmiHeader, CBM_INIT, Bits,
        BitmapInfo^, DIB_RGB_COLORS);
      if BitmapHandle <> 0 then
      begin
         inherited Picture.Bitmap.Handle := BitmapHandle;
         inherited Show;
        Result := True;
      end;
    finally
      ReleaseDC(0, DC);
    end;
  end;


  procedure ProcessImageData;
  type
    TImageDataHeader = packed record
      TotalCount: LongInt;
      ImagesPresent: Byte;
    end;
    TImageDataRecord = packed record
      DataType: Byte;
      StartOfData: LongInt;
      SizeOfData: LongInt;
    end;
  var
    ImageHeader: TImageDataHeader;
    ImageRecord: TImageDataRecord;
    BMPData, WMFData: TImageDataRecord;
    ThumbData: Pointer;
  begin
    BlockRead(DwgFile, ImageHeader, SizeOf(ImageHeader));
    if ImageHeader.TotalCount + FilePos(DwgFile) > FileSize(DwgFile) then
      Exit;
    FillChar(BMPData, SizeOf(BMPData), 0);
    FillChar(WMFData, SizeOf(WMFData), 0);
    while (IOResult = 0) and (ImageHeader.ImagesPresent > 0) do
    begin
      BlockRead(DwgFile, ImageRecord, SizeOf(ImageRecord));
      if (IOResult <> 0) or (ImageRecord.StartOfData > FileSize(DwgFile)) then
        Break;
      case ImageRecord.DataType of
        2: BMPData := ImageRecord;
        3: WMFData := ImageRecord;
      end;
      Dec(ImageHeader.ImagesPresent);
    end;
    if BMPData.StartOfData > 0 then
      ImageRecord := BMPData
    else
      Exit;
    Seek(DwgFile, ImageRecord.StartOfData);
    GetMem(ThumbData, ImageRecord.SizeOfData);
    BlockRead(DwgFile, ThumbData^, ImageRecord.SizeOfData);
    try
        LoadBMPData(ThumbData);
    finally
      FreeMem(ThumbData);
    end;
  end;

begin
  Visible:=False;
  StoreFileMode := FileMode;
  FileMode := 0;
  System.Assign(DwgFile, DWGFileName);
  Reset(DwgFile, 1);
  FileMode := StoreFileMode;
  if IOResult <> 0 then
    Exit;
  try
    BlockRead(DwgFile, DwgFileHeader, SizeOf(DwgFileHeader));
    if (IOResult = 0) and (Copy(DwgFileHeader.Signature, 1, 4) = 'AC10') and
      (DwgFileHeader.ImageSeek <= FileSize(DwgFile)) then
    begin
      Seek(DwgFile, DwgFileHeader.ImageSeek);
      BlockRead(DwgFile, DwgSentinelData, SizeOf(DwgSentinelData));
      if (IOResult = 0) and CompareMem(@DwgSentinelData, @ImageSentinel,
        SizeOf(DwgSentinelData)) then
        ProcessImageData;
    end;
  finally
    Close(DwgFile);
  end;
end;

procedure Register;
begin
  RegisterComponents('Acad', [TDwgPreview]);
end;

end.