wwexpandbutton.pas

胜天进销存源码,国产优秀的进销存

{
//
// Components : TwwCheckbox
//
// Copyright (c) 2001 by Woll2Woll Software
}
unit wwExpandButton;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, wwframe, dbctrls, db, wwcommon, imglist, wwradiobutton, grids;

type
  TwwCustomCheckBox = class(TCustomCheckBox)
  private
    FCanvas: TControlCanvas;
    FFrame: TwwEditFrame;
    FIndents: TwwWinButtonIndents;
    FAlwaysTransparent: boolean;
    FValueChecked: string;
    FValueUnchecked: string;
    FShowFocusRect: boolean;
    FDynamicCaption: boolean;
    FImages: TCustomImageList;
    FWordWrap: boolean;

    FPaintBitmap: TBitmap;
    FPaintCanvas: TCanvas;
    UseTempCanvas: Boolean;
    SpaceKeyPressed: boolean;
    FModified: Boolean;
//    PaintCopyState: TCheckBoxState;

    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FShowAsButton: boolean;

    function isTransparentEffective: boolean;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure DrawItem(const DrawItemStruct: TDrawItemStruct); virtual;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure BMSetCheck(var Message: TMessage); message BM_SETCHECK;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure EMGetModify(var Message: TMessage); message EM_GETMODIFY;

    Function IsMouseInControl: boolean;
    procedure SetValueChecked(const Value: string);
    procedure SetValueUnchecked(const Value: string);
    procedure ComputeGlyphRect(var DrawRect: TRect);
    procedure ComputeTextRect(var DrawRect: TRect);
    function GetModified: Boolean;
    procedure SetModified(Value: Boolean);

  protected
    function GetFieldState: TCheckBoxState; virtual;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure CreateWnd; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; virtual;
    procedure PaintBorder;
    procedure DataChange(Sender: TObject); virtual;
    Function GetCanvas: TCanvas; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    { Protected declarations }
    procedure DoMouseEnter; virtual;
    procedure DoMouseLeave; virtual;
    function GetField: TField; virtual;
  public
     destructor Destroy; override;
     constructor Create(AOwner: TComponent); override;
     property Canvas: TCanvas read GetCanvas;
     property Images: TCustomImageList read FImages write FImages;
     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
     property Modified: Boolean read GetModified write SetModified;

  published
    property AlwaysTransparent: boolean read FAlwaysTransparent write FAlwaysTransparent;
    property Frame: TwwEditFrame read FFrame write FFrame;
    property Indents: TwwWinButtonIndents read FIndents write FIndents;
    property DynamicCaption: boolean read FDynamicCaption write FDynamicCaption default False;
    property ValueChecked: string read FValueChecked write SetValueChecked;
    property ValueUnchecked: string read FValueUnchecked write SetValueUnchecked;
    property ShowFocusRect: boolean read FShowFocusRect write FShowFocusRect default true;
    property WordWrap: boolean read FWordWrap write FWordWrap default False;
    property Action;
    property Alignment;
    property AllowGrayed;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Checked;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property State;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

