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

📄 sstyleedits.pas

📁 AlphaControls是一个Delphi标准控件的集合
💻 PAS
📖 第 1 页 / 共 4 页
字号:
var
  R, aRect: TRect;
  width : integer;
  ActiveColor : TColor;
begin
  aRect := Rect(0, 0, FOwner.Width, FOwner.Height);
  ActiveColor := GetActiveColor;

  if ControlIsActive then begin
    OffsetRect(aRect, -3, -3);
  end;
  R := aRect;
  width := 3;
  DrawRectangleOnDC(DC, R, ActiveColor, ActiveColor, Width);
  PaintBorder(DC, aRect);
end;
}
procedure TsEditorStyle.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    SM_OFFSET..EM_CHANGEALL : begin
      if Message.Msg = SM_GETSTYLEINFO then begin
        TSMGetStyleInfo(Message).WParam := tos_SEDITSTYLE;
        TSMGetStyleInfo(Message).LParam := Longint(Self);
        Message.Result := 1;
        Exit;
      end
      else sStyleMessage(Message);
    end;
    CM_SYSCOLORCHANGE, CM_PARENTCOLORCHANGED: begin
      if Painting.ParentColor and Assigned(FOwner.Parent) then begin
        Painting.FColor := TsHackedControl(FOwner.Parent).Color;
        if not RestrictDrawing then BGChanged := True;
      end;
    end;
  end;
  inherited;
end;

procedure TsEditorStyle.sStyleMessage(var Message: TMessage);
{$IFNDEF ALITE}
var
  sSC : TsEditorsManager;
{$ENDIF}  
begin
  if Assigned(Self) and (Message.WParam = GroupIndex) then begin
    case Message.Msg of
      EM_SETBORDERTOP:      begin
        Painting.ColorBorderTop := TSMSetColor(Message).Value;
        if not RestrictDrawing then BGChanged := True;
      end;
      EM_SETBORDERBOTTOM:   begin
        Painting.ColorBorderBottom := TSMSetColor(Message).Value;
        if not RestrictDrawing then BGChanged := True;
      end;
      EM_SETCOLOR:          begin
        Painting.Color := TSMSetColor(Message).Value;
        if not RestrictDrawing then BGChanged := True;
      end;
      EM_SETBEVEL:          begin
        Painting.Bevel := aEditorBevels[TSMSetBevel(Message).Value];
        if not RestrictDrawing then BGChanged := True;
      end;
      EM_SETCOLORHOT:       begin
        Selection.Color := TSMSetColor(Message).Value;
      end;
      EM_SETBEVELHOT:       begin
        Selection.FBorder.FBevel := aEditorBevels[TSMSetInteger(Message).Value];
      end;
      EM_SETBEVELWIDTHHOT:  begin
        Selection.FBorder.Width := TSMSetInteger(Message).Value;
      end;
    {$IFNDEF ALITE}
      EM_CHANGEALL : begin
        sSC := TEMChangeAll(Message).sStyleControl;

        Painting.FColorBorderTop := sSC.Painting.ColorBorderTop;
        Painting.FColorBorderBottom := sSC.Painting.ColorBorderBottom;
        Painting.FColor := sSC.Painting.Color;
        Painting.FBevel := sSC.Painting.Bevel;

        Selection.FColor := sSC.Selection.Color;
        Selection.FBorder.FBevel := sSC.Selection.Border.Bevel;
        Selection.FBorder.FWidth := sSC.Selection.Border.Width;
      end;
    {$ENDIF}
    end;
  end;
end;

procedure TsEditorStyle.PaintShadow(aCanvas: TCanvas; X, Y : integer);
var
  aRect: TRect;
  ss: TsShadowingShape;
  tr: integer;
