wwradiogroup.pas

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

     if not ShowGroupCaption then begin
        StartText:= 0;
        EndText:= 0;
     end
     else begin
        StartText:= TextR.Left;
        EndText:= TextR.Left + Canvas.TextWidth(Text);
     end;

     if wwUseThemes(self) then
     begin
       {$ifdef wwUseThemeManager}
       if self.enabled then CheckboxStyle:= tbGroupBoxNormal
       else CheckboxStyle:= tbGroupBoxDisabled;
       Details := ThemeServices.GetElementDetails(CheckboxStyle);
       PaintRect := R;
       CaptionRect:= Rect(StartText-1, TextR.top, EndText+1, TextR.Bottom);
       with CaptionRect do
          ExcludeClipRect(Handle, Left, Top, Right, Bottom);
       ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);

       //Paint background over lines just drawn
//       ThemeServices.DrawParentBackground(self.Handle, Canvas.Handle, @Details, False, @TempTextRect)

       SelectClipRgn(Handle, 0);
       if Text <> '' then
          ThemeServices.DrawText(Handle, Details, Text, CaptionRect, DT_LEFT, 0);
       exit;
       {$endif}
     end
     else begin
       if Ctl3D then
       begin
         Inc(R.Left);
         Inc(R.Top);
         Brush.Color := clBtnHighlight;
         Pen.Color:= clBtnHighlight;
         if not ShowGroupCaption then begin
            PolyLine([Point(0, r.top), Point(r.left, r.top), Point(r.left, r.bottom-1),
                 Point(r.right-1, r.bottom-1), Point(r.right-1, r.top),
                 Point(0, r.top)]);
         end
         else begin
            PolyLine([Point(TextR.Left, r.top), Point(r.left, r.top), Point(r.left, r.bottom-1),
                   Point(r.right-1, r.bottom-1), Point(r.right-1, r.top),
                 Point(TextR.Left + Canvas.TextWidth(Text), r.top)]);
         end;
         OffsetRect(R, -1, -1);
         Brush.Color := clBtnShadow;
         Pen.Color:= clBtnShadow;
       end else
         Brush.Color := clWindowFrame;
       PolyLine([Point(StartText, r.top), Point(r.left, r.top), Point(r.left, r.bottom-1),
               Point(r.right-1, r.bottom-1), Point(r.right-1, r.top),
               Point(EndText, r.top)]);
     end;
   end;

   if not UseRightToLeftAlignment then
     R := Rect(8, 0, 0, H)
   else
     R := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
   Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);

   if not ShowGroupCaption then exit;
   with Canvas do begin
      SetBkMode(Handle, windows.TRANSPARENT);
      //      if FFrame.Transparent then
      DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
{      if (not Transparent) then
      begin
         if Frame.NonFocusColor<>clNone then
            Brush.Color:= Frame.NonFocusColor
         else
            Brush.Color := Color;
      end;
}
      SetBkMode(Handle, windows.TRANSPARENT);
      DrawText(Handle, PChar(Text), Length(Text), R, Flags);
   end
end;

procedure TwwCustomRadioGroup.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if SkipSetChildFocus then exit;

  if (ItemIndex=-1) then
  begin
     if (FButtons.Count>0) then
        TGroupButton(FButtons[0]).SetFocus
     else exit
  end
  else
     TGroupButton(FButtons[ItemIndex]).SetFocus
end;

{ TDBRadioGroup }

constructor TwwRadioGroup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
  FValues := TStringList.Create;
end;

destructor TwwRadioGroup.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  FValues.Free;
  inherited Destroy;
end;

procedure TwwRadioGroup.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
  begin
     if (FDataLink <> nil) and (AComponent = DataSource) then
        DataSource := nil
     else if AComponent = Images then Images := nil
     else if AComponent = GlyphImages then GlyphImages:= nil
     else if (AComponent = FController) then FController:= nil;
  end;
end;

function TwwRadioGroup.UseRightToLeftAlignment: Boolean;
begin
  Result := inherited UseRightToLeftAlignment;
end;

procedure TwwRadioGroup.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then
    Value := FDataLink.Field.Text else
    Value := '';
end;

procedure TwwRadioGroup.UpdateData(Sender: TObject);
begin
  if FDataLink.Field <> nil then FDataLink.Field.Text := Value;
end;

function TwwRadioGroup.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TwwRadioGroup.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TwwRadioGroup.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TwwRadioGroup.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TwwRadioGroup.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TwwRadioGroup.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TwwRadioGroup.GetField: TField;
begin
  Result := FDataLink.Field;
end;

function TwwRadioGroup.GetButtonValue(Index: Integer): string;
begin
  if (Index < FValues.Count) and (FValues[Index] <> '') then
    Result := FValues[Index]
  else if Index < Items.Count then
    Result := Items[Index]
  else
    Result := '';
end;

function TwwRadioGroup.GetDisplayValue(const Value: string): string;
var
   I: Integer;
begin
   result:= '';
   for I := 0 to Items.Count - 1 do
     if Value = GetButtonValue(I) then
     begin
       result:= TGroupButton(FButtons[i]).Caption;
       Break;
     end;
end;

procedure TwwRadioGroup.SetValue(const Value: string);
var
  I, Index: Integer;
begin
  if FValue <> Value then
  begin
    FInSetValue := True;
    try
      Index := -1;
      for I := 0 to Items.Count - 1 do
        if Value = GetButtonValue(I) then
        begin
          Index := I;
          Break;
        end;
      ItemIndex := Index;
    finally
      FInSetValue := False;
    end;
    FValue := Value;
    Change;
  end;
