explbtn.pas

地址档案管理系统

procedure TExplorerButton.SetAlignment(value: TAlignment);
begin
  FAlignment := value;
  Repaint;
end;

procedure TExplorerButton.SetAllowAllUp(value: Boolean);
var i: Integer;
  otherbutton: TExplorerButton;
begin
  FAllowAllUp := value;
  if FGroupIndex <> 0 then
  begin
    for i := 0 to Parent.ControlCount - 1 do
    begin
      if Parent.Controls[i] is TExplorerButton then
      begin
        otherbutton := (Parent.Controls[i] as TExplorerButton);
        if (otherbutton <> Self) and (otherbutton.GroupIndex = GroupIndex) then
          otherbutton.FAllowAllUp := value;
      end
    end
  end
end;

procedure TExplorerButton.SetBevelStyle(value: TBevelStyle);
begin
  FBevelStyle := value;
  Repaint;
end;

procedure TExplorerButton.SetBitmap(value: TBitmap);
begin
  FBitmap.Assign(value);
  if not FBitmap.Empty then
    FBitmap.Dormant;
end;

procedure TExplorerButton.SetCaption(value: TCaption);
begin
  FCaption := value;
  if boIconOnly in FOptions then
    Hint := RemoveAmpersand(FCaption)
  else
    Repaint;
end;

procedure TExplorerButton.SetDisabledBitmap(value: TBitmap);
begin
  FDisabledBitmap.Assign(value);
  if not FDisabledBitmap.Empty then
    FDisabledBitmap.Dormant;
end;

procedure TExplorerButton.SetDown(value: Boolean);
var i: Integer;
  otherbutton: TExplorerButton;
begin
  if FDown = value then
     Exit;
  if FGroupIndex <> 0 then
  begin
    FDown := value;
    Repaint;
       if FDown = True then
    begin
      for i := 0 to Parent.ControlCount - 1 do
         begin
        if Parent.Controls[i] is TExplorerButton then
        begin
          otherbutton := (Parent.Controls[i] as TExplorerButton);
          if (otherbutton <> Self) and (otherbutton.GroupIndex = GroupIndex)
            and (otherbutton.FDown = True) then
          begin
            otherbutton.FDown := False;
            otherbutton.Repaint;
          end
        end
      end
    end
  end
end;

procedure TExplorerButton.SetDropDown(value: TPopupMenu);
begin
  FDropDown := value;
  if  FDropDown <> nil then
    ExplorerPopup := nil;
  if boPopupMark in FOptions then
    Invalidate;
end;

procedure TExplorerButton.SetDropDownStyle(value: TExplorerButtonDropDownStyle);
begin
  if FDropDownStyle = value then
     Exit;
  FDropDownStyle := value;
  GetLost;
end;

procedure TExplorerButton.SetEnabled(value: Boolean);
begin
  if FEnabled = value then
     Exit;
  FEnabled := value;
  GetLost;
end;

procedure TExplorerButton.SetExplorerPopup(value: TExplorerPopup);
begin
  if value <> FExplorerPopup then
  begin
    FExplorerPopup := value;
     if value <> nil then
        DropDownMenu := nil;
  end
end;

procedure TExplorerButton.SetGroupIndex(value: Integer);
begin
  if FGroupIndex = value then
    Exit;
  FGroupIndex := value;
  if (FGroupIndex = 0) and FDown then
  begin
    FDown := False;
    Repaint;
  end;
end;

procedure TExplorerButton.SetLayout(value: TExplorerButtonLayout);
begin
  if FLayout = value then
     Exit;
  FLayout := value;
  Repaint;
end;

procedure TExplorerButton.SetNoFocusBitmap(value: TBitmap);
begin
  FNoFocusBitmap.Assign(value);
  if not FNoFocusBitmap.Empty then
    FNoFocusBitmap.Dormant;
end;

procedure TExplorerButton.SetOptions(value: TExplorerButtonOptions);
var
  wasTransparent: Boolean;
