Кое-что про динамическое создание объектов (ver2)

База знаний

Модераторы: m0p3e, edward_K, Модераторы

Кое-что про динамическое создание объектов (ver2)

Сообщение m0p3e » Чт мар 02, 2017 18:30

Первоначальный вариант не прижился по причине "пожирания" буфера команд. Быстро исправил с хранением коэффициентов в реестр. Хочется сделать красивее, но времени свободного не хватает. Итак ver2.

В продолжение темы http://www.tyumbit.ru/gal_forum/viewtopic.php?f=2&t=11538&start=15
Вернулся к проблеме по причине появления слабовидящего юзера с FontSize = 14 и 125% в винде работающим через трехзвенный клиент с другого конца страны.
Опущу долгий путь с Delphi, dll, OleCall...
Предложенный вариант проще. Окно моргает один раз в момент запуска клиента. В идеальные позиции мы не попадем, по вполне понятным причинам, но и жесткого наложения объектов не будет.
Создаем настройки:
Код: Выделить всё
   TR.AddTuneU ( 'ZOOM.KoefZoomPosX', 'Коэффициент позиции X',  ftDouble, '1', '', 0  ); TR.SetCorpoType ( 'ZOOM.KoefZoomPosX', ttCorpoTune );
   TR.AddTuneU ( 'ZOOM.KoefZoomPosY', 'Коэффициент позиции Y',  ftDouble, '1', '', 0  ); TR.SetCorpoType ( 'ZOOM.KoefZoomPosY', ttCorpoTune );
   TR.AddTuneU ( 'ZOOM.KoefZoomSizeX', 'Коэффициент размера X', ftDouble, '1', '', 0  ); TR.SetCorpoType ( 'ZOOM.KoefZoomSizeX', ttCorpoTune );
   TR.AddTuneU ( 'ZOOM.KoefZoomSizeY', 'Коэффициент размера Y', ftDouble, '1', '', 0  ); TR.SetCorpoType ( 'ZOOM.KoefZoomSizeY', ttCorpoTune );

cfsEx.vip
Код: Выделить всё
CONST
x_def  = 401;
y_def  = 343;
xs_def = 304;
ys_def = 14;
END;

Interface _cfsEx '' CacheAble;

var TestField : string;
var x, y, xs, ys :Integer;
var kx, ky, kxs, kys : Double;

window wTest;
Show At ( ,,45,3 );
screen sTest;
Fields
TestField : Skip;
<<

Инициализация модуля для работы с конфигуратором















                                                         .@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
>>
End;

HandleEvent
cmInit :
{
  PutCommand ( cmValue10 );
}; //cmInit
cmValue10 :
{
  cfsSetCurrentContainer ( cfsGetCurrentContainerSelf );

  If cfsGetProp ( 'i_STEST_TestField', cfpOrigin_X, x  ) <> 0 x  := x_def;
  If cfsGetProp ( 'i_STEST_TestField', cfpOrigin_Y, y  ) <> 0 y  := y_def;
  If cfsGetProp ( 'i_STEST_TestField', cfpSize_X,   xs ) <> 0 xs := xs_def;
  If cfsGetProp ( 'i_STEST_TestField', cfpSize_Y,   ys ) <> 0 xs := ys_def;

  CloseWindow ( wTest );
};
End; //HandleEvent
End; //window

Public Procedure Init;
{
RunWindowModal ( wTest );

kx  := x / x_def;   If kx = 0 kx := 1;   doSetTune ( 'ZOOM.KoefZoomPosX', kx );
ky  := y / y_def;   If ky = 0 ky := 1;   doSetTune ( 'ZOOM.KoefZoomPosY', ky );
kxs := xs / xs_def; If kxs = 0 kxs := 1; doSetTune ( 'ZOOM.KoefZoomSizeX', kxs );
kys := ys / ys_def; If kys = 0 kys := 1; doSetTune ( 'ZOOM.KoefZoomSizeY', kys );
};

///////////////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
//                        Коэффициенты зависимости от системного шрифта                             \\
///////////////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Public Function GetKoefPosX : double;
{
result := kx;
}; //Function GetKoefY

Public Function GetKoefPosY : double;
{
Result := ky;
}; //Function GetKoefX

Public Function GetKoefSizeX : double;
{
Result := kxs;
}; //Function GetKoefSizeY

Public Function GetKoefSizeY : double;
{
Result := kys;
}; //Function GetKoefSizeX

Public Function CalcPosX ( x : integer ) : integer;
{
Result := Round ( x * GetKoefPosX );
}; //Function CalcPosX

Public Function CalcPosY ( y : integer ) : integer;
{
Result := Round ( y * GetKoefPosY );
}; //Function CalcPosX

Public Function CalcSizeX ( x : integer ) : integer;
{
Result := Round ( x * GetKoefSizeX );
}; //Function CalcSizeX

Public Function CalcSizeY ( y : integer ) : integer;
{
Result := Round ( y * GetKoefSizeY );
}; //Function CalcSizeX

HandleEvent
cmOnVipLoad :
{
  kx := doGetTune ( 'ZOOM.KoefZoomPosX' );
  ky := doGetTune ( 'ZOOM.KoefZoomPosY' );
  kxs := doGetTune ( 'ZOOM.KoefZoomSizeX' );
  kys := doGetTune ( 'ZOOM.KoefZoomSizeY' );
}; //cmInit
End;

END.

Для определения текущих коэффициентов и записи их в реестр настроек в момент запуска клиента подписываемся на точку расширения.
AppInit.vip
Код: Выделить всё
ExtensionPoint epAppInit;

handler with replace epAppInitZoom on ExtensionPoint epAppInit
Action
{
Result := true;

var iCfsEx : _cfsEx;
iCfsEx.Init;
}


Соответственно при создании объектов координаты скармливаем функциям.
Проверял этим интерфейсом:
TestFontSize.vip
Код: Выделить всё
Interface TestFontSize 'Тестирование создания объекта' EscClose, Cyan;
Show At ( ,,100,20 );

var iCfs : _cfsEx;

Create View
var xPos, yPos, xSize, ySize : double;
    b1, b2 : LongInt;
    f1, f2 : LongInt;
    s1, s2, s3, s4 : string;
    b1x1, b1y1, b1x2, b1y2,
    b2x1, b2y1, b2x2, b2y2,
    b3x1, b3y1, b3x2, b3y2,
    b4x1, b4y1, b4x2, b4y2 : integer;
    f1x1, f1y1, f1x2, f1y2,
    f2x1, f2y1, f2x2, f2y2,
    f3x1, f3y1, f3x2, f3y2,
    f4x1, f4y1, f4x2, f4y2 : integer;
    b1x1e, b1y1e, b1x2e, b1y2e,
    b2x1e, b2y1e, b2x2e, b2y2e,
    b3x1e, b3y1e, b3x2e, b3y2e,
    b4x1e, b4y1e, b4x2e, b4y2e : boolean;
As Select *
From x$users
;

Procedure DestroyObjects;
{
cfsSetCurrentContainer ( cfsGetCurrentContainerSelf );

If b1 > 0
  {
   cfsDestroyObject ( b1 );
   b1 := 0;
  };
If b2 > 0
  {
   cfsDestroyObject ( b2 );
   b2 := 0;
  };
If f1 > 0
  {
   cfsDestroyObject ( f1 );
   f1 := 0;
  };
If f2 > 0
  {
   cfsDestroyObject ( f2 );
   f2 := 0;
  };
}; //Procedure DestroyButtons

Procedure MakeObjects;
{
DestroyObjects;

cfsSetCurrentContainer ( cfsGetCurrentContainerSelf );

cfsCreateObject ( 'BUTTON', 'SCR2', 'cmValue1', false, b1 );
cfsSetProp ( b1, cfpOrigin_X, 24 * xPos );
cfsSetProp ( b1, cfpOrigin_Y, 25  * yPos );
cfsSetProp ( b1, cfpSize_X, 169 * xSize );
cfsSetProp ( b1, cfpSize_Y, 25  * ySize );
cfsSetProp ( b1, cfpTitle, 'Динамическая кнопка 1' );

cfsCreateObject ( 'BUTTON', 'SCR2', 'cmValue4', false, b2 );
cfsSetProp ( b2, cfpOrigin_X, 234 * xPos );
cfsSetProp ( b2, cfpOrigin_Y, 65  * yPos );
cfsSetProp ( b2, cfpSize_X, 162 * xSize );
cfsSetProp ( b2, cfpSize_Y, 25  * ySize );
cfsSetProp ( b2, cfpTitle, 'Динамическая кнопка 2' );

cfsCreateObject ( 'PanelInputLine', 'SCR3', 's1', false, f1 );
cfsSetProp ( f1, cfpOrigin_X, 16 * xPos );
cfsSetProp ( f1, cfpOrigin_Y, 23 * yPos );
cfsSetProp ( f1, cfpSize_X, 185 * xSize );
cfsSetProp ( f1, cfpSize_Y, 14  * ySize );

cfsCreateObject ( 'PanelInputLine', 'SCR3', 's4', false, f2 );
cfsSetProp ( f2, cfpOrigin_X, 226 * xPos );
cfsSetProp ( f2, cfpOrigin_Y, 63  * yPos );
cfsSetProp ( f2, cfpSize_X, 178 * xSize );
cfsSetProp ( f2, cfpSize_Y, 14  * ySize );
}; //Procedure MakeButtons

Procedure Refresh;
{
If cfsGetProp ( b1, cfpOrigin_X, b1x1 ) <> 0 b1x1 := 0;
If cfsGetProp ( b1, cfpOrigin_Y, b1y1 ) <> 0 b1y1 := 0;
If cfsGetProp ( b1, cfpSize_X,   b1x2 ) <> 0 b1x2 := 0;
If cfsGetProp ( b1, cfpSize_Y,   b1y2 ) <> 0 b1y2 := 0;

If cfsGetProp ( 'b_SCR2_Стандартная_кнопка_1', cfpOrigin_X, b2x1 ) <> 0 b2x1 := 0;
If cfsGetProp ( 'b_SCR2_Стандартная_кнопка_1', cfpOrigin_Y, b2y1 ) <> 0 b2y1 := 0;
If cfsGetProp ( 'b_SCR2_Стандартная_кнопка_1', cfpSize_X,   b2x2 ) <> 0 b2x2 := 0;
If cfsGetProp ( 'b_SCR2_Стандартная_кнопка_1', cfpSize_Y,   b2y2 ) <> 0 b2y2 := 0;

If cfsGetProp ( 'b_SCR2_Стандартная_кнопка_2', cfpOrigin_X, b3x1 ) <> 0 b3x1 := 0;
If cfsGetProp ( 'b_SCR2_Стандартная_кнопка_2', cfpOrigin_Y, b3y1 ) <> 0 b3y1 := 0;
If cfsGetProp ( 'b_SCR2_Стандартная_кнопка_2', cfpSize_X,   b3x2 ) <> 0 b3x2 := 0;
If cfsGetProp ( 'b_SCR2_Стандартная_кнопка_2', cfpSize_Y,   b3y2 ) <> 0 b3y2 := 0;

If cfsGetProp ( b2, cfpOrigin_X, b4x1 ) <> 0 b4x1 := 0;
If cfsGetProp ( b2, cfpOrigin_Y, b4y1 ) <> 0 b4y1 := 0;
If cfsGetProp ( b2, cfpSize_X,   b4x2 ) <> 0 b4x2 := 0;
If cfsGetProp ( b2, cfpSize_Y,   b4y2 ) <> 0 b4y2 := 0;

If cfsGetProp ( f1, cfpOrigin_X, f1x1 ) <> 0 f1x1 := 0;
If cfsGetProp ( f1, cfpOrigin_Y, f1y1 ) <> 0 f1y1 := 0;
If cfsGetProp ( f1, cfpSize_X,   f1x2 ) <> 0 f1x2 := 0;
If cfsGetProp ( f1, cfpSize_Y,   f1y2 ) <> 0 f1y2 := 0;

If cfsGetProp ( 'i_SCR3_S2', cfpOrigin_X, f2x1 ) <> 0 f2x1 := 0;
If cfsGetProp ( 'i_SCR3_S2', cfpOrigin_Y, f2y1 ) <> 0 f2y1 := 0;
If cfsGetProp ( 'i_SCR3_S2', cfpSize_X,   f2x2 ) <> 0 f2x2 := 0;
If cfsGetProp ( 'i_SCR3_S2', cfpSize_Y,   f2y2 ) <> 0 f2y2 := 0;

If cfsGetProp ( 'i_SCR3_S3', cfpOrigin_X, f3x1 ) <> 0 f3x1 := 0;
If cfsGetProp ( 'i_SCR3_S3', cfpOrigin_Y, f3y1 ) <> 0 f3y1 := 0;
If cfsGetProp ( 'i_SCR3_S3', cfpSize_X,   f3x2 ) <> 0 f3x2 := 0;
If cfsGetProp ( 'i_SCR3_S3', cfpSize_Y,   f3y2 ) <> 0 f3y2 := 0;

If cfsGetProp ( f2, cfpOrigin_X, f4x1 ) <> 0 f4x1 := 0;
If cfsGetProp ( f2, cfpOrigin_Y, f4y1 ) <> 0 f4y1 := 0;
If cfsGetProp ( f2, cfpSize_X,   f4x2 ) <> 0 f4x2 := 0;
If cfsGetProp ( f2, cfpSize_Y,   f4y2 ) <> 0 f4y2 := 0;


RescanPanel ( #x$users );
}; //Procedure Refresh

Screen scr1;
Show At ( ,,,9 );
Table x$users;
Fields
'Параметр FontSize: ' + GetLongIntParameter ( 'WINDOWS', 'FONTSIZE', 0 ) : Skip;
                              b1x1 : skip, { FONT = { COLOR = If ( b1x1 <> b3x1, ColorSysRed, 0 ) } };
                              b1y1 : skip, { FONT = { COLOR = If ( b1y1 <> b2y1, ColorSysRed, 0 ) } };
                              b1x2 : skip, { FONT = { COLOR = If ( b1x2 <> b3x2, ColorSysRed, 0 ) } };
                              b1y2 : skip, { FONT = { COLOR = If ( b1y2 <> b2y2, ColorSysRed, 0 ) } };
                              b2x1 : skip;
                              b2y1 : skip;
                              b2x2 : skip;
                              b2y2 : skip;
xPos : [ 5.3 ], noProtect;
                              b3x1 : skip;
                              b3y1 : skip;
                              b3x2 : skip;
                              b3y2 : skip;
                              b4x1 : skip, { FONT = { COLOR = If ( b4x1 <> b2x1, ColorSysRed, 0 ) } };
                              b4y1 : skip, { FONT = { COLOR = If ( b4y1 <> b3y1, ColorSysRed, 0 ) } };
                              b4x2 : skip, { FONT = { COLOR = If ( b4x2 <> b2x2, ColorSysRed, 0 ) } };
                              b4y2 : skip, { FONT = { COLOR = If ( b4y2 <> b3y2, ColorSysRed, 0 ) } };
yPos : [ 5.3 ], noProtect;
xSize : [ 5.3 ], noProtect;
                              f1x1 : skip, { FONT = { COLOR = If ( f1x1 <> f3x1, ColorSysRed, 0 ) } };
                              f1y1 : skip, { FONT = { COLOR = If ( f1y1 <> f2y1, ColorSysRed, 0 ) } };
                              f1x2 : skip, { FONT = { COLOR = If ( f1x2 <> f3x2, ColorSysRed, 0 ) } };
                              f1y2 : skip, { FONT = { COLOR = If ( f1y2 <> f2y2, ColorSysRed, 0 ) } };
                              f2x1 : skip;
                              f2y1 : skip;
                              f2x2 : skip;
                              f2y2 : skip;
ySize : [ 5.3 ], noProtect;
                              f3x1 : skip;
                              f3y1 : skip;
                              f3x2 : skip;
                              f3y2 : skip;
                              f4x1 : skip, { FONT = { COLOR = If ( f4x1 <> f2x1, ColorSysRed, 0 ) } };
                              f4y1 : skip, { FONT = { COLOR = If ( f4y1 <> f3y1, ColorSysRed, 0 ) } };
                              f4x2 : skip, { FONT = { COLOR = If ( f4x2 <> f2x2, ColorSysRed, 0 ) } };
                              f4y2 : skip, { FONT = { COLOR = If ( f4y2 <> f3y2, ColorSysRed, 0 ) } };
Buttons
cmValue10;
cmValue11;
<<
.@@@@@@@@@@@@@@@@@@@@@@@@@@@                  Координаты кнопок:
                                               .@@@.@@@.@@@.@@@  .@@@.@@@.@@@.@@@
Коэффициент позиции x .@@@@@@@@@@@@           .@@@.@@@.@@@.@@@  .@@@.@@@.@@@.@@@
Коэффициент позиции y .@@@@@@@@@@@@           Координаты полей:
Коэффициент размера x .@@@@@@@@@@@@           .@@@.@@@.@@@.@@@  .@@@.@@@.@@@.@@@
Коэффициент размера y .@@@@@@@@@@@@           .@@@.@@@.@@@.@@@  .@@@.@@@.@@@.@@@

                                  <. Создать объекты .>  <. Уничтожить объекты .>
>>
End;

Screen scr2;
Show At ( ,10,,14 );
Table x$users;
Fields


Buttons
cmValue2;
cmValue3;
<<

                                <. Стандартная кнопка 1 .>

  <.  Стандартная кнопка 2 .>
>>
End;

Screen scr3;
Show At ( ,15,, );
Table x$users;
Fields
s2 : Protect;
s3 : Protect;
<<

                                .@@@@@@@@@@@@@@@@@@@@@@@@@

  .@@@@@@@@@@@@@@@@@@@@@@@@@@
>>
End;


HandleEvent
cmValue10 :
{
  MakeObjects;
  Refresh;
};
cmValue11 :
{
  DestroyObjects;
  Refresh;
};

cmInit :
{
  xPos := iCfs.GetKoefPosX;
  yPos := iCfs.GetKoefPosY;
  xSize := iCfs.GetKoefSizeX;
  ySize := iCfs.GetKoefSizeY;

  b1 := 0;
  b2 := 0;

  f1 := 0;
  f2 := 0;

  s1 := 'Динамическое поле 1';
  s2 := 'Стандартное поле 1';
  s3 := 'Стандартное поле 2';
  s4 := 'Динамическое поле 2';

  Refresh;
}; //cmInit
End;
END.


Если кто будет проверять - отпишитесь.
m0p3e
Местный житель
 
Сообщения: 1382
Зарегистрирован: Вт мар 29, 2005 17:49
Откуда: Москва
Reputation point: 97

Вернуться в Опыт

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1