Changeset 46

Timestamp:

Jan 11, 2017, 8:12:01 AM (8 years ago)

Author:

chronos

Message:

• Fixed: Some graphic drawing problems caused by different pixel byte width of bitmaps under Linux.

Location:

trunk

Files:

• ScreenTools.pas (modified) (10 diffs)
• Start.pas (modified) (7 diffs)

trunk/ScreenTools.pas

@@ -19 +19 @@
   end;
 
+  TColor32 = type Cardinal;
+  TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
+  TPixel32 = packed record
+   case Integer of
+     0: (B, G, R, A: Byte);
+     1: (ARGB: TColor32);
+     2: (Planes: array[0..3] of Byte);
+     3: (Components: array[TColor32Component] of Byte);
+  end;
+  PPixel32 = ^TPixel32;
+
 {$IFDEF WINDOWS}
 function ChangeResolution(x, y, bpp, freq: integer): boolean;
 {$ENDIF}
+function GetBitmapPixelPtr(Bitmap: TBitmap; X, Y: Integer): PPixel32;
 procedure RestoreResolution;
 function Play(Item: string; Index: integer = -1): boolean;
@@ -272 +284 @@
 end;
 
+function GetBitmapPixelPtr(Bitmap: TBitmap; X, Y: Integer): PPixel32;
+begin
+  Result := Pointer(Bitmap.RawImage.Data) + X * (Bitmap.RawImage.Description.BitsPerPixel shr 3) + Y * Bitmap.RawImage.Description.BytesPerLine;
+end;
+
 procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0);
 var
@@ -514 +531 @@
 
 function LoadGraphicSet(Name: string): integer;
-type
-  TLine = array [0 .. 999, 0 .. 2] of Byte;
 var
   i, x, y, xmax, OriginalColor: integer;
   FileName: string;
   Source: TBitmap;
-  DataLine, MaskLine: ^TLine;
+  DataPixel, MaskPixel: PPixel32;
 begin
   i := 0;
@@ -556 +571 @@
     for y := 0 to Source.Height - 1 do
     begin
-      DataLine := GrExt[nGrExt].Data.ScanLine[y];
-      MaskLine := GrExt[nGrExt].Mask.ScanLine[y];
       for x := 0 to xmax - 1 do
       begin
-        OriginalColor := Cardinal((@DataLine[x])^) and $FFFFFF;
+        DataPixel := GetBitmapPixelPtr(GrExt[nGrExt].Data, x, y);
+        MaskPixel := GetBitmapPixelPtr(GrExt[nGrExt].Mask, x, Y);
+
+        OriginalColor := DataPixel^.ARGB and $FFFFFF;
         if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then
         begin // transparent
-          Cardinal((@MaskLine[x])^) := $FFFFFF;
-          Cardinal((@DataLine[x])^) := Cardinal((@DataLine[x])^) and $FF000000
+          MaskPixel^.ARGB := $FFFFFF;
+          DataPixel^.ARGB := DataPixel^.ARGB and $FF000000
         end
         else
         begin
-          Cardinal((@MaskLine[x])^) := $000000; // non-transparent
+          MaskPixel^.ARGB := $000000; // non-transparent
           if Gamma <> 100 then
           begin
-            DataLine[x, 0] := GammaLUT[DataLine[x, 0]];
-            DataLine[x, 1] := GammaLUT[DataLine[x, 1]];
-            DataLine[x, 2] := GammaLUT[DataLine[x, 2]];
+            DataPixel^.B := GammaLUT[DataPixel^.B];
+            DataPixel^.G := GammaLUT[DataPixel^.G];
+            DataPixel^.R := GammaLUT[DataPixel^.R];
           end
         end
@@ -621 +637 @@
 // Src is template
 // X channel = background amp (old Dst content), 128=original brightness
-type
-  TPixel = array [0 .. 2] of Byte;
 var
   i, Brightness, test: integer;
   PixelSrc: ^Byte;
-  PixelDst: ^TPixel;
+  PixelDst: PPixel32;
 begin
   {TODO assert(Src.PixelFormat = pf8bit);}
@@ -654 +668 @@
   while yDst < h do
   begin
-    PixelDst := dst.ScanLine[yDst] + 3 * xDst;
+    PixelDst := GetBitmapPixelPtr(dst, xDst, yDst);
     PixelSrc := Src.ScanLine[ySrc] + xSrc;
     for i := 0 to w - 1 do
     begin
       Brightness := PixelSrc^;
-      test := (PixelDst[2] * Brightness) shr 7;
+      test := (PixelDst^.R * Brightness) shr 7;
+      if test >= 256 then PixelDst^.R := 255
+        else PixelDst^.R := test; // Red
+      test := (PixelDst^.G * Brightness) shr 7;
+      if test >= 256 then PixelDst^.G := 255
+        else PixelDst^.G := test; // Green
+      test := (PixelDst^.B * Brightness) shr 7;
       if test >= 256 then
-        PixelDst[2] := 255
+        PixelDst^.R := 255
       else
