程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 字符畫軟件的四個關鍵技術

字符畫軟件的四個關鍵技術

編輯:Delphi

  第一個關鍵技術:漢字庫讀取技術

  使用漢字庫技術可以做到和操作系統無關性,我們先了解一下點陣字庫的基本原理
  如下所示,下面是一個“字”的點陣圖,在16點陣字庫中一個漢字為16x16點,每一行使用兩個字節表示,如下面示例第一行的十六進制為:0x02和0x00,所以,一個漢字在16點陣字庫中需要占用2x16個字節,24點陣字庫需要3x24個字節,下面我們僅以16點陣字庫為例,其他點陣類似。

  ██████ █████████
  ███████ ████████
  ██    ██
  ██ ██████████ ██
  █ ██████████ ███
  ███  █████
  █████████ ██████
  ████████ ███████
  ███████ █████ ██
     █
  ███████ ████████
  ███████ ████████
  ███████ ████████
  ███████ ████████
  █████ █ ████████
  ██████ █████████

  下面的函數返回指定字符串的字符畫文本
  function Get16(const AWord,AForeground,ABackground:string):string;
      function GetBit(const c,n:byte):integer;
      begin
          result:=(c shr n) and 1;
      end;
  var
      iLen        :integer;
      iFileSize   :integer;
      s           :string;
      k,l,i,p     :integer;
      cw:array[0..31] of char;
      qu_ma,wei_ma:integer;
      File16      :file;
  begin
      iLen:=length(AWord);
      AssignFile(File16,piProgramInfo.Path+'HZK16');
      FileMode := fmOpenRead;
      try
          Reset(File16,1);
      finally
          FileMode:=fmOpenReadWrite;
      end;
      iFileSize:=FileSize(File16);
      try
          for l:=1 to iLen div 2 do
          begin
              k:=l*2-1;
              // 如果不是漢字,往前進一位
              while k<=iLen do
              begin
                  if ByteType(AWord,k)=mbLeadByte then break;
                  inc(k);
              end;
              if k>iLen then break;
              if ((ord(AWord[k]) and $80)<>0) then
              begin
                  qu_ma:=ord(AWord[k])-161;
                  wei_ma:=ord(AWord[k+1])-161;
                  if (94*qu_ma+wei_ma)*32+32>iFileSize then continue;
                  try
                      seek(File16,(94*qu_ma+wei_ma)*32);
                  except
                      myMessageBox('fseek call fail!');
                      exit;
                  end;
                  BlockRead(File16,cw,32);

                  for i:=0 to 15 do
                  begin
                      for p:=7 downto 0 do
                      begin
                          if GetBit(ord(cw[i*2]),p)=1 then s:=s+AForeground
                          else                            s:=s+ABackground;
                      end;
                      for p:=7 downto 0 do
                      begin
                          if GetBit(ord(cw[i*2+1]),p)=1 then s:=s+AForeground
                          else                              s:=s+ABackground;
                      end;
                      s:=s+#13#10;
                  end;
              end;
          end;
      finally
          CloseFile(File16);
      end;

      result:=s;
  end;

  第二個關鍵技術:使用系統字庫進行轉換
  其實使用系統字庫是極為自由的方式,因為這樣我們完全不必關心字庫的技術,這一切都交給系統好了,讓我們充分利用系統資源。
  如果我們定義一個設備,然後設定好設備的各種屬性,包括寬度、高度、字體、顏色等,然後在上面繪制文本就可以了,要轉換為字符畫,只需要把設備上的點陣信息轉換為文本即可。
  配合 CreateFontIndirect 函數,使用 DrawText 可以繪制豐富的文本效果。實現完整的字符畫效果

  下面是十二號宋體的轉換結果
  █████ ██████
  █    █
  ████████ █
  ██   ███
  ██████ █████
  █████ ██████
     █
  █████ ██████
  █████ ██████
  █████ ██████
  ███   ██████
  ████████████

  下面是九號@黑體的轉換結果
  ████████████
  ██  ███ ████
  ██ ████ ████
  ██ █ ██ ████
  ██ █  █ ████
  █  █   █
   █ ██ ██ █
  ██ █ ██ ██ █
  ██ █ ██ ████
  ██ ████ ████
  ██  ███ ████
  ████████████

  第三個關鍵技術:圖片轉換為文本
  要把圖像轉換為文本,這其中有一個很大的困難,就是文本沒有顏色,所以我們特別引進了一個概念:文本灰度,就是把不同字母在屏幕上顯示的大小排序,得到一張灰度表,用這個灰度表來轉換圖片,可以達到比較好的效果。
  下面的函數可以把一個位圖轉換成文本,ABit 是位圖,AGray 是灰度
  function ImageToText(ABit:TBitmap;const AGray:string):string;
  var
      x,y         :integer;
      s           :string;
      pColor      :Longint;
      R,G,B       :byte;
      iGray       :integer;

      sGrayPer    :string;               
      iGrayLen    :integer;              
      iIndex      :integer;              
  begin
      s:='';
      sGrayPer:=AGray;
      iGrayLen:=Length(sGrayPer);
      for y:=0 to ABit.Height-1 do
      begin
          for x:=0 to ABit.Width-1 do
          begin
              pColor:=ABit.Canvas.Pixels[x,y];
              R:=pColor and $FF;
              G:=(pColor shr 8) and $FF;
              B:=(pColor shr 16) and $FF;

              iGray:=HiByte(R*77+G*151+B*28);         
              iIndex:=(iGray*iGrayLen div 255);
              if iIndex<1 then iIndex:=1;
              if iIndex>iGrayLen then iIndex:=iGrayLen;
              s:=s+sGrayPer[iIndex];
          end;
          s:=s+Crlf;
      end;
      result:=s;
  end;
  這是一個常用且效果比較好的灰度:“MNHQ$OC?7>!":-';. ”

  
  第四個關鍵技術:把文本轉換為圖像
  要把文本轉換為圖片,必須獲取兩個重要參數:轉換後的寬和高,要取得這兩個參數,我們可以使用 GetTextExtentPoint32 函數,該函數的定義如下:
  function GetTextExtentPoint32(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): BOOL;
  DC 傳入設備句柄
  Str 為文本內容
  Count 為文本的長度(字節)
  Size 返回寬和高
  在實際應用中,往往被轉換的文本有多行,且每一行的長度不定,
  所以我們還需要在生成圖像前進行一遍預掃,以便獲得完整的圖像大小

  下面演示了文本轉換為圖像的代碼

  ////////////////////////////////////////////////////////////////////////////////
  // 功能     : 把文本轉換為位圖
  // AOwner   : 窗體參數
  // AText    : 要轉換的文本
  // AFont    : 文本的字體
  // ABitmap  : 轉換後的位圖對象
  // 日期     : 2003.12.15
  ////////////////////////////////////////////////////////////////////////////////
  procedure TextToBitmap(AOwner:TObject;const AText:TStrings;AFont:TFont;ABitmap:TBitmap);
  var
      i               :integer;
      iWidth,iHeight  :integer;
      iCharHeight     :integer;
      s               :string;
      r               :TRect;
      size            :TSize;
      lblTemp         :TLabel;
  begin
      iWidth:=0;
      iHeight:=0;

      lblTemp:=TLabel.Create(nil);
      r.Top:=0;
      try
          lblTemp.Visible:=false;
          lblTemp.Parent:=TWinControl(AOwner);
          lblTemp.Font.Assign(AFont);

          ABitmap.Canvas.Brush.Style:=bsClear;
          ABitmap.Canvas.Pen.Color:=rgb(0,0,0);
          ABitmap.Canvas.Brush.Color:=RGB(255,255,255);
          ABitmap.Canvas.Font.Assign(AFont);

          // 下面代碼用戶獲得文本的最大寬度和高度
          for i:=0 to AText.Count-1 do
          begin
              s:=AText.Strings[i];
              if s='' then s:=' ';
              lblTemp.Caption:=s;

              GetTextExtentPoint32(lblTemp.Canvas.Handle,pchar(lblTemp.Caption),lblTemp.GetTextLen,size);
              if iWidth<size.cx then iWidth:=Size.cx;
              iHeight:=iHeight+Size.cy;
          end;

          // 獲得一個字符的高度
          GetTextExtentPoint32(lblTemp.Canvas.Handle,pchar('   '),length('   '),size);
          iCharHeight:=size.cy;

          ABitmap.Width:=iWidth;
          ABitmap.Height:=iHeight;
          for i:=0 to AText.Count-1 do
          begin
              s:=AText.Strings[i];

              r.Left:=0;
              r.Right:=ABitmap.Width;
              r.Bottom:=r.Bottom+iCharHeight;

              DrawText(ABitmap.Canvas.Handle,PChar(s),length(s),r,0);
              r.Top:=r.Top+iCharHeight;
          end;
      finally
          lblTemp.Free;
      end;
  end;

  

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved