Как работать с 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/