PledgeCrest, AllyCrest -> Tbitmap

[alexteam]

каким образом конвертировать то что приходит в этих информационных пакетах в Tbitmap ?

[xkor]

Прошу: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 просто размерчики подогнать или сделать выбор для них чтоб универсально было
юзать например так (вырезка из моего бота):
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;

[alexteam]

Спасибо... а то я тут такого нагородил (таблица соответствий).. -)

[vahes]

С мемо на форме считываю пакет PledgeCrest в хексе, после определенных переобразований формирую сам пакет по примеру TFixPck, хочу вывести на форму картинку со значком клана, но чет не получается ошибка где-то в функции конвертирования, в чем может быть проблема? Может я неправильно формирую TFixPck. Вот код
procedure TForm1.Button2Click(Sender: TObject);
Type
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
Bmp: TBitmap;
pck: TFixPck;
s: string;
i: integer;

begin
//Формирую pck
pck.size:=2+Round(Length(SymbolEntersCount(Memo1.t ext))/2);
Edit6.Text:=InvertStr(IntToHex(pck.size,4))+Symbol EntersCount(Memo1.text);
s:=HexToString(InvertStr(IntToHex(pck.size,4))+Sym bolEntersCount(Memo1.text));
Edit7.Text:=StringToHex(s,'');

for i:=1 to Length(s) do
begin
pck.ch[i]:=s[i];
pck.bt[i]:=Byte(pck.ch[i]);
if i=3 then pck.id:=Byte(pck.ch[i]);
if i>3 then pck.dbt[i-3]:=pck.bt[i];
end;

for i:=1 to Length(s) do //смотрю че записало в масивы
begin
Edit1.Text:=Edit1.Text+StringToHex(pck.ch[i],' ');
Edit2.Text:=Edit2.Text+IntToHex(pck.bt[i],2);
Edit3.Text:=Edit3.Text+IntToHex(pck.dbt[i],2);
end;
Edit4.Text:=IntToHex(pck.size,4);
Edit5.Text:=IntToHex(pck.id,2);

//формирую Bmp
Bmp:=TBitmap.Create;
//Bmp.PixelFormat:= pf24bit;
try begin
bmp.Width:=DDS_DXT1_To_Bitmap(pck.dbt[8]).width;
bmp.Height:=DDS_DXT1_To_Bitmap(pck.dbt[8]).height;
bmp:=DDS_DXT1_To_Bitmap(pck.dbt[8]);
end;
except on E : Exception do
ShowMessage('с картинкой то говнецо '+E.ClassName+' ошибка: '+E.Message);
end;
Image1.Canvas.Draw(0, 0, bmp);
//Bmp.SaveToFile('c:\test.bmp');
Bmp.Free;
end;

(Такое количество Editов для мониторинга ибо часто ошибаюсь)
и доп. ф-я для ивертации порядка байт в части размера
function InvertStr(s: string):string;
var i,j:integer; r: string;
begin
r:=s;
j:=1;
for i:=1 to round(length(s)/2) do
begin
r[length(s)-j]:=s[j];
r[length(s)+1-j]:=s[j+1];
j:=j+2;
end;
result:=r;
end;
прошу помощи, совета, критики :)

все работает прекрасно, bmp:=DDS_DXT1_To_Bitmap(pck.dbt[9]); считывать с 9го байта надо было

[supernewbie]

заметил что клиент не всегда шлет 0x67 (RequestPledgeCrest), при логине он ещё откуда-то получает инфу о значках

[alexteam]

с кеша.

[xkor]

supernewbie, из SysTextures\Crest.utx, это как сказал алекс - кеш

[vahes]

еще маленький вопросик, заметил одну кляксу, когда присваиваю pck.id значение 3го байта, 2му байту тоже присваивается значение 3го байта. Немогу понять в чем косяк, то ли в формировании массива, то ли может IntToHex как-то косячит и в Эдиты выводится инфа не соответствующая инфе в масивах. Кароче не пойму в чем проблема.:help:

[xkor]

vahes, ну без кода мы тебе ничего не скажем...

[vahes]

//Формирую pck
pck.size:=2+Round(Length(SymbolEntersCount(Memo1.t ext))/2);
Edit6.Text:=InvertStr(IntToHex(pck.size,4))+Symbol EntersCount(Memo1.text);
s:=HexToString(InvertStr(IntToHex(pck.size,4))+Sym bolEntersCount(Memo1.text));
Edit7.Text:=StringToHex(s,'');

for i:=1 to Length(s) do
begin
pck.ch[i]:=s[i];
pck.bt[i]:=Byte(pck.ch[i]);
if i=3 then pck.id:=Byte(pck.ch[i]);
if i>3 then pck.dbt[i-3]:=pck.bt[i];
end;

for i:=1 to Length(s) do //смотрю че записало в масивы
begin
Edit1.Text:=Edit1.Text+StringToHex(pck.ch[i],' ');
Edit2.Text:=Edit2.Text+IntToHex(pck.bt[i],2);
Edit3.Text:=Edit3.Text+IntToHex(pck.dbt[i],2);
end;
Edit4.Text:=IntToHex(pck.size,4);
Edit5.Text:=IntToHex(pck.id,2);

[xkor]

vahes, эм, эт что за бред
pck.bt, pck.ch[i] и pck.dbt[i-3] и так являются одним и тем же байтом, нахера их равнять друг другу?
ну и pck.id = pck.bt[2] = pck.ch[2] = pck.dbt[-1]
а pck.size это pck.bt[0] и pck.bt[1] или pck.ch[0] и pck.ch[1]

[I]Добавлено через 11 минут
да кстати, если у тебя дельфя 2009+ то замени все string и char в которых храниться пакет на ansistring и ansichar

[vahes]

ну просто я посмотрел на твой Type
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);
и решил заполнить все масивы с текста в Мемо, чтобы запись типа была полной (практического применения не предвиделось, просто для себя попрактиковаться хотел).
А по делу, я чет думал что нумерация элементов масива идет с 1цы, а не с 0. В этом скорее всего и ошибка. Спасибо за ответ.
Нет пока с 7й разбираюсь.

[xkor]

vahes, не, нумерация по умолчанию с единицы только у стрингов, у остальных массивов с 0.
А case в обьявлении типа используется чтобы указать что 3 массива располагаются в одном куске памяти и не подряд а прямо друг на друге.

[vahes]

А case в обьявлении типа используется чтобы указать что 3 массива располагаются в одном куске памяти и не подряд а прямо друг на друге.

тоесть заполнять надо только 1 массив? Остальные это типо, тот же массив только с разными типами данных?
Проверил, действительно так и есть, еще раз спс :)

[vahes]

xkor, подскажи пож в каком месте ф-и нужно размерчик подправить например для картинки 64х256

[xkor]

vahes, хм, смотрю вот счас на код и думаю, а какого у меня там размер фиксирован при том что везде он берётся из пакета и только блин в одном месте за каким то фигом указан жестко. Вот тут вот:Result.Canvas.Pixels[x,y-4]:=PColor(@Data[(y*16+x)*4])^;16 это ширина картинки, почему я не поставил вместо 16 там dw.Height (или возможно dw.Height-4) я сейчас не понимаю.

[vahes]

спс ща попробую, у меня еще вопросик, как я понимаю размер картинки идет сначала после 12 байтов мусора(или хз чего), и для PledgeCrest он будет 16х16 и поэтому применяется dw.Height-4 чтобы перейти к размеру 12х16 стандартному для креста правильно?

И кстати
Result.Canvas.Pixels[x,y-4]:=PColor(@Data[(y*dw.Width+x)*4])^;так правильно

[xkor]

правильно