wwradiogroup.pas

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

  begin
      if (key in [vk_left, vk_up]) then
      begin
          if (FButtons.count>0) and TGroupButton(FButtons[0]).Focused then
          begin
             SendToParent;
             exit; //5/17/2002-Don't call inherited.
          end
      end
      else if (key in [vk_right, vk_down]) then
      begin
          if (FButtons.count>0) and TGroupButton(FButtons[FButtons.Count-1]).Focused then
          begin
             SendToParent;
             exit; //5/17/2002-Don't call inherited.
          end;
      end;
  end;

  if (message.charcode in [vk_up, vk_down, vk_left, vk_right]) then
    TwwCustomRadioGroup(Owner).InCNKeyDown:= True;
  try
    inherited;
  finally
    TwwCustomRadioGroup(Owner).InCNKeyDown:= False;
  end;
end;

procedure TwwCustomRadioGroup.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  // 7/30/04 - Fix return probelm outside grid as this code should only be for grid
  if ((key=13) or (key=vk_f2)) and wwIsClass(parent.classtype, 'TwwDBGrid') then parent.setfocus;
end;

constructor TwwCustomRadioGroup.Create(AOwner: TComponent);
begin
  FFrame:= TwwEditFrame.create(self);
  inherited Create(AOwner);
  ShowFocusRect:= True;
  TabStop:= True;
  FShowText:= True;
  FIndents:= TwwRGWinButtonIndents.create(self);
  FButtonFrame:= TwwRGEditFrame.create(self);
  FButtonFrame.FocusBorders:= [];
  FButtonFrame.NonFocusBorders:= [];
  FAlignment:= taRightJustify;

  ControlStyle := [csSetCaption, csDoubleClicks];
//  ControlStyle := [csSetCaption, csDoubleClicks, csAcceptsControls];
  FButtons := TList.Create;
  FItems := TStringList.Create;
  TStringList(FItems).OnChange := ItemsChange;
  FItemIndex := -1;
  FColumns := 1;
  FShowBorder:= True;
  FShowGroupCaption:= True;
end;

destructor TwwCustomRadioGroup.Destroy;
begin
  SetButtonCount(0);
  TStringList(FItems).OnChange := nil;
  FItems.Free;
  FButtons.Free;
  FButtonFrame.Free;
  FFrame.Free;
  FIndents.Free;
  inherited Destroy;
end;

procedure TwwCustomRadioGroup.FlipChildren(AllLevels: Boolean);
begin
  { The radio buttons are flipped using BiDiMode }
end;

procedure TwwCustomRadioGroup.ArrangeButtons;
var
  ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;
  DeferHandle: THandle;
  ALeft: Integer;
  TempWidth,TempHeight, TempButtonWidth, TempButtonHeight : integer;
begin
  if (FButtons.Count <> 0) and not FReading then
  begin
    DC := GetDC(0);
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    SelectObject(DC, SaveFont);
    ReleaseDC(0, DC);
    ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns;
    TempWidth:= Width;
    if (HaveBorder) then TempWidth:= TempWidth - 7;
    if (not ButtonFrame.enabled) then TempWidth:= TempWidth - 4;
    if NoSpacing then
    begin
       if Frame.Enabled then  TempWidth:= TempWidth - 2;
       ButtonWidth := (TempWidth div FColumns);  // 1 less so right-border has space for framing
    end
    else begin
       ButtonWidth := ((TempWidth-1) div FColumns) - 1;  // 1 less so right-border has space for framing
       if Frame.Enabled then ButtonWidth:= ButtonWidth - 2;
    end;

    if HaveBorder then
    begin
       if ShowGroupCaption then
       begin
          I := Height - Metrics.tmHeight - 5;
          ButtonHeight := I div ButtonsPerCol;
          TopMargin := Metrics.tmHeight + 1 + (I mod ButtonsPerCol) div 2
       end
       else begin
          I := Height - 5;
          ButtonHeight := I div ButtonsPerCol;
          TopMargin := 2 + (I mod ButtonsPerCol) div 2
       end;
    end
    else begin
//       I := Height - 3;
       if NoSpacing then i:= Height
       else I:= Height - 3;
       if Frame.Enabled then I:= I - 2;
       ButtonHeight := I div ButtonsPerCol;
       TopMargin := 2;//(I mod ButtonsPerCol) div 2;
    end;
    TempHeight:= i;
    DeferHandle := BeginDeferWindowPos(FButtons.Count);
    try
      for I := 0 to FButtons.Count - 1 do
        with TGroupButton(FButtons[I]) do
        begin
          BiDiMode := Self.BiDiMode;
          ALeft := (I div ButtonsPerCol) * ButtonWidth + 9; { At least left =1}
          if not HaveBorder and Frame.Enabled then
             ALeft:= ALeft + 1;
          if ButtonFrame.enabled then ALeft:= ALeft - 4;
          if (not HaveBorder) then ALeft:= ALeft - 4;

          if UseRightToLeftAlignment then
            ALeft := Self.ClientWidth - ALeft - ButtonWidth;
          //!!! PYW Shortened Buttonwidth or they touch the right edge.  Also made the ButtonHeight a tad smaller.
          Frame.AssignAll(FButtonFrame);
          WordWrap:= self.WordWrap;
          Alignment:= self.Alignment;
          if (self.parent is TCustomGrid) or IsTransparent then
          begin
             Frame.Enabled:= True;
//             if (not ButtonFrame.Transparent) and not (parent is TCustomGrid) then
//              Frame.Transparent:= False; //Transparent;
             if parent is TCustomGrid then
                Frame.Transparent:=False
             else if IsTransparent then
                Frame.Transparent:= True;
          end;
          if self.TransparentActiveItem and Transparent then AlwaysTransparent:= True;
          Images:= self.images;
          ShowFocusRect:= self.ShowFocusRect;
          GlyphImages:= self.GlyphImages;
          Indents.assign(self.indents);
          DoCreateRadioButton(FButtons[i]);

          if NoSpacing and ((i >=(ButtonsPerCol*(FColumns-1)))) then
             TempButtonWidth:= TempWidth - (ButtonWidth * (FColumns-1))
          else
             TempButtonWidth:= ButtonWidth;

          if NoSpacing and ((i mod ButtonsPerCol) = ButtonsPerCol-1)then
             TempButtonHeight:= TempHeight - (ButtonHeight * (ButtonsPerCol-1))
          else
             TempButtonHeight:= ButtonHeight;

          DeferHandle := DeferWindowPos(DeferHandle, Handle, 0,
            ALeft,
            (I mod ButtonsPerCol) * ButtonHeight + TopMargin,
            TempButtonWidth{-4}, TempButtonHeight{-1},
            SWP_NOZORDER or SWP_NOACTIVATE);
          Visible := True;
        end;
    finally
      EndDeferWindowPos(DeferHandle);
    end;
  end;
end;

procedure TwwCustomRadioGroup.DoCreateRadioButton(RadioButton: TwwRadioButton);
begin
   if Assigned(FOnCreateRadioButton) then
      FOnCreateRadioButton(Self, RadioButton);
end;

procedure TwwCustomRadioGroup.ButtonClick(Sender: TObject);
begin
  if not FUpdating then
  begin
    FItemIndex := FButtons.IndexOf(Sender);
    Changed;
    Click;
    if Transparent {and ButtonFrame.Transparent }then Invalidate;
  end;
end;

procedure TwwCustomRadioGroup.ItemsChange(Sender: TObject);
begin
  if not FReading then
  begin
    if FItemIndex >= FItems.Count then FItemIndex := FItems.Count - 1;
    UpdateButtons;
  end;
end;

procedure TwwCustomRadioGroup.Loaded;
begin
  inherited Loaded;
  ArrangeButtons;
end;

procedure TwwCustomRadioGroup.ReadState(Reader: TReader);
begin
  FReading := True;
  inherited ReadState(Reader);
  FReading := False;
  UpdateButtons;
end;

procedure TwwCustomRadioGroup.SetButtonCount(Value: Integer);
begin
  while FButtons.Count < Value do TGroupButton.InternalCreate(Self);
  while FButtons.Count > Value do TGroupButton(FButtons.Last).Free;
end;

procedure TwwCustomRadioGroup.SetColumns(Value: Integer);
begin
  if Value < 1 then Value := 1;
  if Value > 16 then Value := 16;
  if FColumns <> Value then
  begin
    FColumns := Value;
    ArrangeButtons;
    Invalidate;
  end;
end;

procedure TwwCustomRadioGroup.SetItemIndex(Value: Integer);
begin
  if FReading then FItemIndex := Value else
  begin
    if Value < -1 then Value := -1;
    if Value >= FButtons.Count then Value := FButtons.Count - 1;
    if FItemIndex <> Value then
    begin
      if FItemIndex >= 0 then
        TGroupButton(FButtons[FItemIndex]).Checked := False;
      FItemIndex := Value;
      if FItemIndex >= 0 then
        TGroupButton(FButtons[FItemIndex]).Checked := True;
    end;
  end;
end;

procedure TwwCustomRadioGroup.SetItems(Value: TStrings);
begin
  FItems.Assign(Value);
end;

procedure TwwCustomRadioGroup.UpdateButtons;
var
  I: Integer;
