sframeadapter.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sFrameAdapter;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sConst, sCommondata, sPanel, acSBUtils{$IFDEF LOGGED}, sDebugMsgs{$ENDIF};

type
  TsFrameAdapter = class(TComponent)
{$IFNDEF NOTFORHELP}
  protected
    FCommonData: TsCommonData;
    procedure PrepareCache;
    procedure OurPaintHandler(Msg : TWMPaint; DefaultDrawing : boolean = True);
  public
    Frame : TFrame;
    OldWndProc: TWndMethod;
    ListSW : TacScrollWnd;
    procedure Loaded; override;
    procedure AfterConstruction; override;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure NewWndProc(var Message: TMessage); 
{$ENDIF} // NOTFORHELP
  published
    property SkinData : TsCommonData read FCommonData write FCommonData;
  end;

implementation

uses math, menus, sVclUtils, sBorders, sGraphUtils, sSkinProps, sSkinManager,
  sMaskData{$IFDEF CHECKXP}, UxTheme, Themes{$ENDIF}, acntUtils, sMessages, sStyleSimply,
  sAlphaGraph, sStrings, sSpeedButton;

const
  sWinControlForm = 'TWinControlForm';

{ TsFrameAdapter }

procedure TsFrameAdapter.AfterConstruction;
begin
  inherited;
  if Assigned(Frame) and GetBoolMsg(Frame, AC_CTRLHANDLED) then begin
    SkinData.UpdateIndexes;
{$IFDEF CHECKXP}
    Frame.ControlStyle := Frame.ControlStyle - [csParentBackground];
{$ENDIF}
  end;
end;

constructor TsFrameAdapter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FCommonData := TsCommonData.Create(Self, True);
  if (FCommonData.SkinSection = ClassName) or (FCommonData.SkinSection = '') then FCommonData.SkinSection := s_GroupBox;
  FCommonData.COC := COC_TsFrameAdapter;

  if AOwner is TFrame then begin
    Frame := TFrame(AOwner);
    FCommonData.FOwnerControl := TControl(AOwner);
  end
  else begin
    Frame := nil;
    ShowError(LoadStr(s_FrameAdapterError1));
  end;

  if Frame <> nil then begin
    OldWndProc := Frame.WindowProc;
    Frame.WindowProc := NewWndProc;
  end;
end;

destructor TsFrameAdapter.Destroy;
begin
  if ListSW <> nil then FreeAndNil(ListSW);
  if {not (csDesigning in ComponentState) and v4.23} (Frame <> nil) and Assigned(OldWndProc) then Frame.WindowProc := OldWndProc;
  Frame := nil;
  FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsFrameAdapter.Loaded;
var
  i : integer;
begin
  inherited Loaded;
  if Assigned(Frame) and GetBoolMsg(Frame, AC_CTRLHANDLED) and Assigned(SkinData) and Assigned(SkinData.SkinManager) then begin
    SkinData.UpdateIndexes;
    if not SkinData.SkinManager.SkinData.Active or (csDesigning in ComponentState) then Exit;
    if (csDesigning in Frame.ComponentState) and // Updating of form color in design-time
         (Frame.Parent.ClassName = sWinControlForm) and FCommonData.SkinManager.IsValidSkinIndex(FCommonData.SkinManager.ConstData.IndexGlobalInfo)
           then TsHackedControl(Frame.Parent).Color := SkinData.SkinManager.gd[FCommonData.SkinManager.ConstData.IndexGlobalInfo].Color;
    // Popups initialization
    for i := 0 to Frame.ComponentCount - 1 do begin
      if (Frame.Components[i] is TPopupMenu) and SkinData.SkinManager.SkinnedPopups then begin
        SkinData.SkinManager.SkinableMenus.HookPopupMenu(TPopupMenu(Frame.Components[i]), True);
      end
    end;
{$IFDEF CHECKXP}
    Frame.ControlStyle := Frame.ControlStyle - [csParentBackground];
{$ENDIF}
    if SkinData.Skinned then AddToAdapter(Frame)
  end;
end;

type
  TacWinControl = class(TWinControl);

procedure TsFrameAdapter.NewWndProc(var Message: TMessage);
var
  i : integer;
  m : TMessage;
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if csDesigning in componentState then begin
    OldWndProc(Message);
    Exit;
  end;
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      AlphaBroadCast(Frame, Message);
      CommonWndProc(Message, FCommonData);
      if not Assigned(SkinData.SkinManager) then Exit;
      for i := 0 to Frame.ComponentCount - 1 do
        if (Frame.Components[i] is TPopupMenu) and SkinData.SkinManager.SkinnedPopups
          then SkinData.SkinManager.SkinableMenus.HookPopupMenu(TPopupMenu(Frame.Components[i]), True);
      if (csDesigning in Frame.ComponentState) and // Updating of form color in design-time
           (Frame.Parent.ClassName = sWinControlForm) and (FCommonData.SkinManager.ConstData.IndexGlobalInfo > -1)
             then TsHackedControl(Frame.Parent).Color := SkinData.SkinManager.gd[FCommonData.SkinManager.ConstData.IndexGlobalInfo].Color;
      exit
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      if not Assigned(FCommonData.SkinManager) then Exit;
      if (csDesigning in Frame.ComponentState) and // Updating of form color in design-time
           (Frame.Parent.ClassName = sWinControlForm) and (FCommonData.SkinManager.ConstData.IndexGlobalInfo > -1)
             then TsHackedControl(Frame.Parent).Color := SkinData.SkinManager.gd[FCommonData.SkinManager.ConstData.IndexGlobalInfo].Color;
      AlphaBroadcast(Frame, Message);
      RedrawWindow(Frame.Handle, nil, 0, RDW_NOERASE or RDW_UPDATENOW or RDW_INVALIDATE or RDW_ALLCHILDREN or RDW_FRAME);
      RefreshScrolls(SkinData, ListSW);
      exit
    end;
    AC_STOPFADING : AlphaBroadcast(Frame, Message);
    AC_BEFORESCROLL : if GetBoolMsg(Frame, AC_CHILDCHANGED) or FCommonData.RepaintIfMoved then begin
      SendMessage(Frame.Handle, WM_SETREDRAW, 0, 0);
    end;
    AC_AFTERSCROLL : if GetBoolMsg(Frame, AC_CHILDCHANGED) or FCommonData.RepaintIfMoved then begin
      SendMessage(Frame.Handle, WM_SETREDRAW, 1, 0);
      RedrawWindow(Frame.Handle, nil, 0, RDW_NOERASE or RDW_UPDATENOW or RDW_INVALIDATE or RDW_ALLCHILDREN or RDW_FRAME);
    end;
    AC_REMOVESKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      if ListSW <> nil then FreeAndNil(ListSW);
      CommonWndProc(Message, FCommonData);
      if (csDesigning in Frame.ComponentState) and // Updating of form color in design-time
           Assigned(Frame.Parent) and
           (Frame.Parent.ClassName = sWinControlForm)
             then TsHackedControl(Frame.Parent).Color := clBtnFace;
      AlphaBroadcast(Frame, Message);
      SetWindowPos(Frame.Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_FRAMECHANGED);
      RedrawWindow(Frame.Handle, nil, 0, RDW_NOERASE or RDW_UPDATENOW or RDW_INVALIDATE or RDW_ALLCHILDREN or RDW_FRAME);
      exit
    end;
    AC_GETCACHE : if SkinData <> nil then begin
      GlobalCacheInfo := MakeCacheInfo(SkinData.FCacheBmp);
      Exit;
    end;
  end;
  if (csDestroying in ComponentState) or (csDestroying in Frame.ComponentState) or not FCommonData.Skinned or not SkinData.SkinManager.SkinData.Active then begin
    OldWndProc(Message);
  end
  else begin
    if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
      AC_SETTRANSBGCHANGED : if BgIsTransparent(SkinData) then FCOmmonData.BGChanged := True;
      AC_URGENTPAINT : begin // v4.09
        FCommonData.UrgentPainting := boolean(Message.wParam);
        if FCommonData.UrgentPainting then PrepareCache;
        CommonWndProc(Message, FCommonData);
        Exit;
      end;
      AC_CHILDCHANGED : begin
        if (SkinData.SkinIndex < 0) or not Assigned(SkinData.SkinManager)
          then Message.LParam := 0
          else Message.LParam := integer((SkinData.SkinManager.gd[SkinData.SkinIndex].GradientPercent + SkinData.SkinManager.gd[SkinData.SkinIndex].ImagePercent > 0) or SkinData.RepaintIfMoved);
        Message.Result := Message.LParam;
        Exit;
      end;
      AC_PREPARING : begin
        Message.LParam := integer(FCommonData.BGChanged or FCommonData.Updating);
        Exit
      end;
      AC_UPDATING : begin
        FCommonData.Updating := Message.WParamLo = 1;
        for i := 0 to Frame.ControlCount - 1 do Frame.Controls[i].Perform(Message.Msg, Message.WParam, Message.LParam);
      end;
      AC_GETCACHE : begin
        GlobalCacheInfo := MakeCacheInfo(FCommonData.FCacheBmp);
        Exit;
      end;
      AC_ENDPARENTUPDATE : if IsNT or (not IsNT and FCommonData.Updating) {v4.83 for win9x} then begin // To optimize here !!!