-        PixelDst[2] := test; // Red
-      test := (PixelDst[1] * Brightness) shr 7;
-      if test >= 256 then
-        PixelDst[1] := 255
-      else
-        PixelDst[1] := test; // Green
-      test := (PixelDst[0] * Brightness) shr 7;
-      if test >= 256 then
-        PixelDst[2] := 255
-      else
-        PixelDst[0] := test; // Blue
-      PixelDst := Pointer(PixelDst) + 3;
+        PixelDst^.B := test; // Blue
+      PixelDst := Pointer(PixelDst) + (Dst.RawImage.Description.BitsPerPixel shr 3);
       PixelSrc := Pointer(PixelSrc) + 1;
     end;
@@ -690 +700 @@
 // G channel = Color1 amp, 128=original brightness
 // R channel = Color2 amp, 128=original brightness
-type
-  TLine = array [0 .. 9999, 0 .. 2] of Byte;
 var
   ix, iy, amp1, amp2, trans, Value: integer;
-  SrcLine, DstLine: ^TLine;
+  SrcPixel, DstPixel: PPixel32;
 begin
   if xDst < 0 then begin
@@ -717 +725 @@
   for iy := 0 to h - 1 do
   begin
-    SrcLine := Src.ScanLine[ySrc + iy];
-    DstLine := dst.ScanLine[yDst + iy];
     for ix := 0 to w - 1 do
     begin
-      trans := SrcLine[xSrc + ix, 0] * 2; // green channel = transparency
-      amp1 := SrcLine[xSrc + ix, 1] * 2;
-      amp2 := SrcLine[xSrc + ix, 2] * 2;
+      SrcPixel := GetBitmapPixelPtr(Src, xSrc + ix, ySrc + iy);
+      DstPixel := GetBitmapPixelPtr(Dst, xDst + ix, yDst + iy);
+      trans := SrcPixel^.B * 2; // green channel = transparency
+      amp1 := SrcPixel^.G * 2;
+      amp2 := SrcPixel^.R * 2;
       if trans <> $FF then
       begin