begin
  SetButtonCount(FItems.Count);
  for I := 0 to FButtons.Count - 1 do
    TGroupButton(FButtons[I]).Caption := FItems[I];
  if (FItemIndex >= 0) and (FItemIndex<FButtons.Count) then // 8/7/01 - Avoid Idx out of range
  begin
    FUpdating := True;
    TGroupButton(FButtons[FItemIndex]).Checked := True;
    FUpdating := False;
  end;
  ArrangeButtons;
  Invalidate;
end;

procedure TwwCustomRadioGroup.CMEnabledChanged(var Message: TMessage);
var
  I: Integer;
begin
  inherited;
  for I := 0 to FButtons.Count - 1 do
    TGroupButton(FButtons[I]).Enabled := Enabled;
end;

procedure TwwCustomRadioGroup.CMFontChanged(var Message: TMessage);
begin
  inherited;
  ArrangeButtons;
end;

procedure TwwCustomRadioGroup.WMSize(var Message: TWMSize);
begin
  inherited;
  ArrangeButtons;
end;

function TwwCustomRadioGroup.CanModify: Boolean;
begin
  Result := True;
end;

procedure TwwCustomRadioGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
  Control: TControl;
begin
  for I := 0 to ControlCount - 1 do
  begin
    Control := Controls[I];
    if Control is TwwRadioButton then exit;
    if Control.Owner = Root then Proc(Control);
  end;
end;

procedure TwwCustomRadioGroup.SetParent(AParent: TWinControl);
begin
   inherited;
   if AParent <>nil then
      ArrangeButtons;
end;

type
  TwwCheatGridCast = class(TwwDBGrid);

procedure TwwRadioGroup.Paint;
var r: TRect;
  function DrawHighlight: boolean;
  begin
     result:= False;
     if wwIsClass(parent.classtype, 'TwwDBGrid') then begin
       result:= parent.focused and
                not wwInPaintCopyState(ControlState)
     end
  end;
begin
   LastBrushColor:= clNone;

   if (parent is TCustomGrid) and not (csPaintCopy in ControlState)
      and parent.focused then
   begin
      r:= ClientRect;
      Canvas.Brush.Color:= Color;
      if DrawHighlight then begin
         Canvas.Brush.Color := clHighlight;
         Canvas.Font.Color := clHighlightText;
      end;

      {  Honor grid's colors when painting cell }
      if DrawHighlight and (wwIsClass(parent.classtype, 'TwwCustomDBGrid')) then
      begin
         if (DataLink.Field<>nil) then
             TwwCheatGridCast(Parent).DoCalcCellColors(GetField, [], True, Canvas.Font, Canvas.Brush);
      end;

      Canvas.FillRect(r);
      LastBrushColor:= Canvas.Brush.Color;
      if DrawHighlight then
      begin
        r:= ClientRect;
        Canvas.Brush.Color := clHighlight;
        Canvas.Font.Color := clHighlightText;
        Canvas.Pen.Color:= clHighlight;
        Canvas.FrameRect(r);
        SetTextColor(Canvas.Handle, ColorToRGB(clHighlightText));
        SetBkColor(Canvas.Handle, ColorToRGB(clHighlight));
        Canvas.DrawFocusRect(r);
      end
   end;
   inherited;
end;

procedure TwwCustomRadioGroup.Paint;
var
  H: Integer;
  TempRect, R, TextR: TRect;
  Flags: Longint;
  Text: string;
  StartText, EndText: integer;

  {$ifdef wwUseThemeManager}
  Details: TThemedElementDetails;
  CheckboxStyle: TThemedButton;
  PaintRect: TRect;
  CaptionRect: TRect;
  {$endif}

  Function GetRect: TRect;
  begin
     with Canvas do begin
       Font := Self.Font;
       if not ShowGroupCaption then
         H:= 2
       else
         H := TextHeight('0');
       Result := Rect(0, H div 2 - 1, Width, Height);
     end;
  end;

begin
   // 4/15/01 - Back-color support
   if (Frame.Enabled and (not Frame.Transparent)) and
      (not FFocused) and (Frame.NonFocusColor<>clNone) then
  begin
     Canvas.Brush.Color:= Frame.NonFocusColor;
     tempRect:= ClientRect;
//     tempRect.Top:= GetRect.Top;
     Canvas.FillRect(tempRect);
  end;

  if not HaveBorder then begin
     if Frame.Enabled then
      wwDrawEdge(self, Frame, Canvas, FFocused);
     exit;
  end;


   Text:= Caption;
   if Text='' then exit;

   if not ShowGroupCaption then
      H:= 2
   else
      H:= Canvas.TextHeight('0');

   if UseRightToLeftAlignment then
   begin
      R:= GetRect; // 7/8/02 - Not initialized before
      TextR := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
      TextR.Left:= TextR.left - 2;
   end
   else
      TextR := Rect(8, 0, 0, H);

   with Canvas do begin
     R:= GetRect;