wwdotdot.pas

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

      if CanFocus then
      begin

         if not IsVistaComboNonEditable then
         begin
            SetFocus;  { 8/30/96 - Set focus to control }
         end;
         // 6/4/02 - Following code causes OnExit to fire twice for exiting control such as TEdit
{
         // 6/16/01 - Fix problem when using WebBrowse and it has text selected
         if Handle<>GetFocus then
            windows.SetFocus(Handle);
}
      end;

      { 3/13/00 - MDI forms should check ActiveControl instead of focused}
      parentForm:= GetParentForm(self);
      if (parentForm<>nil) and
          (TForm(parentForm).formstyle = fsMDIChild) then
      begin
         if Focused or
            (parentForm.ActiveControl=self) then
         DropDown;
      end
      else if (Focused or IsVistaComboNonEditable) then DropDown;
   end
end;

procedure TwwDBCustomCombo.CloseUp(Accept: boolean);
begin
   if Accept then modified:= True;
end;

procedure TwwDBCustomCombo.DropDown;
begin
   if Assigned(FOnCustomDlg) then begin
      FDroppedDown:= True;

      Invalidate;

      try  { If exception then clean-up }
         if AutoEnableEdit then
         begin
           if (datasource<>nil) and (datasource.dataset<>nil) then
              EnableEdit;
         end;
         FOnCustomDlg(self);
      finally
         if (not editable) then
            HideCaret(Handle); { Support csDropDownList style }
         Invalidate;
         FDroppedDown:= False;
      end;
   end
end;

Function TwwDBCustomCombo.Editable: boolean;
begin
   Result := (FStyle <> csDropDownList) or isDroppedDown;
end;

Function TwwDBCustomCombo.MouseEditable: boolean;
begin
   Result := (FStyle <> csDropDownList);
end;


