sradiobutton.pas

Alpha Controls.v5.46b Source

end;

function TsRadioButton.IsHintStored: Boolean;
begin
  Result := TntControl_IsHintStored(Self)
end;
{$ENDIF}

procedure TsRadioButton.Loaded;
begin
  inherited;
  SkinData.Loaded;
  AdjustSize;
end;

procedure TsRadioButton.PaintControl(DC: HDC);
begin
  if not FCommonData.Updating and not (Assigned(FadeTimer) and FadeTimer.Enabled) then begin
    PrepareCache;
    UpdateCorners(FCommonData, 0);
    BitBlt(DC, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
  end;
end;

procedure TsRadioButton.PaintGlyph(Bmp: TBitmap);
var
  R : TRect;
  function CurrentMaskRect : TRect; begin
    if FPressed then begin
      Result := Rect(2 * GlyphWidth, 0, 3 * GlyphWidth, GlyphHeight);
    end
    else if ControlIsActive(FCommonData) and not ReadOnly then begin
      Result := Rect(GlyphWidth, 0, 2 * GlyphWidth, GlyphHeight);
    end
    else begin
      Result := Rect(0, 0, GlyphWidth, GlyphHeight);
    end;
  end;
begin
  if FCommonData.FCacheBmp.Width < 1 then exit;
  Bmp.PixelFormat := pf24bit;
  R := CheckRect;
  CopyByMask(Rect(R.Left, R.Top, R.Right, R.Bottom), CurrentMaskRect, FCommonData.FCacheBmp, Bmp, EmptyCI, True);
end;

procedure TsRadioButton.PaintHandler(M: TWMPaint);
var
  PS: TPaintStruct;
  DC : hdc;
  SavedDC: hdc;
begin
  CtrlParentColor := TsHackedControl(Parent).Color;
  DC := M.DC;
  if DC = 0 then begin
    BeginPaint(Handle, PS);
    DC := GetDC(Handle);
  end;
  SavedDC := SaveDC(DC);
  try
    if not FCommonData.Updating then PaintControl(DC) else FCommonData.Updating := True;
  finally
    CtrlParentColor := clFuchsia;
    RestoreDC(DC, SavedDC);
    if M.DC = 0 then begin
      ReleaseDC(Handle, DC);
      EndPaint(Handle, PS);
    end;
  end;
end;

procedure TsRadioButton.PrepareCache;
var
  CI : TCacheInfo;
begin
  FCommonData.InitCacheBmp;
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  try
    CI := GetParentCache(FCommonData);
    PaintItem(FCommonData, CI, True, integer(ControlIsActive(FCommonData) and not ReadOnly),
                Rect(0, 0, FCommonData.FCacheBmp.Width, Height), Point(Left, Top), FCommonData.FCacheBmp, False);
    DrawCheckText;
    DrawCheckArea;
    if not Enabled then BmpDisabledKind(FCommonData.FCacheBmp, FDisabledKind, Parent, CI, Point(Left, Top));
    FCommonData.BGChanged := False
  finally
  end;
end;

{$IFDEF TNTUNICODE}
procedure TsRadioButton.SetCaption(const Value: TWideCaption);
begin
  TntControl_SetText(Self, Value);
end;
{$ENDIF}

{$IFNDEF DELPHI7UP}
procedure TsRadioButton.SetWordWrap(const Value: boolean);
begin
  if FWordWrap <> Value then begin
    FWordWrap := Value;
    FCommonData.BGChanged := True;
    if AutoSize then AutoSize := False;
    Repaint;
  end;
end;
{$ENDIF}

procedure TsRadioButton.SetDisabledKind(const Value: TsDisabledKind);
begin
  if FDisabledKind <> Value then begin
    FDisabledKind := Value;
    FCommonData.Invalidate;
  end;
end;

procedure TsRadioButton.SetGlyphChecked(const Value: TBitmap);
begin
  FGlyphChecked.Assign(Value);
  if AutoSize then AdjustSize;
  FCommonData.Invalidate;
end;

procedure TsRadioButton.SetGlyphUnChecked(const Value: TBitmap);
begin
  FGlyphUnChecked.Assign(Value);
  if AutoSize then AdjustSize;
  Invalidate;
end;

{$IFDEF TNTUNICODE}
procedure TsRadioButton.SetHint(const Value: WideString);
begin
  TntControl_SetHint(Self, Value);
end;
{$ENDIF}

procedure TsRadioButton.SetMargin(const Value: integer);
begin
  if FMargin <> Value then begin
    FMargin := Value;
    if AutoSize then AdjustSize;
    Invalidate;
  end;
end;

procedure TsRadioButton.SetReadOnly(const Value: boolean);
begin
  FReadOnly := Value;
end;

procedure TsRadioButton.SetShowFocus(const Value: Boolean);
begin
  if FShowFocus <> Value then begin
    FShowFocus := Value;
    Invalidate;
  end;
end;

procedure TsRadioButton.SetTextIndent(const Value: integer);
begin
  if FTextIndent <> Value then begin
    FTextIndent := Value;
    if AutoSize then AdjustSize;
    Invalidate;
  end;
end;

function TsRadioButton.SkinCheckRect(i: integer): TRect;
var
  h, w, hdiv : integer;
begin
  h := SkinGlyphHeight(i);
  w := SkinGlyphWidth(i);
  hdiv := (Height - h) div 2;
  if GetControlsAlignment = taRightJustify then begin
    Result := Rect(Margin, hdiv, Margin + w, h + hdiv);
  end
  else begin
    Result := Rect(Width - w - Margin, hdiv, Width - Margin, h + hdiv);
  end;
end;

function TsRadioButton.SkinGlyphHeight(i: integer): integer;
begin
  if Assigned(FCommonData.SkinManager.ma[i].Bmp) then Result := FCommonData.SkinManager.ma[i].Bmp.Height div 2 else Result := HeightOf(FCommonData.SkinManager.ma[i].R) div (FCommonData.SkinManager.ma[i].MaskType + 1);
end;

function TsRadioButton.SkinGlyphWidth(i: integer): integer;
begin
  if Assigned(FCommonData.SkinManager.ma[i].Bmp) then Result := FCommonData.SkinManager.ma[i].Bmp.Width div 3 else Result := WidthOf(FCommonData.SkinManager.ma[i].R) div FCommonData.SkinManager.ma[i].ImageCount;
end;

procedure TsRadioButton.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      StopFading(FadeTimer, FCommonData);
      CommonWndProc(Message, FCommonData);
      if HandleAllocated then SendMessage(Handle, BM_SETCHECK, Integer(Checked), 0);
      if not (csDesigning in ComponentState) and (@Ac_SetWindowTheme <> nil) then Ac_SetWindowTheme(Handle, nil, nil);
      Repaint;
      exit
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      SetClassLong(Handle, GCL_STYLE, GetClassLong(Handle, GCL_STYLE) and not CS_VREDRAW and not CS_HREDRAW);
      StopFading(FadeTimer, FCommonData);
      CommonWndProc(Message, FCommonData);
      AdjustSize; // v5.32
      Repaint;
      exit
    end;
    AC_PREPARECACHE : PrepareCache;
    AC_STOPFADING : begin StopFading(FadeTimer, FCommonData); Exit end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      StopFading(FadeTimer, FCommonData);
      CommonWndProc(Message, FCommonData);
      exit
    end
  end;
  if (FCommonData <> nil) and FCommonData.Skinned(True) then case Message.Msg of
    CM_MOUSEENTER : if Enabled and not (csDesigning in ComponentState) and not FCommonData.FMouseAbove then begin
      FCommonData.FMouseAbove := True;
      DoChangePaint(FadeTimer, FCommonData, False, EventEnabled(aeMouseEnter, FAnimatEvents));
    end;
    CM_MOUSELEAVE : if Enabled and not (csDesigning in ComponentState) then begin
      FCommonData.FMouseAbove := False;
      FPressed := False;
      DoChangePaint(FadeTimer, FCommonData, False, EventEnabled(aeMouseLeave, FAnimatEvents));
    end;
    WM_SETFOCUS, CM_ENTER : if not (csDesigning in ComponentState) then begin
      if Enabled then begin
        inherited;
        FCommonData.BGChanged := True;
        if FadeTimer = nil then Repaint else FadeTimer.Change; // Fast repaint
      end;
      Exit;
    end;
    WM_KILLFOCUS, CM_EXIT: if not (csDesigning in ComponentState) then begin
      if Enabled then begin
        if FadeTimer <> nil then StopFading(FadeTimer, FCommonData);
        inherited;
        FCommonData.FFocused := False;
        FCommonData.FMouseAbove := False;
        FCommonData.Invalidate;
        Exit
      end;
    end;
  end;
  if not ControlIsReady(Self) then inherited else begin
    CommonWndProc(Message, FCommonData);
    if FCommonData.Skinned(True) then begin
      if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
        AC_ENDPARENTUPDATE : if FCommonData.Updating or FCommonData.HalfVisible then begin
          FCommonData.Updating := False;
          PaintHandler(TWMPaint(MakeMessage(WM_PAINT, 0, 0, 0)));
        end
      end
      else case Message.Msg of
        WM_ENABLE, WM_NCPAINT : Exit; // Disabling of blinking when switched
{$IFDEF CHECKXP}
        WM_UPDATEUISTATE : begin
          if SkinData.Skinned and UseThemes and not (csDesigning in ComponentState) and (@Ac_SetWindowTheme <> nil)
            then Ac_SetWindowTheme(Handle, ' ', ' ');
          Exit;
        end;
{$ENDIF}
        CM_ENABLEDCHANGED : begin inherited; Repaint; Exit end;
        BM_SETSTATE : begin
          Exit;
        end;
        BM_SETCHECK : begin
          FCommonData.BGChanged := True;
          if (FadeTimer <> nil) and (FadeTimer.FadeLevel < FadeTimer.Iterations) then begin
            FadeTimer.Enabled := False;
//            FCommonData.BGChanged := True;
            Repaint;
          end;
          case Message.WParam of
            0 : Checked := False;
            1 : Checked := True;
          end;
          if not (csDesigning in ComponentState) then begin
            if Checked then DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseUp, FAnimatEvents), fdUp) else DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseUp, FAnimatEvents));
          end
          else FCommonData.Invalidate;
          Exit;
        end;
        WM_ERASEBKGND : begin
          Message.Result := 1;
          Exit;
        end;
        WM_PRINT : begin
          SkinData.Updating := False;
          PaintHandler(TWMPaint(Message));
        end;
        WM_PAINT : begin
          PaintHandler(TWMPaint(Message));
          if not (csDesigning in ComponentState) then Exit;
        end;
        CM_TEXTCHANGED : begin
          if AutoSize then AdjustSize;
          Repaint;
          Exit;
        end;
        WM_KEYDOWN : if Enabled and not (csDesigning in ComponentState) and (TWMKey(Message).CharCode = VK_SPACE) then begin
          if ReadOnly then Exit;
          FPressed := True;
          if not Focused then begin
            ClicksDisabled := True;
            Windows.SetFocus(Handle);
            ClicksDisabled := False;
          end;
          Repaint;
          if Assigned(OnKeyDown) then OnKeydown(Self, TWMKeyDown(Message).CharCode, KeysToShiftState(word(TWMKeyDown(Message).KeyData)));
          Exit;
        end;
        WM_LBUTTONDBLCLK, WM_LBUTTONDOWN : if not (csDesigning in ComponentState) and Enabled and (DragMode = dmManual) then begin
          if ReadOnly then Exit;
          FPressed := True;
          DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseDown, FAnimatEvents));

          if not Focused then begin
            ClicksDisabled := True;
            Windows.SetFocus(Handle);
            ClicksDisabled := False;
          end;

          if WM_LBUTTONDBLCLK = Message.Msg then begin
            if Assigned(OnDblClick) then OnDblClick(Self)
          end
          else if Assigned(OnMouseDown) then OnMouseDown(Self, mbLeft, KeysToShiftState(TWMMouse(Message).Keys), TWMMouse(Message).XPos, TWMMouse(Message).YPos);
          Exit;
        end;
        WM_KEYUP : if not (csDesigning in ComponentState) and Enabled then begin
          if ReadOnly then Exit;
          if FPressed then begin
            FPressed := False;
            Checked := True; //!
          end;
          Repaint;
          if Assigned(OnKeyUp) then OnKeyUp(Self, TWMKey(Message).CharCode, KeysToShiftState(TWMKey(Message).KeyData));
          Exit;
        end;
        WM_LBUTTONUP : if not (csDesigning in ComponentState) and Enabled then begin
          if ReadOnly then Exit;
          if FPressed then begin
            FPressed := False;
            Checked := True; //!
          end;
          Repaint;
          if Assigned(OnMouseUp) then OnMouseUp(Self, mbLeft, KeysToShiftState(TWMMouse(Message).Keys), TWMMouse(Message).XPos, TWMMouse(Message).YPos);
          Exit;
        end;
      end
    end else case Message.Msg of
      BM_SETSTATE, BM_SETCHECK : if ReadOnly then Exit;
    end;
    inherited;
  end;
end;

end.