-        Value := (DstLine[xDst + ix][0] * trans + ((Color2 shr 16) and $FF) * amp2
+        Value := (DstPixel^.B * trans + ((Color2 shr 16) and $FF) * amp2
           + ((Color1 shr 16) and $FF) * amp1) div $FF;
-        if Value < 256 then
-          DstLine[xDst + ix][0] := Value
-        else
-          DstLine[xDst + ix][0] := 255;
-        Value := (DstLine[xDst + ix][1] * trans + ((Color2 shr 8) and $FF) * amp2
+        if Value < 256 then DstPixel^.B := Value
+        else DstPixel^.B := 255;
+        Value := (DstPixel^.G * trans + ((Color2 shr 8) and $FF) * amp2
           + ((Color1 shr 8) and $FF) * amp1) div $FF;
-        if Value < 256 then
-          DstLine[xDst + ix][1] := Value
-        else
-          DstLine[xDst + ix][1] := 255;
-        Value := (DstLine[xDst + ix][2] * trans + (Color2 and $FF) * amp2 +
+        if Value < 256 then DstPixel^.G := Value
+          else DstPixel^.G := 255;
+        Value := (DstPixel^.R * trans + (Color2 and $FF) * amp2 +
           (Color1 and $FF) * amp1) div $FF;
-        if Value < 256 then
-          DstLine[xDst + ix][2] := Value
-        else
-          DstLine[xDst + ix][2] := 255;
-      end
-    end
+        if Value < 256 then DstPixel^.R := Value
+          else DstPixel^.R := 255;
+      end;
+    end;
   end;
   Src.EndUpdate;
@@ -757 +759 @@
 // G channel = Color1 amp, 128=original brightness
 // R channel = Color2 amp, 128=original brightness
-type
-  TPixel = array [0 .. 2] of Byte;
 var
   i, Red, Green: integer;
-  Pixel: ^TPixel;
+  Pixel: PPixel32;
 begin
   bmp.BeginUpdate;
@@ -768 +768 @@
   while y < h do
   begin
-    Pixel := pointer(bmp.ScanLine[y]) + 3 * x;
+    Pixel := GetBitmapPixelPtr(Bmp, x, y);
     for i := 0 to w - 1 do
     begin
-      Red := ((Pixel[0] * (Color0 and $0000FF) + Pixel[1] * (Color1 and $0000FF)
-        + Pixel[2] * (Color2 and $0000FF)) shr 8) and $ff;
-      Green := ((Pixel[0] * (Color0 shr 8 and $0000FF) + Pixel[1] *
-        ((Color1 shr 8) and $0000FF) + Pixel[2] * ((Color2 shr 8) and
+      Red := ((Pixel^.B * (Color0 and $0000FF) + Pixel^.G * (Color1 and $0000FF)
+        + Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff;
+      Green := ((Pixel^.B * ((Color0 shr 8) and $0000FF) + Pixel^.G *
+        ((Color1 shr 8) and $0000FF) + Pixel^.R * ((Color2 shr 8) and
         $0000FF)) shr 8) and $ff;
-      Pixel[0] := ((Pixel[0] * (Color0 shr 16 and $0000FF) + Pixel[1] *
-        ((Color1 shr 16) and $0000FF) + Pixel[2] * ((Color2 shr 16) and $0000FF))
+      Pixel^.B := ((Pixel^.B * ((Color0 shr 16) and $0000FF) + Pixel^.G *
+        ((Color1 shr 16) and $0000FF) + Pixel^.R * ((Color2 shr 16) and $0000FF))
         shr 8) and $ff; // Blue
-      Pixel[1] := Green;
-      Pixel[2] := Red;
-      Pixel := pointer(Pixel) + 3;
+      Pixel^.G := Green;
+      Pixel^.R := Red;
+      Pixel := pointer(Pixel) + (Bmp.RawImage.Description.BitsPerPixel shr 3);
     end;
     inc(y);

trunk/Start.pas

@@ -5 +5 @@
 
 uses
-  GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area,
-
-  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
+  GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Math,
+  LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
   Menus, Registry;
 
@@ -451 +450 @@
     BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkAge0 - 1, cliDimmedText],
       $000000, xAction, y + 21, Phrases2.Lookup(TextItem));
-    BitBlt(LogoBuffer.Canvas.Handle, 0, 0, 50, 50, Canvas.Handle,
+    BitBltCanvas(LogoBuffer.Canvas, 0, 0, 50, 50, Canvas,
       xActionIcon - 2, y - 2, SRCCOPY);
     GlowFrame(LogoBuffer, 8, 8, 34, 34, $202020);
@@ -566 +565 @@
           h := ClientHeight - ActionBottomBorder -
             (yAction + SelectedAction * ActionPitch - 8);
-        BitBlt(LogoBuffer.Canvas.Handle, 0, 0, w, h, Canvas.Handle,
+        BitBltCanvas(LogoBuffer.Canvas, 0, 0, w, h, Canvas,
           ActionSideBorder + i * wBuffer, yAction + SelectedAction * ActionPitch
           - 8, SRCCOPY);
@@ -822 +821 @@
 
 procedure TStartDlg.FormShow(Sender: TObject);
-type
-  TLine = array [0 .. 99999999] of Byte;
-var
-  i, x, y: integer;
-  PictureLine: ^TLine;
+var
+  x, y: integer;
+  PicturePixel: PPixel32;
 begin
   SetMainTextureByAge(-1);
@@ -836 +833 @@
   for y := 0 to 63 do
   begin // darken texture for empty slot
-    PictureLine := EmptyPicture.ScanLine[y];
-    for x := 0 to 64 * 3 - 1 do
-    begin
-      i := integer(PictureLine[x]) - 28;
-      if i < 0 then
-        i := 0;
-      PictureLine[x] := i;
+    for x := 0 to 64 - 1 do
+    begin
+      PicturePixel := GetBitmapPixelPtr(EmptyPicture, x, y);
+      PicturePixel^.B := Max(PicturePixel^.B - 28, 0);
+      PicturePixel^.G := Max(PicturePixel^.G - 28, 0);
+      PicturePixel^.R := Max(PicturePixel^.R - 28, 0);
     end
   end;
@@ -1004 +1000 @@
 
   procedure PaintRandomMini(Brightness: integer);
-  type
-    TLine = array [0 .. lxmax * 2, 0 .. 2] of Byte;
   var
     i, x, y, xm, cm: integer;
-    MiniLine: ^TLine;
+    MiniPixel: PPixel32;
     Map: ^TTileList;
   begin
@@ -1016 +1010 @@
 
     Mini.PixelFormat := pf24bit;
-    Mini.width := MiniWidth * 2;
-    Mini.height := MiniHeight;
+    Mini.SetSize(MiniWidth * 2, MiniHeight);
     Mini.BeginUpdate;
-    for y := 0 to MiniHeight - 1 do
-    begin
-      MiniLine := Mini.ScanLine[y];
-      for x := 0 to MiniWidth - 1 do
-        for i := 0 to 1 do
-        begin
+    for y := 0 to MiniHeight - 1 do begin
+      for x := 0 to MiniWidth - 1 do begin
+        for i := 0 to 1 do begin
           xm := (x * 2 + i + y and 1) mod (MiniWidth * 2);
+          MiniPixel := GetBitmapPixelPtr(Mini, xm, y);
           cm := MiniColors
             [Map[x * lxmax div MiniWidth + lxmax *
             ((y * (lymax - 1) + MiniHeight div 2) div (MiniHeight - 1))] and
             fTerrain, i];
-          MiniLine[xm, 0] := cm shr 16 * Brightness div 3;
-          MiniLine[xm, 1] := cm shr 8 and $FF * Brightness div 3;
-          MiniLine[xm, 2] := cm and $FF * Brightness div 3;
+          MiniPixel^.B := ((cm shr 16) and $FF) * Brightness div 3;
+          MiniPixel^.G := ((cm shr 8) and $FF) * Brightness div 3;
+          MiniPixel^.R := ((cm shr 0) and $FF) * Brightness div 3;
         end;
+      end;
     end;
     Mini.EndUpdate;