'hx8357 $nocompile Config Submode = New '------------------------------------------------------------------------------- 'pre define Colors '------------------------------------------------------------------------------- Const Red = &HF800 Const Green = &H07E0 Const Blue = &H001F 'Const White = &HFFFF Const Black = &H0000 Const Yellow = &HFFE0 'Const Cyan = &H0410 'Const Magenta = &H8010 'Const Brown = &HFC00 'Const Olive = &H8400 'Const Bright_red = &HF800 'Const Bright_green = &H07E0 'Const Bright_blue = &H001F 'Const Bright_yellow = &HFFE0 'Const Bright_cyan = &H07FF 'Const Bright_magenta = &HF81F 'Const Light_gray = &H8410 'Const Dark_gray = &H4208 'Const Light_blue = &H841F 'Const Light_green = &H87F0 'Const Light_cyan = &H87FF 'Const Light_red = &HFC10 'Const Gray1 = &HC618 'Const Gray2 = &HA514 'Const Gray3 = &H630C 'Const Gray4 = &H4208 'Const Gray5 = &H2104 'Const Gray6 = &H3186 'Const Blue0 = &H1086 'Const Blue1 = &H3188 Const Blue2 = &H4314 Const Blue3 = &H861C 'Const Cyan0 = &H3D34 'Const Cyan1 = &H1DF7 Const Green0 = &H0200 Const Green1 = &H0208 'Dim Color_array(10) As Word 'Color_array(1) = Red 'Color_array(2) = Green 'Color_array(3) = Blue 'Color_array(4) = White 'Color_array(5) = Bright_yellow 'Color_array(6) = Yellow 'Color_array(7) = Cyan 'Color_array(8) = Magenta 'Color_array(9) = Brown 'Color_array(10) = Black Const Landscape = 0 Const Portrait = 1 Dim X_pixel As Word , Y_pixel As Word Dim Orient As Byte Const Disp_y_size = 479 Sub Hx8357c_write_com(byval Command As Byte) Reset Rs_disp 'Reset Cs_disp 'Nop : Nop Data_disp_hi = 0 Data_disp_lo = Command Reset Wr_disp 'Nop : Nop Set Wr_disp 'Set Cs_disp End Sub Sub Hx8357c_write_dataw(byval Data_w As Word) Set Rs_disp 'Reset Cs_disp Data_disp_hi = High(data_w) Data_disp_lo = Low(data_w) Reset Wr_disp 'Nop : Nop Set Wr_disp 'Set Cs_disp End Sub Sub Hx8357c_write_datab(byval Data_b As Byte) Set Rs_disp 'Reset Cs_disp Data_disp_hi = 0 Data_disp_lo = Data_b Reset Wr_disp 'Nop : Nop Set Wr_disp 'Set Cs_disp End Sub Sub Hx8357c_write_adr(byval Adress As Word) Set Rs_disp Data_disp_hi = 0 Data_disp_lo = High(adress) Reset Wr_disp Set Wr_disp Data_disp_lo = Low(adress) Reset Wr_disp Set Wr_disp End Sub Sub Hx8357c_init(byval Orientation As Byte) Orient = Orientation '0=Landscape 1=Portrait ' First, Reset the Display Res_disp = 1 Waitms 50 Res_disp = 0 Waitms 50 Res_disp = 1 'Set Cs_disp Set Wr_disp Waitms 50 Call Hx8357c_write_com(&H11) Waitms 20 Call Hx8357c_write_com(&HD0) Call Hx8357c_write_datab(&H07) Call Hx8357c_write_datab(&H42) Call Hx8357c_write_datab(&H18) Call Hx8357c_write_com(&HD1) Call Hx8357c_write_datab(&H00) Call Hx8357c_write_datab(&H07) Call Hx8357c_write_datab(&H10) Call Hx8357c_write_com(&HD2) Call Hx8357c_write_datab(&H01) Call Hx8357c_write_datab(&H02) Call Hx8357c_write_com(&HC0) Call Hx8357c_write_datab(&H10) Call Hx8357c_write_datab(&H3B) Call Hx8357c_write_datab(&H00) Call Hx8357c_write_datab(&H02) Call Hx8357c_write_datab(&H11) Call Hx8357c_write_com(&HC5) Call Hx8357c_write_datab(&H03) Call Hx8357c_write_com(&HC8) Call Hx8357c_write_datab(&H00) Call Hx8357c_write_datab(&H32) Call Hx8357c_write_datab(&H36) Call Hx8357c_write_datab(&H45) Call Hx8357c_write_datab(&H06) Call Hx8357c_write_datab(&H16) Call Hx8357c_write_datab(&H37) Call Hx8357c_write_datab(&H75) Call Hx8357c_write_datab(&H77) Call Hx8357c_write_datab(&H54) Call Hx8357c_write_datab(&H0C) Call Hx8357c_write_datab(&H00) Call Hx8357c_write_com(&H36) Call Hx8357c_write_datab(&H0A) Call Hx8357c_write_com(&H3A) ' //один пиксель будет кодироваться 16 битами H05 Call Hx8357c_write_datab(&H55) 'было 55 Call Hx8357c_write_com(&H2A) Call Hx8357c_write_datab(&H00) Call Hx8357c_write_datab(&H00) Call Hx8357c_write_datab(&H01) Call Hx8357c_write_datab(&H3F) Call Hx8357c_write_com(&H2B) Call Hx8357c_write_datab(&H00) Call Hx8357c_write_datab(&H00) Call Hx8357c_write_datab(&H01) Call Hx8357c_write_datab(&HE0) Waitms 120 Call Hx8357c_write_com(&H29) Waitms 120 'If Orient = 1 Then ' X_pixel = 320 ' Y_pixel = 480 'Else X_pixel = 480 Y_pixel = 320 ' End If End Sub Sub Hx8357c_set_new_orient(byval New_orient As Byte) ' If New_orient = 1 Then ' X_pixel = 320 ' Y_pixel = 480 ' Orient = 1 'Else X_pixel = 480 Y_pixel = 320 Orient = 0 ' End If End Sub Sub Hx8357c_setxy(byval X1 As Word , Byval Y1 As Word , Byval X2 As Word , Byval Y2 As Word) Local Tmp As Integer 'If Orient = 0 Then Tmp = X1 X1 = Y1 Y1 = Disp_y_size - Tmp Tmp = X2 X2 = Y2 Y2 = Disp_y_size - Tmp Tmp = Y1 Y1 = Y2 Y2 = Tmp Data_disp_hi = 0 ' Call Hx8357c_write_com(&H2a) Reset Rs_disp : Data_disp_lo = &H2a : Reset Wr_disp : Set Wr_disp ''Call Hx8357c_write_adr(x1) Set Rs_disp : Data_disp_lo = High(x1) : Reset Wr_disp : Set Wr_disp : Data_disp_lo = Low(x1) : Reset Wr_disp : Set Wr_disp '' Call Hx8357c_write_adr(x2)'Set Rs_disp Data_disp_lo = High(x2) : Reset Wr_disp : Set Wr_disp : Data_disp_lo = Low(x2) : Reset Wr_disp : Set Wr_disp ' 'Call Hx8357c_write_com(&H2b) Reset Rs_disp : Data_disp_lo = &H2b : Reset Wr_disp : Set Wr_disp ' 'Call Hx8357c_write_adr(y1) Set Rs_disp : Data_disp_lo = High(y1) : Reset Wr_disp : Set Wr_disp : Data_disp_lo = Low(y1) : Reset Wr_disp : Set Wr_disp ' 'Call Hx8357c_write_adr(y2) 'Set Rs_disp Data_disp_lo = High(y2) : Reset Wr_disp : Set Wr_disp : Data_disp_lo = Low(y2) : Reset Wr_disp : Set Wr_disp ' 'Call Hx8357c_write_com(&H2c) Reset Rs_disp : Data_disp_lo = &H2c : Reset Wr_disp : Set Wr_disp ' End Sub 'Sub Hx8357c_setxy_frame(byval X1 As Word , Byval Y1 As Word , Byval X2 As Word , Byval Y2 As Word) 'Swap X1 , Y1 'Swap X2 , Y2 'Call Hx8357c_write_com(&H2a) 'Call Hx8357c_write_adr(x1) 'Call Hx8357c_write_adr(x2) 'Call Hx8357c_write_com(&H2b) 'Call Hx8357c_write_adr(y1) 'Call Hx8357c_write_adr(y2) 'Call Hx8357c_write_com(&H2c) '&H3C 'End Sub Sub Hx8357c_clrscr(byval Color As Word) Local I As Long 'Local Tmp As Integer 'If Orient = 1 Then 'Portrait ' Call Hx8357c_setxy(0 , 0 , 319 , Disp_y_size) 'was 319 'Else Call Hx8357c_setxy(0 , 0 , Disp_y_size , 319) 'was 319 'End If Set Rs_disp For I = 0 To 153599 '95999 'Call Hx8357c_write_dataw(color) Data_disp_hi = High(color) Data_disp_lo = Low(color) Reset Wr_disp Set Wr_disp Next I End Sub Sub Hx8357c_text(byval S As String , Byval Xoffset As Word , Byval Yoffset As Word , Byval Fontset As Byte , Byval Forecolor As Word , Byval Backcolor As Word) 'Print text on the display Local Tempstring As String * 1 , Temp As Word 'Dim local the variables Local A As Word , Pixels As Byte , Count As Byte , Carcount As Byte , Lus As Byte Local Row As Byte , Byteseach As Byte , Blocksize As Byte , Dummy As Byte Local Colums As Byte , Columcount As Byte , Rowcount As Byte , Stringsize As Byte Local Xpos As Word , Ypos As Word , Pixel As Word , Pixelcount As Byte Stringsize = Len(s) - 1 'Size of the text string -1 because we must start with 0 For Carcount = 0 To Stringsize 'Loop for the numbers of caracters that must be displayed If Fontset = 1 Then Restore Font8x8 'Font8x8 'Add or remove here fontset's that you need or not, If Fontset = 2 Then Restore Font12x16 If Fontset = 3 Then Restore Font12x16 'Crn15x16 'right on top. Temp = Carcount + 1 'Cut the text string in seperate caracters Tempstring = Mid(s , Temp , 1) Read Row : Read Byteseach : Read Blocksize : Read Dummy 'Read the first 4 bytes from the font file Temp = Asc(tempstring) - 32 'Font files start with caracter 32 For Lus = 1 To Temp 'Do dummie read to point to the correct line in the fontfile For Count = 1 To Blocksize Read Pixels Next Count Next Lus Colums = Blocksize / Row 'Calculate the numbers of colums Row = Row * 8 'Row is always 8 pixels high = 1 byte, so working with row in steps of 8. Row = Row - 1 'Want to start with row=0 instead of 1 Colums = Colums - 1 'Same for the colums For Rowcount = 0 To Row Step 8 'Loop for numbers of rows A = Rowcount + Yoffset For Columcount = 0 To Colums 'Loop for numbers of Colums Read Pixels Xpos = Columcount 'Do some calculation to get the caracter on the correct Xposition Temp = Carcount * Byteseach Xpos = Xpos + Temp Xpos = Xpos + Xoffset For Pixelcount = 0 To 7 'Loop for 8 pixels to be set or not Ypos = A + Pixelcount 'Each pixel on his own spot Pixel = Pixels.0 'Set the pixel (or not) If Pixel = 1 Then Pixel = Forecolor Else Pixel = Backcolor End If Call Hx8357c_set_pixel(xpos , Ypos , Pixel) 'Finaly we can set the pixel Shift Pixels , Right 'Shift the byte 1 bit to the right so the next pixel comes availible Next Pixelcount Next Columcount Next Rowcount Next Carcount End Sub '------------------------------------------------------------------------------- ' hx8357c_set_pixel Set one Pixel in given color '------------------------------------------------------------------------------- Sub Hx8357c_set_pixel(byval X1 As Word , Byval Y1 As Word , Byval Color_set As Word) Call Hx8357c_setxy(x1 , Y1 , X1 , Y1) 'Call Hx8357c_write_dataw(color_set) Set Rs_disp : Data_disp_hi = High(color_set) : Data_disp_lo = Low(color_set) : Reset Wr_disp : Set Wr_disp End Sub '------------------------------------------------------------------------------- ' hx8357c_line draw line in given color '------------------------------------------------------------------------------- Sub Hx8357c_line(byval X1 As Word , Byval Y1 As Word , Byval X2 As Word , Byval Y2 As Word , Byval Color_line As Word) Local Y As Word , X As Word , X_diff As Single , Y_diff As Single , Pos As Word Local X_factor As Single , X_pos As Word , Y_pos As Word , Base As Word If X1 > X_pixel Then X1 = X_pixel If X2 > X_pixel Then X2 = X_pixel If Y1 > Y_pixel Then Y1 = Y_pixel If Y2 > Y_pixel Then Y2 = Y_pixel Y_diff = Y2 - Y1 X_diff = X2 - X1 Pos = 0 X_factor = Abs(y_diff) Y = X_factor X_factor = Abs(x_diff) X = X_factor If Y > X Then X_factor = X_diff / Y_diff If Y1 > Y2 Then Swap Y1 , Y2 Base = X2 Else Base = X1 End If For Y = Y1 To Y2 X_diff = Pos * X_factor X_pos = X_diff X_pos = X_pos + Base Call Hx8357c_set_pixel(x_pos , Y , Color_line) 'Call Hx8357c_write_dataw(color_line) Incr Pos Next Y Else X_factor = Y_diff / X_diff ' If X1 > X2 Then ' Swap X1 , X2 ' Base = Y2 'Else Base = Y1 'End If For X = X1 To X2 Y_diff = Pos * X_factor Y_pos = Y_diff Y_pos = Y_pos + Base Call Hx8357c_set_pixel(x , Y_pos , Color_line) 'Call Hx8357c_write_dataw(color_line) Incr Pos Next X End If End Sub