tbxmacosxg32theme.pas

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

unit TBXMacOSXG32Theme;

interface

{$I TB2Ver.inc}
{$I TBX.inc}

uses
  Windows, Messages, Graphics, TBXThemes, TBXDefaultTheme, ImgList,
  PngImage, GR32;

type
  TItemPart = (ipBody, ipText, ipFrame);
  TBtnItemState = (bisNormal, bisDisabled, bisSelected, bisPressed, bisHot,
    bisDisabledHot, bisSelectedHot, bisPopupParent);
  TMenuItemState = (misNormal, misDisabled, misHot, misDisabledHot);
  TWinFramePart = (wfpBorder, wfpCaption, wfpCaptionText);
  TWinFrameState = (wfsActive, wfsInactive);

  TTBXMacOSXg32Theme= class(TTBXDefaultTheme)//TTBXTheme)//
  private
//    FInterpolationMode: Integer;
    procedure EnlargeBitmap(Source:TBitmap32; Target:TCanvas; SourceRect, TargetRect:TRect; VSideSize:Integer=3; HSideSize:Integer=3); overload;
    procedure DrawImage(Source:TBitmap32; Target:TCanvas; SourceRect:TRect; x,y: Integer);
    Procedure DrawStripeBG(Target: TCanvas; R:TRect; AColor:TColor);
  protected
    { View/Window Colors }
    DockColor: TColor;
    MenuBarColor: TColor;
    ToolbarColor: TColor;
    StatusbarColor: TColor;
    PopupColor: TColor;
    DockPanelColor: TColor;
    PopupFrameColor: TColor;
    WinFrameColors: array [TWinFrameState, TWinFramePart] of TColor;
    PnlFrameColors: array [TWinFrameState, TWinFramePart] of TColor;
    MenuItemColors: array [TMenuItemState, TItemPart] of TColor;
    BtnItemColors: array [TBtnItemState, TItemPart] of TColor;
    SeparatorColor: TColor;
    PopupSeparatorColor:TColor;
    DefaultRoughness: Integer;
    procedure SetupColorCache; virtual;
    function GetPartColor(const ItemInfo: TTBXItemInfo; ItemPart: TItemPart): TColor;
    function GetBtnColor(const ItemInfo: TTBXItemInfo; ItemPart: TItemPart): TColor;
  public
    constructor Create(const AName: string); override;
    destructor Destroy; override;

    function GetIntegerMetrics(Index: Integer): Integer; override;
    function GetItemColor(const ItemInfo: TTBXItemInfo): TColor; override;
    function GetItemTextColor(const ItemInfo: TTBXItemInfo): TColor; override;
    function GetItemImageBackground(const ItemInfo: TTBXItemInfo): TColor; override;
    function GetViewColor(AViewType: Integer): TColor; override;

    procedure PaintBackgnd(Canvas: TCanvas; const ADockRect, ARect, AClipRect: TRect; AColor: TColor; Transparent: Boolean; AViewType: Integer); override;
    procedure PaintButton(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo); override;
    procedure PaintDock(Canvas: TCanvas; const ClientRect, DockRect: TRect; DockPosition: Integer); override;
    procedure PaintDockPanelNCArea(Canvas: TCanvas; R: TRect; const DockPanelInfo: TTBXDockPanelInfo); override;
    procedure PaintDropDownArrow(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo); override;
    procedure PaintComboArrow(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo);
    procedure PaintEditButton(Canvas: TCanvas; const ARect: TRect; var ItemInfo: TTBXItemInfo; ButtonInfo: TTBXEditBtnInfo); override;
    procedure PaintEditFrame(Canvas: TCanvas; const ARect: TRect; var ItemInfo: TTBXItemInfo; const EditInfo: TTBXEditInfo); override;
    procedure PaintFrameControl(Canvas: TCanvas; R: TRect; Kind, State: Integer; Params: Pointer); override;
    procedure PaintFloatingBorder(Canvas: TCanvas; const ARect: TRect; const WindowInfo: TTBXWindowInfo); override;
    procedure PaintImage(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo; ImageList: TCustomImageList; ImageIndex: Integer); override;
    procedure PaintMenuItem(Canvas: TCanvas; const ARect: TRect; var ItemInfo: TTBXItemInfo); override;
    procedure PaintMenuItemFrame(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo); override;
    procedure PaintMDIButton(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo; ButtonKind: Cardinal); override;
    procedure PaintSeparator(Canvas: TCanvas; ARect: TRect; ItemInfo: TTBXItemInfo; Horizontal, LineSeparator: Boolean); override;
    procedure PaintToolbarNCArea(Canvas: TCanvas; R: TRect; const ToolbarInfo: TTBXToolbarInfo); override;
  public
