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

📄 sstylesimply.pas

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

  s := UpperCase(gd[SkinIndex].ParentClassName);
  if (s <> '') and (UpperCase(SkinSection) <> s) then begin
    i := GetSkinIndex(s);
    if i > -1 then Result := GetPatternIndex(i, s, pattern);
  end;
end;

function GetMaskIndex(SkinIndex : integer; SkinSection, mask : string) : integer;
var
  i, l : integer;
  s : string;
begin
  Result := -1;
  if not IsValidSkinIndex(SkinIndex) then Exit;
  l := Length(ma);
  if (l < 0) or not sSkinData.Active or (SkinSection = '' ) or (SkinIndex < 0) then Exit;

  for i := 0 to l - 1 do begin
    if (ma[i].PropertyName = mask) and (ma[i].ClassName = UpperCase(skinSection)) then begin
      Result := i;
      Exit;
    end;
  end;


  s := UpperCase(gd[SkinIndex].ParentClassName);

  if (s <> '') and (UpperCase(SkinSection) <> s) then begin
    i := GetSkinIndex(s);
    if i > -1 then Result := GetMaskIndex(i, s, mask);
  end;
end;

function GetStyleInfo(Control : TComponent) : integer;
var
  m : TMessage;
begin
  Result := 0;
  if Control is TControl then begin
    m.LParam := 0;
    m.WParam := 0;
    m.Msg    := SM_GETSTYLEINFO;
    m.Result := 0;
    TControl(Control).WindowProc(m);//, 0, 0);
    Result := m.WParam;
  end;
end;

{ TsCustomBorder }

constructor TsCustomBorder.Create(AOwner: TPersistent);
begin
  FBevel := sConst.bsFlat1;
  FOwner := AOwner;
  FWidth := 2;
end;

procedure TsCustomBorder.SetWidth(const Value: integer);
begin
  if FWidth <> Value then begin
    FWidth := Value;
  end;
end;

{ TsGenStyle }

constructor TsGenStyle.Create(AOwner : TControl);
var
  ScreenDC: HDC;
begin
  SkinIndex := -1;
  BorderIndex := -1;
  FOwner := AOwner;
  FFocused := False;
  FMouseAbove := False;
  if not RestrictDrawing then BGChanged := True;

{$IFDEF DEBUGGING}
  FLogged := False;
{$ENDIF}

// <<<<< Creating Cache
{$IFNDEF ALITE}
  if not (AOwner is TsTabSheet) then
{$ENDIF}
  begin
    FCacheBmp := Graphics.TBitmap.Create;
    ScreenDC := GetWindowDC(0);
    FCacheBmp.Handle := CreateCompatibleBitmap(ScreenDC, FOwner.Width, FOwner.Height);
    ReleaseDC(0, ScreenDC);

    FCacheBmp.Width := FOwner.Width;
    FCacheBmp.Height := FOwner.Height;
    FCacheBmp.PixelFormat := pf24bit;
  end;

// Creating Cache >>>>>>>>

  FEffects := TsEffects.Create(Self);

  FSoftControl := True;
{$IFDEF RUNIDEONLY}
  if not IsIDERunning and not (csDesigning in FOwner.ComponentState) and not sTerminated then begin
    sTerminated := True;
    ShowWarning(sIsRUNIDEONLYMessage);
  end;
{$ENDIF}
  RegionChanged := True;
end;

destructor TsGenStyle.Destroy;
begin
//  if FOwner = nil then exit;
  if Assigned(FCacheBmp) then FreeAndNil(FCacheBmp);
  if Assigned(FEffects) then FreeAndNil(FEffects);
  inherited Destroy;
end;

{$IFDEF DEBUGGING}
procedure TsGenStyle.SetLogged(Value : boolean);
begin
  FLogged := Value;
end;
{$ENDIF}

function TsGenStyle.ControlIsActive: boolean;
begin
  Result := False;
  if not Assigned(FOwner) or (csDestroying in FOwner.ComponentState) then Exit;
  if (FOwner is TsButton) and TsButton(FOwner).Default and TsButton(FOwner).FActive then begin
    Result := True;
    Exit;
  end
  else
  if not FOwner.Enabled or (csDesigning in FOwner.ComponentState) then begin
    Exit;
  end
  else
  if FOwner is TsButtonControl and TsButtonControl(FOwner).Down then begin
    Result := True;
    Exit;
  end
  else if not (COC in sForbidMouse) then begin
    if FFocused or ((FOwner is TWinControl) and TWinControl(FOwner).Focused) then begin
      Result := True;
    end
    else begin
      Result := FMouseAbove;
    end;
  end;
end;

procedure TsGenStyle.RedrawBorder(DC: hWnd);
begin
end;

