wwframetst.pas

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

   else Control.Invalidate;
end;

{procedure TwwEditFrame.AdjustEditRect;
var TempEditRect:TRect;
begin
   if not Control.HandleAllocated then exit;
   SendMessage(Control.handle,em_getrect, 0, Integer(@TempEditRect));
   GetEditRectForFrame(TempEditRect);
   SendMessage(Control.Handle, EM_SETRECTNP, 0, LongInt(@TempEditRect));
end;
}

function TwwEditFrame.IsSingleBorderStyle(Style: TwwEditFocusStyle): boolean;
begin
  result:= Style in [efsFrameBox, efsFrameSingle];
end;

procedure TwwEditFrame.GetEditRectForFrame(var Loc: TRect);
begin
     if IsSingleBorderStyle(FocusStyle) then
//     if (FocusStyle = efsFrameBox) then
     begin
        Loc.Top := 2;
        Loc.Left := 2;
        //6/9/2000 - PYW - Correct problem where editrect is 1 pixel too large when RightBorder is showing for FrameBox.
        if (efRightBorder in FocusBorders) and (FocusStyle = efsFrameBox) then
          Loc.Right:= Loc.Right - 1
     end
     else begin
        Loc.Top := 3;
        if efLeftBorder in FocusBorders then
        begin
           if FocusStyle in [efsFrameSunken, efsFrameBump] then
              Loc.Left := 3
           else Loc.Left:= 2;
        end
        else Loc.Left:=1;

        Loc.Right:= Loc.Right -2
     end
end;

procedure TwwEditFrame.AdjustHeight;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, TEdit(Control).Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  if NewStyleControls then
  begin
    if TEdit(Control).Ctl3D then I := 8 else I := 6;
    I := GetSystemMetrics(SM_CYBORDER) * I;
    if TEdit(Control).BorderStyle=bsNone  then i:= 6;
    if self.enabled then i:= i + AutoSizeHeightAdjust;;
  end else
  begin
    I := SysMetrics.tmHeight;
    if I > Metrics.tmHeight then I := Metrics.tmHeight;
    I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
  end;
  Control.Height := Metrics.tmHeight + I;
end;

{Function GetBooleanProp(control: TControl; PropertyName: string): boolean;
var PropInfo: PPropInfo;
begin
   Result:= False;
   PropInfo:= Typinfo.GetPropInfo(Control.ClassInfo, PropertyName);
   if PropInfo<>Nil then
      result:= Boolean(GetOrdProp(Control, PropInfo));
end;
}
procedure SetBooleanProp(control: TControl; PropertyName: string; val: boolean);
var PropInfo: PPropInfo;
begin
   PropInfo:= Typinfo.GetPropInfo(Control.ClassInfo, PropertyName);
   if PropInfo<>Nil then
      SetOrdProp(control, PropInfo, ord(val));
end;

procedure TwwButtonEffects.SetTransparent(val: boolean);
begin
   if FTransparent<>val then
   begin
      FTransparent:= val;
      SetBooleanProp(Button, 'Transparent', FFlat or FTransparent);
      SetBooleanProp(Button, 'Flat', FFlat or FTransparent);
      Refresh;  //      FButton.Glyph.Handle:= LoadComboGlyph;
      Button.Invalidate;
   end;
end;

procedure TwwButtonEffects.SetFlat(val: boolean);
begin
   if FFlat<>val then
   begin
      FFlat:= val;
      SetBooleanProp(Button, 'Flat', FFlat or FTransparent);
      Refresh;  //      FButton.Glyph.Handle:= LoadComboGlyph;
      Button.Invalidate;
   end;
end;

constructor TwwButtonEffects.Create(Owner: TComponent; AButton: TControl);
begin
   inherited Create;
   button:= TControl(AButton);
   control:= TControl(Owner);
end;

Procedure TwwButtonEffects.Refresh;
begin
end;

class Function TwwEditFrame.Get(Control: TControl): TwwEditFrame;
var PropInfo: PPropInfo;
begin
   Result:= Nil;
   PropInfo:= Typinfo.GetPropInfo(Control.ClassInfo,'Frame');
   if PropInfo<>Nil then
      result:= TwwEditFrame(GetOrdProp(Control, PropInfo));
end;

class Function TwwButtonEffects.Get(Control: TControl): TwwButtonEffects;
var PropInfo: PPropInfo;
begin
   Result:= Nil;
   PropInfo:= Typinfo.GetPropInfo(Control.ClassInfo,'ButtonEffects');
   if PropInfo<>Nil then
      result:= TwwButtonEffects(GetOrdProp(Control, PropInfo));
end;

Function TwwEditFrame.IsFrameEffective: boolean;
begin
   result:= enabled and (control<>nil) and not (control.parent is TCustomGrid);
end;

procedure TwwEditFrame.Assign(Source: TPersistent);
//var s: TwwEditFrame;
begin
  if Source is TwwEditFrame then
  begin
     AssignAll(Source, False);
  end
  else inherited Assign(Source);
end;

procedure TwwEditFrame.AssignAll(Source: TPersistent; SkipOptimize : boolean = True);
var s: TwwEditFrame;
begin
  if Source is TwwEditFrame then
  begin
     s:= TwwEditFrame(source);
     Enabled:= s.Enabled;
     Transparent:= s.Transparent;
     if (not SkipOptimize) and (not Enabled) then exit; {Optimization }
     TransparentClearsBackground:= s.TransparentClearsBackground;
     MouseEnterSameAsFocus:= s.FMouseEnterSameAsFocus;
     AutoSizeHeightAdjust:= s.AutoSizeHeightAdjust;
     FocusBorders:= s.FocusBorders;
     NonFocusBorders:= s.NonFocusBorders;
     FocusStyle:= s.FocusStyle;
     NonFocusStyle:= s.NonFocusStyle;
     NonFocusTextOffsetX:= s.NonFocusTextOffsetX;
     NonFocusTextOffsetY:= s.NonFocusTextOffsetY;
     NonFocusTransparentFontColor:= s.NonFocusTransparentFontColor;
     NonFocusColor:= s.NonFocusColor;
     NonFocusFontColor:= s.NonFocusFontColor;
  end
