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

📄 sstylesimply.pas

📁 AlphaControls是一个Delphi标准控件的集合
💻 PAS
📖 第 1 页 / 共 3 页
字号:
//      WriteIniStr(Application.ExeName, IntToStr(GetTickCount) + ' - ' + FOwner.Name, sMsgToString(Message.Msg) + '  - ', 'c:\Temp\Messages.log');
    end
  end;
{$ENDIF}
    case Message.Msg of
      SM_SETNEWSKIN : begin
        BGChanged := True;
        SkinIndex := GetSkinIndex(SkinSection);
        BorderIndex := GetMaskIndex(SkinIndex, SkinSection, BordersMask);
        RestrictDrawing := False;
        RegionChanged := True;
      end;
      SM_REFRESH : begin
        BGChanged := True;
        Invalidate;
      end;
      SM_CLEARINDEXES : begin
//        BGChanged := False;
        BorderIndex := -1;
        SkinIndex := -1;
      end;
      SM_REMOVESKIN : begin
        BorderIndex := -1;
        SkinIndex := -1;
        RegionChanged := True;
        Invalidate;
      end;
      SM_GETCACHE : begin
{$IFNDEF ALITE}
        if FOwner is TsTabSheet then begin
          if TsTabSheet(FOwner).PageControl.Skinable
            then GlobalCacheInfo.Bmp := TsTabSheet(FOwner).PageControl.CommonData.FCacheBmp
            else GlobalCacheInfo.Bmp := nil;
          GlobalCacheInfo.X := TsTabSheet(FOwner).Left;
          GlobalCacheInfo.Y := TsTabSheet(FOwner).Top;
        end
        else
{$ENDIF}
        begin
          GlobalCacheInfo.Bmp := FCacheBmp;
          GlobalCacheInfo.X := 0;
          GlobalCacheInfo.Y := 0;
        end;
        GlobalCacheInfo.Ready := not (COC in [COC_TSLISTBOX, COC_TSMEMO]) and (GlobalCacheInfo.Bmp <> nil);
{        if GlobalCacheInfo.Ready and (GlobalCacheInfo.Bmp = nil) then begin
          GlobalCacheInfo.Ready := False;
        end;}
      end;
      SM_UPDATESECTION : begin
        if UpperCase(SkinSection) = GlobalSectionName then begin
          RestrictDrawing := False;
          RegionChanged := True;
          Invalidate;
          SendMessage(TWinControl(FOwner).Handle, WM_PAINT, 0, 0);
        end;
      end;
      SM_SETBGCHANGED : begin
        if not RestrictDrawing then BGChanged := TSMSetBoolean(Message).Value;
      end;
      CM_SETSHADOWENABLED, EM_SETSHADOWENABLED: begin if not (COC in sNoShadow)
                                    and FOwner.Visible
                                    and not Effects.Shadow.DontUse then begin
          Effects.Shadow.FEnabled := TSMSetBoolean(Message).Value;
          if not RestrictDrawing then BGChanged := True;
        end
        else begin
          Effects.Shadow.FEnabled := False;
          if not RestrictDrawing then BGChanged := True;
        end;
      end;
      CM_SETSOFT, EM_SETSOFT :                      begin
        SoftControl := TSMSetBoolean(Message).Value;
        if not RestrictDrawing then BGChanged := True;
      end;
      CM_SETCOLORSHADOW, EM_SETCOLORSHADOW :        begin
        Effects.Shadow.FColor := TSMSetColor(Message).Value;
        if not RestrictDrawing then BGChanged := True;
      end;
      CM_SHADOWTRANSPARENCY, EM_SHADOWTRANSPARENCY: begin
        Effects.Shadow.FTransparency := TSMSetInteger(Message).Value;
        if not RestrictDrawing then BGChanged := True;
      end;
      CM_SHADOWOFFSET, EM_SHADOWOFFSET:             begin
        Effects.Shadow.FOffset       := TSMSetInteger(Message).Value;
        if not RestrictDrawing then BGChanged := True;
      end;
      CM_SHADOWBLUR, EM_SHADOWBLUR:                 begin
        Effects.Shadow.FBlur         := TSMSetInteger(Message).Value;
        if not RestrictDrawing then BGChanged := True;
      end;
      CM_UPDATESHADOWS, EM_UPDATESHADOWS: begin
        if (COC in sCanBeParent) then begin
           for i := 0 to TWinControl(FOwner).ControlCount - 1 do begin
             if (GetStyleInfo(TWinControl(FOwner).Controls[i]) > 0)
                and not GetsStyle(TWinControl(FOwner).Controls[i]).Effects.Shadow.DontUse
                  then begin
               if not RestrictDrawing then BGChanged := True;
               FOwner.Repaint;
               Break;
             end;
           end;
        end;
      end;
    {$IFNDEF ALITE}
      CM_CHANGEALL : begin
        sSC := TCMChangeAll(Message).sStyleControl;

        Effects.Shadow.FColor        := sSC.Shadow.Color;
        Effects.Shadow.FTransparency := sSC.Shadow.Transparency;
        Effects.Shadow.FOffset       := sSC.Shadow.Offset;
        Effects.Shadow.FBlur         := sSC.Shadow.Blur;
        if not (COC in sNoShadow) and FOwner.Visible
             and not Effects.Shadow.DontUse then begin
          Effects.Shadow.FEnabled := sSC.Shadow.Enabled;
        end
        else begin
          Effects.Shadow.FEnabled := False;
        end;

        FSoftControl := sSC.SoftControls;
        if not RestrictDrawing then BGChanged := True;
        Invalidate;
      end;
      EM_CHANGEALL : begin
        sEM := TEMChangeAll(Message).sStyleControl;

        Effects.Shadow.FColor        := sEM.Shadow.Color;
        Effects.Shadow.FTransparency := sEM.Shadow.Transparency;
        Effects.Shadow.FOffset       := sEM.Shadow.Offset;
        Effects.Shadow.FBlur         := sEM.Shadow.Blur;

        if not (COC in sNoShadow) and FOwner.Visible
             and not Effects.Shadow.DontUse then begin
          Effects.Shadow.FEnabled := sEM.Shadow.Enabled;
        end
        else begin
          Effects.Shadow.FEnabled := False;
        end;

        FSoftControl := sEM.SoftControls;
        Invalidate;
      end;
    {$ENDIF}
    end;
  end;
