lcdscreen.pas.svn-base

LCDScreen is a couple of Delphi component which simulate a dot-LCD multilines screen. It is fully c

  begin
    FontWidth := 11;
    FontHeight := 11;
  end;

  if mbLeft   in FDotMatrixBorders then Inc(FontWidth);
  if mbRight  in FDotMatrixBorders then Inc(FontWidth);
  if mbTop    in FDotMatrixBorders then Inc(FontHeight);
  if mbBottom in FDotMatrixBorders then Inc(FontHeight);
  
  if FCharBitmap<>0 then
  begin
    SelectObject(FCharDC, FOCharBitmap);
    DeleteObject(FCharBitmap);
  end;

  FCharBitmap := CreateCompatibleBitmap(FCharDC, FontWidth*2, FontHeight+1);
  SelectObject(FCharDC, FFont.Handle);
  FOCharBitmap := SelectObject(FCharDC, FCharBitmap);
end;

procedure TLCDScreen.Resize;
begin
  inherited Resize;

  UpdateInternalMatrixBitmap;
end;

////////////////////////////////////////////////////////////////////////////////
//
// Create Virgin and Black Matrix.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.UpdateInternalMatrixBitmap;
  procedure DrawOnePixelX(DC: HDC; PixelSize: TPixelsize; PixelShape: TPixelShape;
                         Color: TColor; psx, psy: Byte; tx, ty: Integer);
  begin
       if PixelSize = pix1x1
       then SetPixel(DC, tx, ty, ColorToRGB(Color))
       else case PixelShape of
             psSquare:  Rectangle(DC, tx, ty, tx + psx, ty + psy); { Standard square pixels}
             psRound:   Ellipse(DC, tx, ty, tx + psx, ty + psy);   { Round pixels }
            end;
  end;
var
    tx, ty: Integer;
    bkBrush: HBRUSH;
    pBrush, poBrush: HBRUSH;
    pPen, poPen: HPEN;
    //FVirginMatrixBitmap, FBlackMatrixBitmap: TBitmap;
begin
  if Width*Height<=0 then exit;

  if Assigned(FVirginMatrixBitmap) then FVirginMatrixBitmap.Destroy;
  if Assigned(FBlackMatrixBitmap) then FBlackMatrixBitmap.Destroy;
  //DeleteObject(SelectObject(FVirginMatrixDC, FOVirginMatrixBitmap));
  //DeleteObject(SelectObject(FBlackMatrixDC, FOBlackMatrixBitmap));

  FVirginMatrixBitmap := TBitmap.Create;
  FVirginMatrixBitmap.Width := Width;
  FVirginMatrixBitmap.Height := Height;
  FVirginMatrixBitmap.Canvas.Brush.Color := FColor;
  FVirginMatrixBitmap.Canvas.FillRect(Rect(0, 0, Width, Height));

  pBrush := CreateSolidBrush(ColorToRGB(FTrueOffColor)); poBrush := SelectObject(FVirginMatrixBitmap.Canvas.Handle, pBrush);
  pPen := CreatePen(PS_SOLID, 1, ColorToRGB(FTrueOffColor)); poPen := SelectObject(FVirginMatrixBitmap.Canvas.Handle, pPen);
  ty := 0;
  while (ty<=Height) do
  begin
    tx := 0;
    while (tx<=Width) do
    begin
      DrawOnePixelX(FVirginMatrixBitmap.Canvas.Handle, FPixelSize, FPixelShape,
                     FTrueOffColor, psx, psy, tx, ty);

      tx := tx + psx + FPixelSpacing;
    end;

    ty := ty + psy + FPixelSpacing;
  end;
  SelectObject(FVirginMatrixBitmap.Canvas.Handle, poBrush); DeleteObject(pBrush);
  SelectObject(FVirginMatrixBitmap.Canvas.Handle, poPen); DeleteObject(pPen);

  FBlackMatrixBitmap := TBitmap.Create;
  FBlackMatrixBitmap.Width := Width;
  FBlackMatrixBitmap.Height := Height;
  FBlackMatrixBitmap.Canvas.Brush.Color := FColor;
  FBlackMatrixBitmap.Canvas.FillRect(Rect(0, 0, Width, Height));

  pBrush := CreateSolidBrush(ColorToRGB(FTrueOnColor)); poBrush := SelectObject(FBlackMatrixBitmap.Canvas.Handle, pBrush);
  pPen := CreatePen(PS_SOLID, 1, ColorToRGB(FTrueOnColor)); poPen := SelectObject(FBlackMatrixBitmap.Canvas.Handle, pPen);
  ty := 0;
  while (ty<=Height) do
  begin
    tx := 0;
    while (tx<=Width) do
    begin
      DrawOnePixelX(FBlackMatrixBitmap.Canvas.Handle, FPixelSize, FPixelShape,
                     FTrueOnColor, psx, psy, tx, ty);

      tx := tx + psx + FPixelSpacing;
    end;

    ty := ty + psy + FPixelSpacing;
  end;
  SelectObject(FBlackMatrixBitmap.Canvas.Handle, poBrush); DeleteObject(pBrush);
  SelectObject(FBlackMatrixBitmap.Canvas.Handle, poPen); DeleteObject(pPen);

  //FOVirginMatrixBitmap := SelectObject(FVirginMatrixDC, FVirginMatrixBitmap.ReleaseHandle);
  //FOBlackMatrixBitmap := SelectObject(FBlackMatrixDC, FBlackMatrixBitmap.ReleaseHandle);

  //FVirginMatrixBitmap.Destroy;
  //FBlackMatrixBitmap.Destroy;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Repaint the component.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.Paint;
var
  tempBitMap, tempBitmap2: TBitMap;
  inverse: Boolean;
begin
  if Visible   { Draw only real graphics if display is marked visible }
  then begin
         SetCorrectSize;

         inverse := false;

         if (spInverse in FSpecialEffects) then inverse := true;
         if (spBlinking in FSpecialEffects) and FBlinkingStatus then inverse := not inverse;

         tempBitmap := TBitMap.Create;
         tempBitmap.Height := Height;
         tempBitmap.Width  := Width;

         with tempBitmap.Canvas
         do begin                   { Border drawing on tempBitmap}
              Brush.Color := FColor;
              FillRect(Rect(0, 0, tempBitmap.Width, tempBitmap.Height));
              if FBorderStyle <> bsNone
              then begin
                     case FBorderStyle of
                        bsRaised:  Pen.Color := clBtnShadow;
                        bsLowered: Pen.Color := clBtnHighlight;
                       end;
                     PolyLine([Point(Width-1, 0), Point(Width-1, Height-1), Point(-1, Height-1)]);

                     case FBorderStyle of
                        bsRaised:  Pen.Color := clBtnHighlight;
                        bsLowered: Pen.Color := clBtnShadow;
                        end;
                     PolyLine([Point(Width - 1, 0), Point(0, 0), Point(0, Height - 1)]);
                     end;
              end;

          {
          if inverse then
          begin
            BitBlt(tempBitmap.Canvas.Handle,
                   FBorderSpace, FBorderSpace,
                   Width- 2 * FBorderSpace, Height- 2 * FBorderSpace,
                   FBlackMatrixBitmap.Canvas.Handle,
                   0,
                   0,
                   srcCopy);
          end
          else
          begin
            BitBlt(tempBitmap.Canvas.Handle,
                   FBorderSpace, FBorderSpace,
                   Width- 2 * FBorderSpace, Height- 2 * FBorderSpace,
                   FVirginMatrixBitmap.Canvas.Handle,
                   0,
                   0,
                   srcCopy);
          end;
          }
         if Enabled
         then begin
                tempBitmap2 := TBitMap.Create;
                tempBitmap2.Height := Height; // + 2 * (CharHeight + FBorderSpace + FLineSpacing);
                tempBitmap2.Width  := Width; //  + 2 * (CharWidth + FBorderSpace + FLineSpacing);
                //tempBitmap2.Canvas.Brush.Color := FColor;
                //tempBitmap2.Canvas.FillRect(Rect(0, 0, tempBitmap2.Width, tempBitmap2.Height));

                { Draw Backgroud Matrix }

                if inverse then
                begin
                  BitBlt(tempBitmap2.Canvas.Handle,
                         0, 0,
                         Width, Height,
                         FBlackMatrixBitmap.Canvas.Handle,
                         0,
                         0,
                         srcCopy);
                end
                else
                begin
                  BitBlt(tempBitmap2.Canvas.Handle,
                         0, 0,
                         Width, Height,
                         FVirginMatrixBitmap.Canvas.Handle,
                         0,
                         0,
                         srcCopy);
                end;

                { Characters drawing on tempBitmap2}
                DrawDisplayCharacters(tempBitmap2);

                { Copy characters from tempBitmap2 to tempBitmap bitmap }
                BitBlt(tempBitmap.Canvas.Handle,
                       FBorderSpace, FBorderSpace,
                       Width- 2 * FBorderSpace, Height- 2 * FBorderSpace,
                       tempBitMap2.Canvas.Handle,
                       CharWidth  + FCharSpacing - PixHRef * (FPixelWidth  + 1) - 1,
                       CharHeight + FLineSpacing - PixVRef * (FPixelHeight + 1) - 1,
                       srcCopy);

                tempBitmap2.Free;
                end;

         { Copy characters + border from tempBitmap to Window bitmap }
         //while Canvas.TryLock do Sleep(1);

         Canvas.Lock;
         try
           BitBlt(Canvas.Handle, 0, 0, Width, Height, tempBitMap.Canvas.Handle, 0, 0, srcCopy);
         finally
           Canvas.Unlock;
         end;

         tempBitMap.Free;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Drawing routine for the display using FTempLines strings.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.DrawDisplayCharacters(BitMap: TBitMap);
