[ZURG]

У меня проблема с выводом изображения при глубине цвета 32 бита. Есть процедура для вывода линии используя DirectDraw, при глубине цвета 16 бит. Вот фрагмент:

Код:

procedure DrawLine(surf: IDirectDrawSurface7; X1, Y1,
             X2, Y2:Integer; r, g, b:BYTE);
var
 c:WORD;
 NS:Integer;
 desc:DDSURFACEDESC2;
 dst:PByteArray;
 DX, DY, iOffset, i:Integer;
begin
 c := (trunc(b/8) + (trunc(g/4) SHL 5) + (trunc(r/8) shl 11));

 // Если первая точка выше, то меняем их местами,
 // чтобы всегда рисовать сверху вниз
 if (Y2<Y1) then
  begin
   NS:=Y1;
   Y1:=Y2;
   Y2:=NS;

   NS:=X1;
   X1:=X2;
   X2:=NS;
  end;

 // Блокировка поверхности
 ZeroMemory(@desc, sizeof(desc));
 desc.dwSize := sizeof(desc);
    
 if (surf.Lock(nil, desc, DDLOCK_WAIT, 0)=DD_OK) then
  begin
   dst := desc.lpSurface;
   DX := abs(X2-X1);
   DY := abs(Y2-Y1);
   iOffset := Y1*desc.lPitch+X1*2;

   // Рисуем слева направо
   if (X1<=X2) then
    begin
     //Рисуем слева направо и Х изменяется чаще
     if (DX>DY) then
      begin
       NS:=DX div 2;
       for i:=0 to DX do
        begin
         PWordArray(dst)^[iOffset div 2]:=c;
         iOffset:=iOffset+2;
         NS:=NS-DY;
         if (NS<0) then
          begin
           iOffset:=iOffset+desc.lPitch;
           NS:=NS+DX;
          end;
        end;
      end
     else
.............

Я не как не могу понять как переделать эту процедуру под режим 32 бита. Подскажите пожалуйста решение этой не хитрой проблемы.

[zip000]

Попробуй так

Код:

procedure DrawLine(surf: IDirectDrawSurface7; X1, Y1,
             X2, Y2:Integer; r, g, b:BYTE);
var
 c : Longword;
 NS : Integer;
 desc : DDSURFACEDESC2;
 DX, DY, iOffset, i : Integer;
begin
 c := b + (g SHL 8) + (r shl 16);

 // Если первая точка выше, то меняем их местами,
 // чтобы всегда рисовать сверху вниз
 if (Y2<Y1) then
  begin
   NS:=Y1;
   Y1:=Y2;
   Y2:=NS;

   NS:=X1;
   X1:=X2;
   X2:=NS;
  end;

 // Блокировка поверхности
 ZeroMemory(@desc, sizeof(desc));
 desc.dwSize := sizeof(desc);

 if (surf.Lock(nil, desc, DDLOCK_WAIT, 0)=DD_OK) then
  begin
   DX := abs(X2-X1);
   DY := abs(Y2-Y1);
   iOffset := Y1*desc.lPitch+X1*4;

   // Рисуем слева направо
   if (X1<=X2) then
    begin
     //Рисуем слева направо и Х изменяется чаще
     if (DX>DY) then
      begin
       NS:=DX div 2;
       for i:=0 to DX do
        begin
         PLongWord(LongWord(desc.lpSurface)+iOffset)^:=c;
         iOffset:=iOffset+4;
         NS:=NS-DY;
         if (NS<0) then
          begin
           iOffset:=iOffset+desc.lPitch;
           NS:=NS+DX;
          end;
        end;
      end
     else
...........

[ZURG]

Спасибо большое, всё работает.