//    property InterpolationMode: Integer read FInterpolationMode write FInterpolationMode default InterpolationModeNearestNeighbor;
  end;

Var
  HotColor, BaseColor, BaseShade: TColor;

implementation

uses
  TBXUtils, TB2Item, TB2Common, Classes, Controls, Forms, Commctrl,
  SysUtils, ActiveX, TBXUxThemes, Types;

{$R macr.RES}

type TGraphicAccess = class(TGraphic);

function PngObjectToBitmap32(APng: TPngObject; ADIB: TBitmap32): integer;
var
  i, j: integer;
  P: PColor32;
  A: PByte;
  ABmp: TBitmap;
  Canvas: TCanvas;
begin
  ABmp := TBitmap.Create;
  try
    // assign to the a bitmap
    APng.AssignTo(ABmp);

    // We now *draw* the bitmap to our bitmap.. this will clear alpha in places
    // where drawn.. so we can use it later
    ADib.SetSize(APng.Width, APng.Height);
    ADib.Clear(clBlack32);
    //ADib.Canvas.Draw(0,0, ABmp);
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := ADib.Handle;
      TGraphicAccess(ABmp).Draw(Canvas, Rect(0, 0, ADib.Width, ADib.Height));
    finally
      Canvas.Free;
    end;

    // Flip the alpha channel
    P := @ADib.Bits[0];
    for i := 0 to ADib.Width * ADib.Height - 1 do begin
      P^ := P^ XOR $FF000000;
      inc(P);
    end;

    // The previous doesn't handle bitwise alpha info, so we do that here
    for i := 0 to APng.Height - 1 do begin
      A := PByte(APng.AlphaScanLine[i]);
      if assigned(A) then begin
        P := @ADib.Bits[i * ADib.Width];
        for j := 0 to APng.Width - 1 do begin
          P^ := SetAlpha(P^, A^);
          inc(P); inc(A);
        end;
      end else
        break;
    end;

    // Arriving here means "all ok"
    Result := 1;
  finally
    //APng.Free;
    ABmp.Free;
  end;
end;

Var
  StockBitmap: TBitmap = nil;

Procedure DrawBitmap32Rect(AHDC:HDC; x,y: Integer; Bmp32:TBitmap32; const RSrc: TRect);
Var
  ImageWidth, ImageHeight: Integer;
  I, J: Integer;
  srcx, srcy:Integer;
  Src: PColor32;
  Dst: PColor;//^Cardinal;
  S, C, CBRB, CBG: Cardinal;
  Wt1, Wt2: Cardinal;
Begin
  If Not Assigned(StockBitmap) then
  Begin
    StockBitmap:= TBitmap.Create;
    StockBitmap.HandleType:= bmDIB;
    StockBitmap.PixelFormat:= pf32bit;
  End;
  ImageWidth := RSrc.Right - RSrc.Left;
  ImageHeight := RSrc.Bottom - RSrc.Top;
  {with Bmp32 do
  begin
    if Width < ImageWidth then ImageWidth := Width;
    if Height < ImageHeight then ImageHeight :=  Height;
  end;}
  StockBitmap.Width:= ImageWidth;
  StockBitmap.Height:= ImageHeight;
  BitBlt(StockBitmap.Canvas.Handle, 0, 0, ImageWidth, ImageHeight,
    AHDC, x, y, SRCCOPY);
  srcx:= RSrc.Left;
  srcy:= RSrc.Top;
  for J := 0 to ImageHeight - 1 do
  begin
    Src := Bmp32.PixelPtr[srcx+0, srcy+J];
    Dst := StockBitmap.ScanLine[J];
    for I := 0 to ImageWidth - 1 do
    begin
      S := Src^;
      Wt2:= (S and $FF000000) shr 24;
      Wt1:= 255-Wt2;

      CBRB := (Dst^ and $00FF00FF) * Wt1;
      CBG  := (Dst^ and $0000FF00) * Wt1;
      C := ((S and $FF00FF) * Wt2 + CBRB) and $FF00FF00 + ((S and $00FF00) * Wt2 + CBG) and $00FF0000;
      Dst^ := C shr 8;
      Inc(Src);
      Inc(Dst);
    end;
  end;  
  BitBlt(AHDC, x, y, ImageWidth, ImageHeight,
    StockBitmap.Canvas.Handle, 0, 0, SRCCOPY);