procedure TsGenStyle.AlignShadow;
begin
  if Assigned(FOwner.Parent) then begin
    SetControlChanged(FOwner.Parent, True);
    if (FOwner.Parent is TsTabSheet) and Assigned(TsTabSheet(FOwner.Parent).PageControl) then begin
      SetControlChanged(TsTabSheet(FOwner.Parent).PageControl, True);
      TsTabSheet(FOwner.Parent).PageControl.CommonData.BGChanged := True;
      TsTabSheet(FOwner.Parent).PageControl.Repaint;
      FOwner.Parent.Repaint;
    end
    else FOwner.Parent.Repaint;
  end;
end;

procedure TsGenStyle.WndProc(var Message: TMessage);
begin
{$IFDEF DEBUGGING}
  case Message.MSG of
    WM_CREATE, 45069, 45096, 45100, 45110, 14, 24, 133, 70, 71, 20, 2, 130, 48656, 45108: ;
    else if Logged and (MessageToStr(Message.Msg) <> 'NO') then begin
      if Assigned(FMesBox) then begin
        MesBox.Items.Add(FOwner.Name + ' - ' + MessageToStr(Message.Msg) + ' = ' + IntToStr(Message.Msg) + ', L=' + IntToStr(Message.LParam) + ', W=' + IntToStr(Message.WParam));
      end
      else;
//      WriteIniStr(Application.ExeName, IntToStr(GetTickCount) + ' - ' + FOwner.Name, MessageToStr(Message.Msg) + '  - ', 'c:\Temp\Messages.log');
    end
  end;
{$ENDIF}
  case Message.Msg of
    SM_GETSTYLEINFO : begin
      TSMGetStyleInfo(Message).WParam := tos_SIMPLYSTYLE;
      TSMGetStyleInfo(Message).LParam := Longint(Self);
      Message.Result := 1;
    end;
    SM_OFFSET + 1 .. SM_SHARED : begin
      sStyleMessage(Message);
    end;
    SM_SHARED + 1 .. EM_CHANGEALL : begin
      if (Self is TsEditorStyle) then begin
        sStyleMessage(Message);
      end;
    end;
    EM_CHANGEALL + 1..SM_LAST : begin
      if (Self is TsPaintStyle) then begin
        sStyleMessage(Message);
      end;
    end;
    WM_KILLFOCUS, CM_EXIT : begin
      FFocused := False;
      Invalidate;
    end;
    WM_SETFOCUS, CM_ENTER: begin
      FFocused := True;
      if not (COC in [1..15]) then Invalidate;
//      Message.Result := 1;
    end;
    CM_ENABLEDCHANGED, WM_FONTCHANGE: begin
      Invalidate;
    end;
    CM_MOUSEENTER : begin
      if not (COC in sForbidMouse) then begin
        FMouseAbove := True;
        if not FFocused and not ((FOwner is TWinControl) and TWinControl(FOwner).Focused) and not(csDesigning in FOwner.ComponentState) then begin
        {$IFNDEF ALITE}
          if (FOwner is TsCustomComboBox) and Assigned(FOwner.Parent) and
                    not(TsCustomComboBox(FOwner).DroppedDown) then begin
//            TsCustomComboBox(FOwner).PaintButton;        
            Invalidate;
          end
          else
        {$ENDIF}
          begin
            if (FOwner is TsButtonControl) and
                 not(TsButtonControl(FOwner).ButtonStyle in [tbsDivider, tbsSeparator]) and
                      TsButtonControl(FOwner).sStyle.ActualFadingEnabled then begin
              TsButtonControl(FOwner).StartFadeIn;
            end
{$IFNDEF ALITE}
            else if (FOwner is TsTrackBar) and
                      TsTrackBar(FOwner).sStyle.ActualFadingEnabled then begin
              TsTrackBar(FOwner).StartFadeIn;
            end
{$ENDIF}
            else begin
              Invalidate;
            end;
          end;
        end;
      end;
      Message.Result := 1;
    end;
    CM_MOUSELEAVE : begin
      if not (COC in sForbidMouse) then begin
        FMouseAbove := False;
        if not FFocused and not ((FOwner is TWinControl) and TWinControl(FOwner).Focused) and not(csDesigning in FOwner.ComponentState) then begin
        {$IFNDEF ALITE}
          if (FOwner is TsCustomComboBox) and Assigned(FOwner.Parent) and
                    not(TsCustomComboBox(FOwner).DroppedDown) then begin
