Последние записи
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
- Взаимодействие через командную строку
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
- wprintf как напечатать кириллицу
- Взаимодействие через командную строку
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
10th
Фев
Чтение файла DWG
Posted by bullvinkle under Delphi, Топик-обзор
Есть файл *.dwg, хранящий график кривой. Подскажите как можно прочитать координаты точек, составляющих кривую. Пишу в Delphi 7. Желательно без использования дополнительных библиотек и компонентов. Полезная ссылка по DWG. Возможно в файле хранится сама функция, по которой пострен график? Вообщем просветите кто-что знает или подкиньте ссылку.
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.
Похожие статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)