Галактика в вопросах и ответах

Обсуждение различных вопросов, связанных с сопровождением, администрированием и программированием
https://ns1.tyumbit.ru/

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

https://ns1.tyumbit.ru/viewtopic.php?t=13190

Страница 1 из 1

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

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

В продолжение темы http://www.tyumbit.ru/gal_forum/viewtop ... 8&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.
Если кто будет проверять - отпишитесь.
Часовой пояс: UTC+05:00
Страница 1 из 1

Создано на основе phpBB® Forum Software © phpBB Limited

Русская поддержка phpBB