⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sstylepassive.pas

📁 AlphaControls是一个Delphi标准控件的集合
💻 PAS
📖 第 1 页 / 共 2 页
字号:
end;

procedure TsPassivePaintStyle.Update;
begin
{$IFDEF TSHINTS}
  if FOwner is TsHintManager then begin
    TsHintManager(FOwner).SetCustomDefinition;
  end;
{$ENDIF}
end;

procedure TsPassivePaintStyle.SetSkinSection(const Value: string);
begin
  if FSkinSection <> Value then begin
    FSkinSection := Value;
  end;
end;

procedure TsPassivePaintStyle.WndProc(var Message: TMessage);
{$IFNDEF ALITE}
var
  sSC : TsControlsManager;
{$ENDIF}
begin
  if (Message.Msg >= SM_OFFSET) and (Message.Msg <= SM_LAST) then begin
    if ((Message.WParam = GroupIndex) or (Message.WParam = GI_FORPANELPATTERN)) then begin
      case Message.Msg of
//        CM_SETBORDERBOTTOM:   Painting.ColorBorderBottom := TSMSetColor(Message).Value;
//        CM_SETCOLORACTIVE:    Selection.Color := TSMSetColor(Message).Value;
        CM_SETColor:  Painting.Color := TSMSetColor(Message).Value;
        CM_SETCOLORSHADOW :   Shadow.Color := TSMSetColor(Message).Value;

        SM_CLEARINDEXES : begin
          SkinIndex := -1;
          BorderIndex := -1;
        end;
        SM_SETNEWSKIN : begin
          DeleteUnusedBmps(True);
          SkinIndex := GetSkinIndex;
          BorderIndex := GetMaskIndex(BordersMask);
          if (FOwner is TsSkinProvider) and (sSkinData.SkinManager <> nil) then begin
            TsSkinProvider(FOwner).ButtonMin.ImageIndex   := GetMaskIndex(BorderIconMinimize);
            TsSkinProvider(FOwner).ButtonMax.ImageIndex   := GetMaskIndex(BorderIconMaximize);
            TsSkinProvider(FOwner).ButtonClose.ImageIndex := GetMaskIndex(BorderIconClose);
            TsSkinProvider(FOwner).ButtonHelp.ImageIndex  := GetMaskIndex(BorderIconHelp);
            TsSkinProvider(FOwner).MDIMin.ImageIndex   := GetMaskIndex(SmallIconMinimize);
            TsSkinProvider(FOwner).MDIMax.ImageIndex   := GetMaskIndex(SmallIconMaximize);
            TsSkinProvider(FOwner).MDIClose.ImageIndex := GetMaskIndex(SmallIconClose);

            if TsSkinProvider(FOwner).SkinManager = nil then begin
              TsSkinProvider(FOwner).SkinManager := sSkinData.SkinManager;
            end;

            if not (csDesigning in TsSkinProvider(FOwner).ComponentState) then begin
              DeleteUnusedBmps(True);
              if TForm(TsSkinProvider(FOwner).Form).BorderIcons <> [] then begin
                TForm(TsSkinProvider(FOwner).Form).BorderIcons := [];
              end;
              TsSkinProvider(FOwner).SkinManager.SkinableMenus.UpdateMenus;
              if Pointer(GetWindowLong(TsSkinProvider(FOwner).Form.Handle, GWL_WNDPROC)) <> TsSkinProvider(FOwner).NewInstance then begin
                TsSkinProvider(FOwner).FormActive := Screen.ActiveForm = TsSkinProvider(FOwner).Form;
                SetWindowLong(TsSkinProvider(FOwner).Form.Handle, GWL_WNDPROC, LongInt(TsSkinProvider(FOwner).NewInstance));
              end;