var
  row, col, maxcol, truerow, truecol: Integer;
  xpos, ypos: Integer;
  NullChar: TOneChar;
  dx: Integer;
begin
  NullChar.TheChar := space_char;
  NullChar.SpEff := 0;

  ypos := 0;

  for row := 0 to Lines.Count -1 do
  begin
       xpos := 0;
       maxcol := Length(Lines[row]);
       col := 0;
       truerow := (row + CharVref) mod TrueDisplayHeight;
       if truerow < 0 then truerow := TrueDisplayHeight + truerow;

       repeat
         truecol := (col+CharHref) mod TrueDisplayWidth;
         if truecol < 0 then truecol := TrueDisplayWidth + truecol;
         if Display[truerow][truecol].TheChar <> Char(0)
         then dx := DrawOneCharacter(BitMap, xpos, ypos, Display[truerow][truecol])
         else dx := DrawOneCharacter(BitMap, xpos, ypos, NullChar);

         xpos := xpos + (dx * psx)  + (dx  - 1) * FPixelSpacing + FCharSpacing;
         //xpos := xpos + CharWidth + FCharSpacing;
         Inc(col);
       until col >= maxcol;

       ypos := ypos + (FontHeight * psy) + (FontHeight - 1) * FPixelSpacing + FLineSpacing;

       if ypos>=Height then break;
  end;

  {
  for row := -1 to FNoOfLines + 1
  do begin
       xpos := 0;
       maxcol := FNoOfChars;
       col := 0;
       truerow := (row + CharVref) mod TrueDisplayHeight;
       if truerow < 0 then truerow := TrueDisplayHeight + truerow;

       repeat
         truecol := (col+CharHref) mod TrueDisplayWidth;
         if truecol < 0 then truecol := TrueDisplayWidth + truecol;
         if Display[truerow][truecol].TheChar <> Char(0)
         then dx := DrawOneCharacter(BitMap, xpos, ypos, Display[truerow][truecol])
         else dx := DrawOneCharacter(BitMap, xpos, ypos, NullChar);

         xpos := xpos + (dx * psx)  + (dx  - 1) * FPixelSpacing + FCharSpacing;
         //xpos := xpos + CharWidth + FCharSpacing;
         Inc(col);
       until col >= maxcol + 2;

       ypos := ypos + CharHeight + FLineSpacing;
       end; }
end;


////////////////////////////////////////////////////////////////////////////////
//
// Draw One Character ie Copy Vigin Matrix and then Draw only OnPixels.
//
////////////////////////////////////////////////////////////////////////////////

function TLCDScreen.DrawOneCharacter(BitMap: TBitMap; xpos, ypos: Integer; Display: TOneChar): Integer;
var
  x, y,
  topborder, leftborder: Byte;
  tx, ty, dx: Integer;
  pixcol: TColor;
  inverse: Boolean;
  size: TSize;
  col: COLORREF;
begin
  inverse := false;

  if Display.SpEff <> 0 then
  begin
     if ((Display.SpEff mod 2) = 0) and (spInverse in FSpecialEffects) then inverse := true;
     if ((Display.SpEff mod 3) = 0) and (spBlinking in FSpecialEffects) and FBlinkingStatus then inverse := not inverse;
  end;

  if inverse then pixcol := FTrueOffColor else pixcol := FTrueOnColor;
  if (Display.TheChar <> space_char){ Useless to try to draw OnPixels with 'space' character
                                      or to draw OffPixels with 'block' characters!      }
  then begin
    topborder := Ord(mbTop in FDotMatrixBorders);
    leftborder := Ord(mbLeft in FDotMatrixBorders);

    ty := ypos + topborder * (psy + FPixelSpacing);

    GetTextExtentPoint32(FCharDC, PChar(''+Display.TheChar), Length(''+Display.TheChar), size);
    dx := size.cx;

    FillRect(FCharDC, Rect(0, 0, FontWidth * 2, FontHeight+1), GetStockObject(WHITE_BRUSH));
    Textout(FCharDC, 0, 0, PChar(''+Display.TheChar), Length(''+Display.TheChar));

    for y := 0 to FontHeight do
    begin
      tx := xpos + leftborder * (psx + FPixelSpacing);

      for x := 0 to dx do
      begin
        if GetPixel(FCharDC, x, y)<>RGB(255,255,255) { then draw the OnPixels }
        then DrawOnePixel(Bitmap, FPixelSize, FPixelShape,
                         pixcol, psx, psy, tx, ty);
        tx := tx + psx + FPixelSpacing;
      end;
      ty := ty + psy + FPixelSpacing;
    end;
  end
  else
  begin
    dx := FFont.Size;
  end;


  if  ((Display.SpEff mod 5) = 0) and (spUnderLine in FSpecialEffects) and (Display.SpEff <> 0)
  then begin
         tx := xpos;
         ty := ypos + (FontHeight - 1) * (psy + FPixelSpacing);