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

📄 xibutton.pas

📁 Xi control is a component for delphi. its have alot of feature like customizable button, gradient s
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    Left:=TextLeft;
    Right:= Left + TextWidth;
    Bottom:= Top + TextHeight;
  end;

  if Caption <> '' then begin
    BtnBmp.Canvas.Brush.Style:= bsClear;
    DrawText(BtnBmp.Canvas.Handle,
             PChar(Caption),
             length(Caption),
             CaptionRect,
             DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);
  end;

  with BtnBmp.Canvas do begin
    Pen.Style:= psSolid;
    Brush.Color:= FaceColor;
    Pen.Color:= BorderColor;
    Brush.Style:= bsClear;
    Rectangle(0, 0, Width, Height);

    if Ctl3D then begin
      Pen.Color:= LightColor;
      MoveTo(1, Height-2);
      LineTo(1, 1);
      LineTo(Width -1 , 1);

      Pen.Color:= DarkColor;
      MoveTo(Width-2, 1);
      LineTo(Width-2, Height-2);
      LineTo(1, Height-2);
    end;
  end;

  if FFocused then begin
    BtnBmp.Canvas.Pen.Color:= FColorFocusRect;
    BtnBmp.Canvas.Brush.Style:= bsClear;
    BtnBmp.Canvas.Rectangle(3, 3, Width-3, Height-3)
  end;

  Canvas.Draw(0, 0, BtnBmp);
  BtnBmp.Free;
end;

procedure TXiButton.Click;
begin
  if Parent <> nil then
    GetParentForm(self).ModalResult:= ModalResult;
  FBtnState:= bsNormal;
  Paint;
  inherited;
end;

procedure TXiButton.MouseEnter(var msg: TMessage);
begin
  if csDesigning in ComponentState then exit;
  if not FHotTrack then exit;
  if FClicked then
    FBtnState:= bsDown
  else
    FBtnState:= bsOver;
  Paint;
end;

procedure TXiButton.MouseLeave(var msg: TMessage);
begin
  inherited;
  FBtnState:= bsNormal;
  Paint;
end;

procedure TXiButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Button <> mbLeft then Exit;
  FClicked:= True;
  FBtnState:= bsDown;
  if TabStop then SetFocus;
  Paint;
end;

procedure TXiButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  FClicked:= False;
  if (x>0) and (y>0) and (x<width) and (y<height) then
    if FHotTrack then FBtnState:= bsOver
  else
    FBtnState:= bsNormal;
  Paint;
end;

procedure TXiButton.MouseMove (Shift: TShiftState; X, Y: Integer);
begin
  inherited;
end;

procedure TXiButton.WMSetFocus(var msg: TWMSetFocus);
begin
  FFocused:= true;
  Paint;
end;

procedure TXiButton.WMKillFocus(var msg: TWMKillFocus);
begin
  FFocused:= false;
  FBtnState:= bsNormal;
  Paint;
end;

procedure TXiButton.WMKeyDown(var msg: TWMKeyDown);
begin
  if msg.CharCode = VK_SPACE then FBtnState:= bsDown;
  if msg.CharCode = VK_RETURN then Click;
  Paint;
end;

procedure TXiButton.WMKeyUp(var msg: TWMKeyUp);
begin
  if (msg.CharCode = VK_SPACE) then begin
    FBtnState:= bsNormal;
    Paint;
    Click;
  end;
end;

procedure TXiButton.CMTextChanged (var msg: TMessage);
begin
  Invalidate;
end;

procedure TXiButton.SetCtl3D(Value: Boolean);
begin
  FCtl3D:= Value;
  Invalidate;
end;

procedure TXiButton.SetLayout(Value: TButtonLayout);
begin
  FLayout:= Value;
  Invalidate;
end;

procedure TXiButton.SetGlyph(Value: TBitmap);
begin
  FGlyph.Assign(Value);
  Invalidate;
end;

procedure TXiButton.SetSpacing(Value: integer);
begin
  FSpacing:= Value;
  Invalidate;
end;

procedure TXiButton.SetTransparentGlyph(Value: Boolean);
begin
  FTransparentGlyph:= Value;
  Invalidate;
end;

procedure TXiButton.SetGradient(Value: Boolean);
begin
  FGradient:= Value;
  Invalidate;
end;

procedure TXiButton.CMFontChanged(var msg: TMessage);
begin
  Invalidate;
end;

procedure TXiButton.CMDialogKey(var msg: TCMDialogKey);
begin
  with msg do begin
    if  (((CharCode = VK_RETURN) and FFocused) or
         ((CharCode = VK_ESCAPE) and FCancel)) and
         (KeyDataToShiftState(KeyData) = []) and CanFocus then
    begin
      Click;
      Result := 1;
    end else if (FDefault and (CharCode = VK_RETURN) and CanFocus) then begin
      Click;
      Result := 1;
    end
    else inherited;
  end;
