Changeset 347 for trunk

Timestamp:

Apr 6, 2021, 7:39:39 PM (3 years ago)

Author:

chronos

Message:

• Modified: Optimized drawing in InitOrnament procedure.

Location:

trunk

Files:

• Direct.pas (modified) (3 diffs)
• Install/deb/debian/control (modified) (1 diff)
• Packages/CevoComponents/DrawDlg.pas (modified) (3 diffs)
• Packages/CevoComponents/ScreenTools.pas (modified) (1 diff)
• Packages/CevoComponents/Sound.pas (modified) (2 diffs)
• Packages/CevoComponents/UPixelPointer.pas (modified) (2 diffs)

trunk/Direct.pas

@@ -31 +31 @@
     procedure SetInfo(x: string);
     procedure SetState(x: integer);
-    procedure OnGo(var m: TMessage); message WM_GO;
-    procedure OnChangeClient(var m: TMessage); message WM_CHANGECLIENT;
-    procedure OnNextPlayer(var m: TMessage); message WM_NEXTPLAYER;
+    procedure OnGo(var Msg: TMessage); message WM_GO;
+    procedure OnChangeClient(var Msg: TMessage); message WM_CHANGECLIENT;
+    procedure OnNextPlayer(var Msg: TMessage); message WM_NEXTPLAYER;
     procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION;
   end;
@@ -200 +200 @@
 end;
 
-procedure TDirectDlg.OnGo(var m: TMessage);
+procedure TDirectDlg.OnGo(var Msg: TMessage);
 var
   i: integer;
@@ -255 +255 @@
 end;
 
-procedure TDirectDlg.OnChangeClient(var m: TMessage);
+procedure TDirectDlg.OnChangeClient(var Msg: TMessage);
 begin
   ChangeClient;
 end;
 
-procedure TDirectDlg.OnNextPlayer(var m: TMessage);
+procedure TDirectDlg.OnNextPlayer(var Msg: TMessage);
 begin
   NextPlayer;

trunk/Install/deb/debian/control

@@ -1 +1 @@
 Source: c-evo
 Maintainer: Chronos <robie@centrum.cz>
-Section: devel
+Section: games
 Priority: optional
 Standards-Version: 1.3.0

trunk/Packages/CevoComponents/DrawDlg.pas

@@ -23 +23 @@
     // defines area to grip the window for moving (from top)
     procedure InitButtons;
-    procedure OnEraseBkgnd(var m: TMessage); message WM_ERASEBKGND;
+    procedure OnEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
     procedure OnHitTest(var Msg: TMessage); message WM_NCHITTEST;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
@@ -84 +84 @@
 end;
 
-procedure TDrawDlg.OnEraseBkgnd(var m: TMessage);
+procedure TDrawDlg.OnEraseBkgnd(var Msg: TMessage);
 begin
   // Full area should be covered by Paint method
@@ -118 +118 @@
           end;
         end;
-      Msg.Result := HTCAPTION
+      Msg.Result := HTCAPTION;
     end;
   end;

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -1035 +1035 @@
 procedure InitOrnament;
 var
-  x, y, p, Light, Shade: Integer;
+  P: TColor;
+  X, Y: Integer;
+  Light, Shade: TColor32;
+  PixelPtr: TPixelPointer;
 begin
   if InitOrnamentDone then Exit;
-  Light := MainTexture.clBevelLight;
+  Light := ColorToColor32(MainTexture.clBevelLight);
   // and $FCFCFC shr 2*3+MainTexture.clBevelShade and $FCFCFC shr 2;
-  Shade := MainTexture.clBevelShade and $FCFCFC shr 2 * 3 +
-    MainTexture.clBevelLight and $FCFCFC shr 2;
-  for x := 0 to Ornament.Width - 1 do
-    for y := 0 to Ornament.Height - 1 do begin
-      p := HGrSystem2.Data.Canvas.Pixels[Ornament.Left + x, Ornament.Top + y];
-      if p = $0000FF then
-        HGrSystem2.Data.Canvas.Pixels[Ornament.Left + x, Ornament.Top + y] := Light
-      else if p = $FF0000 then
-        HGrSystem2.Data.Canvas.Pixels[Ornament.Left + x, Ornament.Top + y] := Shade;
-    end;
+  Shade := ColorToColor32(MainTexture.clBevelShade and $FCFCFC shr 2 * 3 +
+    MainTexture.clBevelLight and $FCFCFC shr 2);
+  HGrSystem2.Data.BeginUpdate;
+  PixelPtr := PixelPointer(HGrSystem2.Data, ScaleToNative(Ornament.Left), ScaleToNative(Ornament.Top));
+  if PixelPtr.BytesPerPixel = 3 then begin
+    for Y := 0 to ScaleToNative(Ornament.Height) - 1 do begin
+      for X := 0 to ScaleToNative(Ornament.Width) - 1 do begin
+        P := Color32ToColor(PixelPtr.Pixel^.RGB);
+        if P = $0000FF then PixelPtr.Pixel^.RGB := Light
+        else if P = $FF0000 then PixelPtr.Pixel^.RGB := Shade;
+        PixelPtr.NextPixel;
+      end;
+      PixelPtr.NextLine;
+    end;
+  end else begin
+    for Y := 0 to ScaleToNative(Ornament.Height) - 1 do begin
+      for X := 0 to ScaleToNative(Ornament.Width) - 1 do begin
+        P := Color32ToColor(PixelPtr.Pixel^.ARGB);
+        if P = $0000FF then PixelPtr.Pixel^.ARGB := Light
+        else if P = $FF0000 then PixelPtr.Pixel^.ARGB := Shade;
+        PixelPtr.NextPixel;
+      end;
+      PixelPtr.NextLine;
+    end;
+  end;
   InitOrnamentDone := True;
+  HGrSystem2.Data.EndUpdate;
 end;
 

trunk/Packages/CevoComponents/Sound.pas

@@ -19 +19 @@
     {$IFDEF WINDOWS}
     PrevWndProc: WNDPROC;
-    procedure OnMCI(var m: TMessage); message MM_MCINOTIFY;
+    procedure OnMCI(var Msg: TMessage); message MM_MCINOTIFY;
   public
     constructor Create(AOwner: TComponent); override;
@@ -255 +255 @@
 end;
 
-procedure TSoundPlayer.OnMCI(var m: TMessage);
-begin
-  if (m.wParam = MCI_NOTIFY_SUCCESSFUL) and (PlayingSound <> nil) then
+procedure TSoundPlayer.OnMCI(var Msg: TMessage);
+begin
+  if (Msg.wParam = MCI_NOTIFY_SUCCESSFUL) and (PlayingSound <> nil) then
   begin
     PlayingSound.Reset;

trunk/Packages/CevoComponents/UPixelPointer.pas

@@ -46 +46 @@
   function PixelPointer(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; inline;
   function SwapRedBlue(Color: TColor32): TColor32;
+  function Color32ToColor(Color: TColor32): TColor;
+  function ColorToColor32(Color: TColor): TColor32;
 
 implementation
@@ -113 +115 @@
 end;
 
+function Color32ToColor(Color: TColor32): TColor;
+begin
+  Result := ((Color shr 16) and $ff) or (Color and $00ff00) or
+    ((Color and $ff) shl 16);
+end;
+
+function ColorToColor32(Color: TColor): TColor32;
+begin
+  Result := $ff000000 or ((Color shr 16) and $ff) or (Color and $00ff00) or
+    ((Color and $ff) shl 16);
+end;
 
 end.