procedure TwwDBCustomCombo.HandleDropDownKeys(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_F4: // Support F4 for dropping-down
      if not (ssAlt in Shift) then begin
         if isDroppedDown then CloseUp(True)
         else DropDown;
         Key := 0;
      end;
    VK_UP, VK_DOWN:
      if ssAlt in Shift then
      begin
        if isDroppedDown then CloseUp(True)
        else DropDown;
        Key := 0;
      end;
    VK_RETURN, VK_ESCAPE:
      if isDroppedDown and not (ssAlt in Shift) then
      begin
        CloseUp(Key = VK_RETURN);
        Key := 0;
      end;
  end;
end;


procedure TwwDBCustomCombo.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if GetKeyState(VK_MENU) < 0 then
  begin
     Include(Shift, ssAlt);
{     wwClearAltChar;}
  end;

  HandleDropDownKeys(Key, Shift);

  inherited KeyDown (Key, Shift);

  { 2/25/98 }
  if wwIsValidChar(Key) and (not Editable) then key:= 0;
//  if (Key in [32..255]) and (not Editable) then key:=0;

end;

procedure TwwDBCustomCombo.KeyPress(var Key: Char);
begin
  { Disregard tab key since inherited maskedit event will beep }
  if isMasked and (Key=#9) then exit;
  inherited KeyPress(Key);
end;

procedure TwwDBCustomCombo.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if MouseEditable then
    inherited
  else
    NonEditMouseDown (Message);
end;

procedure TwwDBCustomCombo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  if MouseEditable then
    inherited
  else
    NonEditMouseDown (Message);
end;

procedure TwwDBCustomCombo.WMLButtonUp(var Message: TWMLButtonUp);
begin
  if not MouseEditable then MouseCapture := False;
  inherited;
end;

procedure TwwDBCustomCombo.NonEditMouseDown(var Message: TWMLButtonDown);
var
  CtrlState: TControlState;
begin
  // 3/15/02 - Remove dependency upon grid
  if (parent=nil) or
     (not wwIsClass(parent.classtype, 'TwwCustomDBGrid')) then
  begin
     if not IsVistaComboNonEditable then
     begin
        SetFocus;
        if (not IsDroppedDown) and (not Focused) then
        begin
           with Message do
              MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
           exit; // 12/15/03 - If did not receive focus then don't dropdown
        end;
     end;
  end;
//  if not (Parent is TwwCustomDBGrid) then SetFocus;
{  HideCaret (Handle);}

  if isDroppedDown then CloseUp(True)
  else DropDown;

  if csClickEvents in ControlStyle then
  begin
    CtrlState := ControlState;
    Include(CtrlState, csClicked);
    ControlState := CtrlState;
  end;
  with Message do
    MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
end;

Procedure TwwDBCustomCombo.DrawButton(Canvas: TCanvas; R: TRect; State: TButtonState;
       ControlState: TControlState; var DefaultPaint: boolean);
var Transparent: boolean;
begin
   {$ifdef win32}
   if ButtonStyle=cbsCustom then exit;

   DefaultPaint:= False;
   Transparent:=  FButton.Flat and
      (not FMouseInButtonControl) and not (FFocused);
   if ButtonStyle=cbsDownArrow then
      wwDrawDropDownArrow(Canvas, R, State, Enabled, ControlState)
   else begin
      wwDrawEllipsis(Canvas, R, State, Enabled, Transparent,
         ButtonEffects.Transparent {and ButtonEffects.Flat},
         ControlState)
   end
   {$endif}
end;

constructor TBtnWinControl.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   EditControl:= AOwner as TwwDBCustomCombo;
end;

procedure TBtnWinControl.CMMouseEnter(var Message: TMessage);
begin
  inherited;
//  if EditControl.FButton.Flat and (not EditControl.ButtonTransparent) then
//  begin
//     EditControl.UpdateButtonPosition;
//     EditControl.InvalidateTransparentButton;
//     Invalidate;
//  end
end;

procedure TBtnWinControl.CMMouseLeave(var Message: TMessage);
var r: TRect;
    offset: integer;
begin
  inherited;
  if not EditControl.ButtonEffects.Flat then exit;

  if EditControl.BorderStyle=bsSingle then offset:=2 else offset:= 0;
  if not EditControl.FFocused then begin
     if EditControl.IsTransparentEffective then begin
        r:= Rect(parent.left + Left + offset, parent.Top+top+offset,
                 parent.left + left + offset + Width, parent.top + offset + Top + Height);
        if wwIsTransparentParent(self) then
          wwInvalidateTransparentArea(self, false) // just to be safer, but probably works in both cases
        else
          InvalidateRect(parent.parent.handle, @r, True);
        Invalidate;
     end;
     Invalidate;
  end
end;

function TwwComboDlgButton.IsVistaTransparentButton: boolean;
var combo: TwwDBCustomCombo;
begin
   combo:= TwwDBCustomCombo(parent.parent);
   if wwUseThemes(self) and IsVista and not IsVistaComboNonEditable and
      not (combo.Frame.Enabled and combo.Frame.Transparent) then
      result:= true
   else
      result:=false;
end;

function TwwComboDlgButton.IsVistaComboNonEditable: boolean;
begin
   result:= twwdbCustomCombo(parent.parent).IsVistaComboNonEditable;
end;

function TwwComboDlgButton.ParentMouseInControl: boolean;
begin
   result:= twwdbCustomCombo(parent.parent).MouseInControl;
end;

function TwwComboDlgButton.ParentDroppedDown: boolean;
begin
   result:= twwdbCustomCombo(parent.parent).IsDroppedDown;
end;

procedure TwwComboDlgButton.Paint;
var R : TRect;
    DefaultPaint: boolean;
begin
   if twwdbCustomCombo(parent.parent).SkipUpdate then exit;

   if (csPaintCopy in ControlState) and
      not (csDesigning in ComponentState) and IsInGrid(parent.parent) then exit;

   SetRect(R, 0, 0, ClientWidth, ClientHeight);
   with TwwDBCustomCombo(Parent.Parent) do
   begin
      DefaultPaint:= True;
      FMouseInButtonControl:= MouseInControl;

      if (FButton.Glyph.Handle=0) or MouseInControl or
         FFocused or wwisClass(Parent.classType, 'TwwDBGrid') then
         if not (ButtonEffects.Transparent and (ButtonStyle=cbsDownArrow)) then
           if not wwUseThemes(self.parent.parent) then
           begin
              DrawButton(Canvas, R, FState, ControlState, DefaultPaint);
           end;

      if DefaultPaint then begin
         Ellipsis:= ButtonStyle = cbsEllipsis;
         inherited Paint;
      end;

      { Draw edges  }
      if MouseInControl or (not ButtonEffects.Flat) or
         FFocused or wwisClass(Parent.classType, 'TwwDBGrid') then
      begin
         if not wwUseThemes(self.parent.parent) then
         begin
           if FState=bsDown then
              DrawEdge(Canvas.Handle, R, EDGE_SUNKEN, BF_RECT)
           else
              DrawEdge(Canvas.Handle, R, EDGE_RAISED, BF_RECT)
         end
      end

   end
end;

{Function TwwDBCustomCombo.GetClientEditRect: TRect;
begin
   result:= ClientRect;
   if ShowButton then result.Right:= FBtnControl.Left;
end;}

procedure TwwDBCustomCombo.SetButtonStyle(val: TwwComboButtonStyle);
begin
   if val<>FButtonStyle then begin
      FButtonStyle:= val;
      UpdateButtonGlyph;
      FButton.Invalidate;
   end
end;

Function TwwDBCustomCombo.IsDroppedDown: boolean;
begin
   result:= FDroppedDown;
end;

procedure TwwDBCustomCombo.Loaded;
begin
  if FButtonWidth=0 then
     FButton.Width:= wwmax(GetSystemMetrics(SM_CXVSCROLL), 15);
  if (parent<>Nil) or (owner<>nil) then  { 11/17/97 - parent=nil causes runtime error }
     UpdateButtonPosition;
  inherited Loaded;
end;

procedure TwwDBCustomCombo.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  FButton.Enabled := Enabled;
end;

procedure TwwDBCustomCombo.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  Invalidate;
end;

procedure Register;
begin
{  RegisterComponents('InfoPower', [TwwDBComboDlg]);}
end;

procedure TwwDBCustomCombo.InvalidateTransparentButton;
var r: TRect;
begin
   if ButtonEffects.Flat or ButtonEffects.Transparent then begin
     with FBtnControl do begin
         r:= Rect(parent.left + Left, parent.Top+top,
               parent.left + left+ Width, parent.top + Top + Height);
        { Calling with True causes flicker for any control that is invalidated.
          Test with False to see if any side effects  }
         InvalidateRect(parent.parent.handle, @r, False);
         if not wwIsTransparentParent(self) then
            parent.parent.Update;
      end
   end;
   FButton.invalidate;
end;

procedure TwwComboDlgButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
   inherited MouseUp(Button, Shift, X, Y);
   TwwDBComboDlg(parent.parent).InvalidateTransparentButton;
end;

procedure TwwComboDlgButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var dropDownListVisible: boolean;
begin

  if TwwDBComboDlg(Parent.Parent).Patch[2]=True then
  begin
     inherited MouseDown (Button, Shift, X, Y);
     TwwDBComboDlg(parent.parent).InvalidateTransparentButton;
     exit;
  end;

  with TwwDBComboDlg(Parent.Parent) do
  begin

    dropDownListVisible:= IsDroppedDown;

    if isDroppedDown then
    begin
      if (Handle <> GetFocus) and CanFocus then
      begin
        SetFocus;
        if GetFocus <> Handle then Exit;
      end;
    end;
  end;
  inherited MouseDown (Button, Shift, X, Y);
  if not wwIsTransparentParent(Parent.Parent) then
     Update;  { 4/17/98 - Finish drawing down state }

  with TwwDBComboDlg(Parent.Parent) do
  begin
    if not dropDownListVisible and isDroppedDown then exit; {skip remaining code }

    if IsDroppedDown then begin
//      if InList then GridClick(self);  {Now hiding drop down so select current selection } {5/14/97 - if InList}
      CloseUp(True)
    end
    else
    begin
      DropDown;
    end;
  end;


end;

{procedure TwwDBCustomCombo.SetFlatButton(val: boolean);
begin
   if FFlatButton <>val then
   begin
      FFlatButton:= val;
      FButton.Flat:= FFlatButton or FFlatButtonTransparent;
      FButton.Glyph.Handle:= LoadComboGlyph;
      FButton.Invalidate;
   end;
end;

procedure TwwDBCustomCombo.SetFlatButtonTransparent(val: boolean);
begin
   if FFlatButtonTransparent<>val then
   begin
      FFlatButtonTransparent:= val;
      FButton.Flat:= FFlatButton or FFlatButtonTransparent;
      FButton.Glyph.Handle:= LoadComboGlyph;
      FButton.Invalidate;
   end;
end;

function TwwDBCustomCombo.GetFlatButton: boolean;
begin
   result:= FFlatButton;
//   result:= FButton.Flat;
end;
}

procedure TwwDBCustomCombo.CMExit(var Message: TCMExit);
begin
   inherited;
   if ButtonEffects.Flat then FButton.invalidate;
end;

procedure TwwDBCustomCombo.CMEnter(var Message: TCMEnter);
begin
   inherited;
   if ButtonEffects.Flat then begin
      UpdateButtonPosition;
      FButton.invalidate;
   end
end;

function TwwDBCustomCombo.IsCustom: Boolean;
begin
  Result := ButtonStyle = cbsCustom;
end;

function TwwDBCustomCombo.GetButtonGlyph: TBitmap;
begin
  result:= FButton.Glyph;
end;

procedure TwwDBCustomCombo.SetButtonGlyph(Value: TBitmap);
begin
  FButton.Glyph.Assign(Value);
  Invalidate;
end;
{
procedure TwwDBCustomCombo.GlyphChanged(Sender: TObject);
begin
   FButton.Glyph.Handle:= LoadComboGlyph;
   Invalidate;
end;
}
Procedure TwwDBCustomCombo.SetButtonWidth(val: integer);
begin
   if FButtonWidth<>val then
   begin
      FButtonWidth:= val;
      if val<>0 then Button.Width:= val
      else Button.Width:= wwmax(GetSystemMetrics(SM_CXVSCROLL), 15);
      UpdateButtonPosition;
   end
end;

function TwwDBCustomCombo.GetButtonWidth: integer;
begin
   result:= FButtonWidth;
end;


end.