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

📄 sdbcombobox.pas

📁 alpha db da sa pouzit na vsetky druhy coho len chcete
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit sDBComboBox;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBCtrls, sConst, acntUtils, sGraphUtils, sGlyphUtils, math, sCommonData,
  sDefaults;

type
  TsDBComboBox = class(TDBComboBox)
  private
    FAlignment : TAlignment;
    FButtonMargin: integer;
    FBoundLabel: TsBoundLabel;
    FCommonData: TsCommonData;
    FDisabledKind: TsDisabledKind;

    procedure SetAlignment(const Value: TAlignment);
    procedure SetButtonMargin(const Value: integer);
    procedure SetDisabledKind(const Value: TsDisabledKind);
  protected
    FActive : boolean;
    FCharsInCode : integer;
    FUseItemIndex : boolean;
    BorderStyle : TFormBorderStyle;
    FDefBmpName : string;

    procedure DropDown; override;

    procedure PaintBorder(ADC : HDC);
    procedure PrepareCache;
    procedure PaintText;
//    procedure OurPaintHandler(ADC : HDC);
    procedure DrawSkinItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);

    procedure WndProc (var Message: TMessage); override;
    procedure CreateWnd; override;
  public
    FChildHandle: HWND;
    FDefListProc: Pointer;
    FListHandle: HWND;
    FListInstance: Pointer;
    FDropDown : boolean;

    procedure AfterConstruction; override;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    property Color;
    procedure Invalidate; override;
    procedure InvalidateSelection;
    procedure PaintButton;
    function ButtonRect: TRect;
//    function ButtonWidth : integer;
    function ButtonHeight : integer;

    procedure WriteText;
    function Focused: Boolean; override;
    property Alignment : TAlignment read FAlignment write SetAlignment;
    property CharsInCode:integer read FCharsInCode write FCharsInCode;
    property UseItemIndex : boolean read FUseItemIndex write FUseItemIndex;
    property ButtonMargin : integer read FButtonMargin write SetButtonMargin default 2;
  published
    property BoundLabel : TsBoundLabel read FBoundLabel write FBoundLabel;
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
    property DropDownCount default 16;
    property SkinData : TsCommonData read FCommonData write FCommonData;
  end;

implementation

uses sMessages, sMaskData, sStyleSimply, sSkinProps, sVCLUtils, sAlphaGraph;

{ TsDBComboBox }

procedure TsDBComboBox.AfterConstruction;
begin
  inherited AfterConstruction;
  FCommonData.Loaded;
end;

function TsDBComboBox.ButtonHeight: integer;
var
  i : integer;
begin
  if FCommonData.Skinned then begin
    i := FCommonData.SkinManager.GetMaskIndex(FCommonData.SkinIndex, FCommonData.SkinSection, s_ItemGlyph);
    if FCommonData.SkinManager.ma[i].Bmp = nil
      then Result := HeightOf(FCommonData.SkinManager.ma[i].R) div (1 + FCommonData.SkinManager.ma[i].MaskType)
      else Result := FCommonData.SkinManager.ma[i].Bmp.Height div 2;
  end
  else begin
    Result := 16;
  end;
end;

function TsDBComboBox.ButtonRect: TRect;
var
  w : integer;
begin
  if (Style <> csSimple) then w := GetSystemMetrics(SM_CXVSCROLL) else w := 0;
  if UseRightToLeftAlignment then Result.Left := 3 else Result.Left := Width - w - 3;
  Result.Top := 3;
  Result.Right := Result.Left + w;
  Result.Bottom := Height - 3;
end;

constructor TsDBComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csFixedHeight, csFramed, csOpaque];
  TControlCanvas(Canvas).Control := self;
  FDropDown := False;

  ParentColor := False;

  FCommonData := TsCommonData.Create(Self, {$IFDEF DYNAMICCACHE} False {$ELSE} True {$ENDIF});
  FCommonData.COC := COC_TsEdit;
  if FCommonData.SkinSection = '' then FCommonData.SkinSection := s_ComboBox;
  FDisabledKind := DefDisabledKind;

  FBoundLabel := TsBoundLabel.Create(Self, FCommonData);
  FButtonMargin := 2;

  FDefListProc := nil;
  ItemHeight := 13;

  CharsInCode := 0;
  UseItemIndex := False;
  DropDownCount := 16;
  DoubleBuffered := True;