begin
  ss := ssRectangle;
  if SkinIndex > -1 then begin
    if gd[SkinIndex].ShadowEnabled then begin
      case COC of
        COC_TsCheckedControl..COC_TsRadioButton : begin
          aRect := TsCheckedControl(FOwner).CheckRect;
          OffsetRect(aRect, gd[SkinIndex].ShadowOffset + FOwner.Left, gd[SkinIndex].ShadowOffset + FOwner.Top);
        {$IFNDEF ALITE}
          if FOwner is TsRadioButton then
            ss := ssEllipse;
        {$ENDIF}
        end
        else begin
        {$IFNDEF ALITE}
          if (COC in [COC_TsCustomComboBox..COC_TsBDEComboBox]) then
            if TsCustomComboBox(FOwner).DroppedDown then Exit;
        {$ENDIF}

          aRect.Top := FOwner.Top + gd[SkinIndex].ShadowOffset;
          aRect.Bottom := aRect.Top + FOwner.Height;
          aRect.Left := FOwner.Left + gd[SkinIndex].ShadowOffset;
          aRect.Right := aRect.Left + FOwner.Width;
        end;
      end;
      if FOwner.Parent is TsTabSheet then begin
        if aRect.Right > FOwner.Parent.Width + FOwner.Parent.Left - X then
            aRect.Right := FOwner.Parent.Width + FOwner.Parent.Left - X;
        if aRect.Bottom > FOwner.Parent.Height + FOwner.Parent.Top - Y then
            aRect.Bottom := FOwner.Parent.Height + FOwner.Parent.Top - Y;
      end;

      tr := SumTrans(0, gd[SkinIndex].ShadowTransparency);

      OffsetRect(aRect, X, Y);
      FadeRect(aCanvas, aRect, aCanvas.Handle,
           Point(aRect.Left, aRect.Top),
           tr,
           ColorToRGB(gd[SkinIndex].ShadowColor),
           gd[SkinIndex].ShadowBlur, ss, 3 * integer(SoftControl));
    end;
  end
  else begin
    case COC of
      COC_TsCheckedControl..COC_TsRadioButton : begin
        aRect := TsCheckedControl(FOwner).CheckRect;
        OffsetRect(aRect, Effects.Shadow.Offset + FOwner.Left, Effects.Shadow.Offset + FOwner.Top);
      {$IFNDEF ALITE}
        if FOwner is TsRadioButton then
          ss := ssEllipse;
      {$ENDIF}
      end
      else begin
      {$IFNDEF ALITE}
        if (COC in [COC_TsCustomComboBox..COC_TsBDEComboBox]) then
          if TsCustomComboBox(FOwner).DroppedDown then Exit;
      {$ENDIF}

        aRect.Top := FOwner.Top + Effects.Shadow.Offset;
        aRect.Bottom := aRect.Top + FOwner.Height;
        aRect.Left := FOwner.Left + Effects.Shadow.Offset;
        aRect.Right := aRect.Left + FOwner.Width;
      end;
    end;

    tr := SumTrans(0, Effects.Shadow.Transparency);

    OffsetRect(aRect, X, Y);
    FadeRect(aCanvas, aRect, aCanvas.Handle,
         Point(aRect.Left, aRect.Top),
         tr,
         ColorToRGB(Effects.Shadow.Color),
         Effects.Shadow.Blur, ss, 3 * integer(SoftControl));
  end;
end;

function TsEditorStyle.GetSelBorder: TsEditorBorder;
begin
  Result := Selection.Border
end;

function TsEditorStyle.GetSelMode: TModeSelection;
begin
  if Self is TsCustomStyle then begin
    Result := TsCustomStyle(Self).Selection.Mode
  end
  else begin
    Result := [];
  end;
end;

procedure TsEditorStyle.CreateRgn;
var
  fr2 : hrgn;
  cRect : TRect;
  i : integer;
begin
  if (COC in [COC_TsMemo, COC_TsCustomListBox]) or IsValidImgIndex(BorderIndex) then Exit;
  i := GetMaskIndex(SkinIndex, SkinSection, BordersMask);
  if (FOwner = nil) or (i > -1) then exit;
  if FSoftControl and (COC in sCanBeRounded) then begin
    FRegion := 0;
    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);
end;

{
function TsEditorStyle.GetBorderMaskIndex: integer;
var
  i, l : integer;
  s : string;
begin
  Result := -1;
  if Assigned(sSkinData.SkinFile) then begin
    l := Length(ma);
    s := sSkinData.SkinFile.ReadString(SkinSection, 'Synonym', '');
    if l > 0 then begin
      for i := 0 to l - 1 do begin
        if (ma[i].ClassName = SkinSection) and (ma[i].PropertyName = BordersMask) then begin
          Result := i;
          Break;
        end;
      end;
      if Result < 0 then begin
        for i := 0 to l - 1 do begin
          if (ma[i].ClassName = s) and (ma[i].PropertyName = BordersMask) then begin
            Result := i;
            Break;
          end;
        end;
      end;
    end;
  end;
end;
}
// TsCustomStyle

constructor TsCustomStyle.Create(AOwner : TControl);
begin
  inherited Create(AOwner);
  FCaption := TsStyleCaption.Create(Self);
{$IFDEF USEDB}
  FEditable := True;
{$ENDIF}  
end;