end;

procedure TwwRadioGroup.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    if ItemIndex >= 0 then
      TRadioButton(Controls[ItemIndex]).SetFocus else
      TRadioButton(Controls[0]).SetFocus;
    raise;
  end;
  inherited;
end;

procedure TwwRadioGroup.Click;
begin
  if not FInSetValue then
  begin
    inherited Click;
    if ItemIndex >= 0 then Value := GetButtonValue(ItemIndex);
    if FDataLink.Editing then FDataLink.Modified;
  end;
end;

procedure TwwRadioGroup.SetItems(Value: TStrings);
begin
  Items.Assign(Value);
  DataChange(Self);
end;

procedure TwwRadioGroup.SetValues(Value: TStrings);
begin
  FValues.Assign(Value);
  DataChange(Self);
end;

procedure TwwRadioGroup.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TwwRadioGroup.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    #8, ' ': FDataLink.Edit;
    #27: FDataLink.Reset;
  end;
end;

function TwwRadioGroup.CanModify: Boolean;
begin
  result:= inherited CanModify;
  if ReadOnly then result:= False;

  if result and (FDataLink.DataSet<>nil) then
     Result := FDataLink.Edit
end;

function TwwRadioGroup.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (DataLink <> nil) and
    DataLink.ExecuteAction(Action);
end;

function TwwRadioGroup.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (DataLink <> nil) and
    DataLink.UpdateAction(Action);
end;

Function TwwRadioGroup.GetColor: TColor;
begin
   result:= inherited Color;
end;

procedure TwwRadioGroup.SetColor(Value: TColor);
begin
   inherited Color:= Value;
end;

Function TwwRadioGroup.IsColorStored;
begin
   result:= not ParentColor;
end;

function TwwCustomRadioGroup.HaveBorder: boolean;
begin
   result:= ShowBorder and not (parent is TCustomGrid)
end;

procedure TwwRGWinButtonIndents.Repaint(FWinControl: TWinControl);
begin
//   if csDestroying in FWinControl.ComponentState then exit;

   TwwRadioGroup(FWinControl).UpdateButtons;
   if FWinControl.parent is TCustomGrid then
      FWinControl.parent.Invalidate;
end;

function TGroupButton.GetLastBrushColor: TColor;
begin
   result:= TwwRadioGroup(Owner).LastBrushColor;
end;

function TGroupButton.GetPaintCopyTextColor: TColor;
begin
   result:= TwwRAdioGroup(Owner).PaintCopyTextColor;
end;

function TGroupButton.GetShowText: boolean;
begin
   result:= TwwRadioGroup(Owner).ShowText;
end;

procedure TwwCustomRadioGroup.CMEnter(var Message: TCMEnter);
var exStyle, origStyle: longint;
begin
   FFocused:= True;
   inherited;

   if Frame.Enabled and Frame.Transparent and not Transparent then begin
     OrigStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
     exStyle:= OrigStyle and not WS_EX_TRANSPARENT;
     Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);
   end;

   if Frame.Enabled then begin
      Invalidate;
//      InvalidateBorder;
   end
end;

procedure TwwCustomRadioGroup.CMExit(var Message: TCMExit);
//var exStyle, origStyle: longint;
begin
  FFocused:= False;
  inherited;
  if (Frame.Enabled and Frame.Transparent) and not Transparent then begin
     RecreateWnd;
  end;
  if Frame.Enabled then Invalidate;
end;

procedure TwwCustomRadioGroup.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  if Frame.Enabled and (Frame.NonFocusColor<>clNone) and (not FFocused) then
     message.result:=1
  else if wwUseThemes(self) then
  begin
    {$ifdef wwDelphi7Up}
    if not (parent is TCustomGrid) then
    begin
      { Get the parent to draw its background into the control's background. }
      ThemeServices.DrawParentBackground(Handle, Message.DC, nil, False);
      message.result:=1;
    end
    else inherited
    {$else}
    message.result:=1;  // default causes gray in lischke theme manager
    {$endif}
  end
  else inherited;
end;

function TwwCustomRadioGroup.IsTransparent: boolean;
begin
   result:= inherited IsTransparent;
   if (not result) and Frame.Enabled and Frame.Transparent then
      result:= not FFocused;
end;

function TwwCustomRadioGroup.StoreItemIndex: boolean;
begin
   result:= True;
end;

function TwwRadioGroup.StoreItemIndex: boolean;
begin
   // 10/01/2001 - Correct typo that caused itemindex not to get stored in unbound case.
   result:= DataSource=nil
end;

procedure TwwCustomRadioGroup.SetController(Value: TwwController);
begin
   if FController<>Value then
   begin
      wwUpdateController(TComponent(FController), Value, self);
      if FController<>nil then
      begin
         FFrame.Assign(FController.Frame);
         if HandleAllocated then RecreateWnd;
      end
   end
end;


procedure TGroupButton.CMEnter(var Message: TCMEnter);
var rg: TwwCustomRadioGroup;
begin
   inherited;
   rg:=parent as TwwCustomRadioGroup;
   if (rg<>nil) then
   begin
      if rg.InCNKeyDown and TwwCustomRadioGroup(parent).ArrowsModifySelection then
      begin
          if rg.CanModify then SetChecked(True);
      end
   end;
end;



end.