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

📄 scustomcomboedit.pas

📁 AlphaControls是一个Delphi标准控件的集合
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit sCustomComboEdit;

{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Mask, sUtils, buttons, menus, sCalcUnit, sConst,
  sGraphUtils, {sCustomButton, }sButtonControl, sStyleEdits,
  sGlyphUtils{$IFDEF DELPHI6}, Variants{$ENDIF};

type
  TCloseUpEvent = procedure (Sender: TObject; Accept: Boolean) of object;

  TsCustomComboEdit = class;

  TsEditButton = class(TsButtonControl)
  private
    FOwner : TsCustomComboEdit;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    procedure DrawContents; override;
    procedure DrawGlyph; override;
  published
  end;

  TsCustomComboEdit = class(TCustomMaskEdit)
  private
    FButton: TsEditButton;
    FClickKey: TShortCut;
    FReadOnly: Boolean;
    FDirectInput: Boolean;
    FAlignment: TAlignment;
    FFocused: Boolean;
    FPopupWindowAlign: TPopupWindowAlign;
    FGlyphMode: TsGlyphMode;
    FPopupWidth: integer;
    procedure SetEditRect;
    procedure EditButtonClick(Sender: TObject);
    procedure EditButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure EditButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    function GetMinHeight: Integer;
    function GetTextHeight: Integer;
    procedure SetShowCaret;
    function GetDroppedDown: Boolean;
    function GetDirectInput: Boolean;
    procedure SetDirectInput(Value: Boolean);
    procedure SetReadOnly(Value: Boolean);
    procedure SetAlignment(Value: TAlignment);
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure CMEnter(var Message: TMessage); message CM_ENTER;
    procedure CNCtlColor(var Message: TMessage); message CN_CTLCOLOREDIT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
    procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
    procedure WMCut(var Message: TWMCut); message WM_CUT;
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure SetPopupWidth(const Value: integer);
  protected
    FOnButtonClick: TNotifyEvent;
    FsStyle : TsStyle;
    FPopupWindow: TWinControl;
    procedure WndProc (var Message: TMessage); override;
    procedure CreateWnd; override;
    procedure KeyPress(var Key: Char); override;

    procedure PopupWindowShow; virtual;
    procedure PopupWindowClose; virtual;
    procedure CreateParams(var Params: TCreateParams); override;

    procedure Change; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure ButtonClick; dynamic;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property PopupAlign: TPopupWindowAlign read FPopupWindowAlign write FPopupWindowAlign default pwaRight;
  public
    DontPopup : boolean;
    MousePressed : boolean;
    FDefBmpName : string;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;

    procedure DoClick;
    procedure SelectAll;
    procedure UpdateBtnBounds;
    property Button: TsEditButton read FButton;
    property DroppedDown: Boolean read GetDroppedDown;
    property CharCase;
    property ClickKey: TShortCut read FClickKey write FClickKey default scAlt + vk_Down;
    property PopupWidth : integer read FPopupWidth write SetPopupWidth default 197;
  published
    property GlyphMode : TsGlyphMode read FGlyphMode write FGlyphMode;
    property DirectInput: Boolean read GetDirectInput write SetDirectInput default True;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
    property sStyle:TsStyle read FsStyle write FsStyle;
    property AutoSelect;
    property DragCursor;
    property DragMode;
    property EditMask;
    property Enabled;
    property Font;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnContextPopup;
    property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
  end;

function EditorTextMargins(Editor: TsCustomComboEdit): TPoint;

implementation

uses sStyleSimply, sCurrencyEdit;

constructor TsEditButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sStyle.Painting.Transparency := 100;
  sStyle.HotStyle.HotPainting.Transparency := 100;
  sStyle.BtnEffects.Fading.Enabled := False;
  sStyle.SkinSection := 'TsEditButton';
end;

procedure TsEditButton.DrawContents;
var
  b : TBitmap;
  r : TRect;
  c, cc : TsColor;
  tc : TColor;
  function CurrentMaskRect : TRect; begin
    if Down then begin
      Result := Rect(2 * FOwner.GlyphMode.Width, 0, 3 * FOwner.GlyphMode.Width - 1, FOwner.GlyphMode.Height - 1);
    end
    else if sStyle.ControlIsActive or FOwner.sStyle.ControlIsActive then begin
      Result := Rect(FOwner.GlyphMode.Width, 0, 2 * FOwner.GlyphMode.Width - 1, FOwner.GlyphMode.Height - 1);
    end
    else begin
      Result := Rect(0, 0, FOwner.GlyphMode.Width - 1, FOwner.GlyphMode.Height - 1);
    end;
  end;
begin
  if Assigned(FOwner) and FOwner.GlyphMode.AssignDefaultBitmap then begin
    DefBMP.PixelFormat := pf24Bit;
    b := TBitmap.Create;
    try
      b.PixelFormat := pf24Bit;
      b.Width := FOwner.GlyphMode.Width;
      b.Height := FOwner.GlyphMode.Height;

      c.C := TsCustomComboEdit(FOwner).sStyle.GetActiveColor;


      tc := FOwner.GlyphMode.Glyph.Canvas.Pixels[0, FOwner.GlyphMode.Height - 1];

      CopyByMask(
               Rect(0, 0, FOwner.GlyphMode.Width - 1, FOwner.GlyphMode.Height - 1),
               CurrentMaskRect,
               b,
               DefBMP, EmptyCI);

      sStyle.FCacheBmp.Canvas.Brush.Style := bsSolid;
      sStyle.FCacheBmp.Canvas.Brush.Color := c.C;
      sStyle.FCacheBmp.Canvas.FillRect(Rect(0, 0, Width, FOwner.Height)); // Borders hiding

      if FOwner.Enabled then begin
        if (GetsStyle(FOwner) <> nil) then begin
          if not TsCustomComboEdit(FOwner).sStyle.ControlIsActive then begin
            if TsCustomComboEdit(FOwner).GlyphMode.Grayed then begin
              tc := b.Canvas.Pixels[0, b.Height - 1];
              cc.C := tc;
              GrayScaleTrans(b, cc);
            end;
            if TsCustomComboEdit(FOwner).GlyphMode.Blend > 0 then begin
              cc.C := tc;
              BlendTransBitmap(b, TsCustomComboEdit(FOwner).GlyphMode.Blend / 100, c, cc);
            end;
          end;
        end;

      end
      else begin
        cc.C := tc;
//        GrayScale(b);
        BlendTransBitmap(b, 0.50, c, cc);
      end;

      // Copy to button canvas
      R.Left := (WidthOf(ClientRect) - FOwner.GlyphMode.Width) div 2;// + GetDown;
      R.Right := R.Left + FOwner.GlyphMode.Width;
      R.Top := (HeightOf(ClientRect) - b.Height) div 2;// + GetDown;
      R.Bottom := R.Top + b.Height;
      sStyle.FCacheBmp.Canvas.Draw(R.Left, R.Top, b);

    finally
      FreeAndNil(b);
    end;

  end;
  FOwner.SetEditRect;
end;

{ TsCustomComboEdit }

constructor TsCustomComboEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  BorderStyle := bsNone;
  sStyle := TsStyle.Create(Self);
  sStyle.COC := COC_TsCustomComboEdit;

  FDefBmpName := '';
  FGlyphMode := TsGlyphMode.Create(Self);

  AutoSize := False;
  FDirectInput := True;
  FClickKey := scAlt + vk_Down;
  FPopupWindowAlign := pwaRight;

  FButton := TsEditButton.Create(Self);
  FButton.FOwner := Self;
  FButton.Parent := Self;
  FButton.Align := alRight;
  FButton.Width := 22;
  FButton.ControlStyle := FButton.ControlStyle + [csReplicatable{, csNoStdEvents, csClickEvents}] - [csCaptureMouse];
  FButton.Visible := True;
  FButton.FsStyle.Painting.Bevel := cbNone;
  FButton.OnClick := EditButtonClick;
  FButton.OnMouseDown := EditButtonMouseDown;
  FButton.OnMouseUp := EditButtonMouseUp;

  DoubleBuffered := True;
  Height := 21;
  FPopupWidth := 197;
end;

destructor TsCustomComboEdit.Destroy;
begin
  OnKeyDown := nil;
  if Assigned(FsStyle) then FreeAndNil(FsStyle);
  if Assigned(FGlyphMode) then FreeAndNil(FGlyphMode);
  FButton.OnClick := nil;
  inherited Destroy;
end;

procedure TsCustomComboEdit.CreateWnd;
begin
  inherited CreateWnd;
  SetEditRect;
end;

procedure TsCustomComboEdit.PopupWindowShow;
var
  P: TPoint;
  Y: Integer;
begin
  if (FPopupWindow <> nil) and not (ReadOnly or DroppedDown) then begin
    DontPopup := True;
    FPopupWindow.Width := FPopupWidth;
    P := Parent.ClientToScreen(Point(Left, Top));
    Y := P.Y + Height;

    if Y + FPopupWindow.Height > Screen.Height then Y := P.Y - FPopupWindow.Height;
    case FPopupWindowAlign of
      pwaRight: begin
        Dec(P.X, FPopupWindow.Width - Width);
        if P.X < 0 then Inc(P.X, FPopupWindow.Width - Width);
      end;
      pwaLeft: begin
        if P.X + FPopupWindow.Width > Screen.Width then
          Dec(P.X, FPopupWindow.Width - Width);
      end;
    end;
    if P.X < 0 then begin
      P.X := 0
    end
    else if P.X + FPopupWindow.Width > Screen.Width then begin
      P.X := Screen.Width - FPopupWindow.Width;
    end;

    SetWindowPos(FPopupWindow.Handle, HWND_TOP, P.X, Y, 0, 0, SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
    TCustomForm(FPopupWindow).Show;
    TCustomForm(FPopupWindow).BringToFront;
  end;
end;

procedure TsCustomComboEdit.Change;
begin
  if not DroppedDown then inherited Change;
end;

procedure TsCustomComboEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  sStyle.onKeyDown(Self, Key, Shift);
  inherited KeyDown(Key, Shift);
  if (FClickKey = ShortCut(Key, Shift)) and (GlyphMode.Width > 0) then begin
    EditButtonClick(Self);
    Key := 0;
  end;
end;

procedure TsCustomComboEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DontPopup := False;
  if not RestrictDrawing then sStyle.BGChanged := True;
  inherited MouseDown(Button, Shift, X, Y);
  if DroppedDown then begin
    PopupWindowClose;
  end;
end;

procedure TsCustomComboEdit.SetEditRect;
var
  R: TRect;
begin
  if Self is TsCurrencyEdit then begin
    R := Rect(0, 0, ClientWidth - 2, ClientHeight + 1);
  end
  else begin
    R := Rect(0, 0, ClientWidth - FButton.Width, ClientHeight + 1);
  end;
  SendMessage(Handle, EM_SETRECT, 0, LongInt(@R));
end;

procedure TsCustomComboEdit.UpdateBtnBounds;

⌨️ 快捷键说明

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