begin
  if boTransparent in FOptions then
    wasTransparent := True
  else
    wasTransparent := False;
  FOptions := value;
  if (boIconOnly in FOptions) and (Hint = '') then
  begin
    Hint := RemoveAmpersand(FCaption);
    ShowHint := True;
  end
  else if (not(boIconOnly in FOptions)) and (Hint = RemoveAmpersand(FCaption)) then
  begin
    Hint := '';
    ShowHint := False;
  end;
  if (((boTransparent in FOptions) and not wasTransparent)
      or (not (boTransparent in FOptions) and wasTransparent))
      and not (csDesigning in ComponentState) then
  begin
    backbitmapCreated := False;
     RecreateWnd;
     Parent.Refresh;
  end
  else
    Repaint;
end;

procedure TExplorerButton.SetShadingType(value: TExplorerButtonShadingType);
begin
  if value <> FShadingType then
  begin
    FShadingType := value;
    if (not FBitmap.Empty) and FNoFocusBitmap.Empty and not (csLoading in ComponentState) then
    begin
      CreateGrayscaleBitmap(IBitmap, FBitmap);
      Repaint;
    end;
  end;
end;

procedure TExplorerButton.SetUnselectedFontColor(value: TColor);
begin
  if FUnselectedFontColor <> value then
  begin
    FUnselectedFontColor := value;
    Repaint;
  end;
end;

procedure TExplorerButton.WMLButtonDown(var msg: TWMLButtonDown);
var p: TPoint;
  theMsg: TMsg;
  lpPoint: TPoint;