End;

Procedure DrawBitmap32(AHDC:HDC; const RDest: TRect; Bmp32:TBitmap32);
Var
  ImageWidth, ImageHeight: Integer;
  I, J: Integer;
  Src: PColor32;
  Dst: PColor;//^Cardinal;
  S, C, CBRB, CBG: Cardinal;
  Wt1, Wt2: Cardinal;
Begin
  If Not Assigned(StockBitmap) then
  Begin
    StockBitmap:= TBitmap.Create;
    StockBitmap.HandleType:= bmDIB;
    StockBitmap.PixelFormat:= pf32bit;
  End;
  ImageWidth := RDest.Right - RDest.Left;
  ImageHeight := RDest.Bottom - RDest.Top;
  with Bmp32 do
  begin
    if Width < ImageWidth then ImageWidth := Width;
    if Height < ImageHeight then ImageHeight :=  Height;
  end;
  StockBitmap.Width:= ImageWidth;
  StockBitmap.Height:= ImageHeight;
  BitBlt(StockBitmap.Canvas.Handle, 0, 0, ImageWidth, ImageHeight,
    AHDC, RDest.Left, RDest.Top, SRCCOPY);
  for J := 0 to ImageHeight - 1 do
  begin
    Src := Bmp32.PixelPtr[0, J];
    Dst := StockBitmap.ScanLine[J];
    for I := 0 to ImageWidth - 1 do
    begin
      S := Src^;
      Wt2:= (S and $FF000000) shr 24;
      Wt1:= 255-Wt2;

      CBRB := (Dst^ and $00FF00FF) * Wt1;
      CBG  := (Dst^ and $0000FF00) * Wt1;
      C := ((S and $FF00FF) * Wt2 + CBRB) and $FF00FF00 + ((S and $00FF00) * Wt2 + CBG) and $00FF0000;
      Dst^ := C shr 8;
      Inc(Src);
      Inc(Dst);
    end;
  end;  
  BitBlt(AHDC, RDest.Left, RDest.Top, ImageWidth, ImageHeight,
    StockBitmap.Canvas.Handle, 0, 0, SRCCOPY);
End;

{ TTBXSimpleTheme }

Const
  FStretchFilter= sfLanczos;//sfNearest;//sfLinear;//sfMitchell;//sfSpline;//

Type
  TDrawStyle = (bsDefault, bsHover, bsDisabled, bsPushed, bsSelected, bsSelectedHover);
  TCheckStatus = (cNone, cChecked, cMixed);

var
  StockBitmap321: TBitmap32 = nil;
  StockBitmap322: TBitmap32 = nil;
  {StockImgList: TImageList;
  StockPatternBitmap: TBitmap;}
  RadioM: TBitmap32 = nil;
  CheckM: TBitmap32 = nil;
  //BOTON: TBitmap32 = nil;
  BOTON: TBitmap32;
//  COMBOBUTTONGLYPH2: TBitmap32 = nil;
  MDICLOSE: TBitmap32 = nil;

  COMBOBOX : TBitmap32 = nil;
  SPINBUTTONBACKGROUNDRIGHT : TBitmap32 = nil;
  //TOOLBARBUTTONSImage : TBitmap32;
  TOOLBARBUTTONS: TBitmap32 = nil;
  TOOLBARBUTTONSSPLIT: TBitmap32 = nil;
  TOOLBARBUTTONSSPLITDROPDOWN: TBitmap32 = nil;
  SPINBUTTONBACKGROUNDUP: TBitmap32 = nil;
  SPINBUTTONBACKGROUNDDOWN: TBitmap32 = nil;
  CLOSEGLYPH: TBitmap32 = nil;
  MINIMIZEGLYPH: TBitmap32 = nil;
  MAXIMIZEGLYPH: TBitmap32 = nil;
//  TOOLBARBUTTONSSPLITDROPDOWNGLYPH: TBitmap32 = nil;
  CounterLock: Integer = 0;

procedure InitializeStock;
var
  ResStream: TResourceStream;
  P:TPngObject;
