sstyleutil.pas

AlphaControls是一个Delphi标准控件的集合

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

procedure TsActiveBGStyle.PaintActiveBG;
var
  aRect, cRect: TRect;
  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) and (ActualImage <> nil)
           and (ActualImage.Width <> 0)
           and (ActualImage.Height <> 0) then begin
      TileBitmap(FCacheBmp.Canvas, aRect, ActualImage);
      iDrawed := True;
    end;
    // BGGradient painting
    if (ActualGradPercent > 0) then begin
      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 := ActualImagePercent * 255 div 100;
        TransColor.G := TransColor.R;
        TransColor.B := TransColor.R;
        SumBitmaps(FCacheBmp, Bmp, TransColor);
//        SumBitmapsEx(FCacheBmp, Bmp, TransColor.R);
      end
      else begin
        if Length(ActualGradArray) > 0 then begin
          PaintGrad(FCacheBmp, aRect, ActualGradArray);
        end
        else begin
          FillCanvas(FCacheBmp);
        end;
      end;
    end;
    if ActualGradPercent + ActualImagePercent in [1..99] then begin
      BlendColorRect(FCacheBMP, Rect(0,
                                 0,
                                 FCacheBMP.Width - 1,
                                 FCacheBMP.Height - 1
                            ),
               (ActualGradPercent + ActualImagePercent),
               ColorToRGB(ActiveColor));
    end
    else if ActualGradPercent + ActualImagePercent <> 100 then begin
      FillDC(FCacheBMP.Canvas.Handle, aRect, ColorToRGB(ActiveColor));
    end;
  end;
begin
  aRect := Rect(0, 0, FOwner.Width, FOwner.Height);
  ci := GetParentCache;
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf24bit;
  bmp.Width := FCacheBMP.Width;
  bmp.Height := FCacheBMP.Height;

  cRect := aRect;
  if (FOwner is TsButtonControl) and TsButtonControl(FOwner).Down then begin
    OffsetRect(aRect, 1, 1);
  end;

  if IsValidSkinIndex(SkinIndex) then begin
    Transparency := gd[SkinIndex].HotPaintingTransparency;
  end
  else begin
    Transparency := HotStyle.HotPainting.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),
                         FCacheBMP.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;
    Bmp.Assign(FCacheBmp);
    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(FCacheBmp, Bmp, TransColor);
  end;

  FreeAndNil(Bmp);
end;

procedure TsActiveBGStyle.CreateRgn;
var
  fr2 : hrgn;
  cRect : TRect;
begin
  if (FOwner = nil) or BtnEffects.MaskedBorders.Enabled or (SkinIndex > -1) then begin
    inherited;
    exit;
  end;
  FRegion := 0;
  if FSoftControl and (COC in sCanBeRounded) then begin
    cRect := Rect(0, 0, FOwner.Width, FOwner.Height);
    FRegion := CreateRectRgn(cRect.Left + 1,
                                  cRect.Top,
                                  cRect.Right - 1,
                                  cRect.Bottom);
    fr2 := CreateRectRgn(cRect.Left,
                                  cRect.Top + 1,
                                  cRect.Right,
                                  cRect.Bottom - 1);
    CombineRgn(FRegion, FRegion, fr2, RGN_OR);
    DeleteObject(fr2);
  end;
  
  if not RestrictDrawing then BGChanged := True;
  SetWindowRgn(TWinControl(FOwner).Handle, FRegion, True);
  Regionchanged := False;
end;

function TsPassiveBGStyle.ActualBevel: TsControlBevel;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].PaintingBevel;
  end
  else begin
    Result := Painting.Bevel;
  end;
end;

function TsActiveBGStyle.ActualBevel: TsControlBevel;
begin
  if ControlIsActive then begin
    if SkinIndex > -1 then begin
      Result := gd[SkinIndex].HotPaintingBevel;
    end
    else begin
      Result := HotStyle.HotPainting.Bevel;
    end;
  end
  else Result := inherited ActualBevel;
end;

function TsPassiveBGStyle.ActualBevelWidth: integer;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].PaintingBevelWidth;
  end
  else begin
    Result := Painting.BevelWidth;
  end;
end;

