estou utilizando 4 pacotes e 2 procedimentos default:
vou deixar anexado abaixo, para ajudar nosso amigos do forum:
-- Procedure Button_proc
-- if there are buttons called EXECUTE_QUERY and CANCEL_QUERY, this function shows
-- them, when the ENTER_QUERY button is pressed and hides them, when EXECUTE_- or
-- CANCEL_QUERY ispressed. No error should be returned, if these buttons do not exist.
-- To make naming of the buttons easier, EXIT, QUIT and EXIT_FORM all perform exit_form,
-- even if the form is in ENTER-QUERY mode !!!!!!!
-- A CANCEL_QUERY button-name cancels a currently "open" query.
PROCEDURE button_proc IS
action varchar(80);
-- hide a button (for ENTER_-, EXECUTE_- or CANCEL_QUERY)
PROCEDURE show_off(item_name VARCHAR2) IS
BEGIN
IF NOT Id_Null(Find_Item(item_name)) THEN
Set_Item_Property(item_name, DISPLAYED,PROPERTY_FALSE);
END IF;
END;
-- try to show a button (for the two query-states. If there is no button to show,
-- return FALSE to the calling procedure.
FUNCTION show_on(item_name VARCHAR2) RETURN BOOLEAN IS
BEGIN
IF NOT Id_Null(Find_Item(item_name)) THEN
Set_Item_Property(item_name,DISPLAYED,PROPERTY_TRUE);
Set_Item_Property(item_name,ENABLED,PROPERTY_TRUE);
RETURN TRUE;
ELSE
RETURN FALSE;
END IF;
RETURN NULL; END;
BEGIN
action := Get_Item_Property(NAME_IN('SYSTEM.TRIGGER_ITEM'),ITEM_NAME);
IF action = 'ENTER_QUERY' THEN
-- only hide the ENTER_QUERY button, if there are EXECUTE_QUERY and (!!) CANCEL_QUERY
-- buttons. Otherwise an existing EXECUTE_QUERY button will be shown.
IF show_on('EXECUTE_QUERY') AND show_on('CANCEL_QUERY') THEN
show_off('ENTER_QUERY');
END IF;
END IF;
IF action IN ('EXIT_FORM', 'EXIT','QUIT') THEN
action := 'EXIT_FORM';
IF NAME_IN('SYSTEM.MODE')='ENTER-QUERY' THEN
Do_Key('EXIT_FORM');
END IF;
END IF;
IF action = 'CANCEL_QUERY' THEN
action := 'EXIT_FORM';
END IF;
Do_Key(action);
IF NAME_IN('SYSTEM.MODE') != 'ENTER-QUERY' THEN
IF show_on('ENTER_QUERY') THEN
show_off('EXECUTE_QUERY');
show_off('CANCEL_QUERY');
END IF;
END IF;
END;
PACKAGE dll IS
FUNCTION tblen(str IN VARCHAR2) RETURN PLS_INTEGER;
END;
PACKAGE BODY DLL IS
l_user Ora_Ffi.LibHandleType;
l_gdi Ora_Ffi.LibHandleType;
f_getdc Ora_Ffi.FuncHandleType;
f_reldc Ora_Ffi.FuncHandleType;
f_setmap Ora_Ffi.FuncHandleType;
f_gte Ora_Ffi.FuncHandleType;
FUNCTION icd_GetDC(f_getdc IN Ora_Ffi.FuncHandleType,
hwnd IN PLS_INTEGER)
RETURN PLS_INTEGER;
PRAGMA INTERFACE(C, icd_GetDC, 11265);
FUNCTION icd_ReleaseDC(f_reldc IN Ora_Ffi.FuncHandleType,
hwnd IN PLS_INTEGER,
hdc IN PLS_INTEGER)
RETURN PLS_INTEGER;
PRAGMA INTERFACE(C, icd_ReleaseDC, 11265);
FUNCTION icd_SetMapMode(f_setmap IN Ora_Ffi.FuncHandleType,
hdc IN PLS_INTEGER,
mm IN PLS_INTEGER)
RETURN PLS_INTEGER;
PRAGMA INTERFACE(C, icd_SetMapMode, 11265);
FUNCTION icd_GetTextExtent(f_gte IN Ora_Ffi.FuncHandleType,
hdc IN PLS_INTEGER,
str IN OUT VARCHAR2,
len IN PLS_INTEGER)
RETURN PLS_INTEGER;
PRAGMA INTERFACE(C, icd_GetTextExtent, 11265);
FUNCTION tblen(str IN VARCHAR2) RETURN PLS_INTEGER IS
hwnd PLS_INTEGER := Get_Window_Property('Window0',Window_Handle);
hdc PLS_INTEGER := 0;
buf PLS_INTEGER;
len PLS_INTEGER := NVL(length(str), 0);
oldmap PLS_INTEGER;
dummy PLS_INTEGER;
s VARCHAR2(255) := rpad(str,255);
s_width PLS_INTEGER;
BEGIN
hdc := icd_GetDC(f_getdc,hwnd); -- Get device context.
oldmap := icd_SetMapMode(f_setmap, hdc, 6); -- Change mapping to MM_TWIPS (~inch)
-- Set to 1 for MM_TEXT (~pixel) and
-- change scaling in TOOLBAR package
-- if forms module runs in REAL PIXEL
s_width := icd_GetTextExtent(f_gte, hdc, s, len); -- retrieve width of text from GDI
dummy := icd_SetMapMode(f_setmap, hdc, oldmap); -- reset mapping mode
dummy := icd_ReleaseDC(f_reldc, hwnd, hdc); -- release deviec context
return(s_width);
END;
BEGIN
break;
l_user := Ora_Ffi.Register_Library('c:\windows\system\','USER.EXE');
l_gdi := Ora_Ffi.Register_Library('c:\windows\system\','GDI.EXE');
f_getdc := Ora_Ffi.Register_Function(l_user,'GetDC', ORA_FFI.PASCAL_STD);
f_reldc := Ora_Ffi.Register_Function(l_user,'ReleaseDC', ORA_FFI.PASCAL_STD);
f_setmap := Ora_Ffi.Register_Function(l_gdi,'SetMapMode',ORA_FFI.PASCAL_STD);
f_gte := Ora_Ffi.Register_Function(l_gdi,'GetTextExtent', ORA_FFI.PASCAL_STD);
Ora_Ffi.Register_Return(f_getdc, ORA_FFI.C_INT);
Ora_Ffi.Register_Parameter(f_getdc, ORA_FFI.C_INT);
Ora_Ffi.Register_Return(f_reldc, ORA_FFI.C_INT);
Ora_Ffi.Register_Parameter(f_reldc, ORA_FFI.C_INT);
Ora_Ffi.Register_Parameter(f_reldc, ORA_FFI.C_INT);
Ora_Ffi.Register_Return(f_setmap, ORA_FFI.C_INT);
Ora_Ffi.Register_Parameter(f_setmap, ORA_FFI.C_INT);
Ora_Ffi.Register_Parameter(f_setmap, ORA_FFI.C_INT);
Ora_Ffi.Register_Return(f_gte, ORA_FFI.C_INT);
Ora_Ffi.Register_Parameter(f_gte, ORA_FFI.C_INT);
Ora_Ffi.Register_Parameter(f_gte, ORA_FFI.C_CHAR_PTR);
Ora_Ffi.Register_Parameter(f_gte, ORA_FFI.C_INT);
END;
PACKAGE toolbar IS
tbscale NUMBER := 43; -- good for 1024x768 (SVGA)
-- tbscale NUMBER := 40; -- good for 640x480 (VGA)
item_name VARCHAR2(80);
PROCEDURE hide_function;
PROCEDURE set_timer;
PROCEDURE show_function;
END;
PACKAGE BODY TOOLBAR IS
cs VARCHAR2(20);
csscale NUMBER;
PROCEDURE hide_function IS
BEGIN
Set_Item_Property('TOOLBAR.TEXT',DISPLAYED,PROPERTY_OFF);
Clear_Message;
IF NOT Id_Null(Find_Timer('ENTER_TOOLBAR')) THEN
Delete_Timer('ENTER_TOOLBAR');
END IF;
END; /* hide_function */
PROCEDURE set_timer IS
t Timer;
BEGIN
toolbar.item_name := :SYSTEM.MOUSE_ITEM;
IF NOT Id_Null(Find_Timer('ENTER_TOOLBAR')) THEN
Delete_Timer('ENTER_TOOLBAR');
END IF;
t := Create_Timer('ENTER_TOOLBAR',250,NO_REPEAT);
END; /* set_timer */
PROCEDURE show_function IS
w_base number := 20/4;
w NUMBER;
msg varchar2(200);
BEGIN
:TOOLBAR.Text := Get_Item_Property(item_name, LABEL);
msg := Get_Item_Property(item_name,HINT_TEXT);
w := trunc(w_base * NVL(length(:toolbar.text), 0) - (25 * (NVL(length(:toolbar.text), 0)/20)));
-- w := dll.tblen(:toolbar.text)*tbscale/100000*csscale;
Set_Item_Property('TOOLBAR.TEXT',WIDTH,w);
Set_Item_Property('TOOLBAR.TEXT',POSITION,
to_number(Get_Item_Property(item_name,X_POS)),
to_number(Get_Item_Property(item_name,Y_POS)) +
to_number(Get_Item_Property(item_name,HEIGHT)));
Set_Item_Property('TOOLBAR.TEXT',DISPLAYED,PROPERTY_ON);
Message(msg);
END; /* show_function */
BEGIN
cs := Get_Form_Property(Get_Application_Property(CURRENT_FORM_NAME),COORDINATE_SYSTEM);
IF cs = 'INCHES' THEN csscale := 1;
ELSIF cs = 'PIXELS' THEN csscale := 120;
ELSIF cs = 'POINTS' THEN csscale := 72;
ELSIF cs = 'CENTIMETERS' THEN csscale := 2.56;
ELSIF cs = 'CHARACTER_CELL' THEN
csscale := Get_Form_Property(Get_Application_Property(CURRENT_FORM_NAME),CHARACTER_CELL_WIDTH);
csscale := 140/csscale;
END IF;
END;
PROCEDURE l_mensagem(as_mensagem VARCHAR2) IS
ls_dummy VARCHAR2(002) ;
BEGIN
SET_ALERT_PROPERTY('MENSAGEM', ALERT_MESSAGE_TEXT, as_mensagem) ;
ls_dummy := SHOW_ALERT('MENSAGEM') ;
END;
Abs Hahu
Que Deus abençõe a todos!
