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

📄 sstyleutil.pas

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

{ TsPassiveBGStyle }

{$IFNDEF ALITE}
procedure TsPassiveBGStyle.AssignByManager(sC: TComponent);
begin
  if FBackground.ListenMSG and TsControlsManager(sC).Active then begin
    Background.Image.Image.Assign(TsControlsManager(sC).Background.Image);
  end;
  inherited;
end;
{$ENDIF}

constructor TsPassiveBGStyle.Create(AOwner: TControl);
begin
  inherited Create(AOwner);
  FBackground := TsBackground.Create(Self);

{$IFNDEF ALITE}
  if (sC = nil) and (csDesigning in FOwner.ComponentState) then sC := GetsControlsManager(GetOwnerForm(AOwner), GroupIndex);
  if Assigned(sC) then begin
    AssignByManager(sC);
  end;
{$ENDIF}  
end;

destructor TsPassiveBGStyle.Destroy;
begin
  FreeAndNil(FBackground);
  inherited Destroy;
end;

function TsPassiveBGStyle.ActiveColor: TColor;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].PaintingColor;
  end
  else begin
    Result := Painting.Color;
  end;
end;

function TsPassiveBGStyle.MouseAllow: boolean;
begin
  Result := True;
end;

procedure TsPassiveBGStyle.PaintBG(BGBmp : TBitmap);
var
  aRect: TRect;
  i : integer;
  wc: TWinControl;
  sc: TsGenStyle;
  ci : TCacheInfo;
  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(ActiveColor);
    BMP.Canvas.Rectangle(aRect.Left, aRect.Top, aRect.Right + 1, aRect.Bottom + 1);
  end;
  procedure PaintAddons; begin
    iDrawed := False;
    // BGImage painting
    if (ActualImagePercent > 0) then begin
      if (ActualImage <> nil)
           and (ActualImage.Width <> 0)
           and (ActualImage.Height <> 0) then begin
        TileBitmap(BGBmp.Canvas, aRect, ActualImage);
        iDrawed := True;
      end
      else begin
        FillCanvas(BGBmp);
      end;
    end;
    // BGGradient painting
    if (ActualGradPercent > 0) then begin
//      if FOwner.ClassName = 'TsDragBar' then Alert;
      if iDrawed then begin
        if Length(ActualGradArray) > 0 then begin
          PaintGrad(Bmp, aRect, ActualGradArray);
        end
        else begin
          FillCanvas(Bmp);
        end;

        TransColor.A := 0;
        TransColor.R := min(ActualImagePercent * 256 div 100, 255);
        TransColor.G := TransColor.R;
        TransColor.B := TransColor.R;

        SumBitmaps(BGBmp, Bmp, TransColor);
      end
      else begin
        if Length(ActualGradArray) > 0 then begin
          PaintGrad(BGBmp, aRect, ActualGradArray);
        end
        else begin
          FillCanvas(BGBmp);
        end;
      end;
    end;
    case ActualGradPercent + ActualImagePercent of
      1..99 : begin
        BlendColorRect(BGBMP, Rect(0,
                                   0,
                                   BGBMP.Width - 1,
                                   BGBMP.Height - 1
                              ),
                 (ActualGradPercent + ActualImagePercent),
                 ColorToRGB(ActiveColor));
      end;
      100 : begin end
      else begin
        FillDC(BGBMP.Canvas.Handle, aRect, ColorToRGB(ActiveColor));
      end;
    end;
  end;
begin
  aRect := Rect(0, 0, FOwner.Width, FOwner.Height);
try
  ci := GetParentCache;
