📄 sdbcombobox.pas
字号:
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 + -