end;

procedure TsDBComboBox.CreateWnd;
begin
  inherited;
end;

destructor TsDBComboBox.Destroy;
begin
  FreeAndNil(FBoundLabel);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsDBComboBox.DrawSkinItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  Offset : integer;
begin
  if not Assigned(OnDrawItem) then begin
    FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
    FCommonData.FCacheBmp.Canvas.Font.Color := Font.Color;
    FCommonData.FCacheBmp.Canvas.Brush.Color := Color;
    FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
    if Text <> '' then begin
      Offset := integer(Style <> csDropDown);
      FCommonData.FCacheBmp.Canvas.TextRect(Rect, Rect.Left + Offset, Rect.Top + Offset, Text);
    end;
  end;
  if odFocused in State then FCommonData.FCacheBmp.Canvas.DrawFocusRect(Rect);
end;

procedure TsDBComboBox.DropDown;
begin
  FDropDown := True;
  inherited;
end;

function TsDBComboBox.Focused: Boolean;
var
  FocusedWnd: HWND;
begin
  Result := False;
  if HandleAllocated then begin
    FocusedWnd := GetFocus;
    Result := (FocusedWnd <> 0) and ((FocusedWnd = EditHandle) or (FocusedWnd = FListHandle));
  end;
end;

{ v4.23
function TsDBComboBox.GetClientRect: TRect;
begin
  Result := Rect(0, 0, Width, Height);
//  InflateRect(Result, -4, - 4);
end;
}

procedure TsDBComboBox.Invalidate;
begin
  if Focused then FCommonData.FFocused := True;
  inherited Invalidate;
end;

procedure TsDBComboBox.InvalidateSelection;
begin
//
end;

procedure TsDBComboBox.Loaded;
begin
  inherited Loaded;
  FCommonData.Loaded;
  if FCommonData.Skinned then begin
    if not FCommonData.CustomColor then Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].Color;
    if not FCommonData.CustomFont then Font.Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].FontColor[1];
  end;
end;
(*
procedure TsDBComboBox.OurPaintHandler(ADC : HDC);
const
  BordWidth = 2;
var
  DC, SavedDC : hdc;
  PS : TPaintStruct;
  R : TRect;
begin
  BeginPaint(Handle, PS);
  SavedDC := 0;
  if ADC = 0 then begin
    DC := GetWindowDC(Handle);
    SavedDC := SaveDC(DC);
  end else begin
    DC := ADC;
  end;
  try
    if not FCommonData.Updating then begin
      if FCommonData.BGChanged then begin
        PrepareCache;
      end;

      UpdateCorners(FCommonData, 0);

      if (Style = csDropDownList) and FCommonData.FFocused then begin
        BitBlt(DC, 0, 0, Width, BordWidth, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
        BitBlt(DC, 0, BordWidth, BordWidth, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, BordWidth, SRCCOPY);
        BitBlt(DC, BordWidth, Height - BordWidth, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, BordWidth, Height - BordWidth, SRCCOPY);
        BitBlt(DC, Width - BordWidth, BordWidth, Width, Height - BordWidth, FCommonData.FCacheBmp.Canvas.Handle, Width - BordWidth, BordWidth, SRCCOPY);
        R := ButtonRect;
        BitBlt(DC, R.Left, R.Top, WidthOf(R), HeightOf(R), FCommonData.FCacheBmp.Canvas.Handle, R.Left, R.TOp, SRCCOPY);
      end
      else begin
        BitBlt(DC, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY)
      end;
{$IFDEF DYNAMICCACHE}
      if Assigned(FCommonData.FCacheBmp) then FreeAndNil(FCommonData.FCacheBmp);
{$ENDIF}
    end else FCommonData.Updating := True;
  finally
    if SavedDC > 0 then begin
      RestoreDC(DC, SavedDC);
      ReleaseDC(Handle, DC);
    end;
    EndPaint(Handle, PS);
  end;
end;
*)
procedure TsDBComboBox.PaintBorder(ADC : HDC);

⌨️ 快捷键说明

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