Статьи Королевства Дельфи

         

В принципе, если бы создатели


В принципе, если бы создатели VCL, придерживались простого правила, присвоения nil указателю, который ссылается на еще не созданный или уже удаленный объект, многое было бы проще, и методологически вернее. И я не вижу ни каких логических объяснений, почему до сих пор это не сделано.

unit Appl; ... const strDelphiMagicText = '0'; strResTextHeight = 'TextHeight'; ... function RtmPPI(FormName: string): integer; var Form: TCustomForm; begin Result := 0; Form := FindForm(FormName); if Form <> nil then Result := Form.Canvas.TextHeight(strDelphiMagicText); end; function DsgnPPI(FormName: string): integer; var List: TStringList; Form: TCustomForm; begin List := TStringList.Create; try Form := FindForm(FormName); if Form <> nil then begin ReadFormRes(Form.ClassName, List); Result := StrToInt(List.Values[strResTextHeight]); end; finally List.Free; end; end;
Эти функции проверяют наличие определенного окна . Если значение не равно nil, то считается, что форма уже создана, и у неё можно определить PPI's. Если форма еще не создана, то возвращается 0. В случае успешного выполнения функции, результатом будет значение высоты текста, отличное от 0. Так как сами функции несколько усложнились, то необходимо расширить их тестирование. Изменится так же, процедура TestDsgnVsRtmPPI, но функциональность её сохраниться, и даже несколько расшириться. Функция IsChangePPI удалена, из-за её несоответствия текущему моменту.

const testPPI = 16; ... procedure TTestUnitAppl.TestRtmPPI; var Test: boolean; begin testForm := TtestForm.Create(Application); try Test := RtmPPI('testForm') = testForm.Canvas.TextHeight(strDelphiMagicText); finally testForm.Free; Check(Test, strFailedTest); end; end; procedure TTestUnitAppl.TestDsgnPPI; var OldPPI, PPI: integer; begin testForm := TtestForm.Create(Application); try OldPPI := DsgnPPI('testForm'); finally testForm.Free; Check(OldPPI = testPPI, Format('DsgnPPI=%d, not %d', [OldPPI, testPPI])); end; end; procedure TTestUnitAppl.TestDsgnVsRtmPPI; var Test: boolean; Text: string; OldPPI, NewPPI: integer; begin Test := False; Text := strFailedTest; testForm := TtestForm.Create(Application); try OldPPI := RtmPPI('testForm'); NewPPI := DsgnPPI('testForm'); if (OldPPI > 0) and (NewPPI > 0) then begin Test := OldPPI = NewPPI; if not Test then Text := Format('DsgnPPI=%d not equal RtmPPI=%d DPI', [OldPPI, NewPPI]); end; finally testForm.Free; Check(Test, Text); end; end;

Содержание  Назад  Вперед