//              if Assigned(TsSkinProvider(FOwner).Form.Menu) then begin
//                TsSkinProvider(FOwner).Form.Menu.Items[0].Assign(TsSkinProvider(FOwner).Form.Menu.Items[0]);
//                OnChange(TsSkinProvider(FOwner).Form.Menu, TsSkinProvider(FOwner).Form.Menu.Items[0], True);
//              end;

              if Assigned(TsSkinProvider(FOwner).VSBar) then SendMessage(TsSkinProvider(FOwner).VSBar.Handle, Message.Msg, Message.WParam, Message.LParam);
              if Assigned(TsSkinProvider(FOwner).HSBar) then SendMessage(TsSkinProvider(FOwner).HSBar.Handle, Message.Msg, Message.WParam, Message.LParam);
              // Menu Line refresh
              TsSkinProvider(FOwner).BGChanged := True;
              SendMessage(TsSkinProvider(FOwner).Form.Handle, WM_NCPaint, Message.WParam, Message.LParam);
            end;
          end;
        end;
        SM_REMOVESKIN : begin
          if FOwner is TsSkinProvider then begin
            BorderIndex := -1;
            SkinIndex := -1;
            TsSkinProvider(FOwner).BGChanged := True;
            if not (csDesigning in TsSkinProvider(FOwner).ComponentState) and Assigned(TsSkinProvider(FOwner).SkinManager) then begin
              DeleteUnusedBmps(True);
              TsSkinProvider(FOwner).SkinManager.SkinableMenus.InitItems(False);
              if TsSkinProvider(FOwner).OldBorderIcons <> TForm(TsSkinProvider(FOwner).Form).BorderIcons then begin
                TsSkinProvider(FOwner).Frozen := True;
                TForm(TsSkinProvider(FOwner).Form).BorderIcons := TsSkinProvider(FOwner).OldBorderIcons;
                TsSkinProvider(FOwner).Frozen := False;
              end
              else begin
                TForm(TsSkinProvider(FOwner).Form).Perform(CM_RECREATEWND, 0, 0);
              end;
            end;
          end;
        end;
        CM_SETSHADOWENABLED:  begin
          if COC <> COC_TsHintManager then
            Shadow.FEnabled := TSMSetBoolean(Message).Value;
        end;
        CM_SHADOWTRANSPARENCY:Shadow.FTransparency := TSMSetInteger(Message).Value;
        CM_SHADOWOFFSET:      Shadow.FOffset       := TSMSetInteger(Message).Value * 2;
        CM_SHADOWBLUR:        Shadow.FBlur         := TSMSetInteger(Message).Value * 2;

        SM_GETSTYLEINFO:      begin
            TSMGetStyleInfo(Message).WParam := 1;
            TSMGetStyleInfo(Message).LParam := Longint(Self);
          end;

{$IFNDEF ALITE}
        CM_SETPATTERN: begin
          if Background.ListenMSG then begin
            if Assigned(TSMSetBground(Message).sBackground.Image) then begin
              Background.Image.Assign(TSMSetBground(Message).sBackground.Image);
            end;
          end;
          Message.Result := 1;
        end;

        CM_CHANGEALL : begin
            sSC := TCMChangeAll(Message).sStyleControl;

            Shadow.Color := sSC.Shadow.Color;
            if COC <> COC_TsHintManager then
              Shadow.Enabled := sSC.Shadow.Enabled;

            Shadow.Offset       := sSC.Shadow.Offset * 2;
            Shadow.Blur         := sSC.Shadow.Blur * 2;

            if Background.ListenMSG and Assigned(sSC.Background) then begin
                  if Assigned(sSC.Background.Image) then begin
                    Background.Image.Assign(sSC.Background.Image);
                  end;
            end;
          end;
{$ENDIF}
      end;
    end;
  end;
end;

{ TsPassiveShadow }

constructor TsPassiveShadow.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := TsPassivePaintStyle(AOwner);
  FColor := clBlack;
  FBlur := 6;
  FOffset := 10;
  FTransparency := 50;
  FEnabled := True;
end;

procedure TsPassiveShadow.SetBlur(const Value: integer);
begin
  if FBlur <> Value then begin
    FBlur := Value;
    FOwner.Update;
  end;
