📄 sframeadapter.pas
字号:
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}, acUtils, 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}
// if SkinData.Skinned then AddToAdapter(Frame)
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 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);
TacWinControl(Frame).RecreateWnd;
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 !!!
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);
// if Message.Msg = WM_SIZE then Frame.Repaint
end;
WM_PARENTNOTIFY : if (Message.WParam and $FFFF = WM_CREATE) or (Message.WParam and $FFFF = WM_DESTROY) then begin
OldWndProc(Message);
if Message.WParamLo = WM_CREATE then AddToAdapter(Frame);
UpdateScrolls(ListSW, False);
end else OldWndProc(Message);
WM_PAINT : begin
if csDesigning in Frame.ComponentState then OldWndProc(Message); // Why??! v4.43
if (Frame.Parent <> nil) and not (csDestroying in ComponentState) then begin
OurPaintHandler(TWMPaint(Message));
// if FCommonData.UrgentPainting then FinishUrgentPainting(Frame); // v4.09
Exit;
end
else OldWndProc(Message);
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 : ;
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 {v4.09} 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)); // v4.09
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.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -