آموزش ست شدن اندازه ی Memo با ارتفاع متن درون آن (مناسب برای ShowMessage)

[یوسف زالی]

سلام.
بی مقدمه:


function GetTextHeightByPixel(aFont: TFont; aText: string): integer;
var
fCanvas: TCanvas;
begin
fCanvas := TCanvas.Create;
try
fCanvas.Handle := GetDC(0);
fCanvas.Font := aFont;
Result := fCanvas.TextHeight(aText);
finally
fCanvas.Destroy;
end;
end;

procedure FitMemoToTextHeight(AMemo: TMemo; MaxHeight: integer = MaxInt);
var
H: integer;
begin
H := GetTextHeightByPixel(AMemo.Font, '|');
AMemo.Height := Min(AMemo.Lines.Count * (H +1), MaxHeight);
end;


مثال:


FitMemoToTextHeight(Memo1);

or

FitMemoToTextHeight(Memo1, 500);

[Mask]

ممنون داش یوسف
من میخام مموی من یه ارتفاعی به صورت پیش فرض داشته باشه وقتی کاربر چند خط نوشت ، و ممو پر شد ، اسکرول نشه و فرم ارتفاعش زیاد بشه و همینطور وقتی خطی حذف میشه ارتفاع فرم کم بشه تا به مقدار پیش فرضش برسه.
هر چی تست میکنم ، یه جای کار مشکل داره : شمام ببین :

function GetTextHeightByPixel(aFont: TFont; aText: string): integer;
var
fCanvas: TCanvas;
begin
fCanvas := TCanvas.Create;
try
fCanvas.Handle := GetDC(0);
fCanvas.Font := aFont;
Result := fCanvas.TextHeight(aText);
finally
fCanvas.Destroy;
end;
end;

function GetTextHeightRichEdit(ARichEdit: TRichEdit;
MaxHeight: integer = MaxInt): integer;
var
H: integer;
begin
H := GetTextHeightByPixel(ARichEdit.Font, '|');
Result := Min(ARichEdit.Lines.Count * (H + 1), MaxHeight);
end;

procedure TForm1.RichEdit1Change(Sender: TObject);
begin
if GetTextHeightRichEdit(RichEdit1) > Form1.Height-60 then
Form1.Height := GetTextHeightRichEdit(RichEdit1)+60
else
Form1.Height := RichEdit1.Height
end;

[یوسف زالی]

داداش دو سه تا فول داشتی.
مهم ترینش اینه که دلیلی نداره تو شرطت یک بار وارد تابع بشی بعد دوباره برای کار با مقدارش بازم محاسبش کنی.
اون Min رو دقت نکردی.
Top شی Rich رو در نظر نگرفتی...


function GetTextHeightByPixel(aFont: TFont; aText: string): integer;
var
fCanvas: TCanvas;
begin
fCanvas := TCanvas.Create;
try
fCanvas.Handle := GetDC(0);
fCanvas.Font := aFont;
Result := fCanvas.TextHeight(aText);
finally
fCanvas.Destroy;
end;
end;

function GetTextHeightRichEdit(ARichEdit: TRichEdit): integer;
var
H: integer;
begin
H := GetTextHeightByPixel(ARichEdit.Font, '|');
Result := ARichEdit.Lines.Count * (H + 2);
end;

procedure TForm1.RichEdit1Change(Sender: TObject);
var
H: integer;
MaxH: integer;
begin
MaxH := 400;
H := min(GetTextHeightRichEdit(RichEdit1), MaxH);

RichEdit1.Height := H;
ClientHeight := RichEdit1.Top + H + 8;
end;



یکم اصلاحات می خواد که خودت اوستایی.

[یوسف زالی]

به نظرت الان ابن مشکلت ربطی به این پست داشت؟؟؟

[zahra_no]

در مورد memo چقدر میشه مانور داد
به نظرت این مشکل من در مورد memo حل شدنیه
http://barnamenevis.org/showthread.php?420179-memo-%D8%A8%D8%A7-%D8%B9%DA%A9%D8%B3-%D9%BE%D8%B4%D8%AA-%D8%B2%D9%85%DB%8C%D9%86%D9%87

[siroosss]

ببخشید این قسمت از کد رو چرا دلفی ارور می ده؟

H := min(GetTextHeightRichEdit(RichEdit1), MaxH);
ببخشید مشکل حل شد دقت نکرده بودم
Math رو به قسمت uses اضافه نکرده بودم

[یوسف زالی]

دوستان عزیز ReleaseDC فراموش نشه!