end;

procedure TsPassiveShadow.SetColor(const Value: TColor);
begin
  if (FColor <> Value) then begin
    FColor := Value;
    FOwner.Update;
  end;
end;

procedure TsPassiveShadow.SetEnabled(const Value: boolean);
begin
  if (FEnabled <> Value) then begin
    FEnabled := Value;
    FOwner.Update;
  end;
end;

procedure TsPassiveShadow.SetOffset(const Value: integer);
begin
  if (FOffset <> Value) then begin
    FOffset := Value;
    FOwner.Update;
  end;
end;

procedure TsPassiveShadow.SetTransparency(const Value: TPercent);
begin
  if FTransparency <> Value then begin
    FTransparency := Value;
    FOwner.Update;
  end;
end;

{ TsPassivePainting }

constructor TsPassivePainting.Create(AOwner: TPersistent);
begin
  inherited Create;
  FColorBorderTop := clWhite;
  FColorBorderBottom := clBlack;
  FColor := clMenu;
  FTransparency := 50;
  FBevel := cbRaisedSoft;
  FOwner := TsPassivePaintStyle(AOwner);
end;

procedure TsPassivePainting.SetBevel(const Value: TsControlBevel);
begin
  if FBevel <> Value then begin
    FBevel := Value;
    FOwner.Update;
  end;
end;

procedure TsPassivePainting.SetColors(Index: Integer; Value: TColor);
begin
  case Index of
    0: if FColorBorderTop <> Value then begin
      FColorBorderTop := Value;
      FOwner.Update;
    end;
    1: if FColorBorderBottom <> Value then begin
      FColorBorderBottom := Value;
      FOwner.Update;
    end;
    3: if FColor <> Value then begin
      FColor := Value;
      FOwner.Update;
    end;
  end;
end;

procedure TsPassivePainting.SetTransparency(const Value: integer);
begin
  if FTransparency <> Value then begin
    FTransparency := Value;
    FOwner.Update;
  end;
end;

{ TsHotPaintStyle }

constructor TsHotPaintStyle.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FHotStyle := TsHotStyle.Create(Self);
end;

destructor TsHotPaintStyle.Destroy;
begin
  FreeAndNil(FHotStyle);
  inherited Destroy;
end;