//            TsCustomComboBox(FOwner).PaintButton;
            Invalidate;
          end
          else
        {$ENDIF}
          begin
            if (FOwner is TsButtonControl) and
                 not(TsButtonControl(FOwner).ButtonStyle in [tbsDivider, tbsSeparator]) and
                      TsButtonControl(FOwner).sStyle.ActualFadingEnabled then begin
              TsButtonControl(FOwner).StartFadeOut;
            end
{$IFNDEF ALITE}
            else if (FOwner is TsTrackBar) and
                      TsTrackBar(FOwner).sStyle.ActualFadingEnabled then begin
              TsTrackBar(FOwner).StartFadeOut;
            end
{$ENDIF}
            else begin
              Invalidate;
            end;
          end;
        end;
      end;
      Message.Result := 1;
    end;
  {$IFNDEF ALITE}
    WM_CTLCOLORLISTBOX: begin
      if (COC in [COC_TsCustomComboBox..COC_TsBDEComboBox]) and TsCustomComboBox(FOwner).FDropDown then begin
        TsCustomComboBox(FOwner).FDropDown := False;
        if not RestrictDrawing then BGChanged := True;
      end;
    end;
  {$ENDIF}
    WM_SIZE : begin
      if not RestrictDrawing then BGChanged := True;
      RegionChanged := True;
      CreateRgn;
      RegionChanged := True;
      if ((SkinIndex > -1) and (gd[SkinIndex].ShadowEnabled)) or Effects.Shadow.Enabled then begin
      {$IFNDEF ALITE}
        if (COC in [COC_TsCustomComboBox..COC_TsBDEComboBox]) and
          TsCustomComboBox(FOwner).FDropDown then begin
        end
        else
      {$ENDIF}
        begin
          AlignShadow;
        end;
      end;
      if FOwner is TsButtonControl then TsButtonControl(FOwner).Repaint 
{$IFNDEF ALITE}
      else if COC = COC_TsScrollBox then begin
        TsScrollBox(FOwner).Repaint;
      end 
      else if FOwner is TsTrackBar then TsTrackBar(FOwner).Repaint
{$ENDIF}
      else if FOwner is TsCheckedControl then TsCheckedControl(FOwner).PaintControl
      else if csDesigning in FOwner.ComponentState then begin
        if FOwner is TWinControl then TWinControl(FOwner).RePaint;
      end;
    end;
    WM_MOVE : begin
      if not RestrictDrawing then BGChanged := True;
      if ((SkinIndex > -1) and (gd[SkinIndex].ShadowEnabled)) or Effects.Shadow.Enabled then begin
      {$IFNDEF ALITE}
        if (COC in [COC_TsCustomComboBox..COC_TsBDEComboBox]) and
          TsCustomComboBox(FOwner).FDropDown then begin
        end
        else
      {$ENDIF}
        begin
          AlignShadow;
        end;
      end;
{$IFNDEF ALITE}
      if COC = COC_TsScrollBox then begin
        TsScrollBox(FOwner).Repaint;
      end else
{$ENDIF}
      if FOwner is TsButtonControl then TsButtonControl(FOwner).Repaint
{$IFNDEF ALITE}
      else if FOwner is TsTrackBar then TsTrackBar(FOwner).Repaint
{$ENDIF}
      else if FOwner is TsCheckedControl then TsCheckedControl(FOwner).PaintControl
      else if csDesigning in FOwner.ComponentState then begin
        if FOwner is TWinControl then TWinControl(FOwner).RePaint;
      end;
    end;
    CM_VISIBLECHANGED{, WM_WINDOWPOSCHANGED} : begin
      if not FOwner.Visible then begin
        if (SkinIndex > -1) and gd[SkinIndex].ShadowEnabled then begin
          AlignShadow;
        end
        else if (COC > 0) and Effects.Shadow.Enabled then begin
          AlignShadow;
        end;
      end;
    end;
  end;
  inherited;
end;

procedure TsGenStyle.CopyFromCache(DC: hWnd; Left, Top, Right, Bottom: integer);
var
  SavedDC: hWnd;
begin
  SavedDC := SaveDC(DC);
  try
    BitBlt(DC, Left, Top, Right, Bottom, FCacheBmp.Canvas.Handle, Left, Top, SRCCOPY);
  finally
    RestoreDC(DC, SavedDC);
    BGChanged := False;
  end
end;

procedure TsGenStyle.CopyToCache(DC: hWnd; Left, Top, Right, Bottom: integer);
begin
  BitBlt(FCacheBmp.Canvas.Handle, Left, Top, Right, Bottom, DC, Left, Top, SRCCOPY);
end;

procedure TsGenStyle.sStyleMessage(var Message: TMessage);
var
  i : integer;
{$IFNDEF ALITE}
  sSC : TsControlsManager;
  sEM : TsEditorsManager;
{$ENDIF}
begin
  if Assigned(Self) and (Message.WParam = GroupIndex) then begin
{$IFDEF DEBUGGING}
  case Message.MSG of
    WM_CREATE, 45069, 45096, 45100, 45110, 14, 24, 133, 70, 71, 20, 2, 130, 48656, 45108: ;
    else if Logged and (sMsgToString(Message.Msg) <> 'NO') then begin
      if Assigned(FMesBox) then begin
        MesBox.Items.Add(FOwner.Name + ' - ' + sMsgToString(Message.Msg) + ' = ' + IntToStr(Message.Msg) + ', L=' + IntToStr(Message.LParam) + ', W=' + IntToStr(Message.WParam));
      end
      else;

⌨️ 快捷键说明

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