scommondata.pas

Alpha Controls 界面控件包

function TsCommonData.GetUpdating: boolean;
begin
  if not Assigned(SkinManager) or not SkinManager.SkinData.Active then begin
    Result := True;
    Exit
  end
  else Result := FUpdating;
  if (Self = nil) or (FOwnerControl = nil) or (csDestroying in FOwnerControl.ComponentState) then Exit; 
  if not Self.FUpdating and (FOwnerControl <> nil) and (FOwnerControl.Parent <> nil)
    then Result := GetBoolMsg(FOwnerControl.Parent, AC_PREPARING)
    else Result := True
end;

procedure TsCommonData.InitCacheBmp;
begin
  if not Assigned(FCacheBmp) then begin
    FCacheBmp := TBitmap.Create;
  end;
  if FCacheBmp.PixelFormat <> pf24bit then FCacheBmp.PixelFormat := pf24bit;
  if FCacheBmp.HandleType <> bmDIB then FCacheBmp.HandleType := bmDIB;
  if Assigned(FOwnerControl) then begin
    if FCacheBmp.Width <> FOwnerControl.Width then FCacheBmp.Width := FOwnerControl.Width;
    if FCacheBmp.Height <> FOwnerControl.Height then FCacheBmp.Height := FOwnerControl.Height;
  end
end;

procedure TsCommonData.Invalidate;
begin
  if Assigned(FOwnerControl) and not ((csDestroying in FOwnerControl.ComponentState) or (csLoading in FOwnerControl.ComponentState)) then begin
    BGChanged := True;
    if ControlIsReady(FOwnerControl) then FOwnerControl.Invalidate
  end;
end;

procedure TsCommonData.Loaded;
begin
  UpdateData(Self);
{$IFDEF CHECKXP}
  if Assigned(FownerControl) and not Skinned then begin
    if UseThemes then
      FownerControl.ControlStyle := FownerControl.ControlStyle - [csParentBackground]; // Patching of bug with TGraphicControls repainting when XPThemes used
  end;
{$ENDIF}
  if Skinned and Assigned(FOwnerControl) and Assigned(FOwnerControl.Parent) and not (csLoading in FOwnerControl.ComponentState) then begin
    if FOwnerControl is TWinControl then begin
      AddToAdapter(TWinControl(FOwnerControl))
    end;
    if ((FOwnerControl is TCustomEdit) or (COC = COC_TsAlphaListBox)) then begin // v4.32
      if not CustomColor and (TsHackedControl(FOwnerControl).Color <> SkinManager.gd[SkinIndex].Color) then TsHackedControl(FOwnerControl).Color := SkinManager.gd[SkinIndex].Color;
      if not CustomFont and (TsHackedControl(FOwnerControl).Font.Color <> SkinManager.gd[SkinIndex].FontColor[1]) then TsHackedControl(FOwnerControl).Font.Color := SkinManager.gd[SkinIndex].FontColor[1];
    end;
  end;
end;

function TsCommonData.ManagerStored: boolean;
begin
  Result := (FSkinManager <> nil)
end;

function TsCommonData.ParentTextured: boolean;
begin
  if Assigned(FOwnerControl) and Assigned(FOwnerControl.Parent) and FOwnerControl.Parent.HandleAllocated then begin
    Result := GetBoolMsg(FOwnerControl.Parent, AC_CHILDCHANGED);
  end else Result := False;
end;

function TsCommonData.RepaintIfMoved: boolean;
begin
  if (Self = nil) or UrgentPainting or not Skinned or{$IFNDEF ALITE}(FOwnerControl is TsTabSheet) or{$ENDIF} (FOwnerControl = nil) or
       (csCreating in FOwnerControl.ControlState) or not FOwnerControl.Visible then begin
    Result := True;
    Exit;
  end;
  if (SkinIndex < 0) or (SkinIndex > High(SkinManager.gd)) then { if not skinned } Result := False else begin
    Result := (FOwnerControl <> nil) and not FOwnerControl.Enabled;
    if not Result then begin
      Result := (SkinManager.gd[SkinIndex].Transparency > 0);
    end;
    if Result and Assigned(FOwnerControl) and Assigned(FOwnerControl.Parent) and FOwnerControl.Parent.HandleAllocated then begin
      Result := GetBoolMsg(FOwnerControl.Parent, AC_CHILDCHANGED);
    end;
  end;
end;

procedure TsCommonData.SetCustomColor(const Value: boolean);
begin
  if FCustomColor <> Value then begin
    FCustomColor := Value;
    if Skinned and Assigned(FOwnerControl) and (FOwnerControl is TCustomEdit) and not (csLoading in FOwnerControl.ComponentState) then begin // v4.32
      if not CustomColor and (TsHackedControl(FOwnerControl).Color <> SkinManager.gd[SkinIndex].Color) then TsHackedControl(FOwnerControl).Color := SkinManager.gd[SkinIndex].Color;
      if not CustomFont and (TsHackedControl(FOwnerControl).Font.Color <> SkinManager.gd[SkinIndex].FontColor[1]) then TsHackedControl(FOwnerControl).Font.Color := SkinManager.gd[SkinIndex].FontColor[1];
      Invalidate
    end;
  end;
