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

📄 scustombutton.pas

📁 AlphaControls是一个Delphi标准控件的集合
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  X, Y: Integer);
var
  cd : TColorDialog;
begin
  if PtInRect(ClientRect, Point(x, y)) then begin
    cd := TColorDialog.Create(Self);
    cd.Color := ColorValue;
    if cd.Execute then begin
      ColorValue := cd.Color;
      if Assigned(FOnChange) then FOnChange(Self);
    end;
    cd.Free;
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TsColorSelect.SetColorValue(const Value: TColor);
begin
  FColorValue := Value;
  sStyle.Invalidate;
end;

procedure TsColorSelect.SetImgHeight(const Value: integer);
begin
  if FImgHeight <> Value then begin
    FImgHeight := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsColorSelect.SetImgWidth(const Value: integer);
begin
  if FImgWidth <> Value then begin
    FImgWidth := Value;
    sStyle.Invalidate;
  end;
end;

{ TsBitBtn }

constructor TsBitBtn.Create(AOwner: TComponent);
begin
  inherited;
  FGlyph := TBitmap.Create;
  sStyle.COC := COC_TsBitButton;
end;

destructor TsBitBtn.Destroy;
begin
  if Assigned(FGlyph) then FreeAndNil(FGlyph);
  inherited Destroy;
end;

procedure TsBitBtn.DrawGlyph;
{var
//  IRect : TRect;
//  Bmp : TBitmap;
  MaskColor: TsColor;
  w : integer;}
begin
  if (FGlyph.Width > 0) then begin
    sGraphUtils.DrawGlyphEx(FGlyph, sStyle.FCacheBmp, ImgRect, NumGlyphs, Enabled, Grayed, DisabledGlyphKind, integer(sStyle.controlIsActive), Blend);
{
    IRect := ImgRect;
    FGlyph.PixelFormat := pf24bit;
    if (GlyphWidth > 0) then begin
      case NumGlyphs of
        1 : begin
          Bmp := TBitmap.Create;
          try
            Bmp.Assign(FGlyph);
            Bmp.PixelFormat := pf24bit;
            if not Enabled then begin
              if dgGrayed in DisabledGlyphKind then begin
                GrayScale(Bmp);
              end;
              if dgBlended in DisabledGlyphKind then begin
                MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
                BlendTransRectangle(sStyle.FCacheBmp, IRect.Left, IRect.Top, Bmp,
                                      Rect(0, 0, Bmp.Width, Bmp.Height), 0.5, MaskColor);
              end
              else begin
                MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
                CopyTransBitmaps(sStyle.FCacheBmp, Bmp, IRect.Left, IRect.Top, MaskColor);
              end;
            end
            else begin
              MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
              if not sStyle.ControlIsActive and Grayed then begin
                GrayScale(Bmp);
              end;
              MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);

              if not sStyle.ControlIsActive and (Blend > 0) then begin
                BlendTransRectangle(sStyle.FCacheBmp, IRect.Left, IRect.Top, Bmp,
                                    Rect(0, 0, Bmp.Width, Bmp.Height), Blend / 100, MaskColor);
              end
              else begin
                CopyTransBitmaps(sStyle.FCacheBmp, Bmp, IRect.Left, IRect.Top, MaskColor);
              end;
            end;
          finally
            FreeAndNil(Bmp);
          end;
        end;
        2 : begin
          w := FGlyph.Width div NumGlyphs;
          if not Enabled then begin
            CopyTransRect(sStyle.FCacheBmp, FGlyph, IRect.Left, IRect.Top, Rect(w, 0, 2 * w - 1, FGlyph.Height - 1), FGlyph.Canvas.Pixels[0, FGlyph.Height - 1]);
          end
          else begin
            CopyTransRect(sStyle.FCacheBmp, FGlyph, IRect.Left, IRect.Top, Rect(0, 0, w - 1, FGlyph.Height - 1), FGlyph.Canvas.Pixels[0, FGlyph.Height - 1]);
          end;
        end
      end;
    end;
}
  end
  else inherited;
end;

function TsBitBtn.GlyphHeight: integer;
begin
  if FGlyph.Height > 0 then begin
    Result := FGlyph.Height;
  end
  else begin
    Result := inherited GlyphHeight;
  end
end;

function TsBitBtn.GlyphWidth: integer;
begin
  if FGlyph.Width > 0 then begin
    Result := FGlyph.Width div NumGlyphs;
  end
  else begin
    Result := inherited GlyphWidth;
  end
