rmkthemes.pas

这是整套横扫千军3D版游戏的源码

unit rmkThemes;

interface

uses
  Windows, Messages, Graphics, Types, TBXUtils;

type
  TGradDir = (tgLeftRight, tgTopBottom);

procedure ButtonFrame(Canvas: TCanvas; R: TRect; RL, RR: Integer; c1, c2, c3:
  TColor);
procedure SmartFrame(Canvas: TCanvas; R: TRect; RL, RR: Integer; c1, c2: TColor);
procedure GradientGlass(const Canvas: TCanvas; const ARect: TRect;
            const Aqua:Boolean; const Direction: TGradDir);  Overload;
procedure GradientGlass(const Canvas: TCanvas; const ARect: TRect;
            const Aqua, Dark: Boolean; const Direction: TGradDir); Overload;
procedure OLDGradientFill(const Canvas: TCanvas; const ARect: TRect;
  const StartColor, EndColor: TColor; const Direction: TGradDir);

// ---
{ LOW LEVEL }
function GradientFillWinEnabled: Boolean;
function GradientFillWin(DC: HDC; PVertex: Pointer; NumVertex: Cardinal;
  PMesh: Pointer; NumMesh, Mode: Cardinal): BOOL;
{ HIGH LEVEL }
procedure GradientFill(DC: HDC; const ARect: TRect;
  StartColor, EndColor: TColor; Direction: TGradDir); overload;
procedure GradientFill(Canvas: TCanvas; const ARect: TRect;
  StartColor, EndColor: TColor; Direction: TGradDir); overload;

{ Redeclare TRIVERTEX }
type
  {$EXTERNALSYM COLOR16}
  COLOR16 = Word; { in Delphi Windows.pas wrong declared as Shortint }

  PTriVertex = ^TTriVertex;
  {$EXTERNALSYM _TRIVERTEX}
  _TRIVERTEX = packed record
    x     : Longint;
    y     : Longint;
    Red   : COLOR16;
    Green : COLOR16;
    Blue  : COLOR16;
    Alpha : COLOR16;
  end;
  TTriVertex = _TRIVERTEX;
  {$EXTERNALSYM TRIVERTEX}
  TRIVERTEX = _TRIVERTEX;
// ---


implementation