end;

procedure TsCommonData.SetCustomFont(const Value: boolean);
begin
  if FCustomFont <> Value then begin
    FCustomFont := Value;
    Invalidate
  end;
end;

procedure TsCommonData.SetSkinManager(const Value: TsSkinManager);
var
  m : TMEssage;
begin
  if FSkinManager <> Value then begin
    if Value <> DefaultManager then FSkinManager := Value else FSkinManager := nil;
    if (FOwnerControl <> nil) and (csLoading in FOwnerControl.ComponentState) then Exit;
    if Assigned(Value) and (Length(Value.gd) > 0) then UpdateIndexes else SkinIndex := -1;
    if Assigned(FOwnerObject) and (FOwnerObject is TsSkinProvider) then begin
      if Assigned(Value) and (Length(Value.gd) > 0) and Value.IsValidSkinIndex(SkinIndex) {v4.51}
        then m.WParam := MakeWParam(0, AC_REFRESH) else m.WParam := MakeWParam(0, AC_REMOVESKIN);
      m.Msg := SM_ALPHACMD;
      m.LParam := LongWord(Value);
      TsSkinProvider(FOwnerObject).DsgnWndProc(m);
    end
    else if (FOwnerControl <> nil) and (FOwnerControl.Parent <> nil) and not (csDestroying in FOwnerControl.ComponentState) then begin
      try
      if Assigned(Value) and (Length(Value.gd) > 0) and Value.IsValidSkinIndex(SkinIndex) {v4.51}
        then FOwnerControl.Perform(SM_ALPHACMD, MakeWParam(0, AC_REFRESH), LongWord(Value))
        else FOwnerControl.Perform(SM_ALPHACMD, MakeWParam(0, AC_REMOVESKIN), LongWord(Value));
      except
      end;
    end;
  end;
end;

procedure TsCommonData.SetSkinSection(const Value: string);
begin
  if FSkinSection <> Value then begin
    if Value = '' then FSkinSection := s_Unknown else FSkinSection := UpperCase(Value);

    if Assigned(SkinManager) and (Length(SkinManager.gd) > 0) then UpdateIndexes else SkinIndex := -1;
    if (FOwnerControl <> nil) and (FOwnerControl.Parent <> nil) and not (csDestroying in FOwnerControl.ComponentState) then begin
      if Assigned(SkinManager) and (Length(SkinManager.gd) > 0) and SkinManager.IsValidSkinIndex(SkinIndex) {v4.51}
        then FOwnerControl.Perform(SM_ALPHACMD, MakeWParam(0, AC_REFRESH), LongWord(SkinManager))
        else FOwnerControl.Perform(SM_ALPHACMD, MakeWParam(0, AC_REMOVESKIN), LongWord(SkinManager));
    end;
  end;
end;

procedure TsCommonData.SetUpdating(const Value: boolean);
begin
  FUpdating := Value;
end;

function TsCommonData.Skinned(CheckSkinActive : boolean = False): boolean;
begin
  if (Self = nil) or ((Self.FOwnerObject <> nil) and (csDestroying in TComponent(Self.FOwnerObject).ComponentState)) or
    (SkinManager = nil) or (csDestroying in SkinManager.ComponentState)
    then Result := False
    else Result := (not CheckSkinActive or SkinManager.SkinData.Active) and SkinManager.IsValidSkinIndex(SkinIndex);
end;

function CommonMessage(var Message: TMessage; SkinData : TsCommonData) : boolean;
var
  i : integer;
