': Fahrenheit-Celsius Converter by Qwerkey 16/05/20 ': Images: pngimg.com ': This program uses ': InForm - GUI library for QB64 - v1.1 ': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor ': https://github.com/FellippeHeitor/InForm '----------------------------------------------------------- $ASSERTS ': Controls' IDs: ------------------------------------------------------------------ DIM SHARED FahrenheitToCelsius AS LONG DIM SHARED ScaleFrame AS LONG DIM SHARED FahrenheitPBox AS LONG DIM SHARED CelsiusPBox AS LONG DIM SHARED DispPB AS LONG DIM SHARED BodyTempRB AS LONG DIM SHARED RoomTempRB AS LONG DIM SHARED FahrenheitTB AS LONG DIM SHARED CelsiusTB AS LONG DIM SHARED FahrenheitLB AS LONG DIM SHARED CelsiusLB AS LONG DIM SHARED FixTextBoxesTS AS LONG DIM SHARED FixTextBoxesLB AS LONG DIM SHARED ExitBT AS LONG DIM SHARED PicUpdate%%, FSetTemp!, CSetTemp! DIM SHARED InFahrenheit%%, InCelsius%%, TClicked%%, TempT! CONST FPos% = 12, CPos% = 31, YPos% = 20, TFPos% = 28, TCPos% = 47, TYPos% = 38, ScaleMin% = 668 CONST TT% = 38, TB% = 668, FL% = 82, FR% = 106, CL% = 321, CR% = 345 ': External modules: --------------------------------------------------------------- '$INCLUDE:'../../InForm/InForm.bi' '$INCLUDE:'Fahrenheit-Celsius.frm' '$INCLUDE:'../../InForm/InForm.ui' ': Functions: ---------------------------------------------------------------------- FUNCTION FTOC! (T!, Deg%%) IF Deg%% THEN FTOC! = (T! - 32) * 5 / 9 ELSE FTOC! = (T! * 9 / 5) + 32 END IF END FUNCTION FUNCTION OnePlace! (Qty!) OnePlace! = CINT(10 * Qty!) / 10 END FUNCTION FUNCTION IText$ (J!) __IText$ = LTRIM$(STR$(J!)) IText$ = __IText$ IF LEFT$(__IText$, 1) = "." THEN IText$ = "0" + __IText$ ELSEIF LEFT$(__IText$, 2) = "-." THEN IText$ = "-0." + RIGHT$(__IText$, LEN(__IText$) - 2) END IF END FUNCTION ': Event procedures: --------------------------------------------------------------- SUB __UI_BeforeInit END SUB SUB __UI_OnLoad _SCREENMOVE 120, 5 END SUB SUB __UI_BeforeUpdateDisplay 'This event occurs at approximately 30 frames per second. 'You can change the update frequency by calling SetFrameRate DesiredRate% STATIC InitDone%%, FThermometer&, TBase&, FLiquid&, CThermometer&, CLiquid& STATIC FT%, FB%, FS%, CT%, CB%, CS%, FTMax%, CTMax%, TD%, FTMin%, CTMin%, OldScale%% STATIC Pics&(), TRange!() IF NOT InitDone%% THEN ': Everything (except events) is done in the __UI_BeforeUpdateDisplay SUB ': All initiations, image loading & manipulations are done once here InitDone%% = TRUE DIM Pics&(1, 4), TRange!(1, 3) ': Read temperature Ranges RESTORE temp_range FOR I1%% = 0 TO 1 FOR J1%% = 0 TO 3 READ TRange!(I1%%, J1%%) NEXT J1%% NEXT I1%% ': Load Images FOR J1%% = 0 TO 4 Pics&(0, J1%%) = _LOADIMAGE("temp" + IText$(J1%%) + ".png", 32) _ASSERT Pics&(0, J1%%) < -1, "Failed to load temp" + IText$(J1%%) + ".png" Pics&(1, J1%%) = _LOADIMAGE("temp1" + IText$(J1%%) + ".png", 32) _ASSERT Pics&(1, J1%%) < -1, "Failed to load temp1" + IText$(J1%%) + ".png" NEXT J1%% ': _MEM processing to convert red into green for Celsius thermometer DIM CMem AS _MEM, COff AS _OFFSET FThermometer& = _LOADIMAGE("thermo.png", 32) _ASSERT FThermometer& < -1, "Failed to load thermo.png" TBase& = _LOADIMAGE("tbase.png", 32) _ASSERT TBase& < -1, "Failed to load tbase.png" FLiquid& = _LOADIMAGE("rbase.png", 32) _ASSERT FLiquid& < -1, "Failed to load rbase.png" CThermometer& = _LOADIMAGE("thermo.png", 32) _ASSERT CThermometer& < -1, "Failed to load thermo.png" CLiquid& = _LOADIMAGE("rbase.png", 32) _ASSERT CLiquid& < -1, "Failed to load rbase.png" CMem = _MEMIMAGE(CThermometer&) COff = 0 WHILE COff < CMem.SIZE B1~%% = _MEMGET(CMem, CMem.OFFSET + COff + 1, _UNSIGNED _BYTE) 'Green B2~%% = _MEMGET(CMem, CMem.OFFSET + COff + 2, _UNSIGNED _BYTE) 'Red IF _MEMGET(CMem, CMem.OFFSET + COff + 3, _UNSIGNED _BYTE) <> 0 THEN 'Alpha IF B2~%% / B1~%% > 1.5 THEN _MEMPUT CMem, CMem.OFFSET + COff + 1, B2~%% AS _UNSIGNED _BYTE 'Green _MEMPUT CMem, CMem.OFFSET + COff + 2, B1~%% AS _UNSIGNED _BYTE 'Red END IF END IF COff = COff + 4 WEND _MEMFREE CMem CMem = _MEMIMAGE(CLiquid&) COff = 0 WHILE COff < CMem.SIZE B1~%% = _MEMGET(CMem, CMem.OFFSET + COff + 1, _UNSIGNED _BYTE) 'Green B2~%% = _MEMGET(CMem, CMem.OFFSET + COff + 2, _UNSIGNED _BYTE) 'Red IF _MEMGET(CMem, CMem.OFFSET + COff + 3, _UNSIGNED _BYTE) <> 0 THEN 'Alpha IF B2~%% / B1~%% > 1.5 THEN _MEMPUT CMem, CMem.OFFSET + COff + 1, B2~%% AS _UNSIGNED _BYTE 'Green _MEMPUT CMem, CMem.OFFSET + COff + 2, B1~%% AS _UNSIGNED _BYTE 'Red END IF END IF COff = COff + 4 WEND _MEMFREE CMem ': Display thermometer images in picture boxes ': All images are software (,32) BeginDraw FahrenheitPBox 'Drawing code goes here _PUTIMAGE (FPos%, YPos%), FThermometer& COLOR _RGB32(0, 0, 0), _RGB32(235, 233, 237) _PRINTSTRING (72, 20), CHR$(248) + "F" EndDraw FahrenheitPBox BeginDraw CelsiusPBox 'Drawing code goes here _PUTIMAGE (CPos%, YPos%), CThermometer& COLOR _RGB32(0, 0, 0), _RGB32(235, 233, 237) _PRINTSTRING (10, 20), CHR$(248) + "C" EndDraw CelsiusPBox END IF ': New Scales IF Control(BodyTempRB).Value <> OldScale%% THEN OldScale%% = Control(BodyTempRB).Value IF OldScale%% THEN ': Body Temperature Scales FSetTemp! = 98.4 CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE)) Text(FahrenheitTB) = IText$(FSetTemp!) Text(CelsiusTB) = IText$(CSetTemp!) FT% = 44 FB% = 644 FS% = 5 CT% = 50 CB% = 610 CS% = 7 FTMax% = 106 CTMax% = 42 TD% = 10 FTMin% = FTMax% - (FB% - FT%) / (FS% * TD%) CTMin% = CTMax% - (CB% - CT%) / (CS% * TD%) ELSE ': Room Temperature Scales FT% = 70 FB% = 590 FS% = 2 CT% = 60 CB% = 620 CS% = 4 FTMax% = 220 CTMax% = 100 TD% = 1 FTMin% = FTMax% - (FB% - FT%) / (FS% * TD%) CTMin% = CTMax% - (CB% - CT%) / (CS% * TD%) END IF ': Draw Scales BeginDraw FahrenheitPBox LINE (60, TT% - 1)-(100, TB% - 1), _RGB32(235, 233, 237), BF LINE (62, FT%)-(62, FB% + 1), _RGB32(0, 0, 0) LINE (63, FT%)-(63, FB% + 1), _RGB32(0, 0, 0) FOR N% = 0 TO (FB% - FT%) / FS% LINE (62, FT% + N% * FS%)-(67, FT% + N% * FS%), _RGB32(0, 0, 0) IF N% \ 5 = N% / 5 THEN LINE (62, FT% + N% * FS%)-(70, FT% + N% * FS%), _RGB32(0, 0, 0) IF N% \ 10 = N% / 10 THEN LINE (62, FT% + 1 + N% * FS%)-(70, FT% + 1 + N% * FS%), _RGB32(0, 0, 0) _PRINTSTRING (72, FT% - 6 + N% * FS%), IText$(FTMax% - N% / TD%) END IF END IF NEXT N% EndDraw FahrenheitPBox BeginDraw CelsiusPBox LINE (0, TT% - 1)-(39, TB% - 1), _RGB32(235, 233, 237), BF LINE (38, CT%)-(38, CB% + 1), _RGB32(0, 0, 0) LINE (37, CT%)-(37, CB% + 1), _RGB32(0, 0, 0) FOR N% = 0 TO (CB% - CT%) / CS% LINE (33, CT% + N% * CS%)-(38, CT% + N% * CS%), _RGB32(0, 0, 0) IF N% \ 5 = N% / 5 THEN LINE (30, CT% + N% * CS%)-(38, CT% + N% * CS%), _RGB32(0, 0, 0) IF N% \ 10 = N% / 10 THEN LINE (30, CT% + 1 + N% * CS%)-(38, CT% + 1 + N% * CS%), _RGB32(0, 0, 0) M% = CTMax% - N% / TD% MS$ = IText$(M%) IF M% > 0 AND M% < 100 THEN MS$ = " " + MS$ ELSEIF M% = 0 THEN MS$ = " " + MS$ END IF _PRINTSTRING (4, CT% - 6 + N% * CS%), MS$ END IF END IF NEXT N% EndDraw CelsiusPBox PicUpdate%% = TRUE END IF ': Poll Mouse LM% = __UI_MouseLeft TM% = __UI_MouseTop ': Look for position inside thermometer tubes and check Click IF LM% > 70 + TFPos% AND LM% < 70 + TFPos% + 24 AND TM% > FT% AND TM% < FB% THEN InFahrenheit%% = TRUE TempT! = OnePlace!(FTMax% + ((TM% - FT%) * (FTMin% - FTMax%) / (FB% - FT%))) IF NOT TClicked%% THEN Text(FahrenheitTB) = IText$(TempT!) ELSEIF LM% > 290 + TCPos% AND LM% < 290 + TCPos% + 24 AND TM% > CT% AND TM% < CB% THEN InCelsius%% = TRUE TempT! = OnePlace!(CTMax% + (TM% - CT%) * (CTMin% - CTMax%) / (CB% - CT%)) IF NOT TClicked%% THEN Text(CelsiusTB) = IText$(TempT!) ELSE IF InFahrenheit%% AND NOT TClicked%% THEN Text(FahrenheitTB) = IText$(FSetTemp!) ELSEIF InCelsius%% AND NOT TClicked%% THEN Text(CelsiusTB) = IText$(CSetTemp!) END IF InFahrenheit%% = FALSE InCelsius%% = FALSE IF TClicked%% THEN TClicked%% = FALSE END IF ': Update thermometers IF PicUpdate%% THEN PicUpdate%% = FALSE YF% = FT% + (FSetTemp! - FTMax%) * (FB% - FT%) / (FTMin% - FTMax%) YC% = CT% + (CSetTemp! - CTMax%) * (CB% - CT%) / (CTMin% - CTMax%) BeginDraw FahrenheitPBox _PUTIMAGE (TFPos%, TYPos%), TBase& IF YF% >= FT% AND YF% <= FB% THEN _PUTIMAGE (TFPos%, YF%)-(TFPos% + 24, ScaleMin%), FLiquid&, , (0, 0)-(24, ScaleMin% - YF%) EndDraw FahrenheitPBox BeginDraw CelsiusPBox _PUTIMAGE (TCPos%, TYPos%), TBase& IF YC% >= CT% AND YC% <= CB% THEN _PUTIMAGE (TCPos%, YC%)-(TCPos% + 24, ScaleMin%), CLiquid&, , (0, 0)-(24, ScaleMin% - YC%) EndDraw CelsiusPBox ': If temperature outside thermometer scale do not display liquid column IF YF% < FT% OR YF% > FB% THEN YF% = ScaleMin% IF YC% < CT% OR YC% > CB% THEN YC% = ScaleMin% ': If fixed text boxes, set at default IF Control(FixTextBoxesTS).Value THEN YF% = 396 YC% = 396 END IF Control(FahrenheitTB).Top = YF% - 8 Control(CelsiusTB).Top = YC% - 8 Control(FahrenheitLB).Top = YF% - 8 - 23 Control(CelsiusLB).Top = YC% - 8 - 23 ': Display Image dependent upon temperature range BeginDraw DispPB LINE (0, 0)-(119, 199), _RGB32(235, 233, 237), BF IF Control(BodyTempRB).Value THEN SELECT CASE FSetTemp! CASE IS < TRange!(0, 0) _PUTIMAGE , Pics&(0, 0) CASE TRange!(0, 0) TO TRange!(0, 1) _PUTIMAGE , Pics&(0, 1) CASE TRange!(0, 1) TO TRange!(0, 2) _PUTIMAGE , Pics&(0, 2) CASE TRange!(0, 2) TO TRange!(0, 3) _PUTIMAGE , Pics&(0, 3) CASE IS > TRange!(0, 3) _PUTIMAGE , Pics&(0, 4) END SELECT ELSE SELECT CASE CSetTemp! CASE IS < TRange!(1, 0) _PUTIMAGE , Pics&(1, 0) CASE TRange!(1, 0) TO TRange!(1, 1) _PUTIMAGE , Pics&(1, 1) CASE TRange!(1, 1) TO TRange!(1, 2) _PUTIMAGE , Pics&(1, 2) CASE TRange!(1, 2) TO TRange!(1, 3) _PUTIMAGE , Pics&(1, 3) CASE IS > TRange!(1, 3) _PUTIMAGE , Pics&(1, 4) END SELECT END IF EndDraw DispPB END IF temp_range: DATA 96.4,97.4,99.4,100.4 DATA -10,10,30,50 END SUB SUB __UI_BeforeUnload 'If you set __UI_UnloadSignal = False here you can 'cancel the user's request to close. END SUB SUB __UI_Click (id AS LONG) SELECT CASE id CASE FahrenheitToCelsius CASE ScaleFrame CASE DispPB CASE BodyTempRB CASE RoomTempRB CASE FahrenheitTB CASE CelsiusTB CASE FahrenheitLB CASE CelsiusLB CASE FixTextBoxesLB CASE FahrenheitPBox ': Check for click in thermometer columns IF InFahrenheit%% AND NOT TClicked%% THEN TClicked%% = TRUE FSetTemp! = OnePlace!(TempT!) Text(FahrenheitTB) = IText$(FSetTemp!) CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE)) Text(CelsiusTB) = IText$(CSetTemp!) PicUpdate%% = TRUE END IF CASE CelsiusPBox ': Check for click in thermometer columns IF InCelsius%% AND NOT TClicked%% THEN TClicked%% = TRUE CSetTemp! = OnePlace!(TempT!) Text(CelsiusTB) = IText$(CSetTemp!) FSetTemp! = OnePlace!(FTOC!(CSetTemp!, FALSE)) Text(FahrenheitTB) = IText$(FSetTemp!) PicUpdate%% = TRUE END IF CASE FixTextBoxesTS ': Check for Toggle Switch Click PicUpdate%% = TRUE CASE ExitBT ': Click Exit Button SYSTEM END SELECT END SUB SUB __UI_MouseEnter (id AS LONG) END SUB SUB __UI_MouseLeave (id AS LONG) END SUB SUB __UI_FocusIn (id AS LONG) END SUB SUB __UI_FocusOut (id AS LONG) 'This event occurs right before a control loses focus. 'To prevent a control from losing focus, set __UI_KeepFocus = True below. END SUB SUB __UI_MouseDown (id AS LONG) END SUB SUB __UI_MouseUp (id AS LONG) END SUB SUB __UI_KeyPress (id AS LONG) 'When this event is fired, __UI_KeyHit will contain the code of the key hit. 'You can change it and even cancel it by making it = 0 IF __UI_KeyHit = 27 THEN 'Esc key (only responds after a Click event has happened) SYSTEM ELSEIF __UI_KeyHit = 13 THEN 'CR SELECT CASE id CASE BodyTempRB CASE RoomTempRB CASE FixTextBoxesTS CASE FahrenheitTB ': Update Fahrenheit temperature & convert FSetTemp! = OnePlace!(VAL(Text(FahrenheitTB))) Text(FahrenheitTB) = IText$(FSetTemp!) CSetTemp! = OnePlace!(FTOC!(FSetTemp!, TRUE)) Text(CelsiusTB) = IText$(CSetTemp!) PicUpdate%% = TRUE CASE CelsiusTB ': Update Celsius temperature & convert CSetTemp! = OnePlace!(VAL(Text(CelsiusTB))) Text(CelsiusTB) = IText$(CSetTemp!) FSetTemp! = OnePlace!(FTOC!(CSetTemp!, FALSE)) Text(FahrenheitTB) = IText$(FSetTemp!) PicUpdate%% = TRUE CASE ExitBT SYSTEM 'Does this condition ever get met? END SELECT END IF END SUB SUB __UI_TextChanged (id AS LONG) END SUB SUB __UI_ValueChanged (id AS LONG) END SUB SUB __UI_FormResized END SUB