rvofficeradiobtn.pas

richviewaction 1.58 需要richview 1.9.46

      property ParentBiDiMode;
      property OnEndDock;
      property OnStartDock;
      {$ENDIF}
      property Caption;
      property Color;
      property Ctl3D;
      property DragCursor;
      property DragMode;
      property Enabled;
      property Font;
      property ParentColor;
      property ParentCtl3D;
      property ParentFont;
      property ParentShowHint;
      property PopupMenu;
      property ShowHint;
      property TabOrder;
      property TabStop default True;
      property Visible;
      property OnClick;
      {$IFDEF RICHVIEWDEF5}
      property OnContextPopup;
      {$ENDIF}
      property OnDragDrop;
      property OnDragOver;
      property OnEndDrag;
      property OnEnter;
      property OnExit;
      property OnStartDrag;
  end;

implementation

{==============================================================================}

function RVU_Charset2CodePage(Charset: TFontCharset): Cardinal;
begin
  // PLEASE REPORT ME ABOUT ERRORS IN THIS TABLE
  case Charset of
    DEFAULT_CHARSET:
      Result := CP_ACP;
    OEM_CHARSET:
       Result := CP_OEMCP;
    MAC_CHARSET:
       Result := CP_MACCP;
    SYMBOL_CHARSET:
      Result := CP_ACP; // ???
    VIETNAMESE_CHARSET:
       Result := 1258;
    ANSI_CHARSET:
      Result := 1252;   // Windows 3.1 US (ANSI)
    SHIFTJIS_CHARSET:
       Result := 932;   // Japan
    HANGEUL_CHARSET:
       Result := 949;   // Korean
    JOHAB_CHARSET:
       Result := 1361;  // Korean (Johab)
    GB2312_CHARSET:
       Result := 936;   // Chinese (PRC, Singapore)
    CHINESEBIG5_CHARSET:
       Result := 950;   // Chinese (Taiwan, Hong Kong)
    GREEK_CHARSET:
       Result := 1253;  // Windows 3.1 Greek
    TURKISH_CHARSET:
       Result := 1254;  // Windows 3.1 Turkish
    HEBREW_CHARSET:
       Result := 1255;   // Hebrew
    ARABIC_CHARSET:
       Result := 1256;   // Arabic
    BALTIC_CHARSET:
       Result := 1257;   // Baltic
    RUSSIAN_CHARSET:
       Result := 1251;   // Windows 3.1 Cyrillic
    THAI_CHARSET:
       Result := 874;    // Thai
    EASTEUROPE_CHARSET:
       Result := 1250;   // Windows 3.1 Eastern European
    else
       Result := CP_ACP;
  end;
end;

function RVU_AnsiToUnicode(CodePage: Cardinal; const s: String): WideString;
var l: Integer;
begin
  if Length(s)=0 then begin
    Result := '';
    exit;
  end;
  l := MultiByteToWideChar(CodePage,MB_PRECOMPOSED or MB_USEGLYPHCHARS,
    PChar(s), Length(s), nil, 0);
  if (l=0) and (CodePage<>CP_ACP) then begin
    CodePage := CP_ACP;
    l := MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_USEGLYPHCHARS,
      PChar(s), Length(s), nil, 0);
  end;
  if l<>0 then begin
    SetLength(Result, l);
    MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_USEGLYPHCHARS, PChar(s), Length(s),
      Pointer(Result), l);
    end
  else begin
    SetLength(Result, Length(s));
    for l := 1 to Length(Result) do
      Result[l] := '?';
  end;
end;

function _GetWideString(const s: String; Charset: TFontCharset): WideString;
begin
  Result := RVU_AnsiToUnicode(RVU_Charset2CodePage(Charset), s);
end;

{==============================================================================}

procedure AdjustValue(var Value: Integer; Min,Max: Integer);
begin
  if Value<Min then
    Value := Min;
  if Value>Max then
    Value := Max;
end;

