Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как работать с DWG файлами (AutoCAD)?

01.01.2007

Vit: Примечания в коде были на каком-то не то китайском, не то японском языке - удалены!

unit DWGView;
 
interface
 
uses
 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 
ExtCtrls;
 
type
  BITMAPINFO256
= record
    bmiHeader
: BITMAPINFOHEADER;
    bmiColors
: array[0..255] of RGBQUAD;
 
end;
 
type
 
TNoPreviewEvent = procedure(Sender: TOBject) of object;
 
TFileErrorEvent = procedure(Sender: TOBject; DWGName: string) of object;
 
 
TDWGView = class(TImage)
 
private
   
FDWGVersion: string;
   
FDWGFile: string;
   
FNoPreviewEvent: TNoPreviewEvent;
   
FOnFileError: TFileErrorEvent;
   
FImage: TImage;
    procedure
SetDWGFile(const Value: string);
    procedure
SetFImage(const Value: TImage);
 
protected
    procedure
ReadDWG;
   
constructor TDWGView;
 
public
  published
    property
Image: TImage read FImage write SetFImage;
    property
DWGFile: string read FDWGFile write SetDWGFile;
    property
DWGVersion: string read FDWGVersion;
    property
OnNoPreview: TNoPreviewEvent read FNoPreviewEvent write FNoPreviewEvent;
    property
OnFileError: TFileErrorEvent read FOnFileError write FOnFileError;
 
end;
 
procedure
Register;
 
implementation
 
procedure
Register;
begin
 
RegisterComponents('Voice', [TDWGView]);
end;
 
procedure
TDWGView.ReadDWG;
var
  DWGF
: TFileStream;
 
MemF: TMemoryStream;
  BMPF
: TMemoryStream;
 
SentinelF: TMemoryStream;
  bif
: BITMAPINFO256;
  bfh
: BITMAPFILEHEADER;
 
PosSentinel: LongInt;
 
LenPreview: Integer;
 
RasterPreview: ShortInt;
 
PosBMP: Integer;
 
LenBMP: Integer;
 
IndexPreview: Integer;
 
TypePreview: Shortint;
begin
 
if Assigned(FOnFileError) then
   
FOnFileError(Self, FDWGFile);
  DWGF
:= TFileStream.Create(FDWGFile, fmOpenRead);
  BMPF
:= TMemoryStream.Create;
 
MemF := TMemoryStream.Create;
 
SentinelF := TMemoryStream.Create;
 
try
   
SetLength(FDWGVersion, 6);
    DWGF
.ReadBuffer(FDWGVersion[1], 6);
    DWGF
.Position := 13;
    DWGF
.Read(PosSentinel, 4);
    DWGF
.Position := PosSentinel;
   
SentinelF.CopyFrom(DWGF, 16);
    DWGF
.Read(LenPreview, 4);
    DWGF
.Read(RasterPreview, 1);
   
for IndexPreview := RasterPreview - 1 downto 0 do
   
begin
     
MemF.Position := 0;
     
MemF.CopyFrom(DWGF, 9);
     
MemF.Position := 0;
     
MemF.Read(TypePreview, 1);
     
case TypePreview of
       
1: ;
       
2:
         
begin
           
MemF.Position := 1;
           
MemF.Read(PosBMP, 4);
           
MemF.Read(LenBMP, 4);
            DWGF
.Position := PosBMP;
            DWGF
.ReadBuffer(bif, sizeof(bif));
 
           
with bif do
           
begin
              bmiColors
[0].rgbBlue := 0;
              bmiColors
[0].rgbGreen := 0;
              bmiColors
[0].rgbRed := 0;
 
              bmiColors
[225].rgbBlue := 255;
              bmiColors
[225].rgbGreen := 255;
              bmiColors
[225].rgbRed := 255;
           
end;
 
            bfh
.bfType := $4D42;
            bfh
.bfSize := LenBMP + sizeof(bfh);
            bfh
.bfReserved1 := 0;
            bfh
.bfReserved2 := 0;
            bfh
.bfOffBits := 14 + $28 + 1024;
 
            BMPF
.Position := 0;
            BMPF
.Write(bfh, sizeof(bfh));
            BMPF
.WriteBuffer(bif, sizeof(bif));
            BMPF
.CopyFrom(DWGF, LenBMP - 1064);
            BMPF
.Position := 0;
           
Picture.Bitmap.LoadFromStream(BMPF);
         
end;
       
3: ;
     
end;
 
   
end;
 
finally
   
SentinelF.Free;
   
MemF.Free;
    DWGF
.Free;
    BMPF
.Free;
 
end;
 
end;
 
procedure
TDWGView.SetDWGFile(const Value: string);
begin
 
FDWGFile := Value;
 
ReadDWG;
end;
 
procedure
TDWGView.SetFImage(const Value: TImage);
begin
 
FImage := Value;
end;
 
constructor TDWGView.TDWGView;
begin
 
//TODO: Add your source code here
 
FDWGFile := '';
 
FDWGVersion := '';
end;
 
end.

Взято с Delphi Knowledge Base: https://www.baltsoft.com/