Pablo, o problema todo está no comando DRAW RECTANGLE.
Código: Selecionar todos
#include <hmg.ch>
#define QUEBRA CHR(13)+CHR(10)
Function Main()
Set Date British
Set Century on
Set Exclusive OFF
Set Delete ON
USE WINUTILS NEW
SET LANGUAGE TO PORTUGUESE
SET MULTIPLE OFF WARNING
SET TOOLTIPSTYLE BALLOON
DEFINE WINDOW oForm1 AT 67,020 WIDTH 786 HEIGHT 476 ;
TITLE 'Inteiração com o Windows' MAIN NOSIZE NOMAXIMIZE ;
BACKCOLOR {236,233,216} ICON "WINUTILS"
ON KEY ESCAPE ACTION ThisWindow.Release
DEFINE STATUSBAR
STATUSITEM PADC(WindowsVersion()[1],55) WIDTH 300
STATUSITEM PADC("Usuário: "+AllTrim(NetName()),30) WIDTH 142
STATUSITEM PADR("Desenvolvido por Pablo César Arrascaeta",45) WIDTH 260 RAISED ;
ACTION MsgINFO (PadC("*** WinUtils V.1.0 ***",60)+QUEBRA+ ;
PadC(" ",60)+QUEBRA+ ;
PadC(" Utilitário Freeware - Contribuição ao Fórum PCTOLEDO",60)+QUEBRA+ ;
PadC(" ",60)+QUEBRA+ ;
PadC(" Desenvolvido com Harbour/MiniGUI - HMG 3.0.35",60),"A respeito de") ;
ICON 'Imagens\CliqueAqui_16x16.ico' TOOLTIP "Clique aqui para ver detalhes do desenvolvimento"
STATUSITEM DTOC(DATE()) WIDTH 072
CLOCK
END STATUSBAR
@ 013,014 BUTTON oButton_1 CAPTION "&Incluir" PICTURE "INCLUIR" LEFT WIDTH 110 HEIGHT 42 ;
FONT 'MS Sans Serif' SIZE 10 BOLD ACTION Cadastrar(.t.) TOOLTIP "Inclui novos comandos"
@ 013,142 BUTTON oButton_2 CAPTION "&Editar" PICTURE "EDITAR" LEFT WIDTH 110 HEIGHT 42 ;
FONT 'MS Sans Serif' SIZE 10 BOLD ACTION Cadastrar(.f.) TOOLTIP "Altera comandos existentes"
@ 013,270 BUTTON oButton_3 CAPTION "E&xcluir" PICTURE "EXCLUIR" LEFT WIDTH 110 HEIGHT 42 ;
FONT 'MS Sans Serif' SIZE 10 BOLD ACTION Excluir() TOOLTIP "Elimina comando existente"
@ 013,398 BUTTON oButton_4 CAPTION "Executa&r " PICTURE "EXECUTAR" LEFT WIDTH 110 HEIGHT 42 ;
FONT 'MS Sans Serif' SIZE 10 BOLD ACTION Executar() TOOLTIP "Executa os comandos existentes"
@ 013,526 BUTTON oButton_5 CAPTION "&Copiar" PICTURE "CLIPBOARD" LEFT WIDTH 110 HEIGHT 42 ;
FONT 'MS Sans Serif' SIZE 10 BOLD ACTION Copiar() TOOLTIP "Copia para a Área de Transferência o comandos"
@ 013,654 BUTTON oButton_6 CAPTION "&Sair" PICTURE "SAIR" LEFT WIDTH 110 HEIGHT 42 ;
FONT 'MS Sans Serif' SIZE 10 BOLD ACTION ThisWindow.Release TOOLTIP "Encerra o programa"
@ 080,008 BROWSE oList WIDTH 762 HEIGHT 326 ;
OF oForm1 TOOLTIP "Mostra comandos existentes" ;
Fields {"DESCRICAO","COMANDO"} ;
HEADERS {"Descrição do Serviço","Comandos"} ;
WIDTHS {340,400} ;
WORKAREA WINUTILS LOCK ;
FONT "Ms Sans Serif" SIZE -010 ;
BACKCOLOR {255,255,255} FONTCOLOR {0,0,0} ;
ON CHANGE DBGOTO( oForm1.oList.VALUE ) ;
ON DblClick Cadastrar(.f.)
ON ENTER Executar()
oForm1.oList.SetFocus
END WINDOW
CENTER WINDOW oForm1
ACTIVATE WINDOW oForm1
RETURN(NIL)
Function Cadastrar(lNovo)
DEFINE WINDOW oForm2 AT 329,208 WIDTH 620 HEIGHT 166 ;
TITLE "Editar registro" MODAL NOSIZE ;
BACKCOLOR {236,233,116}
ON KEY ESCAPE ACTION oForm2.Release
@ 022,022 LABEL oSDESCRICAO Value "Descrição" ;
WIDTH 060 HEIGHT 020 OF oForm2 ;
FONT "Ms Sans Serif" SIZE -010 BOLD ;
BACKCOLOR {236,233,116} FONTCOLOR {0,0,0}
@ 020,090 TEXTBOX oGDESCRICAO VALUE Space(20) ;
WIDTH 500 HEIGHT 022 OF oForm2 ;
FONT "Ms Sans Serif" SIZE -010 ;
FONTCOLOR {0,0,0} BACKCOLOR {255,255,255}
@ 050,028 LABEL oSCOMANDO Value "Comando" ;
WIDTH 056 HEIGHT 020 OF oForm2 ;
FONT "Ms Sans Serif" SIZE -010 BOLD ;
BACKCOLOR {236,233,116} FONTCOLOR {0,0,0}
@ 048,090 TEXTBOX oGCOMANDO VALUE Space(20) ;
WIDTH 500 HEIGHT 022 OF oForm2 ;
FONT "Ms Sans Serif" SIZE -010 ;
FONTCOLOR {0,0,0} BACKCOLOR {255,255,255}
@ 088,344 BUTTON oSave CAPTION "&Salvar" PICTURE "SALVAR" LEFT ;
WIDTH 110 HEIGHT 034 FONT "Ms Sans Serif" SIZE -010 BOLD ;
ACTION Salvar(lNovo)
@ 088,482 BUTTON oCancel CAPTION "&Cancelar" PICTURE "SAIR" LEFT ;
WIDTH 110 HEIGHT 034 FONT "Ms Sans Serif" SIZE -010 BOLD ;
ACTION Cancelar()
if !lNovo
AbreReg()
endif
END WINDOW
oForm2.Activate()
return nil
Function AbreReg()
oForm2.oGDESCRICAO.Value := DESCRICAO
oForm2.oGCOMANDO.Value := COMANDO
Return NIL
Function Salvar(lNovo)
If lNovo
Append Blank
endif
RLock()
WINUTILS->DESCRICAO := oForm2.oGDESCRICAO.Value
WINUTILS->COMANDO := oForm2.oGCOMANDO.Value
UnLock
oForm1.oList.Refresh()
oForm2.Release
Return NIL
Function Cancelar()
oForm2.Release
oForm1.oList.SetFocus
Return nil
Function Executar()
LOCAL cRun :=NIL
cRun := Alltrim(WINUTILS->COMANDO)
If "RUNDLL32" $ UPPER(cRun)
cRun :=SUBSTR(cRun,AT(" ",cRun) +1)
ShellExecute(0, "open","rundll32.exe", cRun ,,1)
Else
ShellExecute(0,nil,cRun,nil,nil,1)
Endif
oForm1.oList.SetFocus
RETURN(NIL)
Function Excluir()
If MsgYesNo("Deseja apagar o registro ?",Alltrim(WINUTILS->DESCRICAO),.t.)
RLock()
DELETE
UnLock
If Recno()=1
SetProperty("oForm1","oList","VALUE",Recno()+1)
Else
SetProperty("oForm1","oList","VALUE",Recno()-1)
Endif
oForm1.oList.SetFocus
oForm1.oList.Refresh()
Endif
Return Nil
Function Copiar()
LOCAL cRun :=NIL
cCmd := Alltrim(WINUTILS->COMANDO)
Hb_GtInfo( HB_GTI_CLIPBOARDDATA, cCmd )
MsgExclamation ("Disponibilização com sucesso !","Área de Transferência")
RETURN(NIL)
Obs.: retirei a função Restaurar(), pois neste exemplo não é necessário.