wwframetst.pas

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

{
// Components : Framing Object defines how borders are drawn in InfoPower edit controls.
//
// Copyright (c) 1996-2001 by Woll2Woll Software
//
// 11/22/99 - Fix problem where far left pixels are not cleared
// 6/9/2000 - PYW - Correct problem where editrect is 1 pixel too large when RightBorder is showing for FrameBox.
//
}
unit wwframetst;
{$i wwIfDef.pas}
interface


uses classes, Windows, controls, stdctrls, graphics, forms, Messages, typinfo;

type
  TwwComboButtonStyle = (cbsEllipsis, cbsDownArrow, cbsCustom);

  TwwButtonEffects = class(TPersistent)
  private
     FTransparent: boolean;
     FFlat: boolean;
     procedure SetTransparent(val: boolean);
     procedure SetFlat(val: boolean);
  protected
     Procedure Refresh; virtual;
  public
     Control: TControl;
     Button: TControl;
     constructor Create(Owner: TComponent; AButton: TControl);
     class Function Get(Control: TControl): TwwButtonEffects;
  published
     property Transparent: boolean read FTransparent write SetTransparent default false;
     property Flat: boolean read FFlat write SetFlat default false;
  end;

  TwwEditFocusStyle = (efsFrameBox, efsFrameSunken, efsFrameRaised, efsFrameEtched,
                       efsFrameBump, efsFrameSingle);
  TwwEditFrameEnabledType = (efLeftBorder, efTopBorder, efRightBorder, efBottomBorder);
  TwwEditFrameEnabledSet = set of TwwEditFrameEnabledType;
  TwwEditFrame = class(TPersistent)
  private
    Control: TWinControl;
    FEnabled: boolean;
    FNonFocusBorders: TwwEditFrameEnabledSet;
    FFocusBorders: TwwEditFrameEnabledSet;
    FFocusStyle: TwwEditFocusStyle;
    FNonFocusStyle: TwwEditFocusStyle;
    FNonFocusTextOffsetX: integer;
    FNonFocusTextOffsetY: integer;
    FTransparent: boolean;
    FTransparentClearsBackground: boolean;
    FMouseEnterSameAsFocus:boolean;
    FAutoSizeHeightAdjust: integer;
    FNonFocusTransparentFontColor: TColor;
    FNonFocusColor: TColor;
    FNonFocusFontColor: TColor;
    procedure SetFocusBorders(val: TwwEditFrameEnabledSet);
    procedure SetNonFocusBorders(val: TwwEditFrameEnabledSet);
    procedure SetNonFocusStyle(val: TwwEditFocusStyle);
    procedure SetEnabled(val: boolean);
    procedure SetTransparent(val: boolean);
    procedure CheckParentClipping;
//    procedure AdjustEditRect;
  public
    CreateTransparent: boolean;
    function NCPaint(FFocused: boolean; AlwaysTransparent: boolean = False;
      adc: HDC=0): integer;
    function IsSingleBorderStyle(Style: TwwEditFocusStyle): boolean;
    constructor Create(Owner: TComponent);
    procedure GetEditRectForFrame(var Loc: TRect);
    procedure RefreshTransparentText(InvalidateBorders: boolean=False; UseEditRect: boolean = True);
    procedure RefreshControl;
    procedure AdjustHeight;
    Function IsFrameEffective: boolean;
    procedure GetFrameTextPosition(
       var Left, Indent: integer;
       Focused: boolean = False); virtual;
    class Function Get(Control: TControl): TwwEditFrame;

    Procedure Assign(Source: TPersistent); override;
    procedure AssignAll(Source: TPersistent; SkipOptimize : boolean = True);
    function GetBorders(AFocused: boolean): TwwEditFrameEnabledSet;

    property TransparentClearsBackground: boolean
       read FTransparentClearsBackground write FTransparentClearsBackground default False;
  published
    property Enabled: boolean read FEnabled write SetEnabled default False;
    property Transparent: boolean read FTransparent write SetTransparent default False;
    property AutoSizeHeightAdjust: integer read FAutoSizeHeightAdjust write FAutoSizeHeightAdjust default 0;
    property FocusBorders : TwwEditFrameEnabledSet read FFocusBorders write SetFocusBorders
       default [efLeftBorder, efTopBorder, efRightBorder, efBottomBorder];
    property NonFocusBorders : TwwEditFrameEnabledSet read FNonFocusBorders write SetNonFocusBorders
             default [efBottomBorder];
    property FocusStyle: TwwEditFocusStyle read FFocusStyle write FFocusStyle default efsFrameBox;
    property NonFocusStyle: TwwEditFocusStyle read FNonFocusStyle write SetNonFocusStyle default efsFrameBox;
    property NonFocusTextOffsetX: integer read FNonFocusTextOffsetX write FNonFocusTextOffsetX default 0;
    property NonFocusTextOffsetY: integer read FNonFocusTextOffsetY write FNonFocusTextOffsetY default 0;

            // Obsolete
    property NonFocusTransparentFontColor: TColor read FNonFocusTransparentFontColor write FNonFocusTransparentFontColor default clNone;
    property NonFocusColor: TColor read FNonFocusColor write FNonFocusColor default clNone;
    property NonFocusFontColor: TColor read FNonFocusFontColor write FNonFocusFontColor default clNone;
    property MouseEnterSameAsFocus: boolean
       read FMouseEnterSameAsFocus write FMouseEnterSameAsFocus default False;
  end;