procedure TsCustomStyle.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    SM_OFFSET..EM_CHANGEALL : begin
      if Message.Msg = SM_GETSTYLEINFO then begin
        TSMGetStyleInfo(Message).WParam := tos_SCUSTOMSTYLE;
        TSMGetStyleInfo(Message).LParam := Longint(Self);
        Message.Result := 1;
        Exit;
      end
      else sStyleMessage(Message);
    end;
    WM_SIZE, WM_MOVE : begin
      if Caption.Active then begin
      {$IFNDEF ALITE}
        if not ((COC in [COC_TsCustomComboBox..COC_TsBDEComboBox]) and TsCustomComboBox(FOwner).FDropDown) then
      {$ENDIF}  
          begin
            AlignLabel;
        end;
      end;
      FOwner.Repaint;
    end;
    CM_VISIBLECHANGED: begin
      if Caption.FActive and Assigned(FTheLabel) then FTheLabel.Visible := FOwner.Visible;
      if not RestrictDrawing then BGChanged := True;
    end;
    CM_ENABLEDCHANGED, WM_FONTCHANGE: begin
      if Caption.FActive and Assigned(FTheLabel) then begin
        FTheLabel.Enabled := FOwner.Enabled;
        FTheLabel.Invalidate;
      end;
    end
  end;
  inherited;
end;

procedure TsCustomStyle.sStyleMessage(var Message: TMessage);
begin
  if Assigned(Self) and (Message.WParam = GroupIndex) then begin
  end;
end;

destructor TsCustomStyle.Destroy;
begin
  FreeAndNil(FCaption);
  inherited;
end;

procedure TsCustomStyle.onKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  StartIndex, NextIndex : integer;
  List : TList;
  CurControl : TWinControl;
  ToExit : boolean;
  bNext : boolean;
begin
  if not (ssAlt in Shift) and not (ssShift in Shift) and not (ssCtrl in Shift) then begin
  {$IFNDEF ALITE}
    if not (( (FOwner is TsCustomComboBox) and TsCustomComboBox(FOwner).DroppedDown
            )) and
       not ((FOwner is TsDateEdit) and TsDateEdit(FOwner).DroppedDown) then
  {$ENDIF}
    begin

      if IsWordPresent(IntToStr(Key), KeysNextControl, [',',' ']) then begin
        bNext := True;
      end
      else if IsWordPresent(IntToStr(Key), KeysPrevControl, [',',' ']) then begin
        bNext := False;
      end
      else begin
        Exit;
      end;

      List := TList.Create;
      GetParentForm(FOwner).GetTabOrderList(List);

      if List.Count > 0 then begin
        StartIndex := List.IndexOf(FOwner);
        NextIndex := StartIndex;
        ToExit := False;

        while not ToExit do begin
          if bNext then begin
            inc(NextIndex);
            if NextIndex > List.Count - 1 then NextIndex := 0;
          end
          else begin
            dec(NextIndex);
            if NextIndex < 0 then NextIndex := List.Count - 1;
          end;

          CurControl := List[NextIndex];
          if StartIndex = NextIndex then begin
            ToExit := True;
          end
          else if CurControl.CanFocus and CurControl.TabStop and CurControl.Enabled and CurControl.Visible then begin
            LastControl := (NextIndex = 0) and bNext;
          {$IFNDEF ALITE}
            if (FOwner is TsCustomComboBox) then FFocused := False;
          {$ENDIF}
            CurControl.SetFocus;
            FOwner.Invalidate;
            ToExit := True;
          end;
        end;
      end;

      List.Free;
      Key := 0;
    end;
  end;
end;

{ TCaption }

constructor TsStyleCaption.Create(AOwner: TPersistent);
begin
  inherited Create;
  FFont := TFont.Create;
  FLayout := sclLeft;
  FOwner := TsCustomStyle(AOwner);
end;

procedure TsStyleCaption.SetActive(const Value: boolean);
begin
  if Value then begin
    if not Active then begin
      FActive := True;
      FOwner.FTheLabel := TsLabel.Create(FOwner.FOwner);
      FOwner.FTheLabel.Parent := FOwner.FOwner.Parent;
      FOwner.FTheLabel.ControlStyle := [csOpaque, csReplicatable];
      TsLabel(FOwner.FTheLabel).Layout := tlTop;//tlCenter;
      TsLabel(FOwner.FTheLabel).FocusControl := TWinControl(FOwner.FOwner);

      TsLabel(FOwner.FTheLabel).Alignment := taRightJustify;
      FOwner.FTheLabel.Name := FOwner.FOwner.Name + 'Label';
{$IFDEF USEDB}
      if StyleIsActive(FOwner) then begin
        Case GetStyleInfo(FOwner.FOwner) of
          5: begin
            Text := iff(Text = '', TsStyle(FOwner).Data.Field.DisplayLabel, Text);

⌨️ 快捷键说明

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