end;

function TsGenStyle.GetParentCache: TCacheInfo;
begin
  Result.Ready := False;
  Result.Bmp := nil;
  Result.X := 0;
  Result.Y := 0;
  if FOwner.Parent = nil then Exit;
{$IFNDEF ALITE}
  if FOwner.Parent is TsTabSheet then begin
    Result.Bmp := TsTabSheet(FOwner.Parent).PageControl.CommonData.FCacheBmp;
    Result.X := TsTabSheet(FOwner.Parent).Left;
    Result.Y := TsTabSheet(FOwner.Parent).Top;
    Result.Ready := True;
  end
  else
{$ENDIF}
  begin
    GlobalCacheInfo.Ready := False;
    SendMessage(FOwner.Parent.Handle, SM_GETCACHE, 0, 0);
    Result := GlobalCacheInfo;
  end;
end;

procedure TsGenStyle.InitCacheBmp;
begin
  if FCacheBmp = nil then Exit;
  if Assigned(FOwner) then begin
    FCacheBmp.Height := FOwner.Height;
    FCacheBmp.Width := FOwner.Width;
  end
  else begin
    FCacheBmp.Height := 0;
    FCacheBmp.Width := 0;
  end;
  FCacheBmp.PixelFormat := pf24bit;
end;

procedure TsGenStyle.CreateRgn;
var
  fr2 : hrgn;
  cRect : TRect;
begin
  if not RegionChanged then Exit;
  RegionChanged := False;

  FRegion := 0;

  if FOwner = nil then exit;
  cRect := Rect(0, 0, FOwner.Width, FOwner.Height);
  if FSoftControl and (COC in sCanBeRounded) then begin
    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);
end;

procedure TsGenStyle.SetSoftControl(const Value: boolean);
begin
  if FSoftControl <> Value then begin
    FSoftControl := Value;
    RegionChanged := True;
//    CreateRgn;
    Invalidate;
  end;
end;

