1 | unit UShpFile;
|
---|
2 |
|
---|
3 | {$mode delphi}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, Contnrs, Graphics, UDecode, Types;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TShpFile = class;
|
---|
12 |
|
---|
13 | { TShpFileItem }
|
---|
14 |
|
---|
15 | TShpFileItem = class
|
---|
16 | Index: Integer;
|
---|
17 | Parent: TShpFile;
|
---|
18 | Offset: Integer;
|
---|
19 | Size: Integer;
|
---|
20 | procedure GetBitmap(Bitmap: TBitmap);
|
---|
21 | end;
|
---|
22 |
|
---|
23 | { TShpFile }
|
---|
24 |
|
---|
25 | TShpFile = class
|
---|
26 | private
|
---|
27 | F: TFileStream;
|
---|
28 | function GetOpenned: Boolean;
|
---|
29 | public
|
---|
30 | Palette: ^TIntegerDynArray;
|
---|
31 | Items: TObjectList; // TList<TShpFileItem>
|
---|
32 | procedure Open(FileName: string);
|
---|
33 | procedure Close;
|
---|
34 | constructor Create;
|
---|
35 | destructor Destroy; override;
|
---|
36 | property Openned: Boolean read GetOpenned;
|
---|
37 | end;
|
---|
38 |
|
---|
39 | implementation
|
---|
40 |
|
---|
41 |
|
---|
42 | { TShpFileItem }
|
---|
43 |
|
---|
44 | procedure TShpFileItem.GetBitmap(Bitmap: TBitmap);
|
---|
45 | var
|
---|
46 | Flags: Word;
|
---|
47 | Slices: Byte;
|
---|
48 | Width: Word;
|
---|
49 | Height: Byte;
|
---|
50 | FileSize: Word;
|
---|
51 | DataSize: Word;
|
---|
52 | Data: array of Byte;
|
---|
53 | Data2: array of Byte;
|
---|
54 | Data3: array of Byte;
|
---|
55 | X, Y: Integer;
|
---|
56 | Offsets: array of Byte;
|
---|
57 | C: Integer;
|
---|
58 | begin
|
---|
59 | Parent.F.Position := Offset;
|
---|
60 | Flags := Parent.F.ReadWord;
|
---|
61 | Slices := Parent.F.ReadByte;
|
---|
62 | Width := Parent.F.ReadWord;
|
---|
63 | Height := Parent.F.ReadByte;
|
---|
64 | FileSize := Parent.F.ReadWord;
|
---|
65 | DataSize := Parent.F.ReadWord;
|
---|
66 | if (Flags and 1) > 0 then begin
|
---|
67 | SetLength(Offsets, 16);
|
---|
68 | Parent.F.Read(Offsets[0], Length(Offsets));
|
---|
69 | end;
|
---|
70 | if (Flags and 2) = 0 then begin
|
---|
71 | SetLength(Data, Offset + Size - Parent.F.Position);
|
---|
72 | Parent.F.Read(Data[0], Length(Data));
|
---|
73 | Data2 := Format80(Data);
|
---|
74 | end else begin
|
---|
75 | SetLength(Data2, Offset + Size - Parent.F.Position);
|
---|
76 | Parent.F.Read(Data2[0], Length(Data));
|
---|
77 | end;
|
---|
78 | Data3 := Format20(Data2);
|
---|
79 | //SetLength(Data3, Length(Data2));
|
---|
80 | //Move(Data2[0], Data3[0], Length(Data2));
|
---|
81 |
|
---|
82 | // Save to image
|
---|
83 | Bitmap.SetSize(Width, Height);
|
---|
84 | Bitmap.Canvas.FillRect(0, 0, Bitmap.Width - 1, Bitmap.Height - 1);
|
---|
85 | for Y := 0 to Height - 1 do
|
---|
86 | for X := 0 to Width - 1 do
|
---|
87 | if X + Y * Width < Length(Data3) then begin
|
---|
88 | C := Data3[X + Y * Width];
|
---|
89 | if (Flags and 1) > 0 then begin
|
---|
90 | if C < 16 then C := Offsets[C]
|
---|
91 | else C := Data3[C - 16];
|
---|
92 | end;
|
---|
93 | C := Parent.Palette^[C];
|
---|
94 | Bitmap.Canvas.Pixels[X, Y] := C;
|
---|
95 | end;
|
---|
96 | end;
|
---|
97 |
|
---|
98 | { TShpFile }
|
---|
99 |
|
---|
100 | function TShpFile.GetOpenned: Boolean;
|
---|
101 | begin
|
---|
102 | Result := Assigned(F);
|
---|
103 | end;
|
---|
104 |
|
---|
105 | procedure TShpFile.Open(FileName: string);
|
---|
106 | var
|
---|
107 | I: Integer;
|
---|
108 | NewItem: TShpFileItem;
|
---|
109 | begin
|
---|
110 | Close;
|
---|
111 | F := TFileStream.Create(FileName, fmOpenRead);
|
---|
112 | Items.Count := F.ReadWord;
|
---|
113 | for I := 0 to Items.Count - 1 do begin
|
---|
114 | NewItem := TShpFileItem.Create;
|
---|
115 | NewItem.Index := I;
|
---|
116 | NewItem.Parent := Self;
|
---|
117 | NewItem.Offset := F.ReadDWord + 2;
|
---|
118 | if I > 0 then
|
---|
119 | TShpFileItem(Items[I - 1]).Size := NewItem.Offset - TShpFileItem(Items[I - 1]).Offset;
|
---|
120 | Items[I] := NewItem;
|
---|
121 | end;
|
---|
122 | if Items.Count > 0 then
|
---|
123 | TShpFileItem(Items.Last).Size := F.Size - TShpFileItem(Items.Last).Offset;
|
---|
124 | end;
|
---|
125 |
|
---|
126 | procedure TShpFile.Close;
|
---|
127 | begin
|
---|
128 | if Openned then begin
|
---|
129 | Items.Count := 0;
|
---|
130 | FreeAndNil(F);
|
---|
131 | end;
|
---|
132 | end;
|
---|
133 |
|
---|
134 | constructor TShpFile.Create;
|
---|
135 | begin
|
---|
136 | Items := TObjectList.Create;
|
---|
137 | end;
|
---|
138 |
|
---|
139 | destructor TShpFile.Destroy;
|
---|
140 | begin
|
---|
141 | Close;
|
---|
142 | FreeAndNil(Items);
|
---|
143 | inherited Destroy;
|
---|
144 | end;
|
---|
145 |
|
---|
146 | end.
|
---|
147 |
|
---|