یوسف زالی
چهارشنبه 06 آذر 1392, 14:07 عصر
سلام.
در پروژه ای متوجه شدم که سرعت باز و بسته شدن یکی از فرم هام ارتباط مستقیم داره با تعداد باز و بسته شدن اون فرم!! اول طبق معمول شکم رفت سمت اس کیو ال و باز گذاشتن اس پی ها و خالی نکردن دی بی کامپوننت ها. ولی با بهبود وضعیت، اگر چه سرعتم بالاتر رفت ولی همچنان نسبت تعداد به لودتایم عدد مثبتی بود و این یعنی این که باز هم در تعدادهای بالاتر کند تر خواهم شد.
برای از بین بردن این شیب شروع کردم به بهبود رفرش شدن کامپوننت ها و فرم. ولی اشکال همچنان وجود داشت.
تا این که تصمیم گرفتم به بررسی عمیق تری بپردازم و بالاخره فهمیدم جریان از چه قراره.
برای این کار برنامه کوچکی نوشتم:
var
QPFrequency: Int64;
QPCounter: Int64;
procedure SpeedTestReset;
begin
QueryPerformanceCounter(QPCounter);
end;
function SpeedTestResult: Int64;
var
TillHere: Int64;
begin
QueryPerformanceCounter(TillHere);
Result := (((TillHere - QPCounter) * 1000) div QPFrequency) and $FFFFFFFF;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
Speed: Int64;
begin
for i := 1 to U30Graph1.XSize do
begin
SpeedTestReset;
with TForm2.Create(Application) do Destroy;
Speed := SpeedTestResult;
U30Graph1.AddValue(Speed, clRed, clYellow);
U30Graph1.Refresh;
end;
U30Graph1.Picture.SaveToFile('D:\1.bmp');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
QueryPerformanceFrequency(QPFrequency);
QPCounter := 0;
end;
که در حقیقت یک مونیتورینگ ساده هست.
کد زیر کدی بود که در فرم دومم تحت نظر داشتم:
function Get_TextWidthHeightByPixel(aFont: TFont; aText: string): TWidthHeight;
var
fCanvas: TCanvas;
begin
fCanvas := TCanvas.Create;
try
fCanvas.Handle := GetDC(0);
fCanvas.Font := aFont;
Result.Width := fCanvas.TextWidth(aText);
Result.Height := fCanvas.TextHeight(aText);
finally
fCanvas.Destroy;
end;
end;
در چند جا نیاز بود که با توجه به تغییر فونت توسط کاربر، برنامه اندازه های مواردی رو ریست کنه و دوباره تنظیمشون کنه.
نتیجه ای که گرفتم شوکه کننده بود:
113267
بررسی های بیشتر نشون داد که ایراد از تابع GetDC هست. بنابراین باید از روش جایگزینی استفاده می کردم:
function Get_TextWidthHeightByPixel(aFont: TFont; aText: string): TWidthHeight;
var
fBitMap: TBitmap;
begin
fBitMap := TBitmap.Create;
try
fBitMap.Canvas.Font.Assign(aFont);
Result.Width := fBitMap.Canvas.TextWidth(aText);
Result.Height := fBitMap.Canvas.TextHeight(aText);
finally
fBitMap.Free;
end;
end;
نتیجه این شد:
113266
فکر می کنم فراخوانی توابعی از این دست برای ویندوز بسیار هزینه بره و پس از فراخوانی هم اقدام عاجل به رها کردن منابع صورت نمی گیره.
توصیه می کنم در به کار بردن چنین توابعی علی الخصوص در کامپوننت ها یا در تعداد دفعات بالاتر حتما تجدید نظر کنید.
امیدوارم تجربه امروز من برای کسی مفید باشه.
موفق باشید دوستان.
در پروژه ای متوجه شدم که سرعت باز و بسته شدن یکی از فرم هام ارتباط مستقیم داره با تعداد باز و بسته شدن اون فرم!! اول طبق معمول شکم رفت سمت اس کیو ال و باز گذاشتن اس پی ها و خالی نکردن دی بی کامپوننت ها. ولی با بهبود وضعیت، اگر چه سرعتم بالاتر رفت ولی همچنان نسبت تعداد به لودتایم عدد مثبتی بود و این یعنی این که باز هم در تعدادهای بالاتر کند تر خواهم شد.
برای از بین بردن این شیب شروع کردم به بهبود رفرش شدن کامپوننت ها و فرم. ولی اشکال همچنان وجود داشت.
تا این که تصمیم گرفتم به بررسی عمیق تری بپردازم و بالاخره فهمیدم جریان از چه قراره.
برای این کار برنامه کوچکی نوشتم:
var
QPFrequency: Int64;
QPCounter: Int64;
procedure SpeedTestReset;
begin
QueryPerformanceCounter(QPCounter);
end;
function SpeedTestResult: Int64;
var
TillHere: Int64;
begin
QueryPerformanceCounter(TillHere);
Result := (((TillHere - QPCounter) * 1000) div QPFrequency) and $FFFFFFFF;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
Speed: Int64;
begin
for i := 1 to U30Graph1.XSize do
begin
SpeedTestReset;
with TForm2.Create(Application) do Destroy;
Speed := SpeedTestResult;
U30Graph1.AddValue(Speed, clRed, clYellow);
U30Graph1.Refresh;
end;
U30Graph1.Picture.SaveToFile('D:\1.bmp');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
QueryPerformanceFrequency(QPFrequency);
QPCounter := 0;
end;
که در حقیقت یک مونیتورینگ ساده هست.
کد زیر کدی بود که در فرم دومم تحت نظر داشتم:
function Get_TextWidthHeightByPixel(aFont: TFont; aText: string): TWidthHeight;
var
fCanvas: TCanvas;
begin
fCanvas := TCanvas.Create;
try
fCanvas.Handle := GetDC(0);
fCanvas.Font := aFont;
Result.Width := fCanvas.TextWidth(aText);
Result.Height := fCanvas.TextHeight(aText);
finally
fCanvas.Destroy;
end;
end;
در چند جا نیاز بود که با توجه به تغییر فونت توسط کاربر، برنامه اندازه های مواردی رو ریست کنه و دوباره تنظیمشون کنه.
نتیجه ای که گرفتم شوکه کننده بود:
113267
بررسی های بیشتر نشون داد که ایراد از تابع GetDC هست. بنابراین باید از روش جایگزینی استفاده می کردم:
function Get_TextWidthHeightByPixel(aFont: TFont; aText: string): TWidthHeight;
var
fBitMap: TBitmap;
begin
fBitMap := TBitmap.Create;
try
fBitMap.Canvas.Font.Assign(aFont);
Result.Width := fBitMap.Canvas.TextWidth(aText);
Result.Height := fBitMap.Canvas.TextHeight(aText);
finally
fBitMap.Free;
end;
end;
نتیجه این شد:
113266
فکر می کنم فراخوانی توابعی از این دست برای ویندوز بسیار هزینه بره و پس از فراخوانی هم اقدام عاجل به رها کردن منابع صورت نمی گیره.
توصیه می کنم در به کار بردن چنین توابعی علی الخصوص در کامپوننت ها یا در تعداد دفعات بالاتر حتما تجدید نظر کنید.
امیدوارم تجربه امروز من برای کسی مفید باشه.
موفق باشید دوستان.