except
//  alert(2);
end;
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf24bit;
  bmp.Width := BGBMP.Width;
  bmp.Height := BGBMP.Height;
  try

  if IsValidSkinIndex(SkinIndex) then begin
    Transparency := gd[SkinIndex].PaintingTransparency;
  end
  else begin
    Transparency := Painting.Transparency;
  end;

  if ci.Ready and (Transparency = 100) then begin
    FadeRect(ci.Bmp.Canvas, Rect(FOwner.Left + ci.X,
                                         FOwner.Top + ci.Y,
                                         FOwner.Left + FOwner.Width + ci.X,
                                         FOwner.Top + FOwner.Height + ci.Y),
                         BGBMP.Canvas.Handle, Point(0, 0),
                         100, clWhite, 0, ssRectangle);
  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;
    FadeRect(ci.Bmp.Canvas, Rect(FOwner.Left + ci.X,
                                         FOwner.Top + ci.Y,
                                         FOwner.Left + FOwner.Width + ci.X,
                                         FOwner.Top + FOwner.Height + 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;

  finally
    FreeAndNil(Bmp);
  end;


  if COC in sCanBeParent then begin
    wc := TWinControl(FOwner);
    for i := 0 to wc.ControlCount - 1 do begin
      sc := GetsStyle(wc.Controls[i]);
      if (csDestroying in wc.Controls[i].ComponentState) then break;
      if Assigned(sc) and (sc.SkinIndex > -1) and gd[sc.SkinIndex].ShadowEnabled and wc.Controls[i].Visible then begin
        sc.PaintShadow(BGBmp.Canvas, 0, 0);
      end
      else
      if Assigned(sc) and (sc.COC > 0) and sc.Effects.Shadow.Enabled and wc.Controls[i].Visible then begin
        sc.PaintShadow(BGBmp.Canvas, 0, 0);
      end;
    end;
  end;
end;

procedure TsPassiveBGStyle.sStyleMessage(var Message: TMessage);
{$IFNDEF ALITE}
var
  sSC : TsControlsManager;
{$ENDIF}  
begin
  if Assigned(Self) and ((Message.WParam = GroupIndex) or (Message.WParam = GI_FORPANELPATTERN)) then begin
    case Message.Msg of
      {$IFNDEF ALITE}
      CM_SETPATTERN: begin
        if (COC in sHaveBG) and Background.FListenMSG then begin
          Background.Image.Image.Assign(TSMSetBground(Message).sBackground.Image);
          Invalidate;
        end;
      end;
      CM_CHANGEALL : begin
        sSC := TCMChangeAll(Message).sStyleControl;
        if (COC in sHaveBG) and Background.FListenMSG and Assigned(sSC.Background) then begin
          AssignByManager(sSC);
          FOwner.Invalidate;
        end;
      end;
      {$ENDIF}
      SM_REPAINTSMOOTH : begin
        if IsValidSkinIndex(SkinIndex) and (gd[SkinIndex].PaintingTransparency > 0) then begin
          BgChanged := True;
          FOwner.Repaint;
        end;
      end;
    end;
  end;
end;

procedure TsPassiveBGStyle.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_SPASSIVEBGSTYLE;
        TSMGetStyleInfo(Message).LParam := Longint(Self);
      end
      else sStyleMessage(Message);
    end;
  end;
  inherited;
end;

{ TsActiveBGStyle }

constructor TsActiveBGStyle.Create(AOwner: TControl);
begin
  inherited Create(AOwner);
  FHotStyle := TsHotStyle.Create(Self);
  FBtnEffects := TsActiveEffects.Create(Self);
end;

destructor TsActiveBGStyle.Destroy;
begin
  FreeAndNil(FHotStyle);
  FreeAndNil(FBtnEffects);
  inherited Destroy;
end;


function TsActiveBGStyle.ActiveColor: TColor;
begin
  if ControlIsActive then begin
    if SkinIndex > -1 then begin
      Result := gd[SkinIndex].HotPaintingColor;
    end
    else
      Result := ColorToRGB(HotStyle.HotPainting.Color);
  end
  else begin
    if SkinIndex > -1 then begin
      Result := gd[SkinIndex].PaintingColor;
    end
    else
      Result := ColorToRGB(Painting.FColor);
  end;
end;

{
function TsActiveBGStyle.ActiveTransparency: TColor;
begin
  if ControlIsActive then begin
    Result := ColorToRGB(HotStyle.HotPainting.Transparency);
  end
  else begin
    Result := ColorToRGB(Painting.Transparency);
  end;
end;
}
procedure TsActiveBGStyle.PaintBG(BGBmp : TBitmap);
begin
  if ControlIsActive then begin
    PaintActiveBG;
  end
  else begin
    inherited PaintBG(BGBMP);
  end;
end;

procedure TsActiveBGStyle.PaintBorder(DC: hWnd; aRect: TsRect);
var
  R: TRect;
  i : integer;
//  Color1, Color2, ct, cb : TColor;
begin
  R := aRect;
  if ControlIsActive then begin
    if (FOwner is TsButtonControl) then begin
      if TsButtonControl(FOwner).Down and not ((TsButtonControl(FOwner).ButtonStyle = tbsDropDown) and (R.Left > 0)) then begin
        PaintBevel(FCacheBmp, R,
                              ActualBevelWidth div 4 + 1, cbLoweredSoft, SoftControl);

        if TsButtonControl(FOwner).DropDownMenu = nil then begin
          PaintBevel(FCacheBmp, Rect(R.Right,
                                               R.Top,
                                               TsButtonControl(FOwner).Width,
                                               R.Bottom
                                              ),
                                ActualBevelWidth div 4 + 1, cbLoweredSoft, SoftControl);
        end;
      end
      else begin
        PaintBevel(FCacheBmp, aRect, ActualBevelWidth, ActualBevel, SoftControl);
      end
    end
    else begin
      PaintBevel(FCacheBmp, aRect, ActualBevelWidth, ActualBevel, SoftControl);
    end
  end
  else begin
    if (FOwner is TsButtonControl) then begin
      i := TsButtonControl(FOwner).BevelWidth;
    end
    else begin
      i := 1;
    end;

    Case ActualBevel of
      cbNone : begin
        if (FOwner is TsButtonControl) and (csDesigning in FOwner.ComponentState) then begin
          PaintBevel(FCacheBmp, aRect, i, ActualBevel, SoftControl);
        end
      end;
      cbRaisedSoft : begin
        if (FOwner is TsButtonControl) and TsButtonControl(FOwner).Down then begin
          PaintBevel(FCacheBmp, aRect, i, cbLoweredSoft, SoftControl);
        end
        else begin
          PaintBevel(FCacheBmp, aRect, i, ActualBevel, SoftControl);
        end;
      end;
      cbRaisedHard : begin
        if (FOwner is TsButtonControl) and TsButtonControl(FOwner).Down then begin
          PaintBevel(FCacheBmp, aRect, i, cbLoweredHard, SoftControl);
        end
        else begin
          PaintBevel(FCacheBmp, aRect, i, ActualBevel, SoftControl);
        end;
      end
      else begin
        PaintBevel(FCacheBmp, aRect, i, ActualBevel, SoftControl);
      end;
    end;
  end;
//  if (FOwner is TsButtonControl) then begin
  if (FOwner is TsButton) and TsButton(FOwner).Default and TsButton(FOwner).FActive then begin
    PaintSimplyBorder(FCacheBmp.Canvas, aRect, clBlack, clBlack, clBlack, True, 1);
  end
end;

procedure TsActiveBGStyle.sStyleMessage(var Message: TMessage);
begin
{
  if Assigned(Self) and ((Message.WParam = GroupIndex) or (Message.WParam = GI_FORPANELPATTERN)) then begin
    case Message.Msg of
    end;
  end;}
end;

⌨️ 快捷键说明

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