begin
  if not GetParentForm(Self).Active then
    GetParentForm(Self).BringToFront;

  if Enabled and Visible then
  begin
     if FDropDownStyle = ddsIExplorer then
      Pushed := True
     else
     begin
       if msg.XPos < Width - 11 then
        Pushed := True
        else
          popupPushed := True
     end;

    MouseIn := True;
    Repaint;
    if ((FDropDown <> nil) or popupPushed or ((FExplorerPopup <> nil) and (FDropDownStyle = ddsIExplorer)))
      and Assigned(FOnDropDownClick) then
      FOnDropDownClick(Self);

     if (not popupOpened) and Assigned(FExplorerPopup)
       and (((FDropDownStyle = ddsOffice) and popupPushed) or (FDropDownStyle = ddsIExplorer)) then
     begin
          PostMessage(Handle, WM_EXPLORERPOPUPOPEN, 0, 0);
     end
     else
    if (not popupOpened) and (FDropDown <> nil) and ((FDropDownStyle = ddsIExplorer) or popupPushed) then
    begin
        p := ClientToScreen(Point(0, Height));

      FDropDown.Popup(p.x, p.y);
      while PeekMessage(theMsg, HWND(0), WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
        ;
      if GetCapture <> 0 then
        SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
      GetCursorPos(lpPoint);
      lpPoint := Parent.ScreenToClient(lpPoint);
      if not  ((lpPoint.y > top) and (lpPoint.y < top + height)
        and (lpPoint.x > left) and (lpPoint.x < left + width)) then
        MouseIn := False;

       if FDropDownStyle = ddsIExplorer then
        Pushed := False
        else
          popupPushed := False;
      Repaint;
    end
     else
       SetCaptureControl(Self);
  end;
   MouseDown(mbLeft, KeysToShiftState(msg.Keys), msg.XPos, msg.YPos);
end;

procedure TExplorerButton.WMLButtonUp(var msg: TWMLButtonUp);
var i: Integer;
  otherbutton: TExplorerButton;
  lpPoint: TPoint;
begin
  if Enabled and Visible and (Pushed or popupPushed) then
  begin
    if Pushed and MouseIn and (GroupIndex <> 0) then
    begin
      (* Was Down -> allow up state if AllowAllUp is True *)
      if FDown then
      begin
        if FAllowAllUp then
          FDown := False
      end
      else
      (* Was Up *)
      begin
        (* Set 'up' all buttons having the same parent
          and GroupIndex *)
        for i := 0 to Parent.ControlCount - 1 do
        begin
          if Parent.Controls[i] is TExplorerButton then
          begin
            otherbutton := (Parent.Controls[i] as TExplorerButton);
            if (otherbutton <> Self) and (otherbutton.GroupIndex = GroupIndex)
              and (otherbutton.FDown = True) then
            begin
              otherbutton.Down := False;
              otherbutton.Repaint;
            end
          end
        end;
        FDown := True;
      end;
    end;

    Pushed := False;

     if MouseCapture then
       SetCaptureControl(nil);
    if MouseIn then
    begin
      GetCursorPos(lpPoint);
      lpPoint := Parent.ScreenToClient(lpPoint);
      if not  ((lpPoint.y > top) and (lpPoint.y < top + height)
        and (lpPoint.x > left) and (lpPoint.x < left + width)) then
        MouseIn := False;
      Invalidate;
      (* If the popup is not defined, activate the click event *)
        if ((FDropDownStyle = ddsOffice) and (not popupPushed))
           or ((FDropDownStyle = ddsIExplorer) and (FDropDown = nil) and (FExplorerPopup = nil)) then
        Click;
    end;
    popupPushed := False;
     MouseUp(mbLeft, KeysToShiftState(msg.Keys), msg.XPos, msg.YPos);
  end;
end;

procedure TExplorerButton.CMMouseEnter(var msg: TMessage);
begin
  MouseIn := True;
  if not FDown and FEnabled then
    Repaint;
        if Assigned(FOnEnter) then
                FOnEnter(Self);
  (*
   * Automatic opening of the popup panel if there is already
   * an opened popup
   *)
  if Assigned(activeExplorerPopup) and (activeExplorerButton <> Self) then
  begin
    if Parent <> activeExplorerPopup then
     begin
     activeExplorerButton.PopupOpened := False;
    activeExplorerPopup.Close;
    activeExplorerButton.Repaint;
     activeExplorerPopup := nil;
     if Assigned(FExplorerPopup) then
     begin
          {
            Needed to avoir recursive opens (could quickly lead to
            stack space exhaustion)
          }
          PostMessage(Handle, WM_EXPLORERPOPUPOPEN, 0, 0);
     end
     end
  end;
end;

procedure TExplorerButton.CMSysColorChange(var msg: TMessage);
begin
  if FNoFocusBitmap.Empty then
    CreateGrayscaleBitmap(IBitmap, FBitmap);
  Regenerate;
end;

procedure TExplorerButton.CMMouseLeave(var msg: TMessage);
begin
  MouseIn := False;
  if not FDown and FEnabled then
    Repaint;
        if Assigned(FOnExit) then
                FOnExit(Self);
end;

procedure TExplorerButton.WMRButtonUp(var msg: TWMRButtonUp);
var
  theMsg: TMsg;
  lpPoint: TPoint;
begin
  inherited;
  if (PopupMenu <> nil) or (TForm(GetParentForm(Self)).PopupMenu <> nil) then
  begin
    while PeekMessage(theMsg, HWND(0), WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
      ;
    if GetCapture <> 0 then
      SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
    GetCursorPos(lpPoint);
    lpPoint := Parent.ScreenToClient(lpPoint);
    if not  ((lpPoint.y > top) and (lpPoint.y < top + height)
      and (lpPoint.x > left) and (lpPoint.x < left + width)) then
      MouseIn := False;
    Pushed := False;
     popupPushed := False;
    Repaint;
  end;
end;

procedure TExplorerButton.WMLButtonDblClk(var msg: TWMLButtonDblClk);
begin
  if ((FDropDownStyle = ddsOffice) and (msg.XPos < Width - 11))
     or ((FDropDownStyle = ddsIExplorer) and (FExplorerPopup = nil)) then
    DblClick;
end;

procedure TExplorerButton.WMSize(var msg: TWMSize);
begin
     inherited;
     if (boTransparent in FOptions) and painted and not (csDesigning in ComponentState) then
     begin
        backBitmapCreated := False;
        RecreateWnd;
     end;

     if FakeResize then
     begin
       FakeResize := False;
       SetBounds(Left, Top, Width - 1, Height);
      Exit;
     end;

     if FButtonSize = bsCustom then
     begin
         updatingSize := True;
        CustomWidth := Width;
        CustomHeight := Height;
        updatingSize := False;
     end else if FButtonSize = bsLarge then
     begin
         updatingSize := True;
        LargeWidth := Width;
        LargeHeight := Height;
        updatingSize := False;
     end else if FButtonSize = bsSmall then
     begin
         updatingSize := True;
        SmallWidth := Width;
        SmallHeight := Height;
        updatingSize := False;
     end
end;

procedure TExplorerButton.WMMove(var msg: TWMMove);
begin
     inherited;
     if (boTransparent in FOptions) and painted and