Pessoal bom dia, Preciso criar uma UPC no PD400 para pegar o numero do pedido (Nr-PedCli) quando crio um novo pedido, para assim que concluir a digitação do pedido, inclusive itens, acertar a informação de Unidade de Negócio através de um update no pedido. O problema é que nunca fiz uma UPC e estou perdido. Alguém tem algum código de exemplo que possa me ajudar? Desde já agradeço o apoio. Neivaldo
Código: /***************************************************************************** ** Programa.: upc-pd4000.p ** Objetivo.: UPC para Implantacao de Pedido - PD4000 ** validar o Campo Tipo de Pedido** ** Data.....: Junho de 2004 ** Versoes..: 15/10/2004 - Substituido validacao de quantidades ** com base na tabela de Parametros Complementares ** por validacao baseada da tasbela de Lote PadrÆo *****************************************************************************/ /*********************** Definicao de Parametros *************************/ DEFINE INPUT PARAMETER p-ind-event AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER p-ind-object AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER p-wgh-object AS HANDLE NO-UNDO. DEFINE INPUT PARAMETER p-wgh-frame AS WIDGET-HANDLE NO-UNDO. DEFINE INPUT PARAMETER p-cod-table AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER p-row-table AS ROWID no-undo. DEFINE VAR h-frame AS WIDGET-HANDLE NO-UNDO. DEFINE VAR h-frame2 AS WIDGET-HANDLE NO-UNDO. DEFINE VAR h-frame3 AS WIDGET-HANDLE NO-UNDO. DEFINE VAR h-frame4 AS WIDGET-HANDLE NO-UNDO. DEFINE VAR h-frame5 AS WIDGET-HANDLE NO-UNDO. /******************** Defini‡Æo de Variaveis Globais *********************/ DEFINE NEW GLOBAL SHARED VAR wgh-menu AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR wgh-tp-pedido AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR wgh-principal AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR i-ep-codigo-usuario AS character no-undo. DEFINE NEW GLOBAL SHARED VAR wh-nome-abrev AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR wh-nr-pedcli AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR wh-tipo-pedido AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR wh-cod-estabel as handle no-undo. DEFINE NEW GLOBAL SHARED VAR wh-container as handle no-undo. DEFINE NEW GLOBAL SHARED VAR p-row-ped-venda AS ROWID NO-UNDO. DEF NEW GLOBAL SHARED VAR wgh-qt-log-aloca AS HANDLE NO-UNDO. DEF NEW GLOBAL SHARED VAR wgh-qt-un-uc AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR txt-qt-uc AS HANDLE NO-UNDO. DEF NEW GLOBAL SHARED VAR wh-quantidade AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR wgh-item AS HANDLE NO-UNDO. DEF NEW GLOBAL SHARED VAR wgh-qt-pedida AS HANDLE NO-UNDO. DEF NEW GLOBAL SHARED VAR wgh-it-codigo AS HANDLE NO-UNDO. define new global shared variable w-cod-canal-venda as handle no-undo. DEF NEW GLOBAL SHARED VAR wgh-bt-cancel-item AS HANDLE NO-UNDO. DEF NEW GLOBAL SHARED VAR wgh-bt-save-item AS HANDLE NO-UNDO. DEF NEW GLOBAL SHARED VAR wgh-bt-delete-order AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR wgh-bt-Complete-Ord AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR wgh-bt-save-ord AS HANDLE NO-UNDO. DEFINE NEW GLOBAL SHARED VAR wgh-bt-save AS HANDLE NO-UNDO. DEF VAR v-ped-venda AS ROWID NO-UNDO. DEF VAR c-objeto AS CHAR NO-UNDO. define new global shared variable btCompleteOrderNew as handle no-undo. define variable btOrderParameters as handle no-undo. define variable btPrecoFamilia as handle no-undo. define variable btPrecoPerfil as handle no-undo. define variable btVendaInterna as handle no-undo. /************************** Incio do Programa ***************************/ ASSIGN c-objeto = entry(num-entries(p-wgh-object:private-data,"~/"), p-wgh-object:private-data,"~/"). /* message "Evento: " p-ind-event skip */ /* "Objeto: " p-ind-object skip */ /* "Nome Obj: " c-objeto skip */ /* "Frame " p-wgh-frame:NAME skip */ /* "Tabela " p-cod-table skip */ /* "Rowid " string(p-row-table) view-as alert-box. */ if p-ind-event = "AFTER-DISPLAY" and p-ind-object = "container" then do: run utils/findWidget.p ("cod-canal-venda", "fill-in", p-wgh-frame, output w-cod-canal-venda). END. if p-ind-event = "AfterDisplayOrder" THEN do: FIND ped-venda NO-LOCK WHERE ROWID(ped-venda) = p-row-table NO-ERROR. IF AVAIL ped-venda THEN ASSIGN v-ped-venda = ROWID(ped-venda). END. if p-ind-object = 'container' then do: run utils/findWidget.p('btOrderParameters', 'button', p-wgh-frame, output btOrderParameters). run utils/findWidget.p('btPrecoFamilia', 'button', p-wgh-frame, output btPrecoFamilia). run utils/findWidget.p('btPrecoPefil', 'button', p-wgh-frame, output btPrecoPerfil). run utils/findWidget.p('btVendaInterna', 'button', p-wgh-frame, output btVendaInterna). if valid-handle(btOrderParameters) and not valid-handle(btPrecoPerfil) then do: create button btPrecoPerfil assign frame = btOrderParameters:frame name = 'btPrecoPerfil' help = 'Informar pre‡os quilo por perfil' tooltip = 'Pre‡o Perfil' width = btOrderParameters:width height = btOrderParameters:height row = btOrderParameters:row col = btOrderParameters:col + 35 flat-button = btOrderParameters:flat-button visible = yes label = 'PPP' sensitive = yes. if valid-handle(btPrecoPerfil) then do: btPrecoPerfil:load-image('image/im-pcust.bmp'). if not btPrecoPerfil:flat-button then btPrecoPerfil:move-before-tab(btOrderParameters). end. on 'choose' of btPrecoPerfil persistent run cstp/cspd4001.w. end. if valid-handle(btOrderParameters) and not valid-handle(btPrecoFamilia) then do: create button btPrecoFamilia assign frame = btOrderParameters:frame name = 'btPrecoFamilia' help = 'Informar pre‡os unitarios por familia' tooltip = 'Pre‡o Familia' width = btOrderParameters:width height = btOrderParameters:height row = btOrderParameters:row col = btOrderParameters:col + 30 flat-button = btOrderParameters:flat-button visible = yes label = 'PPF' sensitive = yes. if valid-handle(btPrecoFamilia) then do: btPrecoFamilia:load-image('image/im-orct2.bmp'). if not btPrecoFamilia:flat-button then btPrecoFamilia:move-before-tab(btOrderParameters). end. on 'choose' of btPrecoFamilia persistent run cstp/cspd4000.w. end. if valid-handle(btOrderParameters) and not valid-handle(btVendaInterna) then do: create button btVendaInterna assign frame = btOrderParameters:frame name = 'btVendaInterna' help = 'Efetuar Venda interna' tooltip = 'Venda Interna' width = btOrderParameters:width height = btOrderParameters:height row = btOrderParameters:row col = btOrderParameters:col + 25 flat-button = btOrderParameters:flat-button visible = yes label = 'VIN' sensitive = yes. if valid-handle(btVendaInterna) then do: btVendaInterna:load-image('image/im-carg.bmp'). end. on 'choose' of btVendaInterna persistent run cstp/csvi020.w. end. end. IF p-ind-object = "container" THEN DO: ASSIGN wh-container = p-wgh-object. if valid-handle(p-wgh-frame) then do: assign h-frame = p-wgh-frame:first-child. do while h-frame <> ?: if h-frame:type = "field-group" OR h-frame:type = "frame" OR h-frame:type BEGINS "menu" then do: ASSIGN h-frame2 = h-frame:first-child. do while h-frame2 <> ?: IF h-frame2:NAME = "nome-abrev" THEN ASSIGN wh-nome-abrev = h-frame2. IF h-frame2:NAME = 'Nr-pedcli' THEN ASSIGN wh-nr-pedcli = h-frame2. ASSIGN h-frame2 = h-frame2:next-sibling. end. end. ASSIGN h-frame = h-frame:next-sibling. end. end. end. IF p-ind-event = "before-display" THEN DO: ASSIGN h-frame = p-wgh-frame:first-child. do while h-frame <> ?: if h-frame:type = "field-group" OR h-frame:type = "frame" OR h-frame:type BEGINS "menu" THEN do: ASSIGN h-frame2 = h-frame:first-child. do while h-frame2 <> ?: if h-frame2:type = "field-group" OR h-frame2:type = "frame" OR h-frame2:type BEGINS "menu" THEN do: ASSIGN h-frame3 = h-frame2:first-child. do while h-frame3 <> ?: if h-frame3:type = "field-group" OR h-frame3:type = "frame" OR h-frame3:type BEGINS "menu" THEN do: ASSIGN h-frame4 = h-frame3:first-child. do while h-frame4 <> ?: IF h-frame2:NAME = "fpage4" THEN DO: IF h-frame4:name = "tp-pedido" THEN DO: find ped-venda no-lock where rowid(ped-venda) = p-row-table no-error. if avail ped-venda THEN ASSIGN p-row-ped-venda = rowid(ped-venda). ASSIGN wgh-tp-pedido = h-frame4. END. END. if h-frame2:name = 'fpage6' THEN ASSIGN wgh-item = h-frame2. IF h-frame4:NAME = 'qt-log-aloca' THEN ASSIGN wgh-qt-log-aloca = h-frame4 wgh-item = wgh-qt-log-aloca:FRAME. IF h-frame4:NAME = 'qt-pedida' THEN ASSIGN wgh-qt-pedida = h-frame4. if h-frame4:name = 'btCompleteOrder' THEN ASSIGN wgh-bt-complete-ord = h-frame4. if h-frame4:name = 'btCompleteOrderNew' THEN ASSIGN btCompleteOrderNew = h-frame4. if h-frame4:name = 'btsaveorder' THEN ASSIGN wgh-bt-save-ord = h-frame4. IF h-frame4:NAME = 'btDeleteOrder' THEN ASSIGN wgh-bt-delete-order = h-frame4. if h-frame4:name = 'cod-estabel' THEN ASSIGN wh-cod-estabel = h-frame4. IF h-frame4:NAME = 'tp-pedido' THEN ASSIGN wh-tipo-pedido = h-frame4. IF h-frame4:NAME = 'It-Codigo' THEN ASSIGN wgh-it-codigo = h-frame4. IF h-frame4:NAME = 'btCancelItem' THEN ASSIGN wgh-bt-cancel-item = h-frame4. IF h-frame4:NAME = 'btSaveItem' THEN ASSIGN wgh-bt-save-item = h-frame4. ASSIGN h-frame4 = h-frame4:next-sibling. end. end. ASSIGN h-frame3 = h-frame3:next-sibling. end. end. ASSIGN h-frame2 = h-frame2:next-sibling. end. end. ASSIGN h-frame = h-frame:next-sibling. IF NOT VALID-HANDLE(wgh-qt-un-uc) THEN DO: create text txt-qt-uc ASSIGN frame = wgh-item /*wgh-item*/ format = "x(9)" width = 8 height = .88 screen-value = 'Qt Un Com:' row = wgh-qt-log-aloca:ROW col = 36.1 visible = yes. create fill-in wh-quantidade ASSIGN frame = wgh-item data-type = 'decimal' name = 'qt-un-uc' format = '>>>>>9.99' width = 10 height = .88 row = wgh-qt-log-aloca:ROW col = 44.2 side-label-handle = txt-qt-uc label = 'Qt Un Com:' screen-value = "" sensitive = NO visible = yes tooltip = "QT Unid Com:" help = "QT Unid Com:". END. end. if valid-handle(wgh-bt-complete-ord) then do: if not valid-handle(btCompleteOrderNew) then do: create button btCompleteOrderNew assign frame = wgh-bt-complete-ord:frame name = 'btCompleteOrderNew' help = wgh-bt-complete-ord:help tooltip = wgh-bt-complete-ord:tooltip width = wgh-bt-complete-ord:width height = wgh-bt-complete-ord:height row = wgh-bt-complete-ord:row col = wgh-bt-complete-ord:col flat-button = wgh-bt-complete-ord:flat-button visible = wgh-bt-complete-ord:visible label = wgh-bt-complete-ord:label sensitive = wgh-bt-complete-ord:sensitive. btCompleteOrderNew:load-image(wgh-bt-complete-ord:image). btCompleteOrderNew:load-image-insensitive(wgh-bt-complete-ord:image-insensitive). if not btCompleteOrderNew:flat-button then btCompleteOrderNew:move-before-tab(wgh-bt-complete-ord). on 'choose' of btCompleteOrderNew persistent run pdupc/upc-pd4000CON.p(wgh-bt-complete-ord, wh-nome-abrev, wh-nr-pedcli). end. end. end. if valid-handle(btCompleteOrderNew) and valid-handle(wgh-bt-complete-ord) then do: assign btCompleteOrderNew :sensitive = yes wgh-bt-complete-ord:sensitive = no wgh-bt-complete-ord:visible = no. end. IF VALID-HANDLE(wgh-qt-pedida) and VALID-HANDLE(wh-quantidade) then wh-quantidade:move-after-tab-item(wgh-qt-pedida:handle). IF VALID-HANDLE(wgh-qt-log-aloca) THEN ASSIGN wgh-qt-log-aloca:VISIBLE = NO. if p-ind-event = 'before_pi-enableitem' THEN DO: ASSIGN wh-quantidade:LABEL = "QT Unid Com:" wh-quantidade:SENSITIVE = YES. END. if p-ind-event = "AfterDisplayItem" THEN DO: ASSIGN wh-quantidade:LABEL = "QT Unid Com:" wh-quantidade:SCREEN-VALUE = ''. IF VALID-HANDLE(wgh-it-codigo ) THEN DO: FIND FIRST ITEM USE-INDEX codigo WHERE ITEM.it-codigo = wgh-it-codigo :SCREEN-VALUE NO-LOCK NO-ERROR. IF AVAIL ITEM THEN DO: FIND FIRST Esp_Par_Com_GerIt USE-INDEX Esp_Par_ComGerIt WHERE Esp_Par_Com_GerIt.it_codigo = ITEM.it-codigo NO-LOCK NO-ERROR. IF AVAIL esp_par_com_gerIt THEN DO: ASSIGN wh-quantidade:SCREEN-VALUE = STRING(decimal(wgh-qt-pedida:SCREEN-VALUE) / Esp_Par_Com_GerIt.Peso_Padrao_Uc) . END. END. END. END. IF VALID-HANDLE(wgh-bt-save-ord) THEN DO: ON 'choose':U OF wgh-bt-save-ord PERSISTENT RUN pdupc/upc-pd4000a.p. END. IF VALID-HANDLE(wgh-qt-pedida) THEN DO: ON 'leave':U OF wgh-qt-pedida PERSISTENT RUN pdupc/upc-pd4000b.p. END. IF VALID-HANDLE(wgh-bt-cancel-item) THEN DO: on 'choose':U of wgh-bt-cancel-item persistent run pdupc/upc-pd4000c.p. END. IF VALID-HANDLE(wgh-bt-save-item) THEN DO: ON 'Choose':U OF wgh-bt-save-item PERSISTENT RUN pdupc/upc-pd4000e.p. END. IF VALID-HANDLE(wh-quantidade) THEN DO: ON 'leave':U OF wh-quantidade PERSISTENT RUN pdupc/upc-pd4000f.p. END. IF VALID-HANDLE(wgh-bt-delete-order) THEN DO: ON 'Choose':U OF wgh-bt-delete-order PERSISTENT RUN pdupc/upc-pd4000g.p. END.
Obrigado Richard, Você me ajudou bastante. Você tem a procurure findWidget.p ?? Também preciso dela Att Neivaldo
verdade, esqueci dela ... Código: /*** * * PROGRAMA: * upc/findWidget.p * * FINALIDADE: * Procedure para encontrar um widget em um frame * * PARAMETROS: * c-widget-name: nome do widget a ser localizado * c-widget-type: tipo do widget a ser localizado * h-start-widget: container para procurar o widget * h-widget: widget encontrado * */ define input parameter c-widget-name as char no-undo. define input parameter c-widget-type as char no-undo. define input parameter h-start-widget as handle no-undo. define output parameter h-widget as handle no-undo. do while valid-handle(h-start-widget): if h-start-widget:type = c-widget-type and (h-start-widget:name = c-widget-name or (h-start-widget:type = 'LITERAL':u and h-start-widget:screen-value = c-widget-name)) then do: assign h-widget = h-start-widget:handle. leave. end. if h-start-widget:type = "field-group":u or h-start-widget:type = "frame":u or h-start-widget:type = "dialog-box":u then do: run utils/findWidget.p (input c-widget-name, input c-widget-type, input h-start-widget:first-child, output h-widget). if valid-handle(h-widget) then leave. end. assign h-start-widget = h-start-widget:next-sibling. end.