begin
  If Not Assigned(StockBitmap321) then
  Begin
    StockBitmap321:= TBitmap32.Create;
    StockBitmap321.DrawMode:=dmBlend;
    StockBitmap321.StretchFilter:= FStretchFilter;
  End;
  If Not Assigned(StockBitmap322) then
  Begin
    StockBitmap322:= TBitmap32.Create;
    StockBitmap322.DrawMode:=dmBlend;
    StockBitmap322.StretchFilter:= FStretchFilter;
  End;

  P:=TPngObject.Create;
  If Not Assigned(RadioM) then
  Begin
    ResStream := TResourceStream.Create(HInstance, 'RADIOM', RT_RCDATA);
    P.LoadFromStream(ResStream);
    ResStream.Free;
    RadioM:= TBitmap32.Create;
    PngObjectToBitmap32(P, RadioM);
    RadioM.DrawMode:=dmBlend;
    RadioM.StretchFilter:= FStretchFilter;
  End;
  If Not Assigned(CheckM) then
  Begin
    ResStream := TResourceStream.Create(HInstance, 'CHECKM', RT_RCDATA);
    P.LoadFromStream(ResStream);
    ResStream.Free;
    CheckM:= TBitmap32.Create;
    PngObjectToBitmap32(P, CheckM);
    CheckM.DrawMode:=dmBlend;
    CheckM.StretchFilter:= FStretchFilter;
  End;
  If Not Assigned(BOTON) then
  Begin
    ResStream := TResourceStream.Create(HInstance, 'BOTON', RT_RCDATA);
    P.LoadFromStream(ResStream);
    ResStream.Free;
    BOTON:= TBitmap32.Create;
    PngObjectToBitmap32(P, BOTON);
    BOTON.DrawMode:=dmBlend;
    BOTON.StretchFilter:= FStretchFilter;
  End;
  If Not Assigned(TOOLBARBUTTONS) then
  Begin
    ResStream := TResourceStream.Create(HInstance, 'TOOLBARBUTTONS', RT_RCDATA);
    P.LoadFromStream(ResStream);
    ResStream.Free;
    TOOLBARBUTTONS:= TBitmap32.Create;
    PngObjectToBitmap32(P, TOOLBARBUTTONS);
    TOOLBARBUTTONS.DrawMode:=dmBlend;
    TOOLBARBUTTONS.StretchFilter:= FStretchFilter;
  End;
  If Not Assigned(TOOLBARBUTTONSSPLIT) then
  Begin
    ResStream := TResourceStream.Create(HInstance, 'TOOLBARBUTTONSSPLIT', RT_RCDATA);
    P.LoadFromStream(ResStream);
    ResStream.Free;
    TOOLBARBUTTONSSPLIT:= TBitmap32.Create;
    PngObjectToBitmap32(P, TOOLBARBUTTONSSPLIT);
    TOOLBARBUTTONSSPLIT.DrawMode:=dmBlend;
    TOOLBARBUTTONSSPLIT.StretchFilter:= FStretchFilter;
  End;
  If Not Assigned(TOOLBARBUTTONSSPLITDROPDOWN) then
  Begin
    ResStream := TResourceStream.Create(HInstance, 'TOOLBARBUTTONSSPLITDROPDOWN', RT_RCDATA);
    P.LoadFromStream(ResStream);
    ResStream.Free;
    TOOLBARBUTTONSSPLITDROPDOWN:= TBitmap32.Create;
    PngObjectToBitmap32(P, TOOLBARBUTTONSSPLITDROPDOWN);
    TOOLBARBUTTONSSPLITDROPDOWN.DrawMode:=dmBlend;
    TOOLBARBUTTONSSPLITDROPDOWN.StretchFilter:= FStretchFilter;
  End;
  If Not Assigned(SPINBUTTONBACKGROUNDRIGHT) then
  Begin
    ResStream := TResourceStream.Create(HInstance, 'SPINBUTTONBACKGROUNDRIGHT', RT_RCDATA);
    P.LoadFromStream(ResStream);
    ResStream.Free;
    SPINBUTTONBACKGROUNDRIGHT:= TBitmap32.Create;
    PngObjectToBitmap32(P, SPINBUTTONBACKGROUNDRIGHT);
    SPINBUTTONBACKGROUNDRIGHT.DrawMode:=dmBlend;