Прошу:
delphi Код:
unit DDS_DXT1;
interface
uses Graphics;
type
Color8888 = record
r: byte;
g: byte;
b: byte;
a: byte;
end;
function DDS_DXT1_To_Bitmap(var dat): TBitmap;
implementation
procedure ReadColor(Data: Word; var OutD: Color8888);
var
r, g, b: Byte;
begin
b := Data and $1f;
g := (Data and $7E0) shr 5;
r := (Data and $F800) shr 11;
OutD.r := r shl 3;
OutD.g := g shl 2;
OutD.b := b shl 3;
end;
function DDS_DXT1_To_Bitmap(var dat): TBitmap;
var
x, y, i, j, k, Select: Integer;
Temp: PByte;
dw: packed record
data1: array[0..11] of Byte;
Height: Integer;
Width: Integer;
end absolute dat;
colours: array[0..3] of Color8888;
color_0, color_1: Word;
bitmask, Offset: Cardinal;
Data: array of Byte;
begin
try
SetLength(Data,dw.Width*dw.Height*4);
Temp := PByte(Cardinal(@dat)+128);
colours[0].a := $FF;
colours[1].a := $FF;
colours[2].a := $FF;
for y := 0 to (dw.Height div 4)-1 do begin
for x := 0 to (dw.Width div 4)-1 do begin
color_0 := PWord(Temp)^;
Inc(Temp,2);
color_1 := PWord(Temp)^;
ReadColor(color_0, colours[0]);
ReadColor(color_1, colours[1]);
Inc(Temp,2);
bitmask := PCardinal(Temp)^;
Inc(Temp,4);
if (color_0 > color_1) then begin
colours[2].b := (2 * colours[0].b + colours[1].b + 1) div 3;
colours[2].g := (2 * colours[0].g + colours[1].g + 1) div 3;
colours[2].r := (2 * colours[0].r + colours[1].r + 1) div 3;
colours[3].b := (colours[0].b + 2 * colours[1].b + 1) div 3;
colours[3].g := (colours[0].g + 2 * colours[1].g + 1) div 3;
colours[3].r := (colours[0].r + 2 * colours[1].r + 1) div 3;
colours[3].a := $FF;
end else begin
colours[2].b := (colours[0].b + colours[1].b) div 2;
colours[2].g := (colours[0].g + colours[1].g) div 2;
colours[2].r := (colours[0].r + colours[1].r) div 2;
colours[3].b := (colours[0].b + 2 * colours[1].b + 1) div 3;
colours[3].g := (colours[0].g + 2 * colours[1].g + 1) div 3;
colours[3].r := (colours[0].r + 2 * colours[1].r + 1) div 3;
colours[3].a := $00;
end;
k:=0;
for j := 0 to 3 do begin
for i := 0 to 3 do begin
Select := (bitmask and ($03 shl (k*2))) shr (k*2);
if (((x*4 + i) < dw.Width) and ((y*4 + j) < dw.Height)) then begin
Offset := (y*4 + j) * dw.Width*4 + (x*4 + i) * 4;
Data[Offset + 0] := colours[Select].r;
Data[Offset + 1] := colours[Select].g;
Data[Offset + 2] := colours[Select].b;
Data[Offset + 3] := 0;//colours[Select].a;
end;
Inc(k);
end;
end;
end;
end;
Result:=TBitmap.Create;
Result.SetSize(dw.Width,dw.Height-4);
for y := 4 to dw.Height-1 do
for x := 0 to dw.Width-1 do
Result.Canvas.Pixels[x,y-4]:=PColor(@Data[(y*16+x)*4])^;
except
Result:=nil;
end;
end;
end.
писал это ещё под С4 но вроде с тех пор в этом ничего не менялось, тут правда тока для PledgeCrest, но для AllyCrest просто размерчики подогнать или сделать выбор для них чтоб универсально было
юзать например так (вырезка из моего бота):
delphi Код:
TFixPck = packed record case Integer of
0:(ch: array[Word] of Char);
1:(bt: array[Word] of Byte);
2:(size: Word;
id: Byte;
dbt: array[0..65532] of Byte);
end;
var pck: TFixPck;
procedure TBotMain.RecvPledgeCrest;
var
_clan: TClan;
begin
_clan:=wo.GetClanByClanCrestId(rwpck.ReadD);
if _clan<>nil then _clan.bmpIcon:=DDS_DXT1_To_Bitmap(pck.dbt[8]);
end;