এটিও লক্ষ করা গুরুত্বপূর্ণ যে ব্যবহারকারীর ডিপিআইকে সম্মান জানানো আপনার আসল কাজের একটি উপসেট মাত্র:
ব্যবহারকারীর ফন্ট আকার সম্মান
কয়েক দশক ধরে, উইন্ডোজ পিক্সেলের পরিবর্তে ডায়ালগ ইউনিটগুলি ব্যবহার করে ধারণাটি সম্পাদনকারী বিন্যাসের সাহায্যে এই সমস্যাটি সমাধান করেছে । একটি "ডায়ালগ ইউনিট" সংজ্ঞায়িত করা হয় যাতে ফন্টের গড় চরিত্রটি হয়
- 4 টি ডায়ালগ ইউনিট (dlus) প্রশস্ত, এবং
- 8 টি ডায়ালগ ইউনিট (ক্লাস) উচ্চ
ডেলফি একটি (বগি) ধারণার সাথে জাহাজটি দেয় Scaled, যেখানে কোনও ফর্ম স্বয়ংক্রিয়ভাবে এর উপর ভিত্তি করে সামঞ্জস্য করার চেষ্টা করে
- ব্যবহারকারীর উইন্ডোজ ডিপিআই সেটিংস, আয়াত
- বিকাশকারীর মেশিনে ডিপিআই সেটিং যিনি সর্বশেষ ফর্মটি সংরক্ষণ করেছিলেন
আপনি যখন সমস্যার সাথে ফর্মটি ডিজাইন করেছেন তার চেয়ে আলাদা কোনও ফন্ট ব্যবহার করে ব্যবহারকারী সমস্যাটি সমাধান করে না:
অথবা
- বিকাশকারী ** তাহোমা 8pt * (যেখানে গড় চরিত্রটি
5.94px x 13.00px96dpi এ রয়েছে) দিয়ে ফর্মটি ডিজাইন করেছেন
- Segoe UI 9pt (যেখানে গড় চরিত্রটি
6.67px x 15px96dpi এ রয়েছে) এর সাথে চলমান একজন ব্যবহারকারী
একজন ভাল বিকাশকারী হিসাবে আপনি আপনার ব্যবহারকারীর ফন্ট পছন্দগুলি সম্মান করতে যাচ্ছেন। এর অর্থ হ'ল নতুন ফন্টের আকারটি মেলাতে আপনার ফর্মের সমস্ত নিয়ন্ত্রণও স্কেল করতে হবে:
- 12.29% (6.67 / 5.94) দ্বারা অনুভূমিকভাবে সমস্ত প্রসারিত করুন
- 15.38% (15/13) দ্বারা উল্লম্বভাবে সবকিছু প্রসারিত করুন
Scaled আপনার জন্য এটি পরিচালনা করবে না।
এটি আরও খারাপ হয় যখন:
- Segoe UI 9pt এ আপনার ফর্মটি ডিজাইন করেছেন (উইন্ডোজ ভিস্তা, উইন্ডোজ 7, উইন্ডোজ 8 ডিফল্ট)
- ব্যবহারকারী Segoe UI 14pt চালাচ্ছেন (যেমন আমার পছন্দ) যা
10.52px x 25px
এখন আপনাকে সব কিছু স্কেল করতে হবে
- অনুভূমিকভাবে 57.72%
- উল্লম্বভাবে 66.66%
Scaled আপনার জন্য এটি পরিচালনা করবে না।
আপনি যদি স্মার্ট হন তবে দেখতে পাবেন কীভাবে ডিপিআইকে সম্মান দেওয়া অবান্তর নয়:
- Segoe UI 9pt @ 96dpi (6.67px x 15px) দিয়ে ডিজাইন করা ফর্ম
- ব্যবহারকারী Segoe UI 9pt @ 150dpi (10.52px x 25px) দিয়ে চলছে
আপনি ব্যবহারকারীর ডিপিআই সেটিংসের দিকে নজর দিচ্ছেন না, আপনি তাদের ফন্টের আকারটি দেখছেন । দু'জন ব্যবহারকারী চলছে
- Segoe UI 14pt @ 96dpi (10.52px x 25px)
- Segoe UI 9pt @ 150dpi (10.52px x 25px)
একই ফন্ট চলমান । ডিপিআই হ'ল একটি জিনিস যা হরফ আকারকে প্রভাবিত করে; ব্যবহারকারীর পছন্দগুলি অন্যটি।
StandardizeFormFont
ক্লোভিস লক্ষ্য করেছে যে আমি এমন একটি ফাংশন উল্লেখ করেছি যা StandardizeFormFontকোনও ফর্মের ফন্টকে স্থির করে, এবং এটি নতুন ফন্টের আকারের আকার দেয়। এটি একটি স্ট্যান্ডার্ড ফাংশন নয়, তবে কার্যকরীতার একটি সম্পূর্ণ সেট যা বোরল্যান্ড কখনও পরিচালনা করেনি এমন সাধারণ কাজটি সম্পাদন করে।
function StandardizeFormFont(AForm: TForm): Real;
var
preferredFontName: string;
preferredFontHeight: Integer;
begin
GetUserFontPreference({out}preferredFontName, {out}preferredFontHeight);
//e.g. "Segoe UI",
Result := Toolkit.StandardizeFormFont(AForm, PreferredFontName, PreferredFontHeight);
end;
উইন্ডোজ 6 টি বিভিন্ন ফন্ট আছে; উইন্ডোজে কোনও "ফন্ট সেটিং" নেই।
তবে আমরা অভিজ্ঞতা থেকে জানি যে আমাদের ফর্মগুলির আইকন শিরোনাম ফন্ট সেটিংসটি অনুসরণ করা উচিত
procedure GetUserFontPreference(out FaceName: string; out PixelHeight: Integer);
var
font: TFont;
begin
font := Toolkit.GetIconTitleFont;
try
FaceName := font.Name; //e.g. "Segoe UI"
//Dogfood testing: use a larger font than we're used to; to force us to actually test it
if IsDebuggerPresent then
font.Size := font.Size+1;
PixelHeight := font.Height; //e.g. -16
finally
font.Free;
end;
end;
একবার আমরা ফন্টের আকার আমরা ফর্ম স্কেল হবে জানি করতে , আমরা ফর্ম সাম্প্রতিক হরফ উচ্চতা (পেতে পিক্সেলে ), এবং যে গুণক দ্বারা আপ স্কেল।
উদাহরণস্বরূপ, আমি যদি ফর্মটি এখানে সেট করে দিচ্ছি -16এবং ফর্মটি বর্তমানে রয়েছে -11তবে আমাদের দ্বারা সম্পূর্ণ ফর্মটি স্কেল করতে হবে:
-16 / -11 = 1.45454%
মানককরণ দুটি ধাপে ঘটে। নতুন: পুরানো ফন্টের আকারের অনুপাত অনুসারে ফর্মটি প্রথম স্কেল করুন। তারপরে নতুন ফন্টটি ব্যবহার করতে আসলে নিয়ন্ত্রণগুলি (পুনরাবৃত্তভাবে) পরিবর্তন করুন।
function StandardizeFormFont(AForm: TForm; FontName: string; FontHeight: Integer): Real;
var
oldHeight: Integer;
begin
Assert(Assigned(AForm));
if (AForm.Scaled) then
begin
OutputDebugString(PChar('WARNING: StandardizeFormFont: Form "'+GetControlName(AForm)+'" is set to Scaled. Proper form scaling requires VCL scaling to be disabled, unless you implement scaling by overriding the protected ChangeScale() method of the form.'));
end;
if (AForm.AutoScroll) then
begin
if AForm.WindowState = wsNormal then
begin
OutputDebugString(PChar('WARNING: StandardizeFormFont: Form "'+GetControlName(AForm)+'" is set to AutoScroll. Form designed size will be suseptable to changes in Windows form caption height (e.g. 2000 vs XP).'));
if IsDebuggerPresent then
Windows.DebugBreak; //Some forms would like it (to fix maximizing problem)
end;
end;
if (not AForm.ShowHint) then
begin
AForm.ShowHint := True;
OutputDebugString(PChar('INFORMATION: StandardizeFormFont: Turning on form "'+GetControlName(AForm)+'" hints. (ShowHint := True)'));
if IsDebuggerPresent then
Windows.DebugBreak; //Some forms would like it (to fix maximizing problem)
end;
oldHeight := AForm.Font.Height;
//Scale the form to the new font size
// if (FontHeight <> oldHeight) then For compatibility, it's safer to trigger a call to ChangeScale, since a lot of people will be assuming it always is called
begin
ScaleForm(AForm, FontHeight, oldHeight);
end;
//Now change all controls to actually use the new font
Toolkit.StandardizeFont_ControlCore(AForm, g_ForceClearType, FontName, FontHeight,
AForm.Font.Name, AForm.Font.Size);
//Return the scaling ratio, so any hard-coded values can be multiplied
Result := FontHeight / oldHeight;
end;
এখানে আসলে একটি ফর্ম স্কেলিংয়ের কাজ। এটি বোরল্যান্ডের নিজস্ব Form.ScaleByপদ্ধতিতে বাগের চারপাশে কাজ করে । প্রথমে এটি ফর্মের সমস্ত অ্যাঙ্কর অক্ষম করতে হবে, তারপরে স্কেলিংটি সম্পাদন করবে, তারপরে অ্যাঙ্কারগুলি পুনরায় সক্ষম করবে:
TAnchorsArray = array of TAnchors;
procedure ScaleForm(const AForm: TForm; const M, D: Integer);
var
aAnchorStorage: TAnchorsArray;
RectBefore, RectAfter: TRect;
x, y: Integer;
monitorInfo: TMonitorInfo;
workArea: TRect;
begin
if (M = 0) and (D = 0) then
Exit;
RectBefore := AForm.BoundsRect;
SetLength(aAnchorStorage, 0);
aAnchorStorage := DisableAnchors(AForm);
try
AForm.ScaleBy(M, D);
finally
EnableAnchors(AForm, aAnchorStorage);
end;
RectAfter := AForm.BoundsRect;
case AForm.Position of
poScreenCenter, poDesktopCenter, poMainFormCenter, poOwnerFormCenter,
poDesigned: //i think i really want everything else to also follow the nudging rules...why did i exclude poDesigned
begin
//This was only nudging by one quarter the difference, rather than one half the difference
// x := RectAfter.Left - ((RectAfter.Right-RectBefore.Right) div 2);
// y := RectAfter.Top - ((RectAfter.Bottom-RectBefore.Bottom) div 2);
x := RectAfter.Left - ((RectAfter.Right-RectAfter.Left) - (RectBefore.Right-RectBefore.Left)) div 2;
y := RectAfter.Top - ((RectAfter.Bottom-RectAfter.Top)-(RectBefore.Bottom-RectBefore.Top)) div 2;
end;
else
//poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly:
x := RectAfter.Left;
y := RectAfter.Top;
end;
if AForm.Monitor <> nil then
begin
monitorInfo.cbSize := SizeOf(monitorInfo);
if GetMonitorInfo(AForm.Monitor.Handle, @monitorInfo) then
workArea := monitorInfo.rcWork
else
begin
OutputDebugString(PChar(SysErrorMessage(GetLastError)));
workArea := Rect(AForm.Monitor.Left, AForm.Monitor.Top, AForm.Monitor.Left+AForm.Monitor.Width, AForm.Monitor.Top+AForm.Monitor.Height);
end;
// If the form is off the right or bottom of the screen then we need to pull it back
if RectAfter.Right > workArea.Right then
x := workArea.Right - (RectAfter.Right-RectAfter.Left); //rightEdge - widthOfForm
if RectAfter.Bottom > workArea.Bottom then
y := workArea.Bottom - (RectAfter.Bottom-RectAfter.Top); //bottomEdge - heightOfForm
x := Max(x, workArea.Left); //don't go beyond left edge
y := Max(y, workArea.Top); //don't go above top edge
end
else
begin
x := Max(x, 0); //don't go beyond left edge
y := Max(y, 0); //don't go above top edge
end;
AForm.SetBounds(x, y,
RectAfter.Right-RectAfter.Left, //Width
RectAfter.Bottom-RectAfter.Top); //Height
end;
এবং তারপরে আমাদের অবশ্যই পুনরাবৃত্তভাবে নতুন ফন্টটি ব্যবহার করতে হবে:
procedure StandardizeFont_ControlCore(AControl: TControl; ForceClearType: Boolean;
FontName: string; FontSize: Integer;
ForceFontIfName: string; ForceFontIfSize: Integer);
const
CLEARTYPE_QUALITY = 5;
var
i: Integer;
RunComponent: TComponent;
AControlFont: TFont;
begin
if not Assigned(AControl) then
Exit;
if (AControl is TStatusBar) then
begin
TStatusBar(AControl).UseSystemFont := False; //force...
TStatusBar(AControl).UseSystemFont := True; //...it
end
else
begin
AControlFont := Toolkit.GetControlFont(AControl);
if not Assigned(AControlFont) then
Exit;
StandardizeFont_ControlFontCore(AControlFont, ForceClearType,
FontName, FontSize,
ForceFontIfName, ForceFontIfSize);
end;
{ If a panel has a toolbar on it, the toolbar won't paint properly. So this idea won't work.
if (not Toolkit.IsRemoteSession) and (AControl is TWinControl) and (not (AControl is TToolBar)) then
TWinControl(AControl).DoubleBuffered := True;
}
//Iterate children
for i := 0 to AControl.ComponentCount-1 do
begin
RunComponent := AControl.Components[i];
if RunComponent is TControl then
StandardizeFont_ControlCore(
TControl(RunComponent), ForceClearType,
FontName, FontSize,
ForceFontIfName, ForceFontIfSize);
end;
end;
অ্যাঙ্করগুলি পুনরাবৃত্তভাবে অক্ষম করা হচ্ছে:
function DisableAnchors(ParentControl: TWinControl): TAnchorsArray;
var
StartingIndex: Integer;
begin
StartingIndex := 0;
DisableAnchors_Core(ParentControl, Result, StartingIndex);
end;
procedure DisableAnchors_Core(ParentControl: TWinControl; var aAnchorStorage: TAnchorsArray; var StartingIndex: Integer);
var
iCounter: integer;
ChildControl: TControl;
begin
if (StartingIndex+ParentControl.ControlCount+1) > (Length(aAnchorStorage)) then
SetLength(aAnchorStorage, StartingIndex+ParentControl.ControlCount+1);
for iCounter := 0 to ParentControl.ControlCount - 1 do
begin
ChildControl := ParentControl.Controls[iCounter];
aAnchorStorage[StartingIndex] := ChildControl.Anchors;
//doesn't work for set of stacked top-aligned panels
// if ([akRight, akBottom ] * ChildControl.Anchors) <> [] then
// ChildControl.Anchors := [akLeft, akTop];
if (ChildControl.Anchors) <> [akTop, akLeft] then
ChildControl.Anchors := [akLeft, akTop];
// if ([akTop, akBottom] * ChildControl.Anchors) = [akTop, akBottom] then
// ChildControl.Anchors := ChildControl.Anchors - [akBottom];
Inc(StartingIndex);
end;
//Add children
for iCounter := 0 to ParentControl.ControlCount - 1 do
begin
ChildControl := ParentControl.Controls[iCounter];
if ChildControl is TWinControl then
DisableAnchors_Core(TWinControl(ChildControl), aAnchorStorage, StartingIndex);
end;
end;
এবং অ্যাঙ্করগুলি পুনরাবৃত্তভাবে পুনরায় সক্ষম করা হচ্ছে:
procedure EnableAnchors(ParentControl: TWinControl; aAnchorStorage: TAnchorsArray);
var
StartingIndex: Integer;
begin
StartingIndex := 0;
EnableAnchors_Core(ParentControl, aAnchorStorage, StartingIndex);
end;
procedure EnableAnchors_Core(ParentControl: TWinControl; aAnchorStorage: TAnchorsArray; var StartingIndex: Integer);
var
iCounter: integer;
ChildControl: TControl;
begin
for iCounter := 0 to ParentControl.ControlCount - 1 do
begin
ChildControl := ParentControl.Controls[iCounter];
ChildControl.Anchors := aAnchorStorage[StartingIndex];
Inc(StartingIndex);
end;
//Restore children
for iCounter := 0 to ParentControl.ControlCount - 1 do
begin
ChildControl := ParentControl.Controls[iCounter];
if ChildControl is TWinControl then
EnableAnchors_Core(TWinControl(ChildControl), aAnchorStorage, StartingIndex);
end;
end;
কন্ট্রোল ফন্টের বামে এখানে পরিবর্তনের কাজটি সহ:
procedure StandardizeFont_ControlFontCore(AControlFont: TFont; ForceClearType: Boolean;
FontName: string; FontSize: Integer;
ForceFontIfName: string; ForceFontIfSize: Integer);
const
CLEARTYPE_QUALITY = 5;
var
CanChangeName: Boolean;
CanChangeSize: Boolean;
lf: TLogFont;
begin
if not Assigned(AControlFont) then
Exit;
{$IFDEF ForceClearType}
ForceClearType := True;
{$ELSE}
if g_ForceClearType then
ForceClearType := True;
{$ENDIF}
//Standardize the font if it's currently
// "MS Shell Dlg 2" (meaning whoever it was opted into the 'change me' system
// "MS Sans Serif" (the Delphi default)
// "Tahoma" (when they wanted to match the OS, but "MS Shell Dlg 2" should have been used)
// "MS Shell Dlg" (the 9x name)
CanChangeName :=
(FontName <> '')
and
(AControlFont.Name <> FontName)
and
(
(
(ForceFontIfName <> '')
and
(AControlFont.Name = ForceFontIfName)
)
or
(
(ForceFontIfName = '')
and
(
(AControlFont.Name = 'MS Sans Serif') or
(AControlFont.Name = 'Tahoma') or
(AControlFont.Name = 'MS Shell Dlg 2') or
(AControlFont.Name = 'MS Shell Dlg')
)
)
);
CanChangeSize :=
(
//there is a font size
(FontSize <> 0)
and
(
//the font is at it's default size, or we're specifying what it's default size is
(AControlFont.Size = 8)
or
((ForceFontIfSize <> 0) and (AControlFont.Size = ForceFontIfSize))
)
and
//the font size (or height) is not equal
(
//negative for height (px)
((FontSize < 0) and (AControlFont.Height <> FontSize))
or
//positive for size (pt)
((FontSize > 0) and (AControlFont.Size <> FontSize))
)
and
//no point in using default font's size if they're not using the face
(
(AControlFont.Name = FontName)
or
CanChangeName
)
);
if CanChangeName or CanChangeSize or ForceClearType then
begin
if GetObject(AControlFont.Handle, SizeOf(TLogFont), @lf) <> 0 then
begin
//Change the font attributes and put it back
if CanChangeName then
StrPLCopy(Addr(lf.lfFaceName[0]), FontName, LF_FACESIZE);
if CanChangeSize then
lf.lfHeight := FontSize;
if ForceClearType then
lf.lfQuality := CLEARTYPE_QUALITY;
AControlFont.Handle := CreateFontIndirect(lf);
end
else
begin
if CanChangeName then
AControlFont.Name := FontName;
if CanChangeSize then
begin
if FontSize > 0 then
AControlFont.Size := FontSize
else if FontSize < 0 then
AControlFont.Height := FontSize;
end;
end;
end;
end;
এটি আপনি যা ভাবেন ঠিক তার থেকে অনেক বেশি কোড; আমি জানি. দুঃখজনক বিষয় হ'ল পৃথিবীতে আর কোনও ডেল্ফি বিকাশকারী নেই, আমি ব্যতীত যারা আসলে তাদের অ্যাপ্লিকেশনগুলি সঠিক করে তোলে।
প্রিয় দেলফি বিকাশকারী : আপনার উইন্ডোজ ফন্টটি Segoe UI 14pt এ সেট করুন এবং আপনার বাগি অ্যাপ্লিকেশনটি ঠিক করুন
দ্রষ্টব্য : যে কোনও কোড পাবলিক ডোমেনে প্রকাশিত হয়। কোনও অ্যাট্রিবিউশনের প্রয়োজন নেই।
SetProcessDPIAware।