{ TDBCheckBox }

  TwwCheckBox = class(TwwCustomCheckBox)
  private
    FDataLink: TFieldDataLink;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetReadOnly(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    function ValueMatch(const ValueList, Value: string): Boolean;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  protected
    Function IsDataBound: boolean;
    procedure DataChange(Sender: TObject); override;
    procedure Toggle; override;
    procedure KeyPress(var Key: Char); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure WndProc(var Message: TMessage); override;
    function GetField: TField; override;
    function GetFieldState: TCheckBoxState; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    function UseRightToLeftAlignment: Boolean; override;
    property Field: TField read GetField;
  published
    property AlwaysTransparent: boolean read FAlwaysTransparent write FAlwaysTransparent;
    property Frame: TwwEditFrame read FFrame write FFrame;
    property DynamicCaption: boolean read FDynamicCaption write FDynamicCaption default False;
    property ValueChecked: string read FValueChecked write SetValueChecked;
    property ValueUnchecked: string read FValueUnchecked write SetValueUnchecked;
    property ShowFocusRect: boolean read FShowFocusRect write FShowFocusRect default true;

    property Action;
    property Alignment;
    property AllowGrayed;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Checked;
    property Color;
    property Constraints;
    property Ctl3D;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Images;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property State;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;

    property OnStartDock;
    property OnStartDrag;

    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  end;


implementation

uses wwdbigrd, wwdbgrid;

procedure TwwCustomCheckBox.CNDrawItem(var Message: TWMDrawItem);
begin
  DrawItem(Message.DrawItemStruct^);
end;

procedure TwwCustomCheckBox.DrawItem(const DrawItemStruct: TDrawItemStruct);
  procedure CanvasNeeded;
  begin
    if FCanvas = nil then
    begin
      FCanvas := TControlCanvas.Create;
      FCanvas.Control := Self;
    end;
  end;
begin
  CanvasNeeded;
  FCanvas.Handle := DrawItemStruct.hDC;
  Paint;
  PaintBorder;
  FCanvas.Handle := 0;
end;

procedure TwwCustomCheckBox.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  if IsInwwObjectViewPaint(self) or
    ((IsTransparentEffective and not Focused) or AlwaysTransparent) then
  begin
     if not (csDesigning in ComponentState) then Message.result:= 1
     else inherited;
  end
  else
     inherited;
{   if Frame.enabled and not (csDesigning in ComponentState) then
      message.result:=1
   else inherited;}
end;

procedure TwwCustomCheckBox.CreateParams(var Params: TCreateParams);
const
  Alignments: array[Boolean, TLeftRight] of DWORD =
    ((BS_LEFTTEXT, 0), (0, BS_LEFTTEXT));
begin
   inherited;
   CreateSubClass(Params, 'BUTTON');
   if IsTransparentEffective then
     Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;  // For transparency
   with Params do begin
     Style:= Style and not BS_3STATE;
     Style := Style or BS_ownerdraw;
//     Style:= Style or ws_border;
     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
   end;
end;

procedure TwwCustomCheckBox.CreateWnd;
  procedure DisableParentClipping;
  begin
     SetWindowLong(GetParent(Handle), GWL_STYLE,
      GetWindowLong(GetParent(Handle), GWL_STYLE) and not WS_CLIPCHILDREN);
  end;
begin
   inherited;
   if IsTransparentEffective then
   begin
     DisableParentClipping;
   end;
   Modified := FModified;
end;

destructor TwwCustomCheckBox.Destroy;
begin
   FIndents.Free;
   FCanvas.Free;
   FFrame.Free;
   inherited;
end;
{
procedure TwwCustomCheckBox.PaintGlyph(drawrect: TRect; b: TBitmap);
var TempRect: TRect;
    FGlyphs: TImageList;
    i: integer;
begin
 for i:= 1 to 1 do
  begin
   FGlyphs:= TImageList.createsize(b.Width, b.Height);
   FGlyphs.AddMasked(b, b.Canvas.Pixels[0, b.Height-1]);
   Canvas.Lock;
   TempRect:= Rect(0, 0, b.Width, b.Height);
   try
      FGlyphs.Draw(Canvas, drawrect.left, drawrect.top,
        0, True);
//      FCanvas.Brush.Style:= bsClear;
//      FCanvas.BrushCopy(DrawRect, b, TempRect,
//          b.Canvas.Pixels[0, b.Height-1]);
   finally
      Canvas.Unlock;
      FGlyphs.Free;
   end;
end
end;
}

procedure TwwCustomCheckBox.ComputeGlyphRect(var DrawRect: TRect);
var offsetx, offsety: integer;
    checkboxSizeX, checkboxSizeY: integer;
    pt: TPoint;
    TempIndentCheckboxX: integer;
begin
   if (Images<>nil) and (Images.count>0) then
   begin
      checkboxSizeX:= Images.Width;
      checkboxSizeY:= Images.Height;
   end
   else begin
      checkboxSizex:= 13;
      checkboxSizey:= 13;
   end;

     offsetx:= checkboxsizex div 2;
     offsety:= checkboxsizey div 2;

     TempIndentCheckboxX:= Indents.ButtonX+1;
     if parent is TCustomGrid then inc(TempIndentCheckboxX);

     if Frame.Enabled and
        (efLeftBorder in Frame.FocusBorders) then
     begin
        TempIndentCheckboxX:= wwmax(TempIndentCheckboxX, 3);
     end;

     if Alignment = taRightJustify then
        pt.x:= offsetx + TempIndentCheckboxX
     else
        pt.x:= ClientWidth - TempIndentCheckboxX - offsetx -2;
     pt.y:= Height div 2;

     DrawRect.Left:= pt.x - offsetx;
     DrawRect.Right:= pt.x + offsetx+1;
     DrawRect.Top:= pt.y-offsety+Indents.ButtonY;
     DrawRect.Bottom:= pt.y+offsety+1+Indents.ButtonY;

end;

procedure TwwCustomCheckBox.ComputeTextRect(var DrawRect: TRect);
var TempIndentTextX: integer;
    pt: TPoint;
    NewDrawRect: TRect;
    DrawFlags: integer;
    TempCaption : string;
begin
   ComputeGlyphRect(DrawRect);

   TempIndentTextX:= Indents.TextX;
   if Frame.Enabled and
      (efLeftBorder in Frame.FocusBorders) then
      TempIndentTextX:= wwmax(TempIndentTextX, 3);
   if FShowAsButton then TempIndentTextX:= wwmax(TempIndentTextX, 3);

   pt.y:= Height div 2;
   if Alignment = taRightJustify then
       NewDrawRect:= Rect(DrawRect.Right + 4 + TempIndentTextX, 0,
                     Width, Height)
   else
      NewDrawRect:= Rect(TempIndentTextX + 2, 0, DrawRect.Left, Height);
   DrawFlags:= 0;
   if WordWrap then
      DrawFlags:= DrawFlags or DT_EDITCONTROL or DT_WORDBREAK;