procedure wwInvalidateTransparentArea(control : TControl);

procedure wwDrawEdge(
     Control: TWinControl;
     Frame: TwwEditFrame;
     DC: HDC;
     Focused: boolean); overload;

procedure wwDrawEdge(
     Control: TWinControl;
     Frame: TwwEditFrame;
     Canvas: TCanvas;
     Focused: boolean); overload;

implementation

uses wwcommon, grids;

function wwIsTransparentParent(control : TControl): boolean;
var OrigStyle: longint;
    pc: TControl;
begin
   result:= false;
   pc:= control;

   // If parent is not transparent then just return
   if (pc.parent is TWinControl) and
      TWinControl(pc.parent).HandleAllocated then
   begin
      OrigStyle:= Windows.GetWindowLong(TWinControl(pc.parent).handle, GWL_EXSTYLE);
      result:= (OrigStyle and WS_EX_TRANSPARENT)<>0;
   end;
end;

constructor TwwEditFrame.Create(Owner: TComponent);
begin
   inherited Create;
   Enabled:= false;
   FNonFocusBorders:= [efBottomBorder];
   FFocusBorders:= [efLeftBorder, efTopBorder, efRightBorder, efBottomBorder];
   if Owner is TWinControl then
     control:= TWinControl(Owner)
   else
     control:= nil;
   FFocusStyle := efsFrameBox;
   FNonFocusStyle:= efsFrameBox;
   FNonFocusTextOffsetX:=0;
   FNonFocusTextOffsetX:=0;
   FNonFocusTransparentFontColor:= clNone;
   FNonFocusColor:= clNone;
   FNonFocusFontcolor:= clNone;
   FMouseEnterSameAsFocus := False;
end;

procedure TwwEditFrame.SetNonFocusBorders(val: TwwEditFrameEnabledSet);
begin
   FNonFocusBorders:= val;
   if control is TCustomEdit then
   begin
      RefreshControl;
   end
//   control.invalidate;
end;

procedure TwwEditFrame.SetFocusBorders(val: TwwEditFrameEnabledSet);
begin
   FFocusBorders:= val;
   if control is TCustomEdit then
   begin
      control.invalidate;
   end
end;

procedure TwwEditFrame.SetNonFocusStyle(val: TwwEditFocusStyle);
begin
   if val<>FNonFocusStyle then
   begin
      FNonFocusStyle:= val;
      if control is TCustomEdit then
      begin
         control.invalidate;
      end
   end
end;

procedure TwwEditFrame.SetEnabled(val: boolean);
   Function wwGetAutoSize(ctrl: TControl): boolean;
   var PropInfo: PPropInfo;
   begin
      Result:= False;
      PropInfo:= Typinfo.GetPropInfo(ctrl.ClassInfo,'AutoSize');
      if PropInfo<>Nil then result:= Boolean(GetOrdProp(Ctrl, PropInfo));
   end;

begin
   if val<>FEnabled then
   begin
      FEnabled:= val;
      if control is TCustomEdit then
      begin
         if val then wwSetBorder(control, False);
         if wwGetAutoSize(control) then AdjustHeight;
         control.invalidate;
      end
   end
end;


procedure wwDrawEdge(
     Control: TWinControl;
     Frame: TwwEditFrame;
     Canvas: TCanvas;
     Focused: boolean);
var cr: TRect;
//    StateFlags: Word;
    Flags: integer;
    focusStyle: TwwEditFocusStyle;
    Borders: TwwEditFrameEnabledSet