begin
  Result := False;
  if SkinData <> nil then with SkinData do if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_SETTRANSBGCHANGED : begin
      if BgIsTransparent(SkinData) and (Message.WParamLo = 1) then BGChanged := True;
    end;
    AC_UPDATESECTION : if UpperCase(SkinSection) = GlobalSectionName then begin
      RestrictDrawing := False;
      Invalidate;
    end;
    AC_SETGRAPHCONTROL : GraphControl := pointer(Message.LParam);
    AC_PREPARING       : begin
      Message.LParam := integer(BGChanged or Updating);
      Result := True;
    end;
    AC_UPDATING        : FUpdating := Message.WParamLo = 1;
    AC_GETHALFVISIBLE  : begin
      Message.LParam := integer(HalfVisible);
      Result := True;
    end;
    AC_URGENTPAINT     : UrgentPainting := Message.WParamLo = 1;
    AC_CHILDCHANGED : if (SkinData.SkinIndex > -1) then begin
      if (SkinData.SkinManager.gd[SkinData.SkinIndex].Transparency = 100) and (FOwnerControl <> nil) and (FOwnerControl.Parent <> nil) then begin
        Message.LParam := integer(ParentTextured);
      end
      else Message.LParam := integer((SkinData.SkinManager.gd[SkinData.SkinIndex].GradientPercent + SkinData.SkinManager.gd[SkinData.SkinIndex].ImagePercent > 0) or SkinData.RepaintIfMoved);
      Message.Result := Message.LParam;
      Result := True;
    end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      FUpdating := True;
      UpdateIndexes;
      RestrictDrawing := False;
    end;
    AC_SETBGCHANGED : BGChanged := True;
    AC_SETHALFVISIBLE : begin
      HalfVisible := True;
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      BGChanged := True;
      Updating := False;
      if Skinned and Assigned(FOwnerControl) then begin
        if (FOwnerControl is TCustomEdit) then begin // v4.32
          if not CustomColor then TsHackedControl(FOwnerControl).Color := SkinData.SkinManager.gd[SkinIndex].Color;
          if not CustomFont then TsHackedControl(FOwnerControl).Font.Color := SkinData.SkinManager.gd[SkinIndex].FontColor[1];
        end;
        if (FOwnerControl is TWinControl) then begin
          AddToAdapter(TWinControl(FOwnerControl))
        end;
      end;
    end;
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      if (SkinData.SkinManager <> nil) and (csDestroying in SkinData.SkinManager.ComponentState) then begin
        FSkinManager := nil;
      end;
      BorderIndex := -1;
      SkinIndex := -1;
      Texture := -1;
      HotTexture := -1;
      FUpdating := True;
      if Assigned(FCacheBmp) then begin
        FCacheBmp.Width := 0;
        FCacheBmp.Height := 0;
      end;
      if Assigned(FOwnerControl) and (FOwnerControl is TCustomEdit) then begin // v4.32
        if not CustomColor then TsHackedControl(FOwnerControl).Color := clWindow;
        if not CustomFont then TsHackedControl(FOwnerControl).Font.Color := clWindowText;
      end
{$IFDEF CHECKXP}
//      if UseThemes and (SkinData.FOwnerControl <> nil) and (SkinData.FOwnerControl is TWinControl) then begin
//        SetWindowTheme(TWinControl(SkinData.FOwnerControl).Handle, nil, nil);
//      end;
{$ENDIF}
    end;
    AC_GETCACHE : begin
      GlobalCacheInfo.Ready := False;
      if Assigned(FCacheBmp) then GlobalCacheInfo := MakeCacheInfo(FCacheBmp);
    end;
    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 : begin
            if SkinData.CustomColor and (SkinData.FOwnerControl <> nil) then begin
              ParentCenterColor := TsHackedControl(SkinData.FOwnerControl).Color;
            end
            else ParentCenterColor := SkinData.SkinManager.gd[SkinData.Skinindex].Color;
          end;
          100 : begin
            if FOwnerControl.Parent <> nil
              then begin
                SendMessage(FOwnerControl.Parent.Handle, SM_ALPHACMD, MakeWParam(0, AC_GETCONTROLCOLOR), 0);
                if ParentCenterColor = clFuchsia {if AlphaMessage not supported} then ParentCenterColor := ColortoRGB(TsHackedControl(FOwnerControl.Parent).Color)
              end
              else ParentCenterColor := ColorToRGB(TsHackedControl(FOwnerControl).Color);
          end
          else begin
            if FOwnerControl.Parent <> nil
              then begin
                SendMessage(FOwnerControl.Parent.Handle, SM_ALPHACMD, MakeWParam(0, AC_GETCONTROLCOLOR), 0);
                if ParentCenterColor = clFuchsia {if AlphaMessage not supported} then ParentCenterColor := ColortoRGB(TsHackedControl(FOwnerControl.Parent).Color)
              end
              else ParentCenterColor := ColorToRGB(TsHackedControl(FOwnerControl).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(FOwnerControl) then ParentCenterColor := ColorToRGB(TsHackedControl(FOwnerControl).Color);
      Result := True;
    end;
    AC_SETCHANGEDIFNECESSARY : begin
      b := SkinData.RepaintIfMoved;
      SkinData.BGChanged := SkinData.BGChanged or b;
      if (SkinData.FOwnerControl <> nil) and (SkinData.FOwnerControl is TWinControl) then begin
        if (Message.WParamLo = 1) 
          then RedrawWindow(TWinControl(SkinData.FOwnerControl).Handle, nil, 0, RDW_NOERASE + RDW_NOINTERNALPAINT + RDW_INVALIDATE + RDW_ALLCHILDREN);
        if b and Assigned(FOwnerControl) then for i := 0 to TWinControl(SkinData.FOwnerControl).ControlCount - 1 do begin
          if (i < TWinControl(SkinData.FOwnerControl).ControlCount) and
               not (csDestroying in TWinControl(SkinData.FOwnerControl).Controls[i].ComponentState)
            then SendAMessage(TWinControl(FOwnerControl).Controls[i], AC_SETCHANGEDIFNECESSARY)
        end
      end;
    end;
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_CTRLHANDLED : begin
      Message.LParam := 1;
      Result := True;
    end;
  end;
end;

procedure TsCommonData.UpdateIndexes;
begin