Changeset 62

Timestamp:

Jan 13, 2017, 7:45:16 PM (8 years ago)

Author:

chronos

Message:

• Fixed: Replaced ScanLine access be linux supported pixel access.

Location:

trunk

Files:

• LocalPlayer/Draft.lfm (modified) (4 diffs)
• LocalPlayer/Draft.pas (modified) (3 diffs)
• LocalPlayer/MessgEx.pas (modified) (4 diffs)
• ScreenTools.pas (modified) (4 diffs)

trunk/LocalPlayer/Draft.lfm

@@ -1 +1 @@
 object DraftDlg: TDraftDlg
   Left = 325
+  Height = 511
   Top = 206
+  Width = 315
   BorderIcons = []
   BorderStyle = bsNone
@@ -7 +9 @@
   ClientWidth = 315
   Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
   Font.Height = -13
   Font.Name = 'MS Sans Serif'
-  Font.Style = []
   FormStyle = fsStayOnTop
   OnCreate = FormCreate
@@ -18 +18 @@
   OnMouseUp = PaintBox1MouseUp
   OnShow = FormShow
-  PixelsPerInch = 96
+  LCLVersion = '1.6.0.4'
   object OKBtn: TButtonA
     Left = 196
+    Height = 25
     Top = 477
     Width = 100
-    Height = 25
     Down = False
     Permanent = False
     OnClick = OKBtnClick
-    Caption = ''
   end
   object CloseBtn: TButtonB
     Left = 284
+    Height = 25
     Top = 6
     Width = 25
-    Height = 25
     Down = False
     Permanent = False
@@ -41 +40 @@
   object GroundArea: TArea
     Left = 30
+    Height = 36
     Top = 464
     Width = 36
-    Height = 36
   end
   object SeaArea: TArea
     Left = 70
+    Height = 36
     Top = 464
     Width = 36
-    Height = 36
   end
   object AirArea: TArea
     Left = 110
+    Height = 36
     Top = 464
     Width = 36
-    Height = 36
   end
 end

trunk/LocalPlayer/Draft.pas

@@ -19 +19 @@
     AirArea: TArea;
     procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
     procedure FormShow(Sender: TObject);
     procedure CloseBtnClick(Sender: TObject);
@@ -26 +27 @@
     procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; x, y: integer);
-    procedure FormDestroy(Sender: TObject);
   public
     procedure ShowNewContent(NewMode: integer);
@@ -232 +232 @@
 begin
   inherited;
+  // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it
+  Back.Canvas.FillRect(0, 0, Back.Width, Back.Height);
 
   ClientHeight := Template.Height - Cut;

trunk/LocalPlayer/MessgEx.pas

@@ -232 +232 @@
   wScrewed = 43;
   hScrewed = 27;
-type
-  TLine = array [0 .. 9999, 0 .. 2] of Byte;
 var
   ix, iy, xDst, yDst, dx, dy, xIcon, yIcon, xb, yb, wb, hb: integer;
   x1, xR, yR, share: single;
   Screwed: array [0 .. wScrewed - 1, 0 .. hScrewed - 1, 0 .. 3] of single;
-  SrcLine: ^TLine;
-
-begin
-  if IconIndex >= 0 then
-  begin
+  SrcPtr: TPixelPointer;
+begin
+  if IconIndex >= 0 then begin
     xIcon := IconIndex mod 7 * xSizeBig;
     yIcon := (IconIndex + SystemIconLines * 7) div 7 * ySizeBig;
@@ -248 +244 @@
     fillchar(Screwed, sizeof(Screwed), 0);
     BigImp.BeginUpdate;
-    for iy := 0 to 39 do
-    begin
-      SrcLine := BigImp.ScanLine[iy + yIcon];
-      for ix := 0 to 55 do
-      begin
+    for iy := 0 to 39 do begin
+      for ix := 0 to 55 do begin
+        SrcPtr.Init(BigImp, ix + xIcon, iy + yIcon);
         xR := ix * (37 + iy * 5 / 40) / 56;
         xDst := Trunc(xR);
@@ -261 +255 @@
         yR := Frac(yR);
         for dx := 0 to 1 do
-          for dy := 0 to 1 do
-          begin
+          for dy := 0 to 1 do begin
             if dx = 0 then
               share := 1 - xR
@@ -272 +265 @@
               share := share * yR;
             Screwed[xDst + dx, yDst + dy, 0] := Screwed[xDst + dx, yDst + dy, 0]
-              + share * SrcLine[ix + xIcon, 0];
+              + share * SrcPtr.Pixel^.B;
             Screwed[xDst + dx, yDst + dy, 1] := Screwed[xDst + dx, yDst + dy, 1]
-              + share * SrcLine[ix + xIcon, 1];
+              + share * SrcPtr.Pixel^.G;
             Screwed[xDst + dx, yDst + dy, 2] := Screwed[xDst + dx, yDst + dy, 2]
-              + share * SrcLine[ix + xIcon, 2];
+              + share * SrcPtr.Pixel^.R;
             Screwed[xDst + dx, yDst + dy, 3] := Screwed[xDst + dx, yDst + dy,
               3] + share;

trunk/ScreenTools.pas

@@ -38 +38 @@
     BytesPerPixel: Integer;
     BytesPerLine: Integer;
-    procedure NextLine;
-    procedure NextPixel;
-    procedure SetXY(X, Y: Integer);
-    procedure SetX(X: Integer);
-    procedure Init(Bitmap: TBitmap; X: Integer = 0; Y: Integer = 0);
+    procedure NextLine; inline;
+    procedure NextPixel; inline;
+    procedure SetXY(X, Y: Integer); inline;
+    procedure SetX(X: Integer); inline;
+    procedure Init(Bitmap: TBitmap; X: Integer = 0; Y: Integer = 0); inline;
   end;
 
@@ -624 +624 @@
 
 procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
-type
-  TLine = array [0 .. 99999, 0 .. 2] of Byte;
-  PLine = ^TLine;
-
-  procedure BlueLine(line: PLine; Length: integer);
-  var
-    i: integer;
-  begin
-    for i := 0 to Length - 1 do
-    begin
-      line[i, 0] := line[i, 0] div 2;
-      line[i, 1] := line[i, 1] div 2;
-      line[i, 2] := line[i, 2] div 2;
-    end
-  end;
-
-var
-  i: integer;
-begin
-  dst.BeginUpdate;
-  for i := 0 to h - 1 do
-    BlueLine(@(PLine(dst.ScanLine[y + i])[x]), w);
-  dst.EndUpdate;
+var
+  XX, YY: Integer;
+  PixelPtr: TPixelPointer;
+begin
+  Dst.BeginUpdate;
+  PixelPtr.Init(Dst, 0, 0);
+  for yy := 0 to h - 1 do begin
+    for xx := 0 to w - 1 do begin
+      PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2;
+      PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2;
+      PixelPtr.Pixel^.R := PixelPtr.Pixel^.R div 2;
+      PixelPtr.NextPixel;
+    end;
+    PixelPtr.NextLine;
+  end;
+  Dst.EndUpdate;
 end;
 
@@ -916 +909 @@
 
 procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
-type
-  TLine = array [0 .. 649, 0 .. 2] of Byte;
 var
   x, y, ch, r: integer;
-  DstLine: ^TLine;
+  DstPtr: TPixelPointer;
 begin
   dst.BeginUpdate;
   for y := -GlowRange + 1 to Height - 1 + GlowRange - 1 do
   begin
-    DstLine := dst.ScanLine[y0 + y];
     for x := -GlowRange + 1 to Width - 1 + GlowRange - 1 do
     begin
+      DstPtr.Init(dst, x0 + x, y0 + y);
       if x < 0 then
         if y < 0 then
@@ -952 +943 @@
       if r < GlowRange then
         for ch := 0 to 2 do
-          DstLine[x0 + x][2 - ch] :=
-            (DstLine[x0 + x][2 - ch] * (r - 1) + (cl shr (8 * ch) and $FF) *
+          DstPtr.Pixel^.Planes[2 - ch] :=
+            (DstPtr.Pixel^.Planes[2 - ch] * (r - 1) + (cl shr (8 * ch) and $FF) *
             (GlowRange - r)) div (GlowRange - 1);
     end;