//      AC_ENDPARENTUPDATE : if FCommonData.Updating then begin // 5.40
        FCommonData.Updating := False;
        RedrawWindow(Frame.Handle, nil, 0, RDW_INTERNALPAINT or RDW_ALLCHILDREN or RDW_INVALIDATE or RDW_ERASE or RDW_FRAME or RDW_UPDATENOW);
        Exit;
      end else Exit;
      AC_GETCONTROLCOLOR : begin
        if SkinData.Skinned then begin //???? Not all controls may be Hot ???? but... in thinking
          case SkinData.SkinManager.gd[SkinData.Skinindex].Transparency of
            0 : ParentCenterColor := SkinData.SkinManager.gd[SkinData.Skinindex].Color;
            100 : begin if Frame.Parent <> nil
              then begin
                SendMessage(Frame.Parent.Handle, SM_ALPHACMD, MakeWParam(0, AC_GETCONTROLCOLOR), 0);
                if ParentCenterColor = clFuchsia {if AlphaMessage not supported} then ParentCenterColor := TsHackedControl(Frame.Parent).Color
              end
              else ParentCenterColor := ColorToRGB(Frame.Color);
            end
            else begin
              if Frame.Parent <> nil
                then SendMessage(Frame.Parent.Handle, SM_ALPHACMD, MakeWParam(0, AC_GETCONTROLCOLOR), 0)
                else ParentCenterColor := ColorToRGB(Frame.Color);
              // Mixing of colors
              C1.C := ParentCenterColor;
              C2.C := SkinData.SkinManager.gd[SkinData.Skinindex].Color;
              C1.R := IntToByte(((C1.R - C2.R) * SkinData.SkinManager.gd[SkinData.Skinindex].Transparency + C2.R shl 8) shr 8);
              C1.G := IntToByte(((C1.G - C2.G) * SkinData.SkinManager.gd[SkinData.Skinindex].Transparency + C2.G shl 8) shr 8);
              C1.B := IntToByte(((C1.B - C2.B) * SkinData.SkinManager.gd[SkinData.Skinindex].Transparency + C2.B shl 8) shr 8);
              ParentCenterColor := C1.C;
            end
          end;
        end
        else if Assigned(Frame) then ParentCenterColor := ColorToRGB(TsHackedControl(Frame).Color);
      end
    end
    else case Message.Msg of
      CM_MOUSEENTER : if not (csDesigning in ComponentState) then begin
        OldWndProc(Message);
        for i := 0 to Frame.ControlCount - 1 do begin
          if (Frame.Controls[i] is TsSpeedButton) and (Frame.Controls[i] <> Pointer(Message.LParam)) and TsSpeedButton(Frame.Controls[i]).SkinData.FMouseAbove then begin
            Frame.Controls[i].Perform(CM_MOUSELEAVE, 0, 0) // !!!!
          end;
        end;
        if DefaultManager <> nil then DefaultManager.ActiveControl := Frame.Handle;
      end;
      CM_SHOWINGCHANGED : begin
        OldWndProc(Message);
        RefreshScrolls(SkinData, ListSW);
      end;
      CM_VISIBLECHANGED : begin
        FCommonData.BGChanged := True;
        OldWndProc(Message); // v4.21
        if Assigned(SkinData.SkinManager) then SendMessage(Frame.Handle, SM_ALPHACMD, MakeWParam(0, AC_REFRESH), LongWord(SkinData.SkinManager));
      end;
      WM_SIZE, WM_MOVE : begin
        FCommonData.BGChanged := FCommonData.BGChanged or (Message.Msg = WM_SIZE) or FCommonData.RepaintIfMoved;
        if FCommonData.BGChanged then begin
          m := MakeMessage(SM_ALPHACMD, MakeWParam(1, AC_SETBGCHANGED), 0, 0);
          Frame.BroadCast(m);
        end;
        OldWndProc(Message);
      end;
      WM_PARENTNOTIFY : if ((Message.WParam and $FFFF = WM_CREATE) or (Message.WParam and $FFFF = WM_DESTROY)) and not (csLoading in ComponentState) and not (csCreating in Frame.ControlState) then begin
        OldWndProc(Message);
        UpdateScrolls(ListSW, False);
        if Message.WParamLo = WM_CREATE then AddToAdapter(Frame);// else RemoveFromAdapter(Frame);
      end else OldWndProc(Message);
      WM_PAINT : begin
        if csDesigning in Frame.ComponentState then OldWndProc(Message) else begin
          if (Frame.Parent <> nil) and not (csDestroying in ComponentState) then begin
            OurPaintHandler(TWMPaint(Message));
          end
          else OldWndProc(Message);
        end;
      end;
      WM_PRINT : if FCommonData.Skinned then begin
        FCommonData.Updating := False;
        if ControlIsReady(Frame) then begin
          OurPaintHandler(TWMPaint(Message), False);
          Ac_NCPaint(ListSW, Frame.Handle, Message.wParam, Message.lParam, -1, TWMPaint(Message).DC);
        end;
        Exit;
      end
      else OldWndProc(Message);
      WM_NCPAINT, WM_ERASEBKGND : if csDesigning in Frame.ComponentState then OldWndProc(Message);
      else OldWndProc(Message);
    end;
  end;