procedure TsHotPaintStyle.PaintActiveBG(BGBmp : TBitmap; R : TRect; ci : TCacheInfo);
var
  aRect, cRect: TRect;
  Bmp : TBitmap;
  TransColor : TsColor;
  iDrawed : boolean;
  Transparency : integer;
  procedure FillCanvas(bmp : TBitmap); begin
    BMP.Canvas.Pen.Style := psClear;
    BMP.Canvas.Brush.Style := bsSolid;
    BMP.Canvas.Brush.Color := ColorToRGB(HotStyle.HotPainting.Color);
    BMP.Canvas.Rectangle(R);
  end;
  procedure PaintAddons; begin
    iDrawed := False;
    // BGImage painting
    if (HotStyle.HotBackground.Image.Percent > 0) and Assigned(HotStyle.HotBackground.Image.Image)
           and (HotStyle.HotBackground.Image.Image.Width <> 0)
           and (HotStyle.HotBackground.Image.Image.Height <> 0) then begin
      TileBitmap(BGBMP.Canvas, Rect(0, 0, BGBmp.Width, BGBmp.Height), HotStyle.HotBackground.Image.Image.Graphic);
      iDrawed := True;
    end;
    // BGGradient painting
    if (HotStyle.HotBackground.Gradient.Percent > 0) then begin
      if iDrawed then begin
        if Length(HotStyle.HotBackground.Gradient.FGradArray) > 0 then begin
          PaintGrad(Bmp, Rect(0, 0, BGBmp.Width, BGBmp.Height), HotStyle.HotBackground.Gradient.FGradArray);
        end
        else begin
          FillCanvas(Bmp);
        end;

        TransColor.A := 0;
        TransColor.R := HotStyle.HotBackground.Image.Percent * 255 div 100;
        TransColor.G := TransColor.R;
        TransColor.B := TransColor.R;
        SumBitmaps(BGBMP, Bmp, TransColor);
      end
      else begin
        if Length(HotStyle.HotBackground.Gradient.FGradArray) > 0 then begin
          PaintGrad(BGBMP, Rect(0, 0, BGBmp.Width, BGBmp.Height), HotStyle.HotBackground.Gradient.FGradArray);
        end
        else begin
          FillCanvas(BGBMP);
        end;
      end;
    end;
    if HotStyle.HotBackground.Gradient.Percent + HotStyle.HotBackground.Image.Percent in [1..99] then begin
      BlendColorRect(BGBMP,
                                 Rect(0,
                                      0,
                                      BGBMP.Width - 1,
                                      BGBMP.Height - 1),
                         (HotStyle.HotBackground.Gradient.Percent + HotStyle.HotBackground.Image.Percent),
                 ColorToRGB(HotStyle.HotPainting.Color));
{      FadeRect(BGBMP.Canvas, Rect(0,
                                      0,
                                      BGBMP.Width,
                                      BGBMP.Height),
                         BGBMP.Canvas.Handle, Point(0, 0),
                         (HotStyle.HotBackground.Gradient.Percent + HotStyle.HotBackground.Image.Percent),
                         ColorToRGB(HotStyle.HotPainting.Color), 0, ssRectangle);}
    end
    else if HotStyle.HotBackground.Gradient.Percent + HotStyle.HotBackground.Image.Percent <> 100 then begin
      BGBMP.Canvas.Pen.Style := psClear;
      BGBMP.Canvas.Brush.Style := bsSolid;
      BGBMP.Canvas.Brush.Color := ColorToRGB(HotStyle.HotPainting.Color);
      BGBMP.Canvas.Rectangle(aRect);
    end;
  end;
begin
  aRect := R;

  bmp := TBitmap.Create;
  bmp.PixelFormat := pf24bit;
  bmp.Width := BGBMP.Width;
  bmp.Height := BGBMP.Height;

  cRect := aRect;
//  if SkinIndex > -1 then begin
//    Transparency := gd[SkinIndex].HotPaintingTransparency;
//  end
//  else begin
    Transparency := HotStyle.HotPainting.Transparency;
//  end;

  if ci.Ready and (Transparency = 100) then begin
  end
  else if not ci.Ready then begin
//    PaintAddons;
  end
  else if Transparency = 0 then begin
    PaintAddons;
  end
  else if ci.Ready and (Transparency > 0) then begin
    PaintAddons;
    Bmp.Assign(BGBmp); // ?????? it's needed?
    FadeRect(ci.Bmp.Canvas, Rect(aRect.Left + ci.X,
                                         aRect.Top + ci.Y,
                                         aRect.Right + ci.X,
                                         aRect.Bottom + ci.Y),
                         Bmp.Canvas.Handle, Point(0, 0),
                         100, clWhite, 0, ssRectangle);
    TransColor.A := 0;
    TransColor.R := (100 - Transparency) * 255 div 100;
    TransColor.G := TransColor.R;
    TransColor.B := TransColor.R;
    SumBitmaps(BGBmp, Bmp, TransColor);
  end;

  FreeAndNil(Bmp);
end;

procedure TsHotPaintStyle.sStyleMessage(var Message: TMessage);
begin
end;

procedure TsHotPaintStyle.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    SM_OFFSET..SM_SHARED, EM_CHANGEALL + 1..SM_LAST : begin
      if Message.Msg = SM_GETSTYLEINFO then begin
        TSMGetStyleInfo(Message).WParam := tos_SPASSIVEPAINTSTYLE;
        TSMGetStyleInfo(Message).LParam := Longint(Self);
      end
      else sStyleMessage(Message);
    end
  end;
  inherited;
end;

end.






⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -