当年我QB的封笔之作——在VGA 12h 模式下实时抖动绘制真彩色数据

原创 2006年05月29日 20:59:00

当年我QB的封笔之作——在VGA 12h 模式下实时抖动绘制真彩色数据

'View RGB
'作者:zyl910

'使用有序抖动算法(dither)绘制线性渐变区域、RGB色彩空间(Screen 12下)
' Up , Down , PageUp , PageDown: 改变B分量
' F4~F8: 改变背景
' Esc: 退出
'直接在QB环境下运行速度很慢,编译为exe后就快些了

'展示了以下技术:
'1.QB在 VGA 12h 如何快速绘图
'2.有序抖动算法的实现
'3.模拟Windows窗口,特别是像Windows 98那样的渐变标题栏

 

ViewRGB的界面

代码
'View RGB
'作者:zyl910
'使用有序抖动算法(dither)绘制线性渐变区域、RGB色彩空间(Screen 12下)
' Up , Down , PageUp , PageDown: 改变B分量
' F4~F8: 改变背景
' Esc: 退出
'直接在QB环境下运行速度很慢,编译为exe后就快些了
'展示了以下技术:
'1.QB在 VGA 12h 如何快速绘图
'2.有序抖动算法的实现
'3.模拟Windows窗口,特别是像Windows 98那样的渐变标题栏
 

'== Rect =====================================================================
TYPE Rect
 Left AS INTEGER
 Top AS INTEGER
 Right AS INTEGER
 Bottom AS INTEGER
END TYPE
CONST RectNoNum = &H8000
DECLARE FUNCTION GetRectW% (rct AS Rect)
DECLARE FUNCTION GetRectH% (rct AS Rect)
DECLARE SUB SetRect (rct AS Rect, x1%, y1%, x2%, y2%)
DECLARE SUB SetRectPos (rct AS Rect, x%, y%)
DECLARE SUB SetRectSize (rct AS Rect, w%, h%)
DECLARE SUB MoveRect (rct AS Rect, x%, y%)
DECLARE SUB SizeRect (rct AS Rect, x%, y%)
DECLARE SUB SetRectMinMax (rct AS Rect, MinX%, MinY%, MaxX%, MaxY%)
DECLARE SUB RectAddSize (rct AS Rect, xAdd AS INTEGER, yAdd AS INTEGER)
DECLARE FUNCTION RectIsNull% (rct AS Rect)
'== Bit ======================================================================
DECLARE SUB InitBit ()
DECLARE FUNCTION MakeWord% (LoByte AS INTEGER, HiByte AS INTEGER)
CONST True = -1
CONST False = 0
'== MemCopy ==================================================================
DECLARE SUB InitMemCopy ()
DECLARE SUB MemCopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)
'== Font =====================================================================
DECLARE SUB InitFont ()
DECLARE SUB DrawText (rct AS Rect, DrawStr AS STRING)
DECLARE SUB DrawTextEx (rct AS Rect, StepX AS INTEGER, StepY AS INTEGER, DrawStr AS STRING, c AS INTEGER)
CONST CharWi = 8
CONST CharHe = 16
'== Color ====================================================================
DECLARE SUB InitLightM ()
DECLARE FUNCTION RGB12% (x%, y%, R%, G%, B%)
'== Draw =====================================================================
DECLARE SUB DrawEdge (qrc AS Rect, Edge AS INTEGER)
DECLARE SUB DrawEdge0 (qrc AS Rect, Edge AS INTEGER)
CONST BdrRAISEDOUTER = &H1 '外层凸
CONST BdrSUNKENOUTER = &H2 '外层凹
CONST BdrRAISEDINNER = &H4 '内层凸
CONST BdrSUNKENINNER = &H8 '内层凹
CONST BdrRAISED = &H5 '凸
CONST BdrSUNKEN = &HA '凹
CONST BdrOuter = &H3 '外
CONST BdrInner = &HC '内
CONST EdgeRAISED = (BdrRAISEDOUTER OR BdrRAISEDINNER)
CONST EdgeETCHED = (BdrSUNKENOUTER OR BdrRAISEDINNER)
CONST EdgeBUMP = (BdrRAISEDOUTER OR BdrSUNKENINNER)
CONST EdgeSUNKEN = (BdrSUNKENOUTER OR BdrSUNKENINNER)

DECLARE SUB FillRect (rct AS Rect, c AS INTEGER)
CONST OnlyLine = &H8000

DECLARE SUB GradH12 (rct AS Rect, cl%, cr%)
DECLARE SUB GradV12 (rct AS Rect, ct%, cb%)

DECLARE SUB DrawForm (rct AS Rect, TitleStr AS STRING)
DECLARE SUB DrawCaption (rct AS Rect, TitleStr AS STRING)
'== Shared Var ===============================================================
DIM SHARED BitMaskInt(0 TO &HF) AS INTEGER
DIM SHARED ASM.MemCopy AS STRING * 28
DIM SHARED FontData(0 TO &HF, 0 TO &HFF) AS INTEGER
DIM SHARED TextC AS INTEGER
DIM SHARED TextStepX AS INTEGER
DIM SHARED TextStepY AS INTEGER
DIM SHARED TextLf AS INTEGER
DIM SHARED AutoLf AS INTEGER
DIM SHARED CharAdd AS INTEGER
DIM SHARED LineAdd AS INTEGER
DIM SHARED BaseLightnessMatrix(0 TO 15, 0 TO 15) AS INTEGER
DIM SHARED LightnessMatrix(0 TO 15, 0 TO 15) AS INTEGER
DIM SHARED RGBIndex(0 TO 1, 0 TO 1, o TO 1) AS INTEGER
'== Const ====================================================================
CONST MyTitle = "View RGB (For QB) V1.0"

CONST ScrColor = 3
CONST ScrWi = 640
CONST ScrHe = 480
CONST MaxWi = ScrWi - 1
CONST MaxHe = ScrHe - 1
CONST TitleHe = 18
CONST TitleLC = 1
CONST TitleRC = 9
CONST CapHe = 1 + TitleHe + 1
CONST EdgeSize = 2
CONST FormBkC = 7
CONST FormTitleC = &HF
CONST FormTop = EdgeSize + CapHe
CONST FormLeft = EdgeSize + 1
CONST FormRight = EdgeSize + 1
CONST FormBottom = EdgeSize + 1
CONST FormStep = 4
CONST MapWi = &H100
CONST MapHe = &H100
CONST MaxMapWi = MapWi - 1
CONST MaxMapHe = MapHe - 1
CONST SolWi = &H10
CONST CurW = 8
CONST CurH = 5
'== Var ======================================================================
DIM I AS INTEGER, J AS INTEGER, K AS INTEGER
DIM ScrRect AS Rect
DIM FormRect AS Rect
DIM MyMap(0 TO ((MapWi / 8) * 4 / 2) * MapHe + 1) AS INTEGER
DIM valueB AS INTEGER
DIM Idx0 AS INTEGER, Idx AS INTEGER, CurIdx AS INTEGER
DIM TempInt(0 TO 3) AS INTEGER
DIM c AS INTEGER
DIM rct AS Rect
DIM HSB(0 TO 6) AS INTEGER
DIM ik AS STRING
DIM KeyCode AS INTEGER
DIM CurMap(0 TO ((CurW + 7) / 8) * 4 * CurH / 2 + 1) AS INTEGER
'== Begin ====================================================================
SCREEN 12
InitMemCopy
InitBit
InitFont
InitLightM
GOSUB LoadCur
HSB(0) = &HC
HSB(1) = &HE
HSB(2) = &HA
HSB(3) = &HB
HSB(4) = &H9
HSB(5) = &HD
HSB(6) = &HC

SetRect ScrRect, 0, 0, ScrWi, ScrHe
FillRect ScrRect, ScrColor
'GradV12 ScrRect, 10, 2

WHILE INKEY$ <> "": WEND 'Clean Key

GOSUB MakeMap
FormRect.Left = 0
FormRect.Top = 0
FormRect.Right = FormLeft + FormStep + MapWi + FormStep + SolWi + CurW + FormStep + FormRight
FormRect.Bottom = FormTop + FormStep + MapHe + FormStep + FormBottom
SetRectPos FormRect, (ScrWi - FormRect.Right) / 2, (ScrHe - FormRect.Bottom) / 2
GOSUB DrawMe
'WHILE INKEY$ = "": WEND
DO
 ik = INKEY$
 IF ik <> "" THEN
  IF LEN(ik) > 1 THEN
   KeyCode = ASC(MID$(ik, 2, 1))
   SELECT CASE KeyCode
   CASE 72'Up
    IF valueB > 0 THEN
     GOSUB DrawCur
     valueB = valueB - 1
     GOSUB DrawCur
     GOSUB MakeMap
     GOSUB DrawMap
    END IF
   CASE 80'Down
    IF valueB < &HFF THEN
     GOSUB DrawCur
     valueB = valueB + 1
     GOSUB DrawCur
     GOSUB MakeMap
     GOSUB DrawMap
    END IF
   CASE 73 'PageUp
    IF valueB > 0 THEN
     GOSUB DrawCur
     valueB = valueB - &H10
     IF valueB < 0 THEN valueB = 0
     GOSUB DrawCur
     GOSUB MakeMap
     GOSUB DrawMap
    END IF
   CASE 81 'PageDown
    IF valueB < &HFF THEN
     GOSUB DrawCur
     valueB = valueB + &H10
     IF valueB > &HFF THEN valueB = &HFF
     GOSUB DrawCur
     GOSUB MakeMap
     GOSUB DrawMap
    END IF
   CASE 62 'F4
    FillRect ScrRect, ScrColor
    GOSUB DrawMe
   CASE 63 'F5
    GradH12 ScrRect, 10, 2
    GOSUB DrawMe
   CASE 64 'F6
    GradV12 ScrRect, 10, 2
    GOSUB DrawMe
   CASE 65 'F7
    rct.Top = 0
    rct.Bottom = ScrHe
    FOR I = 1 TO 6
     rct.Left = (I - 1) * ScrWi / 6
     rct.Right = I * ScrWi / 6
     GradH12 rct, HSB(I - 1), HSB(I)
    NEXT I
    GOSUB DrawMe
   CASE 66 'F8
    rct.Left = 0
    rct.Right = ScrWi
    FOR I = 1 TO 6
     rct.Top = (I - 1) * ScrHe / 6
     rct.Bottom = I * ScrHe / 6
     GradV12 rct, HSB(I - 1), HSB(I)
    NEXT I
    GOSUB DrawMe
   END SELECT
  ELSE
   KeyCode = ASC(ik)
   SELECT CASE KeyCode
   CASE 27 'Esc
    EXIT DO
   END SELECT
  END IF
 END IF
LOOP
SCREEN 0
END
LoadCur:
LINE (0, 0)-(CurW - 1, CurH - 1), 0, BF
LINE (CurW / 2, 0)-(0, CurH / 2), &HF
LINE -(CurW / 2, CurH - 1), &HF
LINE -(CurW - 1, CurH - 1), &HF
LINE -(CurW - 1, 0), &HF
LINE -(CurW / 2, 0), &HF
PAINT (CurW / 2, CurH / 2), &HF
GET (0, 0)-(CurW - 1, CurH - 1), CurMap
'WHILE INKEY$ = "": WEND
RETURN

DrawCur:
PUT (FormRect.Left + FormLeft + FormStep + MapWi + FormStep + SolWi, FormRect.Top + FormTop + FormStep + valueB - CurH / 2), CurMap, XOR
RETURN

MakeMap:
MyMap(0) = MapWi
MyMap(1) = MapHe
Idx0 = 2
FOR I = 0 TO MaxMapHe
 FOR J = 0 TO MaxMapWi
  CurIdx = J AND &HF
  IF CurIdx = 0 THEN
   FOR K = 0 TO 3
    TempInt(K) = 0
   NEXT K
  END IF
  c = RGB12(I, J, I, J, valueB)
  FOR K = 0 TO 3
   IF BitMaskInt(7 - K) AND c THEN TempInt(K) = TempInt(K) OR BitMaskInt(CurIdx)
  NEXT K
  IF CurIdx = &HF THEN
   Idx = Idx0
   FOR K = 0 TO 3
    MyMap(Idx) = TempInt(K)
    Idx = Idx + &H10 'MapWi/8/2
   NEXT K
   Idx0 = Idx0 + 1
  END IF
 NEXT J
 Idx0 = Idx0 + &H30 '(MapWi/8/2)*3
NEXT I
RETURN

DrawMap:
PUT (FormRect.Left + FormLeft + FormStep, FormRect.Top + FormTop + FormStep), MyMap, PSET
RETURN
DrawMe:
DrawForm FormRect, MyTitle
SetRect rct, 0, 0, SolWi, MapHe
MoveRect rct, FormLeft + FormStep + MapWi + FormStep, FormTop + FormStep
MoveRect rct, FormRect.Left, FormRect.Top
GradV12 rct, 0, 9
GOSUB DrawMap
GOSUB DrawCur
RETURN
'有序抖动亮度趋势矩阵
DATA 00,EB,3B,DB,0F,E7,37,D7,02,E8,38,D9,0C,E5,34,D5
DATA 80,40,BB,7B,8F,4F,B7,77,82,42,B8,78,8C,4C,B4,74
DATA 21,C0,10,FB,2F,CF,1F,F7,22,C2,12,F8,2C,CC,1C,F4
DATA A1,61,90,50,AF,6F,9F,5F,A2,62,92,52,AC,6C,9C,5C
DATA 08,E1,30,D0,05,EF,3F,DF,0A,E2,32,D2,06,EC,3C,DC
DATA 88,48,B0,70,85,45,BF,7F,8A,4A,B2,72,86,46,BC,7C
DATA 29,C8,18,F0,24,C5,14,FF,2A,CA,1A,F2,26,C6,16,FC
DATA A9,69,98,58,A4,64,94,54,AA,6A,9A,5A,A6,66,96,56
DATA 03,E9,39,D8,0D,E4,35,D4,01,EA,3A,DA,0E,E6,36,D6
DATA 83,43,B9,79,8D,4D,B5,75,81,41,BA,7A,8E,4E,B6,76
DATA 23,C3,13,F9,2D,CD,1D,F5,20,C1,11,FA,2E,CE,1E,F6
DATA A3,63,93,53,AD,6D,9D,5D,A0,60,91,51,AE,6E,9E,5E
DATA 0B,E3,33,D3,07,ED,3D,DD,09,E0,31,D1,04,EE,3E,DE
DATA 8B,4B,B3,73,87,47,BD,7D,89,49,B1,71,84,44,BE,7E
DATA 2B,CB,1B,F3,27,C7,17,FD,28,C9,19,F1,25,C4,15,FE
DATA AB,6B,9B,5B,A7,67,97,57,A8,68,99,59,A5,65,95,55
SUB DrawCaption (rct AS Rect, TitleStr AS STRING)
 DIM TempRect AS Rect
 TempRect.Left = rct.Left + EdgeSize
 TempRect.Top = rct.Top + EdgeSize
 TempRect.Right = rct.Right - EdgeSize
 SetRectSize TempRect, RectNoNum, CapHe
 FillRect TempRect, FormBkC OR OnlyLine
 SizeRect TempRect, -1, -1
 GradH12 TempRect, TitleLC, TitleRC
 DrawTextEx TempRect, 3, 1, TitleStr, FormTitleC
END SUB
SUB DrawEdge (qrc AS Rect, Edge AS INTEGER)
 DIM Inner AS INTEGER, Outer AS INTEGER
 DIM TempRect AS Rect
 Inner = Edge AND BdrInner
 Outer = Edge AND BdrOuter
 TempRect = qrc
 IF Outer = 0 THEN
 ELSEIF Outer = BdrOuter THEN
 ELSE
  DrawEdge0 TempRect, Outer
  SizeRect TempRect, -1, -1
 END IF
 IF Inner = 0 THEN
 ELSEIF Inner = BdrInner THEN
 ELSE
  DrawEdge0 TempRect, Inner
 END IF
END SUB
SUB DrawEdge0 (qrc AS Rect, Edge AS INTEGER)
 CONST c0 = &H0
 CONST c1 = &H8
 CONST c2 = &H7
 CONST c3 = &HF
 DIM clt AS INTEGER, crb AS INTEGER
 IF qrc.Right <= qrc.Left THEN EXIT SUB
 IF qrc.Bottom <= qrc.Top THEN EXIT SUB
 SELECT CASE Edge
 CASE BdrRAISEDOUTER
  clt = c2
  crb = c0
 CASE BdrSUNKENOUTER
  clt = c1
  crb = c3
 CASE BdrRAISEDINNER
  clt = c3
  crb = c1
 CASE BdrSUNKENINNER
  clt = c0
  crb = c2
 END SELECT
 LINE (qrc.Left, qrc.Top)-(qrc.Right - 1, qrc.Top), clt
 LINE (qrc.Left, qrc.Top)-(qrc.Left, qrc.Bottom - 1), clt
 LINE (qrc.Right - 1, qrc.Top)-(qrc.Right - 1, qrc.Bottom - 1), crb
 LINE (qrc.Left, qrc.Bottom - 1)-(qrc.Right - 1, qrc.Bottom - 1), crb
END SUB
SUB DrawForm (rct AS Rect, TitleStr AS STRING)
 FillRect rct, FormBkC
 DrawEdge rct, EdgeRAISED
 DrawCaption rct, TitleStr
END SUB
SUB DrawText (rct AS Rect, DrawStr AS STRING)
 DIM TempRect AS Rect
 DIM PosX AS INTEGER, PosY AS INTEGER
 DIM StrLen AS INTEGER
 DIM StrPos AS INTEGER
 DIM c AS STRING * 1
 DIM FontPos AS INTEGER
 DIM DrawMinX AS INTEGER, DrawMinY AS INTEGER
 DIM DrawMaxX AS INTEGER, DrawMaxY AS INTEGER
 DIM DrawY AS INTEGER
 DIM DrawX1 AS INTEGER, DrawX2 AS INTEGER
 DIM ExitFlags AS INTEGER
 DIM I AS INTEGER
 DIM MinI AS INTEGER, MaxI AS INTEGER
 DIM TempNum AS INTEGER
 PosX = rct.Left + TextStepX
 PosY = rct.Top + TextStepY
 TempRect = rct
 'PRINT rct.Top, rct.Bottom
 SetRectMinMax TempRect, 0, 0, ScrWi, ScrHe
 IF RectIsNull(TempRect) THEN EXIT SUB
 RectAddSize TempRect, -1, -1
 'PRINT TempRect.Top, TempRect.Bottom
 DrawMinX = TempRect.Left - (CharWi - 1)
 DrawMinY = TempRect.Top - (CharHe - 1)
 DrawMaxX = TempRect.Right + (CharWi - 1)
 DrawMaxY = TempRect.Bottom + (CharHe - 1)
 'PRINT DrawMinY, DrawMaxY
 DrawX1 = PosX
 DrawY = PosY
 StrLen = LEN(DrawStr)
 IF StrLen = 0 THEN EXIT SUB
 StrPos = 1
 'PRINT StrLen
 DO
  c = MID$(DrawStr, StrPos, 1)
  FontPos = ASC(c)
  'PRINT TextLf; c; " ";
  IF ((FontPos = 13) OR (FontPos = 10)) AND TextLf THEN
   'PRINT FontPos
   DrawX1 = PosX
   DrawY = DrawY + LineAdd
   IF StrPos < StrLen OR FontPos = 13 THEN 'CrLf
    IF ASC(MID$(DrawStr, StrPos + 1, 1)) = 10 THEN StrPos = StrPos + 1
   END IF
  END IF
  IF DrawX1 + CharWi >= TempRect.Right THEN
   IF AutoLf THEN
    DrawX1 = PosX
    DrawY = DrawY + LineAdd
   ELSE
    ExitFlags = True
   END IF
  END IF
  IF DrawY >= DrawMinY AND DrawY <= DrawMaxY THEN
   DrawX2 = DrawX1 + CharWi - 1
   IF DrawX2 >= DrawMinX OR DrawX1 <= DrawMaxX THEN
    IF DrawX1 < TempRect.Left THEN DrawX1 = TempRect.Left
    IF DrawX1 > TempRect.Right THEN DrawX1 = TempRect.Right
    IF DrawX2 < TempRect.Left THEN DrawX2 = TempRect.Left
    IF DrawX2 > TempRect.Right THEN DrawX2 = TempRect.Right
    DrawX2 = DrawX2 - DrawX1
    TempNum = DrawY
    IF TempNum < TempRect.Top THEN TempNum = TempRect.Top
    IF TempNum > TempRect.Bottom THEN TempNum = TempRect.Bottom
    MinI = TempNum - DrawY
    
    TempNum = DrawY + CharHe - 1
    IF TempNum < TempRect.Top THEN TempNum = TempRect.Top
    IF TempNum > TempRect.Bottom THEN TempNum = TempRect.Bottom
    MaxI = TempNum - DrawY
    FOR I = MinI TO MaxI
     LINE (DrawX1, DrawY + I)-STEP(DrawX2, 0), TextC, , FontData(I, FontPos)
    NEXT I
   END IF
  END IF
  DrawX1 = DrawX1 + CharAdd
  StrPos = StrPos + 1
  IF StrPos > StrLen THEN ExitFlags = True
  'ExitFlags = True
 LOOP UNTIL ExitFlags
END SUB
SUB DrawTextEx (rct AS Rect, StepX AS INTEGER, StepY AS INTEGER, DrawStr AS STRING, c AS INTEGER)
 DIM tX AS INTEGER, tY AS INTEGER
 DIM tC AS INTEGER
 tX = TextStepX
 TextStepX = StepX
 tY = TextStepY
 TextStepY = StepY
 tC = TextC
 TextC = c
 DrawText rct, DrawStr
 TextStepX = tX
 TextStepY = tY
 TectX = tC
END SUB
SUB FillRect (rct AS Rect, c AS INTEGER)
 IF c AND OnlyLine THEN
  LINE (rct.Left, rct.Top)-(rct.Right - 1, rct.Bottom - 1), c AND &HFF, B
 ELSE
  LINE (rct.Left, rct.Top)-(rct.Right - 1, rct.Bottom - 1), c, BF
 END IF
END SUB
FUNCTION GetRectH% (rct AS Rect)
 GetRectH% = rct.Bottom - rct.Top
END FUNCTION
FUNCTION GetRectW% (rct AS Rect)
 GetRectW% = rct.Right - rct.Left
END FUNCTION
SUB GradH12 (rct AS Rect, cl%, cr%)
 DIM w AS INTEGER, h AS INTEGER
 DIM I AS INTEGER, J AS INTEGER, K AS INTEGER
 DIM DataArr(I) AS INTEGER
 DIM MapArr(I) AS INTEGER
 DIM Idx AS INTEGER
 DIM StartIdx AS INTEGER
 DIM Idx0 AS INTEGER, Idx1 AS INTEGER
 DIM ChanBytes AS INTEGER, ChanInts AS INTEGER
 DIM TempInt(0 TO 3) AS INTEGER
 'DIM TempNum AS INTEGER
 DIM c AS INTEGER
 w = GetRectW(rct)
 h = GetRectH(rct)
 'PRINT w, h
 IF h <= 0 THEN EXIT SUB
 IF w <= 2 THEN EXIT SUB
 ChanBytes = (w + 7) / 8
 ChanInts = (ChanBytes + 1) / 2
 REDIM MapArr(0 TO ChanBytes * 2 + 1) AS INTEGER 'ChanBytes*4/2=ChanBytes*2
 MapArr(0) = w
 MapArr(1) = 1
 w = w - 1
 h = h - 1
 REDIM DataArr(0 TO w) AS INTEGER
 FOR I = 0 TO w
  DataArr(I) = I * &H100& / w
 NEXT I
 IF (ChanBytes AND 1) = 0 THEN
  FOR I = 0 TO h
   StartIdx = 2
   FOR J = 0 TO w
    Idx = J AND &HF
    IF BaseLightnessMatrix(Idx, I AND &HF) >= DataArr(J) THEN c = cl% ELSE c = cr%
    FOR K = 0 TO 3
     IF BitMaskInt(7 - K) AND c THEN TempInt(K) = TempInt(K) OR BitMaskInt(Idx)
    NEXT K
    IF Idx = &HF OR J = w THEN
     Idx0 = StartIdx
     FOR K = 0 TO 3
      MapArr(Idx0) = TempInt(K)
      Idx0 = Idx0 + ChanInts
      TempInt(K) = 0
     NEXT K
     StartIdx = StartIdx + 1
    END IF
   NEXT J
   PUT (rct.Left, rct.Top + I), MapArr, PSET
  NEXT I
 ELSE
  DIM TempArr(0 TO ChanInts - 1, 0 TO 1) AS INTEGER
  FOR I = 0 TO h
   StartIdx = 2
   Idx1 = 0
   FOR J = 0 TO w
    Idx = J AND &HF
    IF LightnessMatrix(Idx, I AND &HF) >= DataArr(J) THEN c = cl% ELSE c = cr%
    FOR K = 0 TO 3
     IF BitMaskInt(7 - K) AND c THEN TempInt(K) = TempInt(K) OR BitMaskInt(Idx)
    NEXT K
    IF Idx = &HF OR J = w THEN
     Idx0 = StartIdx
     FOR K = 0 TO 3 STEP 2
      MapArr(Idx0) = TempInt(K)
      TempArr(Idx1, K / 2) = TempInt(K + 1)
      Idx0 = Idx0 + ChanBytes
      TempInt(K) = 0
      TempInt(K + 1) = 0
     NEXT K
     StartIdx = StartIdx + 1
     Idx1 = Idx1 + 1
    END IF
   NEXT J
   Idx0 = VARSEG(MapArr(0))
   Idx1 = VARPTR(MapArr(0))
   Idx1 = Idx1 + 2 * 2 + ChanBytes
   MemCopy VARSEG(TempArr(0, 0)), VARPTR(TempArr(0, 0)), Idx0, Idx1, ChanBytes
   Idx1 = Idx1 + ChanBytes * 2
   MemCopy VARSEG(TempArr(0, 1)), VARPTR(TempArr(0, 1)), Idx0, Idx1, ChanBytes
   PUT (rct.Left, rct.Top + I), MapArr, PSET
  NEXT I
 END IF
END SUB
SUB GradV12 (rct AS Rect, ct%, cb%)
 DIM w AS INTEGER, h AS INTEGER
 DIM I AS INTEGER, J AS INTEGER, K AS INTEGER
 DIM DataArr(I) AS INTEGER
 DIM MapArr(I) AS INTEGER
 DIM Idx AS INTEGER
 DIM StartIdx AS INTEGER
 DIM Idx0 AS INTEGER, Idx1 AS INTEGER
 DIM ChanBytes AS INTEGER, ChanInts AS INTEGER
 DIM TempInt(0 TO 3) AS INTEGER
 DIM TempNum AS INTEGER
 DIM c AS INTEGER
 w = GetRectW(rct)
 h = GetRectH(rct)
 'PRINT w, h
 IF w <= 0 THEN EXIT SUB
 IF h <= 2 THEN EXIT SUB
 ChanBytes = (w + 7) / 8
 ChanInts = (ChanBytes + 1) / 2
 REDIM MapArr(0 TO ChanBytes * 2 + 1) AS INTEGER 'ChanBytes*4/2=ChanBytes*2
 MapArr(0) = w
 MapArr(1) = 1
 w = w - 1
 h = h - 1
 IF (ChanBytes AND 1) = 0 THEN
  FOR I = 0 TO h
   StartIdx = 2
   TempNum = I * &H100& / h
   FOR J = 0 TO w
    Idx = J AND &HF
    IF BaseLightnessMatrix(Idx, I AND &HF) >= TempNum THEN c = ct% ELSE c = cb%
    FOR K = 0 TO 3
     IF BitMaskInt(7 - K) AND c THEN TempInt(K) = TempInt(K) OR BitMaskInt(Idx)
    NEXT K
    IF Idx = &HF OR J = w THEN
     Idx0 = StartIdx
     FOR K = 0 TO 3
      MapArr(Idx0) = TempInt(K)
      Idx0 = Idx0 + ChanInts
      TempInt(K) = 0
     NEXT K
     StartIdx = StartIdx + 1
    END IF
   NEXT J
   PUT (rct.Left, rct.Top + I), MapArr, PSET
  NEXT I
 ELSE
  DIM TempArr(0 TO ChanInts - 1, 0 TO 1) AS INTEGER
  FOR I = 0 TO h
   StartIdx = 2
   Idx1 = 0
   TempNum = I * &HFF& / h
   FOR J = 0 TO w
    Idx = J AND &HF
    IF LightnessMatrix(Idx, I AND &HF) >= TempNum THEN c = ct% ELSE c = cb%
    FOR K = 0 TO 3
     IF BitMaskInt(7 - K) AND c THEN TempInt(K) = TempInt(K) OR BitMaskInt(Idx)
    NEXT K
    IF Idx = &HF OR J = w THEN
     Idx0 = StartIdx
     FOR K = 0 TO 3 STEP 2
      MapArr(Idx0) = TempInt(K)
      TempArr(Idx1, K / 2) = TempInt(K + 1)
      Idx0 = Idx0 + ChanBytes
      TempInt(K) = 0
      TempInt(K + 1) = 0
     NEXT K
     StartIdx = StartIdx + 1
     Idx1 = Idx1 + 1
    END IF
   NEXT J
   Idx0 = VARSEG(MapArr(0))
   Idx1 = VARPTR(MapArr(0))
   Idx1 = Idx1 + 2 * 2 + ChanBytes
   MemCopy VARSEG(TempArr(0, 0)), VARPTR(TempArr(0, 0)), Idx0, Idx1, ChanBytes
   Idx1 = Idx1 + ChanBytes * 2
   MemCopy VARSEG(TempArr(0, 1)), VARPTR(TempArr(0, 1)), Idx0, Idx1, ChanBytes
   PUT (rct.Left, rct.Top + I), MapArr, PSET
  NEXT I
 END IF
END SUB
SUB InitBit
 DIM I AS INTEGER
 FOR I = 0 TO 7
  BitMaskInt(I) = 2 ^ (7 - I)
 NEXT I
 BitMaskInt(8) = &H8000
 FOR I = 9 TO &HF
  BitMaskInt(I) = 2 ^ (&H17 - I)
 NEXT I
END SUB
SUB InitFont
 DIM I AS INTEGER, J AS INTEGER
 DIM TempPos AS INTEGER
 DIM TempByte AS INTEGER
 SCREEN 12
 WIDTH 80, 30
 DEF SEG = &HA000
 FOR I = 0 TO &HFF
  LINE (0, 0)-(&HF, &HF), 0, BF
  LOCATE 1, 1
  PRINT CHR$(I)
  TempPos = 0
  FOR J = 0 TO &HF
   TempByte = PEEK(TempPos)
   FontData(J, I) = MakeWord(0, TempByte)
   TempPos = TempPos + 80 '=640/8
  NEXT J
  'WHILE INKEY$ = "": WEND
 NEXT I
 DEF SEG
 TextC = 15
 TextLf = True
 AutoLf = False
 TextStepX = 0
 TextStepY = 0
 CharAdd = CharWi
 LineAdd = CharHe
 CLS
END SUB
SUB InitLightM
 DIM I AS INTEGER, J AS INTEGER, K AS INTEGER
 DIM TempStr AS STRING
 DIM TempNum AS INTEGER
 FOR I = 0 TO &HF
  FOR J = 0 TO &HF
   READ TempStr
   TempNum = VAL("&H" + TempStr)
   BaseLightnessMatrix(I, J) = TempNum
   '这样做是为了简化运算,原来需要乘除运算(R*&H100/&HFF>L),现在只需要比较(R>=L),具体可看RGB12函数
   IF TempNum <= &H7F THEN TempNum = TempNum + 1
   LightnessMatrix(I, J) = TempNum
  NEXT J
 NEXT I
 
 FOR I = 0 TO 1 'R
  FOR J = 0 TO 1 'G
   FOR K = 0 TO 1 'B
    RGBIndex(I, J, K) = I * 4 OR J * 2 OR K OR 8
   NEXT K
  NEXT J
 NEXT I
 RGBIndex(0, 0, 0) = 0
END SUB
SUB InitMemCopy
 DIM ASMStr AS STRING
 
 ASMStr = ""
 ASMStr = ASMStr + CHR$(85)                             'PUSH BP
 ASMStr = ASMStr + CHR$(137) + CHR$(229)                'MOV BP,SP
 ASMStr = ASMStr + CHR$(30)                             'PUSH DS
 ASMStr = ASMStr + CHR$(139) + CHR$(70) + CHR$(10)      'MOV AX,[BP+0A]
 ASMStr = ASMStr + CHR$(142) + CHR$(192)                'MOV ES,AX
 ASMStr = ASMStr + CHR$(139) + CHR$(70) + CHR$(14)      'MOV AX,[BP+0E]
 ASMStr = ASMStr + CHR$(142) + CHR$(216)                'MOV DS,AX
 ASMStr = ASMStr + CHR$(139) + CHR$(118) + CHR$(12)     'MOV SI,[BP+0C]
 ASMStr = ASMStr + CHR$(139) + CHR$(126) + CHR$(8)      'MOV DI,[BP+08]
 ASMStr = ASMStr + CHR$(139) + CHR$(78) + CHR$(6)       'MOV CX,[BP+06]
 ASMStr = ASMStr + CHR$(243)                            'REPZ
 ASMStr = ASMStr + CHR$(164)                            'MOVSB
 ASMStr = ASMStr + CHR$(31)                             'POP DS
 ASMStr = ASMStr + CHR$(93)                             'POP BP
 ASMStr = ASMStr + CHR$(203)                            'RETF
 
 'PRINT LEN(ASMStr)
 'STOP
 ASM.MemCopy = ASMStr
 
END SUB
FUNCTION MakeWord% (LoByte AS INTEGER, HiByte AS INTEGER)
 MakeWord% = (LoByte AND &HFF) OR ((HiByte AND &H7F) * &H100) OR ((HiByte AND &H80) <> 0 AND &H8000)
END FUNCTION
SUB MemCopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)
 
 DEF SEG = VARSEG(ASM.MemCopy)
  CALL Absolute(BYVAL fromseg%, BYVAL fromoffset%, BYVAL toseg%, BYVAL tooffset%, BYVAL bytes%, VARPTR(ASM.MemCopy))
 DEF SEG
 
END SUB
SUB MoveRect (rct AS Rect, x%, y%)
 rct.Left = rct.Left + x%
 rct.Top = rct.Top + y%
 rct.Right = rct.Right + x%
 rct.Bottom = rct.Bottom + y%
END SUB
SUB RectAddSize (rct AS Rect, xAdd AS INTEGER, yAdd AS INTEGER)
 rct.Right = rct.Right + xAdd
 rct.Bottom = rct.Bottom + yAdd
END SUB
FUNCTION RectIsNull% (rct AS Rect)
 RectIsNull% = (rct.Right <= rct.Left) OR (rct.Bottom <= rct.Top)
END FUNCTION
FUNCTION RGB12% (x%, y%, R%, G%, B%)
 'DIM L AS INTEGER
 'L = LightnessMatrix(x% AND &HF, y% AND &HF)
 'RGB12% = RGBIndex((R% >= L) AND 1, (G% >= L) AND 1, (B% >= L) AND 1)
 
 '稍微移一下效果比较好
 RGB12% = RGBIndex((R% >= LightnessMatrix(x% AND &HF, y% AND &HF)) AND 1, (G% >= LightnessMatrix(x% + 1 AND &HF, y% AND &HF)) AND 1, (B% >= LightnessMatrix(x% AND &HF, y% + 1 AND &HF)) AND 1)
 
END FUNCTION
SUB SetRect (rct AS Rect, x1%, y1%, x2%, y2%)
 rct.Left = x1%
 rct.Top = y1%
 rct.Right = x2%
 rct.Bottom = y2%
END SUB
SUB SetRectMinMax (rct AS Rect, MinX%, MinY%, MaxX%, MaxY%)
 IF rct.Left < MinX% THEN rct.Left = MinX%
 IF rct.Top < MinY% THEN rct.Top = MinY%
 IF rct.Right > MaxX% THEN rct.Right = MaxX%
 IF rct.Bottom > MaxY% THEN rct.Bottom = MaxY%
END SUB
SUB SetRectPos (rct AS Rect, x%, y%)
 IF x% <> RectNoNum THEN rct.Right = x% + rct.Right - rct.Left: rct.Left = x%
 IF y% <> RectNoNum THEN rct.Bottom = y% + rct.Bottom - rct.Top: rct.Top = y%
END SUB
SUB SetRectSize (rct AS Rect, w%, h%)
 IF w% <> RectNoNum THEN rct.Right = rct.Left + w%
 IF h% <> RectNoNum THEN rct.Bottom = rct.Top + h%
END SUB
SUB SizeRect (rct AS Rect, x%, y%)
 rct.Left = rct.Left - x%
 rct.Top = rct.Top - y%
 rct.Right = rct.Right + x%
 rct.Bottom = rct.Bottom + y%
END SUB

 

代码打包下载(请修改后缀名)

fpga控制vga显示彩色图片

1       关于图像的格式,有JPEG、BMP、PNG等多种格式;图像的位数,也有单色、16色、256色、4096色、16位真彩色、24位真彩色、32位真彩色这几种。各种图像的格式不同,相应...
  • u013915688
  • u013915688
  • 2017年08月11日 15:54
  • 604

VGA及其支持的模式

VGA(Video Graphics Array)是IBM在1987年随PS/2机一起推出的一种视频传输标准,具有分辨率高、显示速率快、颜色丰富等优点,在彩色显示器领域得到了广泛的应用。VGA应用  ...
  • DiegoTJ
  • DiegoTJ
  • 2010年02月23日 10:35
  • 2848

Qt- 绘制实时曲线

功能描述:用曲线来显示数据的变化情况。横坐标表示时间T,纵坐标Y。每隔一定时间取一个Y值确定纵坐标 点击(此处)折叠或打开 #include "dialog...
  • apaul001
  • apaul001
  • 2014年08月13日 22:19
  • 4386

VGA显示卡图形模式访问(提示版) (1)

导读:   新一篇: VGA显示卡图形模式访问(提示版) (2)   VGA显示卡图形模式访问(提示版) (1)   最近闲来无聊,在 上海图书馆 借了本《IBM-PC汇编语言程序设计》。没想,在看...
  • chief1985
  • chief1985
  • 2008年06月09日 22:54
  • 1765

ARM的LCD控制寄存器和原理(抖动算法和FRC)

S3C44B0X内置的LCD控制器的作用是将显示缓存(在系统存储器中)的LCD数据传输到外部LCD驱动器,并产生必须的LCD控制信号。它支持灰度LCD和彩色LCD。在灰度LCD上,使用基于时间抖动算法...
  • zhulizhen
  • zhulizhen
  • 2010年01月20日 14:34
  • 3934

SPOT5多光谱数据模拟真彩色的三种方法

SPOT多光谱数据模拟真彩色的三种方法 以往用户在用遥感数据合成真彩色影像时一般采用Landsat数据,这是因为Landsat的TM或ETM+传感器提供了R,G,B以及IR等共6个波段(1,2,3,...
  • ximenchuixuezijin
  • ximenchuixuezijin
  • 2012年06月12日 14:27
  • 2800

简单的VGA字符模式驱动(一)

进入保护模式后,我们就彻底与BIOS例程说再见了。BIOS下的几乎所有中断例程都是实模式的代码。int 10h 的显示功能自然也是如此。 如今我们已经处于保护模式,因此为了在屏幕上显示东西,我们只有自...
  • gemini_star
  • gemini_star
  • 2009年08月11日 22:09
  • 2336

小谈汇编程序中对VGA显存直接操作

导读:   新一篇: VGA显示卡图形模式访问(提示版) (1)   最近闲来无聊,找了本80x86的汇编教程学习学习。在对显存直接操作的时候,发现书上说的很不清楚,   还没有说清楚呢,就开始例子...
  • chief1985
  • chief1985
  • 2008年06月09日 22:50
  • 3538

网页中实现一个计算当年还剩多少时间的倒数计时程序,要求网页上实时动态显示"××年还剩××天××时××分××秒"

TEst // 为了简化。每月默认30天 function getTimeStri
  • qq_18663357
  • qq_18663357
  • 2016年08月21日 16:40
  • 1428

SQL SERVER中查询当天、当月、当年数据的SQL语句

在SQL SERVER中如果需要查询出当天、当月和当年的数据,可以通过DATEDIFF函数计算相差时间以获取正确的过滤条件。主要思路是通过DATEDIFF函数计算当前日期与数据日期的天数差、月份差和年...
  • qq_15237993
  • qq_15237993
  • 2017年09月07日 17:00
  • 750
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:当年我QB的封笔之作——在VGA 12h 模式下实时抖动绘制真彩色数据
举报原因:
原因补充:

(最多只允许输入30个字)