end;

procedure TsFrameAdapter.OurPaintHandler(Msg: TWMPaint; DefaultDrawing : boolean = True);
var
  Changed : boolean;
  DC, SavedDC : hdc;
  PS : TPaintStruct;
begin
  BeginPaint(Frame.Handle, PS);
  if not DefaultDrawing then DC := Msg.DC else DC := GetDC(Frame.Handle);
  SavedDC := SaveDC(DC);
  try
    FCommonData.Updating := FCommonData.Updating;
    if not FCommonData.Updating then begin
      FCommonData.BGChanged := FCommonData.BGChanged or FCommonData.HalfVisible; // v4.54
      if SkinData.RepaintIfMoved and (Frame.Parent <> nil) then begin
        FCommonData.HalfVisible := not (PtInRect(Frame.Parent.ClientRect, Point(Frame.Left + 1, Frame.Top + 1)));
        FCommonData.HalfVisible := FCommonData.HalfVisible or not PtInRect(Frame.Parent.ClientRect, Point(Frame.Left + Frame.Width - 1, Frame.Top + Frame.Height - 1));
      end
      else FCommonData.HalfVisible := False;
      Changed := FCommonData.BGChanged;
      if Changed and not FCommonData.UrgentPainting then PrepareCache;

      CopyWinControlCache(Frame, FCommonData, Rect(0, 0, 0, 0), Rect(0, 0, Frame.Width, Frame.Height), DC, True);

      sVCLUtils.PaintControls(DC, Frame, Changed, Point(0, 0));
      if DefaultDrawing then SetParentUpdated(Frame);
    end;
  finally
    RestoreDC(DC, SavedDC);
    if DefaultDrawing then ReleaseDC(Frame.Handle, DC);
    EndPaint(Frame.Handle, PS);
  end;
end;

procedure TsFrameAdapter.PrepareCache;
begin
  SkinData.InitCacheBmp;
  SkinData.FCacheBmp.Width := Frame.Width;
  SkinData.FCacheBmp.Height := Frame.Height;

  SkinData.FCacheBMP.Canvas.Font.Assign(Frame.Font);

  SendMessage(Frame.Parent.Handle, SM_ALPHACMD, MakeWParam(0, AC_GETCACHE), 0);

  PaintItem(SkinData, GlobalCacheInfo, False, 0, Rect(0, 0, Frame.Width, Frame.Height),
            Point(Frame.Left, Frame.Top), SkinData.FCacheBMP, False);
  SkinData.BGChanged := False;
end;

end.