// ---
type
  TGradientFillWin = function(DC: HDC; PVertex: Pointer; NumVertex: ULONG;
    Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall;
  TGradientFill = procedure(DC: HDC; const ARect: TRect;
    StartColor, EndColor: TColor; Direction: TGradDir);
var
  InitDone        : Boolean = False;
  MSImg32Module   : THandle;
  GradFillWinProc : TGradientFillWin;
  GradFillProc    : TGradientFill;
// ----

procedure ButtonFrame(Canvas: TCanvas; R: TRect; RL, RR: Integer; c1, c2, c3:
  TColor);
var
  Color: TColor;
begin
  with Canvas, R do
  begin
    Color := Pen.Color;
    Pen.Color := c1;
    Dec(Right);
    Dec(Bottom);
    PolyLine([
      Point(Left + RL, Top),
        Point(Right - RR, Top),
        Point(Right, Top + RR),
        Point(Right, Bottom - RR),
        Point(Right - RR, Bottom),
        Point(Left + RL, Bottom),
        Point(Left, Bottom - RL),
        Point(Left, Top + RL),
        Point(Left + RL, Top)
        ]);

    if c2 <> clNone then
    begin
      Pen.Color := c2;
      PolyLine([
        Point(Right, Top + RR),
          Point(Right, Bottom - RR),
          Point(Right - RR, Bottom),
          Point(Left + RL - 1, Bottom)
          ]);
    end;

    Pen.Color := c3;
    if RR > 0 then
    begin
      Inc(Right);
      MoveTo(Right - RR, Top);
      LineTo(Right, Top + RR);
      MoveTo(Right - RR, Bottom);
      LineTo(Right, Bottom - RR);
      Dec(Right);
    end;

    if RL > 0 then
    begin
      Dec(Left);
      MoveTo(Left + RL, Top);
      LineTo(Left, Top + RL);
      MoveTo(Left + RL, Bottom);
      LineTo(Left, Bottom - RL);
      Inc(Left);
    end;

    Inc(Right);
    Inc(Bottom);
    Pen.Color := Color;
  end;
end;

procedure SmartFrame(Canvas: TCanvas; R: TRect; RL, RR: Integer; c1, c2: TColor);
var
  Color: TColor;
begin
  with Canvas, R do
  begin
    Color := Pen.Color;
    Pen.Color := c1;
    Dec(Right);
    Dec(Bottom);
    PolyLine([
      Point(Left + RL, Top),
        Point(Right - RR, Top),
        Point(Right, Top + RR),
        Point(Right, Bottom - RR),
        Point(Right - RR, Bottom),
        Point(Left + RL, Bottom),
        Point(Left, Bottom - RL),
        Point(Left, Top + RL),
        Point(Left + RL, Top)
        ]);
    if c2 <> clNone then
    begin
      Pen.Color := c2;
      PolyLine([
        Point(Right, Top + RR),
          Point(Right, Bottom - RR),
          Point(Right - RR, Bottom),
          Point(Left + RL - 1, Bottom)
          ]);
    end;

    Pen.Color := Blend(Pixels[Left, Top], c1, 60);
    if RL > 0 then
    begin
      Dec(Left);
      MoveTo(Left + RL, Top);
      LineTo(Left, Top + RL);
      MoveTo(Left + RL, Bottom);
      LineTo(Left, Bottom - RL);
      Inc(Left);
    end;

    if c2 <> clNone then
      Pen.Color := Blend(Pixels[Right, Bottom], c2, 60);
    if RR > 0 then
    begin
      Inc(Right);
      MoveTo(Right - RR, Top);
      LineTo(Right, Top + RR);
      MoveTo(Right - RR, Bottom);
      LineTo(Right, Bottom - RR);
      Dec(Right);
    end;

    Inc(Right);
    Inc(Bottom);
    Pen.Color := Color;
  end;
end;

procedure GradientGlass(const Canvas: TCanvas; const ARect: TRect;
  const Aqua, Dark: Boolean; const Direction: TGradDir);
var
  GSize: Integer;
  rc1, rc2, gc1, gc2, bc1, bc2, rc3, gc3, bc3, rc4, gc4, bc4,
    r, g, b, y1, Counter, i, d1, d2, d3: Integer;

  Brush: HBrush;
begin
  if Aqua then
  begin
    if Dark then
    begin
      rc1 := $e0; rc2 := $70; rc3 := $60; rc4 := $A0;
      gc1 := $e8; gc2 := $A0; gc3 := $D0; gc4 := $EF;
      bc1 := $EF; bc2 := $D0; bc3 := $E0; bc4 := $EF;
    end else
    begin
      rc1 := $f0; rc2 := $80; rc3 := $70; rc4 := $B0;
      gc1 := $f8; gc2 := $B0; gc3 := $E8; gc4 := $FF;
      bc1 := $FF; bc2 := $E0; bc3 := $F0; bc4 := $FF;
    end;
  end else
  begin
    rc1 := $F8; rc2 := $d8; rc3 := $f0; rc4 := $F8;
    gc1 := $F8; gc2 := $d8; gc3 := $f0; gc4 := $F8;
    bc1 := $F8; bc2 := $d8; bc3 := $f0; bc4 := $F8;
  end;

  if Direction = tGTopBottom then
  begin
    GSize := (ARect.Bottom - ARect.Top) - 1;
    y1 := GSize div 3;
    if y1 = 0  then y1:= 1;
    d1 := y1;
    d2 := y1 + y1;
    for i := 0 to y1 do
    begin
      r := rc1 + (((rc2 - rc1) * (i)) div y1);
      g := gc1 + (((gc2 - gc1) * (i)) div y1);
      b := bc1 + (((bc2 - bc1) * (i)) div y1);
      if r < 0 then r := 0 else if r > 255 then r := 255;
      if g < 0 then g := 0 else if g > 255 then g := 255;
      if b < 0 then b := 0 else if b > 255 then b := 255;
      Brush := CreateSolidBrush(
        RGB(r, g, b));
      Windows.FillRect(Canvas.Handle, Rect(ARect.Left, ARect.Top + i, ARect.Right, ARect.Top + i + 1), Brush);
      DeleteObject(Brush);
    end;

    for i := y1 to d2 do
    begin
      r := rc2 + (((rc3 - rc2) * (i - d1)) div y1);
      g := gc2 + (((gc3 - gc2) * (i - d1)) div y1);
      b := bc2 + (((bc3 - bc2) * (i - d1)) div y1);
      if r < 0 then r := 0 else if r > 255 then r := 255;
      if g < 0 then g := 0 else if g > 255 then g := 255;
      if b < 0 then b := 0 else if b > 255 then b := 255;
      Brush := CreateSolidBrush(
        RGB(r, g, b));
      Windows.FillRect(Canvas.Handle, Rect(ARect.Left, ARect.Top + i, ARect.Right, ARect.Top + i + 1), Brush);
      DeleteObject(Brush);
    end;

    for i := d2 to GSize do
    begin
      r := rc3 + (((rc4 - rc3) * (i - d2)) div y1);
      g := gc3 + (((gc4 - gc3) * (i - d2)) div y1);
      b := bc3 + (((bc4 - bc3) * (i - d2)) div y1);
      if r < 0 then r := 0 else if r > 255 then r := 255;
      if g < 0 then g := 0 else if g > 255 then g := 255;
      if b < 0 then b := 0 else if b > 255 then b := 255;
      Brush := CreateSolidBrush(
        RGB(r, g, b));
      Windows.FillRect(Canvas.Handle, Rect(ARect.Left, ARect.Top + i, ARect.Right, ARect.Top + i + 1), Brush);
      DeleteObject(Brush);
    end;
  end else
  begin
    GSize := (ARect.Right - ARect.Left) - 1;
    y1 := GSize div 3;
    if y1 = 0  then y1:= 1;
    d1 := y1;
    d2 := y1 + y1;
    for i := 0 to y1 do
    begin
      r := rc1 + (((rc2 - rc1) * (i)) div y1);