View Issue Details
ID | Project | Category | View Status | Date Submitted | Last Update |
---|---|---|---|---|---|
0006105 | JEDI VCL | 00 JVCL Components | public | 2013-03-17 22:30 | 2014-12-04 16:26 |
Reporter | Dec | Assigned To | obones | ||
Priority | normal | Severity | minor | Reproducibility | always |
Status | resolved | Resolution | suspended | ||
Product Version | |||||
Target Version | Fixed in Version | ||||
Summary | 0006105: TJvCheckBox.CalcAutoSize | ||||
Description | In some Windows themes checkboxes (and radiobutton) has its own font. Even if you assign the font you want to see nothing changes and Windows paint control with its "personal" font. In this case procedure TJvCheckBox.CalcAutoSize calculates wrong size because it use font assigned by user but must use "personal" font of control. There is a screenshot in the attached file which show current result of TJvCheckBox.CalcAutoSize and result of function which I want to offer. My source code in the Additional Information. | ||||
Additional Information | function _CalcAutoSize(AControl: TControl; ACanvas: TCanvas; const ACaption: string; AWordWrap: Boolean; APartID, AStateID: Integer): Boolean; const Flags: array [Boolean] of Cardinal = (DT_SINGLELINE, DT_WORDBREAK); var ASize: TSize; procedure Process; var R: TRect; AWidth, AHeight: Integer; begin R := Rect(0, 0, AControl.ClientWidth, AControl.ClientHeight); if ACaption <> '' then begin DrawText(ACanvas.Handle, ACaption, -1, R, Flags[AWordWrap] or DT_LEFT or DT_NOCLIP or DT_CALCRECT); AWidth := (R.Right - R.Left) + ASize.cx + 4; AHeight := R.Bottom - R.Top; end else begin AWidth := ASize.cx; AHeight := ASize.cy; end; if AWidth < ASize.cx then AWidth := ASize.cx; if AHeight < ASize.cy then AHeight := ASize.cy; AControl.ClientWidth := AWidth; AControl.ClientHeight := AHeight; Result := True; end; var Font: TLogFont; HF: HFONT; Save: TFont; begin Result := False; if StyleServices.Enabled and (StyleServices is TUxThemeStyle) then begin if GetThemePartSize(StyleServices.Theme[teButton], ACanvas.Handle, APartID, AStateID, nil, TS_TRUE, ASize) <> S_OK then ASize := GetDefaultCheckBoxSize; Inc(ASize.cy, 4); if GetThemeFont(TUxThemeStyle(StyleServices).Theme[teButton], ACanvas.Handle, APartID, AStateID, TMT_FONT, Font) = S_OK then begin HF := CreateFontIndirect(Font); if HF <> 0 then begin Save := TFont.Create; try Save.Assign(ACanvas.Font); try ACanvas.Font.Handle := HF; Process; finally ACanvas.Font := Save; end; finally Save.Free; end; end; end else Process; end; end; procedure TJvdecCheckBox.CalcAutoSize; begin if (Parent = nil) or not AutoSize or (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit; if not _CalcAutoSize(Self, Canvas, Caption, WordWrap, BP_CHECKBOX, CBS_CHECKEDNORMAL) then inherited CalcAutoSize; end; procedure TJvdecRadioButton.CalcAutoSize; begin if (Parent = nil) or not AutoSize or (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit; if not _CalcAutoSize(Self, Canvas, Caption, WordWrap, BP_RADIOBUTTON, CBS_CHECKEDNORMAL) then inherited CalcAutoSize; end; | ||||
Tags | No tags attached. | ||||
2013-03-17 22:30
|
|
|
Please try with the latest JVCL version in GIT (or daily zip) and then send us a zipped file containing the sources of an application showing the issue. |
|
No news, suspending the issue |
Date Modified | Username | Field | Change |
---|---|---|---|
2013-03-17 22:30 | Dec | New Issue | |
2013-03-17 22:30 | Dec | File Added: Gif.gif | |
2013-12-13 10:47 | obones | Note Added: 0020715 | |
2013-12-13 10:47 | obones | Status | new => feedback |
2014-12-04 16:26 | obones | Note Added: 0021096 | |
2014-12-04 16:26 | obones | Status | feedback => resolved |
2014-12-04 16:26 | obones | Resolution | open => suspended |
2014-12-04 16:26 | obones | Assigned To | => obones |