end;

    function GetBorders(AFocused: boolean): TwwEditFrameEnabledSet;

function TwwEditFrame.GetBorders(AFocused: boolean): TwwEditFrameEnabledSet;
begin
   if AFocused then
   begin
      if Control is
      result:= FocusBorders;
   end
   else begin
      result:= NonFocusBorders;
   end;
end;

procedure TwwEditFrame.GetFrameTextPosition(
   var Left, Indent: integer;
   Focused: boolean = False);
var Borders: TwwEditFrameEnabledSet;
    FrameStyle: TwwEditFocusStyle;
begin
   if Focused then
   begin
      Borders:= FocusBorders;
      FrameStyle:= FocusStyle;
   end
   else begin
      Borders:= NonFocusBorders;
      FrameStyle:= NonFocusStyle;
   end;

   Left:= 1;
   if (efLeftBorder in Borders) then begin
//      if FrameStyle=efsFrameBox then Left:= 2
      if IsSingleBorderStyle(FrameStyle) then Left:= 2
      else Left:= 3;
   end;

   Indent:= 2;
   if (efTopBorder in Borders) and
      (not IsSingleBorderStyle(FrameStyle)) then
//      (FrameStyle<>efsFrameBox) then
      Indent:= Indent + 1;

   Left:= Left + NonFocusTextOffsetX;
   Indent:= Indent + NonFocusTextOffsetY;
end;

procedure wwDrawEdge(
     Control: TWinControl;
     Frame: TwwEditFrame;
     DC: HDC;
     Focused: boolean);
var cr: TRect;
    Flags: integer;
    focusStyle: TwwEditFocusStyle;
begin
   cr:= Control.ClientRect;
   cr.right:= Control.Width;
   cr.bottom:= Control.height;
//   inflaterect(cr, -1, -1);
   if Focused then begin
      if not (efRightBorder in Frame.FocusBorders) and
         frame.transparent then cr.right:= cr.right-2;
      flags:= 0;
      if efLeftBorder in Frame.FocusBorders then flags:= flags + bf_left;
      if efBottomBorder in Frame.FocusBorders then flags:= flags + bf_bottom;
      if efTopBorder in Frame.FocusBorders then flags:= flags + bf_top;
      if efRightBorder in Frame.FocusBorders then flags:= flags + bf_right;
      focusStyle:= Frame.FocusStyle;

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

   if flags = 0 then exit;  // No need to paint - generates CodeWatch error if call DrawEdge with no edges

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

end;


function TwwEditFrame.NCPaint(FFocused: boolean; AlwaysTransparent: boolean = False;
   adc: HDC=0): integer;
var dc: HDC;
    R: TRect;
//    i: integer;
//    SI: TScrollInfo;
    brush: HBrush;
    SpecialControl: boolean;
begin
   dc:= adc;
   result:= 1;
   if IsFrameEffective then
   begin
      try
        if dc=0 then dc:= GetWindowDC(Control.Handle);
        SpecialControl:= wwIsClass(Control.ClassType, 'TwwCheckBox') or
                         wwIsClass(Control.ClassType, 'TwwRadioButton');

        if not SpecialControl and
           ((not Transparent) or (FFocused and not AlwaysTransparent)) then
        begin
          brush:= CreateSolidBrush(ColorToRGB(TEdit(Control).Color));
          try
            SelectObject(DC, brush);
            r:= Rect(0, 0, Control.Width, Control.Height);
            Windows.FrameRect(dc, r, brush);
            r:= Rect(1, 1, Control.Width-1, Control.Height-1);
            Windows.FrameRect(dc, r, brush);
          finally
            DeleteObject(Brush);
          end
        end;
        wwDrawEdge(Control, self, dc, FFocused);
      finally
        if adc=0 then releaseDc(Control.Handle, dc)
      end;
      result:= 0; //message.result:= 0;
   end
end;

procedure wwInvalidateTransparentArea(control : TControl);
var r: TRect;
   pc: TControl;
begin
  { Draws any image in the background }
   with Control do  r:= Rect(Left, Top, Left+Width, Top+Height);
   pc:= control;
   if pc.parent=nil then exit;

   // If parent is not transparent then just return
   if not wwIsTransparentParent(control) then exit;
{   if (pc.parent is TWinControl) and
      TWinControl(pc.parent).HandleAllocated then
   begin
      OrigStyle:= Windows.GetWindowLong(TWinControl(pc.parent).handle, GWL_EXSTYLE);
      if (OrigStyle and WS_EX_TRANSPARENT)=0 then exit;
   end;
}
   repeat
      pc:= pc.parent;
      if pc is TWinControl then
         InvalidateRect(TWinControl(pc).handle, @r, False);
      if (pc<>nil) and (pc.parent=nil) then break;

      r:= Rect(pc.left + r.Left, pc.top+r.top,
           pc.left + r.right, pc.top + r.bottom);
   until pc.parent=nil;

//   if pc is TWinControl then
//       InvalidateRect(TWinControl(pc).handle, @r, False);

{   r:= Rect(r.left + parent.parent.left, r.top + parent.parent.top,
           r.Right + parent.parent.left, r.bottom + parent.parent.top);
   InvalidateRect(parent.parent.parent.handle, @r, Navigator.TransparentClearsBackground);
}

end;

end.