end;

procedure TXiButton.CMEnabledChanged(var msg: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TXiButton.CMDialogChar(var msg: TCMDialogChar);
begin
  with msg do
    if IsAccel(CharCode, Caption) and Enabled then begin
      Click;
      Result := 1;
    end;
end;

procedure TXiButton.SetModalResult(Value: TModalResult);
begin
  FModalResult:= Value;
end;

procedure TXiButton.SetCancel(Value: Boolean);
begin
  FCancel:= Value;
end;

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

procedure TXiButton.SetHotTrack(Value: Boolean);
begin
  FHotTrack:= Value;
  Invalidate;
end;

procedure TXiButton.SetColors(Index: Integer; Value: TColor);
begin
  case Index of
    0: FColorFace:= Value;
    1: FColorGrad:= Value;
    2: FColorDark:= Value;
    3: FColorLight:= Value;
    4: FColorBorder:= Value;
    5: FColorText:= Value;
    6: FOverColorFace:= Value;
    7: FOverColorGrad:= Value;
    8: FOverColorDark:= Value;
    9: FOverColorLight:= Value;
    10: FOverColorBorder:= Value;
    11: FOverColorText:= Value;
    12: FDownColorFace:= Value;
    13: FDownColorGrad:= Value;
    14: FDownColorDark:= Value;
    15: FDownColorLight:= Value;
    16: FDownColorBorder:= Value;
    17: FDownColorText:= Value;
    18: FDisabledColorFace:= Value;
    19: FDisabledColorGrad:= Value;
    20: FDisabledColorDark:= Value;
    21: FDisabledColorLight:= Value;
    22: FDisabledColorBorder:= Value;
    23: FDisabledColorText:= Value;
    24: FColorFocusRect:= Value;
  end;
  ColorScheme:= csCustom;
  Invalidate;
end;

procedure TXiButton.SetColorScheme(Value: TColorScheme);
begin
  FColorScheme:= Value;
  case FColorScheme of
  csDesert:      begin
                   ColorFace:=$0095DDFF;
                   ColorLight:=$00B9E7FF;
                   ColorDark:=$00009CE8;
                   ColorBorder:=$00005680;
                   ColorText:=clBlack;
                   OverColorFace:=$006FD0FF;
                   OverColorLight:=$0095DAFF;
                   OverColorDark:=$00008ED2;
                   OverColorBorder:=$00005680;
                   OverColorText:=clBlack;
                   DownColorFace:=$006FD0FF;
                   DownColorLight:=$000077B7;
                   DownColorDark:=$008AD9FF;
                   DownColorBorder:=$000070A6;
                   DownColorText:=clBlack;
                   DisabledColorFace:=$00E2E2E2;
                   DisabledColorLight:=$00EAEAEA;
                   DisabledColorDark:=$00D8D8D8;
                   DisabledColorBorder:=$00C4C4C4;
                   DisabledColorText:=clGray;
                   ColorFocusRect:= $004080FF;
                   Gradient:= False;
                 end;
  csGrass:       begin
                   ColorFace:=$0098EBB7;
                   ColorLight:=$00CBF5DB;
                   ColorDark:=$0024B95C;
                   ColorBorder:=$00156F37;
                   ColorText:=clBlack;
                   OverColorFace:=$0068E196;
                   OverColorLight:=$00B5F0CB;
                   OverColorDark:=$0023B459;
                   OverColorBorder:=$0017793D;
                   OverColorText:=clBlack;
                   DownColorFace:=$004EDC83;
                   DownColorLight:=$00177D3E;
                   DownColorDark:=$0089E7AC;
                   DownColorBorder:=$00167439;
                   DownColorText:=clBlack;
                   DisabledColorFace:=$00E2E2E2;
                   DisabledColorLight:=$00EAEAEA;
                   DisabledColorDark:=$00D8D8D8;
                   DisabledColorBorder:=$00C4C4C4;
                   DisabledColorText:=clGray;
                   ColorFocusRect:= $0000A421;
                   Gradient:= False;
                 end;
   csSky:        begin
                   ColorFace:=$00FFE0C1;
                   ColorLight:=$00FFECD9;
                   ColorDark:=$00FFA953;
                   ColorBorder:=$00B35900;
                   ColorText:=clBlack;
                   OverColorFace:=$00FFCD9B;
                   OverColorLight:=$00FFE4CA;
                   OverColorDark:=$00FFB164;
                   OverColorBorder:=$00B35900;
                   OverColorText:=clBlack;
                   DownColorFace:=$00FFC082;

⌨️ 快捷键说明

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