begin
   cr:= Control.ClientRect;
   Borders:= GetBorders(Focused);
   FocusStyle:= GetEffectiveStyle(Focused);

   if not (efRightBorder in Borders) and
      frame.transparent then cr.right:= cr.right-2;
   flags:= 0;
   if efLeftBorder in Borders then flags:= flags + bf_left;
   if efBottomBorder in Borders then flags:= flags + bf_bottom;
   if efTopBorder in Borders then flags:= flags + bf_top;
   if efRightBorder in Borders then flags:= flags + bf_right;
   if Focused then begin
      focusStyle:= Frame.FocusStyle;
   end
   else begin
      focusStyle:= Frame.NonFocusStyle;
   end;

      if (FocusStyle=efsFrameSingle) then
      begin
        DrawEdge(Canvas.Handle, cr, BDR_SUNKENOUTER, flags or bf_mono );
      end
      else if (FocusStyle=efsFrameBox) then
      begin
        DrawEdge(Canvas.Handle, cr, EDGE_SUNKEN, flags or bf_mono);
      end
      else if (FocusStyle=efsFrameSunken) then
      begin
        DrawEdge(Canvas.Handle, cr, EDGE_SUNKEN, flags);
      end
      else if (FocusStyle=efsFrameRaised) then
      begin
        DrawEdge(Canvas.Handle, cr, EDGE_RAISED, flags);
      end
      else if (FocusStyle=efsFrameEtched) then
      begin
        DrawEdge(Canvas.Handle, cr, EDGE_ETCHED, flags);
      end
      else if (FocusStyle=efsFrameBump) then
      begin
         DrawEdge(Canvas.Handle, cr, EDGE_BUMP, flags);
      end;

end;

procedure TwwEditFrame.CheckParentClipping;
var OldStyle:  longint;
begin
   if FTransparent and IsFrameEffective and (Control<>nil) and 
      not (csDesigning in Control.ComponentState) then
   begin
      if Control.HandleAllocated then
      begin
         OldStyle:= GetWindowLong(Control.Parent.Handle, GWL_STYLE);
         if OldStyle and (NOT WS_CLIPCHILDREN)<>OldStyle then
         begin
            SendMessage(Control.Handle, CM_RECREATEWND, 0, 0);
         end
      end
   end
end;

procedure TwwEditFrame.SetTransparent(val: boolean);
begin
   if val<>FTransparent then
   begin
     CreateTransparent:= val;
     FTransparent:= val;
     CheckParentClipping;
   end;

   if (Control<>nil) and Control.HandleAllocated and
      wwIsClass(Control.ClassType, 'TwwCustomRichEdit') and (Control<>nil) then
   begin
     SendMessage(control.handle, cm_recreatewnd, 0, 0);
   end;;


end;

procedure TwwEditFrame.RefreshTransparentText(InvalidateBorders: boolean=False; UseEditRect: boolean = True);
var r,tempeditrect:TRect;
    dc: HDC;
    brush: HBRUSH;
begin
   r:= Control.BoundsRect;
   if not InvalidateBorders then
   begin
     SendMessage(Control.handle,em_getrect, 0, Integer(@tempeditrect));
     if not useEditRect then begin
       InflateRect(r,-2,-2);
       if not (efLeftBorder in nonFocusBorders) then dec(r.Left,2);
     end
     else if (TEdit(Control).BorderStyle=bsNone) then
     begin
       InflateRect(r,-2,-2);
       if not (efLeftBorder in nonFocusBorders) then dec(r.Left,2);
       r.Right := r.Left+tempeditrect.Right+1;
     end
   end;

   { If imager not in background, then need to explicitly clear background }
   if wwIsTransparentParent(Control) then
      wwInvalidateTransparentArea(Control)
   else if (Control.Parent.ControlAtPos(  Point(Control.Left, Control.Top), True)=nil) then
   begin
      DC := GetDC(Control.Handle);
      brush:= 0;
      try
        brush:= CreateSolidBrush(ColorToRGB(TEdit(Control.parent).color));
        SelectObject(DC, brush);
        if not InvalidateBorders then
        begin
          InflateRect(tempEditRect, 1, 1);
          { 11/22/99 - Fix problem where far left pixels are not cleared }
          if not (efLeftBorder in nonFocusBorders) then
          begin
             dec(tempEditRect.Left,1);
             if tempEditRect.Left<0 then tempEditRect.left:= 0;
          end;
          Windows.FillRect(DC, tempEditRect, brush);
        end
        else begin
          r:= Control.ClientRect;
          Windows.FillRect(DC, r, brush);
        end;
      finally
        ReleaseDC(Control.Handle, DC);
        DeleteObject(brush);
      end
   end
   else
//      wwInvalidateTransparentArea(Control)
      InvalidateRect(Control.parent.handle, @r, TransparentClearsBackground);

end;

procedure TwwEditFrame.RefreshControl;
var r:TRect;
begin
//   AdjustEditRect;
   r:= Control.BoundsRect;
   if Enabled and Transparent then
      InvalidateRect(Control.parent.handle, @r, false)