HMGforum.com

Code: Select all

#include "hmg.ch"

Function Main()

   DEFINE WINDOW Form_1 ;
      AT 1,0 ;
      WIDTH 250 ;      
      HEIGHT 300 ; 
      sysmenu .F. ;
      MAIN;
      backcolor {180,180,200} ;
      TITLE 'Button Test'

      DEFINE MAIN MENU
              POPUP 'Test'
                ITEM 'Disable label' ACTION Form_1.Label_1.Enabled := .f.
                ITEM 'Enable label'  ACTION Form_1.Label_1.Enabled := .t.
              END POPUP
      END MENU
	
	DEFINE LABEL LABEL_1
	ROW 70
	COL 75
	HEIGHT 70
        WIDTH 70 
	VALUE SPACE(25) +'  ADD     ITEM'
	TOOLTIP 'Add Item To Invoice'
        TRANSPARENT .T. 
	CENTERALIGN .T.
        action MSGINFO('Adding Item')
	END LABEL

	DEFINE IMAGE IMAGE_1
	ROW 70
	COL 75
	HEIGHT 50
        WIDTH 60 
	PICTURE 'BUTTON3.GIF' 
	END IMAGE

	DEFINE LABEL LABEL_2
	ROW 150
	COL 75
	HEIGHT 70
        WIDTH 70 
	VALUE SPACE(15) +' EXIT'
	TOOLTIP 'Exit Invoice'
        TRANSPARENT .T. 
	CENTERALIGN .T.
        action form_1.release   
	END LABEL

	DEFINE IMAGE IMAGE_2
	ROW 150
	COL 75
	HEIGHT 50
        WIDTH 60 
	PICTURE 'BUTTON3.gif' 
	END IMAGE



   END WINDOW

   CENTER WINDOW Form_1

   ACTIVATE WINDOW Form_1

Return

Code: Select all

#include "hmg.ch"

FUNCTION MAIN

PRIVATE hBitmap := 0 
Private NH := 0, NW := 0

     DEFINE WINDOW Win1;
            AT 0,0;
            WIDTH  500;
            HEIGHT 400;
            TITLE "Demo11: Create Logo";
            MAIN;
            ON INIT     Proc_ON_INIT ();
            ON RELEASE  Proc_ON_RELEASE ();
            ON PAINT    Proc_ON_PAINT ()

            @  200, 190 LABEL Label1 Value "Save Image as ..." FONT "Times New Roman" SIZE 14 BOLD AUTOSIZE
            
            @  250, 100 BUTTON Button1 CAPTION "BMP"  ACTION Proc_Save_Image (1)
            @  250, 210 BUTTON Button2 CAPTION "JPG"  ACTION Proc_Save_Image (2)
            @  250, 320 BUTTON Button3 CAPTION "GIF"  ACTION Proc_Save_Image (3)
            @  300, 150 BUTTON Button4 CAPTION "TIF"  ACTION Proc_Save_Image (4)
            @  300, 260 BUTTON Button5 CAPTION "PNG"  ACTION Proc_Save_Image (5)

    END WINDOW

    CENTER WINDOW Win1
    ACTIVATE WINDOW Win1
RETURN Nil


PROCEDURE Proc_ON_INIT
   hBitmap := Proc_Create_Logo ()
RETURN


PROCEDURE Proc_ON_RELEASE
   BT_BitmapRelease (hBitmap)
RETURN


PROCEDURE Proc_ON_PAINT
LOCAL hDC, BTstruct     
  hDC := BT_CreateDC ("Win1", BT_HDC_INVALIDCLIENTAREA, @BTstruct)
     BT_DrawBitmap (hDC,  30,  180, 300, 200, BT_COPY,  hBitmap)
  BT_DeleteDC (BTstruct)
RETURN



PROCEDURE Proc_Save_Image (nAction)
LOCAL Ret, Button
   DO CASE       
      CASE nAction == 1
           Ret:= BT_BitmapSaveFile (hBitmap, "LOGO_BMP.bmp") // or BT_BitmapSaveFile (hBitmap, "LOGO_BMP.bmp", BT_FILEFORMAT_BMP)
      CASE nAction == 2
           Ret:= BT_BitmapSaveFile (hBitmap, "LOGO_JPG.jpg", BT_FILEFORMAT_JPG)
      CASE nAction == 3
           Ret:= BT_BitmapSaveFile (hBitmap, "LOGO_GIF.gif", BT_FILEFORMAT_GIF)
      CASE nAction == 4
           Ret:= BT_BitmapSaveFile (hBitmap, "LOGO_TIF.tif", BT_FILEFORMAT_TIF)
      CASE nAction == 5
           Ret:= BT_BitmapSaveFile (hBitmap, "LOGO_PNG.png", BT_FILEFORMAT_PNG)
   ENDCASE
   
   IF Ret == .T.
      Button := "Button"+ALLTRIM(STR(nAction))
      SetProperty ("Win1", Button, "Enabled", .F.) 
   ENDIF
   MsgInfo ("Save Image: "+IF(Ret,"OK","Fail"))
RETURN



FUNCTION Proc_Create_Logo
LOCAL hDC, BTstruct
LOCAL hBitmap, hBitmap_aux 
LOCAL aRGBcolor   //{153,217,234}
LOCAL aRGBcolor2  
NH := val(alltrim(inputbox('Enter Height')))
NW := val(alltrim(inputbox('Enter Width')))
if NH  < 1 .or. NW < 1
	msginfo('No Sizes Picked. Program Suspended.')
	Win1.release
	return
endif

msgbox('Pick First MAIN BACKCOLOR * Then Gradient Color')
aRGBcolor := getcolor()   //{153,217,234}

aRGBcolor2 := getcolor()


   // Create bitmap in memory
   hBitmap := BT_BitmapCreateNew (NH, NW, aRGBcolor)

   // Create hDC to a bitmap
   hDC := BT_CreateDC (hBitmap, BT_HDC_BITMAP, @BTstruct)     
     
     // Paint Gradient
     BT_DrawGradientFillVertical (hDC,  0,  0,  NH,  NW, aRGBcolor, aRGBcolor2)

     // Draw Rectangle                
     BT_DrawRectangle (hDC, 0, 0, nh, nw, aRGBcolor2, 10)

  BT_DeleteDC (BTstruct)   

Return hBitmap

Code: Select all

*******************************************************************************
#include "hmg.ch"

FUNCTION Main
   DEFINE WINDOW Win_1 ;
      AT 0,0 ;
      WIDTH 400 ;
      HEIGHT 300 ;
      TITLE 'Label with Background Color' ;
      MAIN

      @ 50,50 LABEL lbl_Colored ;
         VALUE space(61)+'Colored Label' ;           //divide width by 2 (- 3xvalue length)
         WIDTH 200 ;
         HEIGHT 150 ;
	transparent   ;
	centeralign   ;
	action msgbox(this.backcolor)            //       BACKCOLOR {255,0,0}  // RGB for r

	@  50, 50 IMAGE Image1 PICTURE "Logo_bmp.bmp" WIDTH 200 HEIGHT 150 ADJUSTIMAGE
	

   END WINDOW

   CENTER WINDOW Win_1
   ACTIVATE WINDOW Win_1
RETURN