function TsActiveBGStyle.ActualBevelWidth: integer;
begin
  if ControlIsActive then begin
    if SkinIndex > -1 then begin
      Result := gd[SkinIndex].HotPaintingBevelWidth;
    end
    else begin
      Result := HotStyle.HotPainting.BevelWidth;
    end;
  end
  else Result := inherited ActualBevelWidth;
end;

function TsPassiveBGStyle.ActualGradPercent: integer;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].GradientPercent;
  end
  else begin
    Result := Background.Gradient.Percent;
  end;
end;

function TsPassiveBGStyle.ActualGradArray: TsGradArray;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].GradientArray;
  end
  else begin
    Result := Background.Gradient.FGradArray;
  end;
end;

function TsActiveBGStyle.ActualGradArray: TsGradArray;
begin
  if ControlIsActive then begin
    if SkinIndex > -1 then begin
      Result := gd[SkinIndex].HotGradientArray;
    end
    else begin
      Result := HotStyle.HotBackground.Gradient.FGradArray;
    end;
  end
  else Result := inherited ActualGradArray;
end;

function TsActiveBGStyle.ActualGradPercent: integer;
begin
  if ControlIsActive then begin
    if SkinIndex > -1 then begin
      Result := gd[SkinIndex].HotGradientPercent;
    end
    else begin
      Result := HotStyle.HotBackground.Gradient.Percent;
    end;
  end
  else Result := inherited ActualGradPercent;
end;

function TsPassiveBGStyle.ActualImagePercent: integer;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].ImagePercent;
  end
  else begin
    Result := Background.Image.Percent;
  end;
end;

function TsActiveBGStyle.ActualImagePercent: integer;
begin
  if ControlIsActive then begin
    if SkinIndex > -1 then begin
      Result := gd[SkinIndex].HotImagePercent;
    end
    else begin
      Result := HotStyle.HotBackground.Image.Percent;
    end;
  end
  else Result := inherited ActualImagePercent;
end;

function TsPassiveBGStyle.ActualImage: TGraphic;
var
  i : integer;
begin
  Result := nil;
  if IsValidSkinIndex(SkinIndex) then begin
    i := GetMaskIndex(SkinIndex, SkinSection, PatternFile);
    if IsValidImgIndex(i) then Result := ma[i].Bmp;
  end
  else begin
    Result := Background.Image.Image.Graphic;
  end;
end;

function TsActiveBGStyle.ActualImage: TGraphic;
var
  i : integer;
begin
  Result := nil;
  if ControlIsActive then begin
    if IsValidSkinIndex(SkinIndex) then begin
      i := GetMaskIndex(SkinIndex, SkinSection, HOTPatternFILE);
      if i > -1 then Result := ma[i].Bmp;
    end
    else begin
      Result := HotStyle.HotBackground.Image.Image.Bitmap;
    end;
  end
  else Result := inherited ActualImage;
end;

function TsActiveBGStyle.ActualFadingEnabled: boolean;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].FadingEnabled;
  end
  else begin
    Result := BtnEffects.Fading.Enabled;
  end;
end;

function TsActiveBGStyle.ActualFadingIn: integer;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].FadingIntervalIn;
  end
  else begin
    Result := BtnEffects.Fading.IntervalIn;
  end;
end;

function TsActiveBGStyle.ActualFadingIter: integer;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].FadingIterations;
  end
  else begin
    Result := BtnEffects.Fading.Iterations;
  end;
end;

function TsActiveBGStyle.ActualFadingOut: integer;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].FadingIntervalOut;
  end
  else begin
    Result := BtnEffects.Fading.IntervalOut;
  end;
end;

{
function TsActiveBGStyle.ActualMaskedBorder: TBitmap;
begin
  Result := nil;
  if SkinIndex > -1 then begin
    i := GetMaskIndex(BordersMask);
    if i > -1 then begin
      Result := ma[i].Bmp;
    end;
  end
  else begin
    if BtnEffects.MaskedBorders.Enabled then
      Result := BtnEffects.MaskedBorders.Mask;
  end;
end;
}
function TsActiveBGStyle.ActualHotfontcolor: TColor;
begin
  if SkinIndex > -1 then begin
    Result := gd[SkinIndex].HotFontColor[1];
  end
  else begin
    Result := HotStyle.HotPainting.FFontColor;
  end;
end;

end.