?? sdbcombobox.pas
字號:
unit sDBComboBox;
{$I sDefs.inc}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DBCtrls, sConst, sUtils, sGraphUtils,
sGlyphUtils, math, sStyleEdits;
type
TsDBComboBox = class(TDBComboBox)
private
FAlignment : TAlignment;
FGlyphMode: TsGlyphMode;
FButtonMargin: integer;
function ButtonRect: TRect;
procedure CNCommand (var Message: TWMCommand); message CN_COMMAND;
procedure WMPaint (var Message: TWMPaint); message WM_PAINT;
procedure WMNCPaint (var Message: TWMPaint); message WM_NCPAINT;
procedure SetAlignment(const Value: TAlignment);
procedure SetButtonMargin(const Value: integer);
protected
FActive : boolean;
FCharsInCode : integer;
FsStyle : TsStyle;
FUseItemIndex : boolean;
BorderStyle : TFormBorderStyle;
FDefBmpName : string;
procedure DropDown; override;
function GetClientRect: TRect; override;
procedure WndProc (var Message: TMessage); override;
procedure CreateWnd; override;
public
FChildHandle: HWND;
FDefListProc: Pointer;
FListHandle: HWND;
FListInstance: Pointer;
FDropDown : boolean;
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
property Color;
procedure Invalidate; override;
procedure InvalidateSelection;
procedure PaintButton;
function ButtonWidth : integer;
function ButtonHeight : integer;
procedure RedrawBorders;
procedure WriteText;
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 3;
published
property sStyle:TsStyle read FsStyle write FsStyle;
property GlyphMode : TsGlyphMode read FGlyphMode write FGlyphMode;
end;
//var
// COMBO, bTemp : TBitmap;
implementation
uses sCustomComboBox;
{ TsDBComboBox }
function TsDBComboBox.ButtonHeight: integer;
begin
Result := bTemp.Height div 2;
end;
function TsDBComboBox.ButtonRect: TRect;
begin
if GlyphMode.UseDefaultGlyph or (GlyphMode.Glyph.Width < 1) then begin
bTemp := COMBO;
end
else begin
bTemp := GlyphMode.Glyph;
end;
Result := Rect(Width - ButtonWidth - ButtonMargin,
(Height - ButtonHeight) div 2,
Width - ButtonMargin,
Height - (Height - ButtonHeight) div 2);
end;
function TsDBComboBox.ButtonWidth: integer;
begin
Result := bTemp.Width div 3;
end;
procedure TsDBComboBox.CNCommand(var Message: TWMCommand);
begin
Case Message.NotifyCode of
CBN_CLOSEUP: begin
DroppedDown := False;
end;
end;
inherited;
end;
constructor TsDBComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csFixedHeight, csFramed] + [csOpaque];
TControlCanvas(Canvas).Control := self;
FDropDown := False;
ParentColor := False;
FsStyle := TsStyle.Create(Self);
FsStyle.COC := COC_TsDBComboBox;
FButtonMargin := 3;
FDefBmpName := 'SCO1';
FGlyphMode := TsGlyphMode.Create(Self);
OnKeyDown := sStyle.OnKeyDown;
FDefListProc := nil;
ItemHeight := 13;
CharsInCode := 0;
UseItemIndex := False;
DropDownCount := 16;
DoubleBuffered := True;
end;
procedure TsDBComboBox.CreateWnd;
begin
inherited;
end;
destructor TsDBComboBox.Destroy;
begin
FreeAndNil(FsStyle);
FreeAndNil(FGlyphMode);
inherited Destroy;
end;
procedure TsDBComboBox.DropDown;
begin
FDropDown := True;
inherited;
end;
function TsDBComboBox.GetClientRect: TRect;
begin
Result := Rect(0, 0, Width, Height);
InflateRect(Result, -4, - 4);
end;
procedure TsDBComboBox.Invalidate;
begin
if (csDesigning in ComponentState) and Assigned(FsStyle) then begin
FsStyle.BGChanged := True;
end;
Color := sStyle.GetActiveColor;
inherited Invalidate;
end;
procedure TsDBComboBox.InvalidateSelection;
begin
//
end;
procedure TsDBComboBox.PaintButton;
var
b : TBitmap;
R : TRect;
c : TsColor;
tc : TColor;
function CurrentMaskRect : TRect; begin
if DroppedDown then begin
Result := Rect(2 * ButtonWidth, 0, 3 * ButtonWidth - 1, ButtonHeight - 1);
end
else if sStyle.ControlIsActive then begin
Result := Rect(ButtonWidth, 0, 2 * ButtonWidth - 1, ButtonHeight - 1);
end
else begin
Result := Rect(0, 0, ButtonWidth - 1, ButtonHeight - 1);
end;
end;
begin
c.C := sStyle.GetActiveColor;
c.C := sStyle.GetActiveColor;
// Painting on the bitmap B
b := TBitmap.Create;
try
R := ButtonRect;
b.PixelFormat := pf24Bit;
b.Width := ButtonWidth;
b.Height := ButtonHeight;
b.Canvas.Brush.Color := c.c;
b.Canvas.FillRect(Rect(0, 0, b.Width, b.Height));
tc := bTemp.Canvas.Pixels[0, bTemp.Height - 1];
CopyByMask(
Rect(0, 0, bTemp.Width - 1, bTemp.Height - 1),
CurrentMaskRect,
b,
bTemp, EmptyCI);
tc := b.Canvas.Pixels[0, b.Height - 1];
if Enabled then begin
if not sStyle.ControlIsActive then begin
if GlyphMode.Grayed then begin
GrayScaleTrans(b, TsColor(tc));
end;
if GlyphMode.Blend > 0 then begin
BlendTransBitmap(b, GlyphMode.Blend / 100, c, TsColor(tc));
end;
end;
end
else begin
BlendTransBitmap(b, 0.75, c, TsColor(tc));
{
DisBmpColor(b, tc);
b.Transparent := True;
b.TransparentColor := clFuchsia;
}
end;
R := ButtonRect;
tc := b.Canvas.Pixels[0, b.Height - 1];
Canvas.Draw(R.Left, R.Top, b);
finally
FreeAndNil(b);
end;
end;
procedure TsDBComboBox.RedrawBorders;
var
R{, rT}: TRect;
c : TColor;
begin
c := sStyle.GetActiveColor;
if (Focused or sStyle.FFocused) then begin
R := GetClientRect;
// R := Rect(0, 0, Width, Height);
InflateRect(R, 1, 1);
dec(R.Top);
dec(R.Left);
if Style = csDropDownList then begin
Canvas.Brush.Color := C;//clHighLight;
Canvas.FillRect(R);
Canvas.TextRect(R, R.Left + 1, R.Top + 1, Text);
inc(R.Top);
inc(R.Left);
end
else begin
Canvas.Brush.Color := C;
Canvas.FillRect(R);
Canvas.TextRect(R, R.Left + 1, R.Top + 1, Text);
end;
end
else begin
WriteText;
end;
sStyle.RedrawBorder;
if (Style <> csSimple) then PaintButton;
end;
procedure TsDBComboBox.SetAlignment(const Value: TAlignment);
begin
if FAlignment <> Value then begin
FAlignment := Value;
sStyle.Invalidate;
end;
end;
procedure TsDBComboBox.SetButtonMargin(const Value: integer);
begin
if FButtonMargin <> Value then begin
FButtonMargin := Value;
end;
end;
procedure TsDBComboBox.WMNCPaint(var Message: TWMPaint);
begin
Message.Result := 1;
end;
procedure TsDBComboBox.WMPaint(var Message: TWMPaint);
var
R, bR: TRect;
DC: HDC;
PS: TPaintStruct;
WinBrush: HBRUSH;
begin
if (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit;
Color := sStyle.GetActiveColor;
DC := BeginPaint(Handle, PS);
try
R := PS.rcPaint;
R.Right := min(Width - 1, R.Right);
WinBrush := CreateSolidBrush(ColorToRGB(sStyle.GetActiveColor));
FillRect(DC, R, WinBrush);
bR := ButtonRect;
if IntersectRect(bR, bR, PS.rcPaint) then PaintButton;
ExcludeClipRect(DC, Width - ButtonWidth - 2, 0, Width, Height);
if (Style = csDropDown) and DroppedDown then begin
R := ClientRect;
InflateRect(R, -2, -2);
R.Right := Width;
Canvas.Brush.Color := sStyle.GetActiveColor;
Canvas.FrameRect(R);
end
else begin
if Style <> csDropDown then InvalidateSelection;
end;
finally
EndPaint(Handle, PS);
end;
RedrawBorders;
DeleteObject(WinBrush);
Message.Result := 1;
end;
procedure TsDBComboBox.WndProc(var Message: TMessage);
begin
if Assigned(FsStyle) then FsStyle.WndProc(Message);
if Message.Result <> 1 then inherited;
end;
procedure TsDBComboBox.WriteText;
var
Flags: Longint;
R : TRect;
begin
if Text <> '' then begin
Flags := 0;
Canvas.Font.Assign(Font);
R := ClientRect;
dec(R.Left);
dec(R.Top);
dec(R.Right, ButtonWidth);
case Alignment of
taLeftJustify : begin
Flags := DT_LEFT;
end;
taRightJustify : begin
Flags := DT_RIGHT;
end;
taCenter : begin
Flags := DT_CENTER;
end
end;
Flags := Flags or DT_EXPANDTABS or DT_VCENTER or DT_SINGLELINE;
Flags := DrawTextBiDiModeFlags(Flags);
Canvas.Pen.Style := psSolid;
Canvas.Brush.Style := bsClear;
DrawText(Canvas.Handle, PChar(Text), Length(Text), R, Flags);
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -