sdblookupcombobox.pas

Alpha Controls.v5.46b Source

unit sDBLookupComboBox;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBCtrls, sConst, acntUtils, sGraphUtils, sCommonData, sDefaults,
  sGlyphUtils, math, acSBUtils{$IFDEF LOGGED}, sDebugMsgs{$ENDIF};

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

    function ButtonRect: TRect;
//    procedure CNCommand (var Message: TWMCommand); message CN_COMMAND;

    procedure SetAlignment(const Value: TAlignment);
    procedure SetButtonMargin(const Value: integer);
    procedure SetDisabledKind(const Value: TsDisabledKind);
  protected
    lboxhandle : hwnd;
    ListSW : TacScrollWnd;
    FActive : boolean;
    FCharsInCode : integer;
    FUseItemIndex : boolean;
    FDefBmpName : string;

    procedure PaintBorder;
    procedure PrepareCache;
    procedure PaintText;
    procedure OurPaintHandler;

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

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

    property Color;
    procedure Invalidate; override;
    procedure PaintButton;
    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 SkinData : TsCommonData read FCommonData write FCommonData;
  end;

implementation

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

{ TsDBLookupComboBox }

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

function TsDBLookupComboBox.ButtonHeight: integer;
begin
  if FCommonData.Skinned and (FCommonData.SkinManager.ConstData.ComboGlyph > -1)
    then Result := HeightOf(FCommonData.SkinManager.ma[FCommonData.SkinManager.ConstData.ComboGlyph].R) div (1 + FCommonData.SkinManager.ma[FCommonData.SkinManager.ConstData.ComboGlyph].MaskType)
    else Result := 16;
end;

function TsDBLookupComboBox.ButtonRect: TRect;
var
  w : integer;
begin
  w := GetSystemMetrics(SM_CXVSCROLL);
  if UseRightToLeftAlignment then Result.Left := 2 else Result.Left := Width - w - 2;
  Result.Top := 2;
  Result.Right := Result.Left + w;
  Result.Bottom := Height - 2;
end;
{
procedure TsDBLookupComboBox.CNCommand(var Message: TWMCommand);
begin
  Case Message.NotifyCode of
    CBN_CLOSEUP: begin
      DroppedDown := False;
    end;
  end;
  inherited;
end;
}
constructor TsDBLookupComboBox.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;
//  BorderStyle := bsNone;
end;

destructor TsDBLookupComboBox.Destroy;
begin
  if lBoxHandle <> 0 then begin
    SetWindowLong(lBoxHandle, GWL_STYLE, GetWindowLong(lBoxHandle, GWL_STYLE) and not WS_THICKFRAME or WS_BORDER);
    UninitializeACScroll(lBoxHandle, True, False, ListSW);
    lBoxHandle := 0;
  end;
  FreeAndNil(FBoundLabel);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

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

{
function TsDBLookupComboBox.GetClientRect: TRect;
begin
  Result := Rect(0, 0, Width, Height);
  InflateRect(Result, -3, -4);
end;
}
procedure TsDBLookupComboBox.Invalidate;
begin
  if Focused then FCommonData.FFocused := True;
  inherited Invalidate;
end;

{
procedure TsDBLookupComboBox.InvalidateSelection;
begin
//
end;
}
procedure TsDBLookupComboBox.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 TsDBLookupComboBox.OurPaintHandler;
const
  BordWidth = 3;
var
  DC, SavedDC : hdc;
  PS : TPaintStruct;
begin
  BeginPaint(Handle, PS);
  DC := GetWindowDC(Handle);
  SavedDC := SaveDC(DC);
  try
    if not FCommonData.Updating then begin
      FCommonData.BGChanged := FCommonData.BGChanged or FCommonData.HalfVisible or GetBoolMsg(Parent, AC_GETHALFVISIBLE);
      FCommonData.HalfVisible := not RectInRect(Parent.ClientRect, BoundsRect);

      if FCommonData.BGChanged then begin
        FCommonData.InitCacheBmp;
        PrepareCache
      end;
      UpdateCorners(FCommonData, 0);

{      if 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 - 2, 0, WidthOf(R), Height, FCommonData.FCacheBmp.Canvas.Handle, R.Left - 2, 0, 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
    RestoreDC(DC, SavedDC);
    ReleaseDC(Handle, DC);
    EndPaint(Handle, PS);
  end;
end;

procedure TsDBLookupComboBox.PaintBorder;
const
  BordWidth = 3;
var
  DC, SavedDC: HDC;
begin
  DC := GetWindowDC(Handle);
  SavedDC := SaveDC(DC);
  try
    if FCommonData.BGChanged then begin