PledgeCrest, AllyCrest -> Tbitmap

alexteam · 25.11.2009, 22:33

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

xkor · 26.11.2009, 21:26

Прошу:

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;

alexteam · 26.11.2009, 21:27

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

vahes · 24.07.2011, 15:53

С мемо на форме считываю пакет 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.text))/2);
 Edit6.Text:=InvertStr(IntToHex(pck.size,4))+SymbolEntersCount(Memo1.text);
 s:=HexToString(InvertStr(IntToHex(pck.size,4))+SymbolEntersCount(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 · 24.07.2011, 18:01

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

alexteam · 24.07.2011, 18:19

с кеша.

xkor · 24.07.2011, 19:39

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

vahes · 26.07.2011, 23:20

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

xkor · 26.07.2011, 23:34

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

vahes · 26.07.2011, 23:56

Код:

//Формирую pck
 pck.size:=2+Round(Length(SymbolEntersCount(Memo1.text))/2);
 Edit6.Text:=InvertStr(IntToHex(pck.size,4))+SymbolEntersCount(Memo1.text);
 s:=HexToString(InvertStr(IntToHex(pck.size,4))+SymbolEntersCount(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);