{============================ TRVOfficeRadioButton ==============================}
constructor TRVOfficeRadioButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 100;
  Height := 100;
  FFillColor := clWindow;
  FSelColor := clHighlight;
  FSelWidth := 2;
  FTextAreaHeight := 30;
  FDisabled3D := True;
  FImageIndex := -1;
  FUseXPThemes := True;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  {$IFDEF USERVKSDEVTE}
  AddThemeNotification(Self);
  {$ENDIF}
  //DoubleBuffered := True;
end;
{------------------------------------------------------------------------------}
destructor TRVOfficeRadioButton.Destroy;
begin
  {$IFDEF USERVKSDEVTE}
  RemoveThemeNotification(Self);
  {$ENDIF}
  FImageChangeLink.Free;
  inherited;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style:=(Params.Style or BS_OWNERDRAW or BS_NOTIFY or WS_GROUP) and not BS_RADIOBUTTON;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.CNCommand(var Msg: TWMCommand);
begin
  inherited;
  case Msg.NotifyCode of
    BN_SETFOCUS:
      begin
        Checked := True;
      end;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.BMSetCheck(var Msg: TMessage);
begin
  Invalidate;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Msg.Result := 1;
  {$IFDEF USERVKSDEVTE}
  DrawControlBackground(Self, Msg.DC);
  {$ENDIF}
  if (FThemeEdit=0) then
    exit;
  {$IFNDEF USERVKSDEVTE}
  RV_DrawThemeParentBackground(Handle, Msg.DC, nil);
  {$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.CMDenySubclassing(var Msg: TMessage);
begin
  Msg.Result := 1;
end;
{------------------------------------------------------------------------------}
function TRVOfficeRadioButton.DoCustomDraw(Canvas: TCanvas;
  R: TRect): Boolean;
begin
  Result := True;
  if Assigned(FOnCustomDraw) then begin
    InflateRect(R,-4-SelWidth, -4-SelWidth);
    FOnCustomDraw(Self, Canvas, R, Result);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.DrawTo(Canvas: TCanvas; const ARect: TRect; AFocused: Boolean);
var r: TRect;
    Flags: LongInt;
    y: Integer;
    TAH: Integer;
    Form: TCustomForm;
    State: Integer;
    Draw3dBorder: Boolean;
    {...............................................}
    procedure MakeSquare(var r: TRect);
    begin
      if R.Right-R.Left>R.Bottom-R.Top then begin
        R.Left := ((R.Right-R.Left)-(R.Bottom-R.Top)) div 2;
        R.Right := R.Left+(R.Bottom-R.Top);
        end
      else if R.Right-R.Left<R.Bottom-R.Top then begin
        R.Top := ((R.Bottom-R.Top)-(R.Right-R.Left)) div 2;
        R.Bottom := R.Top+(R.Right-R.Left);
      end;
    end;
    {...............................................}
    procedure GetImageRect(var R: TRect);
    begin
      R := ARect;
      if TextPosition=orbtpBottom then
        dec(R.Bottom, TAH)
      else
        inc(R.Top, TAH);
      if FSquare then
        MakeSquare(R);
    end;
    {...............................................}
    procedure GetTextRect(var R: TRect);
    begin
      R := ARect;
      if TextPosition=orbtpBottom then
        R.Top := R.Bottom-TAH
      else
        R.Bottom := TAH;
    end;
    {...............................................}
    procedure RedrawBackground(DC: HDC);
    var
      LastOrigin: TPoint;
    begin
      GetWindowOrgEx(DC, LastOrigin);
      SetWindowOrgEx(DC, LastOrigin.X + Left, LastOrigin.Y + Top, nil);
      Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
      Parent.Perform(WM_PAINT, Integer(DC), 0);
      SetWindowOrgEx(DC, LastOrigin.X, LastOrigin.Y, nil);
    end;
begin
  Draw3dBorder := True;
  TAH := TextAreaHeight;
  Form := GetParentForm(Self);
  if (Form<>nil) and (Form is TForm) then
    TAH := TAH * Screen.PixelsPerInch div TForm(Form).PixelsPerInch;
  // Background
  {$IFDEF USERVKSDEVTE}
  if IsThemeAvailable(CurrentTheme) then
  begin
    GetImageRect(R);
    DrawControlBackground(Self, Canvas.Handle);
    if CurrentTheme.IsEditDefined(kescEdit) then begin
      CurrentTheme.EditDraw(kescEdit, Canvas, EditInfo(R, kedsNormal));
      Draw3dBorder := False;
    end;
  end
  else
  begin
    with ARect do
      IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
    DrawControlBackground(Self, Canvas.Handle);
    SelectClipRgn(Canvas.Handle, 0);
    if (FThemeEdit=0) {or
       (RV_DrawThemeParentBackground(Handle, Canvas.Handle, @ARect)<>S_OK)} then begin
      Canvas.Brush.Color := Color;
      Canvas.Brush.Style := bsSolid;
      Canvas.FillRect(ARect);
    end;
    // Rectangle
    GetImageRect(R);
    if Enabled then
      Canvas.Brush.Color := FillColor
    else
      Canvas.Brush.Color := clBtnFace;
    Canvas.FillRect(R);
    if FThemeEdit<>0 then
    begin
      if not Enabled then
        State := ETS_DISABLED
      else if AFocused then
        State := ETS_FOCUSED
      else
        State := ETS_NORMAL;
      RV_DrawThemeBackground(FThemeEdit, Canvas.Handle, EP_EDITTEXT, State, R, nil);
      Draw3dBorder := False;
    end;
  end;
  {$ELSE}
  if (FThemeEdit<>0) then begin
    with ARect do
      IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
    RedrawBackground(Canvas.Handle);
    SelectClipRgn(Canvas.Handle, 0);
  end;
  if (FThemeEdit=0) {or
     (RV_DrawThemeParentBackground(Handle, Canvas.Handle, @ARect)<>S_OK)} then begin
    Canvas.Brush.Color := Color;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(ARect);
  end;
  // Rectangle
  GetImageRect(R);
  if Enabled then
    Canvas.Brush.Color := FillColor
  else
    Canvas.Brush.Color := clBtnFace;
  Canvas.FillRect(R);
  if FThemeEdit<>0 then
  begin
    if not Enabled then
      State := ETS_DISABLED
    else if AFocused then
      State := ETS_FOCUSED
    else
      State := ETS_NORMAL;
    RV_DrawThemeBackground(FThemeEdit, Canvas.Handle, EP_EDITTEXT, State, R, nil);
    Draw3dBorder := False;
  end;
  {$ENDIF}

  // Image
  if DoCustomDraw(Canvas, R) and (Images<>nil) and (ImageIndex>=0) and
     (ImageIndex<Images.Count) then begin
    R.Left := (R.Left+R.Right - Images.Width) div 2;
    R.Top := (R.Top+R.Bottom - Images.Height) div 2;
    Images.Draw(Canvas, R.Left, R.Top, ImageIndex
      {$IFDEF RICHVIEWDEF4}, Enabled{$ENDIF});
  end;
  // Focus
  GetImageRect(R);
  if Draw3dBorder then
    DrawEdge(Canvas.Handle,R,EDGE_SUNKEN,BF_RECT);
  if AFocused and not LargeSelection then begin
    InflateRect(r,-3,-3);
    Canvas.Font.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := FillColor;
    Canvas.DrawFocusRect(R);
    InflateRect(r,-1,-1);
    end
  else if not LargeSelection then
    InflateRect(r,-4,-4);
  // Selection
  if Checked then begin
    Canvas.Pen.Color := SelColor;
    Canvas.Pen.Style := psInsideFrame;
    Canvas.Pen.Width := FSelWidth;
    Canvas.Brush.Style := bsClear;
    with R do
      Canvas.Rectangle(Left,Top,Right,Bottom);
  end;
  if TextAreaHeight>0 then begin
    // Text Background