end;

procedure TsBitBtn.SetGlyph(const Value: TBitmap);
begin
  FGlyph.Assign(Value);
  sStyle.Invalidate;
end;

{$ENDIF}

{ TsButton }

procedure TsButton.Click;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then Form.ModalResult := ModalResult;
  inherited Click;
end;

procedure TsButton.CMDialogChar(var Message: TCMDialogChar);
begin
  if (sStyle.FFocused and (Message.CharCode = VK_SPACE)) or (IsAccel(Message.CharCode, Caption) and CanFocus) then begin
    if not RestrictDrawing then sStyle.BGChanged := True;
    Down := True;
    Repaint;
    Message.Result := 1;
    Message.CharCode := 0;
  end
  else begin
    inherited;
  end;
end;

procedure TsButton.CMDialogKey(var Message: TCMDialogKey);
begin
  if ((((Message.CharCode = VK_RETURN) and FActive) or
       ((Message.CharCode = VK_ESCAPE) and FCancel)) and
       (KeyDataToShiftState(Message.KeyData) = []) and CanFocus) then begin
    Down := True;
    Application.ProcessMessages;
    Click;
    Down := False;
    Message.Result := 1;
    Application.ProcessMessages;
  end else begin
    inherited;
  end;
end;


procedure TsButton.CMFocusChanged(var Message: TCMFocusChanged);
begin
  with Message do begin
    if Sender is TsButton then begin
      if FActive <> (Sender = Self) then begin
        FActive := Sender = Self;
        sStyle.Invalidate;
      end;
    end
    else begin
      FActive := FDefault;
    end;
  end;
  if not RestrictDrawing then sStyle.BGChanged := True;
  inherited;
end;

procedure TsButton.CNCommand(var Message: TWMCommand);
begin
  if Message.NotifyCode = BN_CLICKED then begin
    if not RestrictDrawing then sStyle.BGChanged := True;
    Click;
  end;
end;

constructor TsButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sStyle.COC := COC_TsButton;
  TabStop := True;
  Height := 25;
  Width := 75;
  FShowFocus := True;
  FFocusMargin := 1;
  if (csDesigning in ComponentState) and (sStyle.Background.Gradient.Data = '') then begin
    sStyle.Background.Gradient.Data := GradientTsButton;
    sStyle.HotStyle.HotBackground.Gradient.Data := GradientTsButtonHot;
  end;
end;

procedure TsButton.CreateWnd;
begin
  inherited CreateWnd;
  FActive := FDefault;
end;

destructor TsButton.Destroy;
begin
  try
    inherited Destroy;
  except
  end;
end;

function TsButton.ActualShowFocus: boolean;
begin
  if sStyle.SkinIndex > -1 then begin
    Result := gd[sStyle.SkinIndex].ShowFocus;
  end
  else begin
    Result := FShowFocus;
  end;
end;

procedure TsButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not RestrictDrawing then sStyle.BGChanged := True;
  inherited;
  SetFocus;
end;

procedure TsButton.SetCanvasProps;
begin
end;

procedure TsButton.SetDefault(const Value: Boolean);
var
  Form: TCustomForm;
begin
  if FDefault <> Value then begin
    FDefault := Value;
    if HandleAllocated then begin
      Form := GetParentForm(Self);
      if Form <> nil then
        Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
    end;
    sStyle.Invalidate;
  end;
end;

procedure TsButton.SetFocusMargin(const Value: integer);
begin
  if FFocusMargin <> Value then begin
    FFocusMargin := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsButton.SetShowFocus(const Value: boolean);
begin
  if FShowFocus <> Value then begin
    FShowFocus := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsButton.WMKeyUp(var Message: TMessage);
begin
  if Down then begin
    Down := False;
    sStyle.Invalidate;
    Application.ProcessMessages;
    Click;
  end;
end;

{ TsTimerSpeedButton }

constructor TsTimerSpeedButton.Create(AOwner: TComponent);
begin
  inherited;
  sStyle.Painting.Transparency := 100;
  Width := Height - 4;
  sStyle.Painting.Bevel := cbNone;
  sStyle.HotStyle.HotPainting.BevelWidth := 3;
  sStyle.Background.Gradient.Data := GradientTsTimerSpeedButton;
  sStyle.HotStyle.HotBackground.Gradient.Data := GradientTsTimerSpeedButtonHot;
end;

end.

⌨️ 快捷键说明

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