procedure TsGenStyle.Invalidate;
begin
  if not RestrictDrawing then begin
    BGChanged := True;
    if not (csCreating in FOwner.ControlState) and
       not (csDestroying in FOwner.ComponentState) and
       FOwner.Visible then begin
      TsHackedControl(FOwner).Invalidate;
//    CreateRgn; // ??????
    end;
  end;
end;

procedure TsGenStyle.AssignByManager(sC: TComponent);
begin
//  FGroupIndex := TsControlsManager(sC).GroupIndex;!!!
end;

procedure TsGenStyle.SetSkinSection(const Value: string);
begin
  if FSkinSection <> Value then begin
    FSkinSection := Value;
    SkinIndex := GetSkinIndex(FSkinSection);
    BorderIndex := GetMaskIndex(SkinIndex, FSkinSection, BordersMask);
    RegionChanged := true;
    Invalidate;
  end;
end;

procedure TsGenStyle.Loaded;
begin
  BGChanged := True;
  if FSkinSection = '' then begin
    FSkinSection := FOwner.ClassName;
  end;
  SkinIndex := GetSkinIndex(SkinSection);
  BorderIndex := GetMaskIndex(SkinIndex, SkinSection, BordersMask);
end;

function TsGenStyle.ActualMaskedBorder: TBitmap;
var
  i : integer;
begin
  Result := nil;
  if IsValidSkinIndex(SkinIndex) then begin
    i := GetMaskIndex(SkinIndex, SkinSection, BordersMask);
    if i > -1 then begin
      Result := ma[i].Bmp;
    end;
  end
end;

procedure TsGenStyle.BeforeDestruction;
begin
  inherited;
  if Assigned(FOwner) and Assigned(FOwner.Parent) then begin
    if not (csDestroying in FOwner.Parent.ComponentState) then begin
      AlignShadow;
    end;
  end;
end;

procedure TsGenStyle.PaintShadow(aCanvas: TCanvas; X, Y: integer);
begin

end;

{ TsShadow }

constructor TsShadow.Create(AOwner: TsEffects);
begin
  FOwner := AOwner;
  FColor := clBlack;
  FBlur := 4;
  FOffset := 8;
  FTransparency := 60;
  FDontUse := True;
  FEnabled := False;
end;

destructor TsShadow.Destroy;
begin
  if Assigned(FOwner.FOwner.FOwner.Parent)
     and not (csDestroying in FOwner.FOwner.FOwner.Parent.ComponentState)
     and Enabled then begin
      Enabled := False;
  end;
  inherited Destroy;
end;

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

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

procedure TsShadow.SetDontUse(const Value: boolean);
begin
  FDontUse := Value;
  if FEnabled and FDontUse then Enabled := False;
end;

procedure TsShadow.SetEnabled(const Value: boolean);
begin
  if GetStyleInfo(FOwner.FOwner.FOwner.Parent) > 0 then begin
    if FOwner.FOwner.COC in sNoShadow then Exit;
    if Value then FDontUse := False;
    FEnabled := Value and (not FDontUse or (csDesigning in FOwner.FOwner.FOwner.ComponentState));
    FOwner.FOwner.AlignShadow;
  end;
end;

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

procedure TsShadow.SetTransparency(const Value: integer);
begin
  if FTransparency <> Value then begin
    if Value < 0 then FTransparency := 0
    else if Value > 100 then FTransparency := 100
    else FTransparency := Value;

    if Enabled then begin
      FOwner.FOwner.AlignShadow;
    end;
  end;
end;

{ TsEffects }

constructor TsEffects.Create(AOwner: TsGenStyle);
begin
  FOwner := AOwner;
  Shadow := TsShadow.Create(Self);
end;

destructor TsEffects.Destroy;
begin
  if Assigned(FShadow) then FreeAndNil(FShadow);
  inherited Destroy;
end;

initialization
  sSkinData := TsSkinData.Create;

finalization
  sSkinData.SkinManager := nil;
  if Assigned(sSkinData.skinFile) then FreeAndNil(sSkinData.SkinFile);
  if Assigned(sSkinData) then FreeAndNil(sSkinData);

end.





⌨️ 快捷键说明

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