unit1.pas

上海高架路指示牌

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus, ImgList, BUGradientCaption, Buttons, lmdcctrl,
  lmdctrl, lmdeditb, lmdeditc, lmdbredt, Abcbusy, OoMisc, AdPort, lmdcombo,
  lmdextcS, RzCmboBx, Abccombo;


type

  TDatBitmap = record
     Data:array [0..$077F] of Byte;
  end;



type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Shape1: TShape;
    Shape2: TShape;
    Label4: TLabel;
    Image1: TImage;
    Shape3: TShape;
    Shape4: TShape;
    Shape5: TShape;
    Shape6: TShape;
    Shape7: TShape;
    Shape8: TShape;
    Shape9: TShape;
    Shape10: TShape;
    Label5: TLabel;
    Label6: TLabel;
    ColorMenu: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ImageList1: TImageList;
    BUGradientCaption1: TBUGradientCaption;
    BUGradientCaption2: TBUGradientCaption;
    Shape11: TShape;
    Shape12: TShape;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Image2: TImage;
    Panel2: TPanel;
    BUGradientCaption3: TBUGradientCaption;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    BUGradientCaption4: TBUGradientCaption;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Label10: TLabel;
    Label11: TLabel;
    GroupBox1: TGroupBox;
    Label12: TLabel;
    Label13: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    SpeedButton5: TSpeedButton;
    Panel3: TPanel;
    LMDFileOpenEdit1: TLMDFileOpenEdit;
    Label14: TLabel;
    SpeedButton6: TSpeedButton;
    NewsMenu: TPopupMenu;
    StautsMenu: TPopupMenu;
    N4: TMenuItem;
    bmp1: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    abcBusy1: TabcBusy;
    ApdComPort1: TApdComPort;
    SaveDialog1: TSaveDialog;
    Label15: TLabel;
    abcColorComboBox1: TabcColorComboBox;
    source: TImage;
    Image3: TImage;
    Label16: TLabel;
    ComboBox1: TComboBox;
    Label17: TLabel;
    Memo1: TMemo;
    ComboBox3: TComboBox;
    Label19: TLabel;
    N9: TMenuItem;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    GroupBox2: TGroupBox;
    Panel4: TPanel;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    Panel5: TPanel;
    ListBox1: TListBox;
    N35Kmh1: TMenuItem;
    N40Kmh1: TMenuItem;
    N60Kmh1: TMenuItem;
    N80Kmh1: TMenuItem;
    N1001: TMenuItem;
    N1201: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    SpeedButton16: TSpeedButton;
    N14: TMenuItem;
    N15: TMenuItem;
    Label18: TLabel;
    ComboBox2: TComboBox;
    SpeedButton15: TSpeedButton;
    Label20: TLabel;
    Label21: TLabel;
    procedure ShapeGetColor(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure LMDFileOpenEdit1Change(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure bmp1Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure SpeedButton14Click(Sender: TObject);
    procedure ComboBox2Click(Sender: TObject);
    procedure SpeedButton15Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure ApdComPort1Trigger(CP: TObject; Msg, TriggerHandle,
      Data: Word);
    procedure N35Kmh1Click(Sender: TObject);
    procedure N40Kmh1Click(Sender: TObject);
    procedure N60Kmh1Click(Sender: TObject);
    procedure N80Kmh1Click(Sender: TObject);
    procedure N1001Click(Sender: TObject);
    procedure N1201Click(Sender: TObject);
    procedure Panel6Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure SpeedButton16Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
  private
    Procedure SendPicture(Id,Effect:Byte;Img:TImage;Data :Array of byte);
    Procedure GetPictureData(Img:TImage;var PictureData:array of byte);
    procedure HZK24(LibCode, X, Y: integer; zw: string; Color: Integer);
    Function  Test(a, k: integer): Boolean;
    procedure GetColor(Sender: TObject);
    procedure SendStauts;
    procedure SendPictures(Id, Effect: Byte;Img:TImage;Data: array of TDatBitmap);

//    Function  ColorToCode:;
    { Private declarations }
  public
    Part:integer;
    FullText :Boolean;
    Picture1Data: array [0..$077F] of Byte; //
    Picture2Data: array [0..$017F] of Byte; //
    StautsData:array[0..7]of Byte;
    BtA,BtB,BtC,BtD:Byte;
    ChrA,ChrB,Chrc,ChrD:Char;
    BpParam: array[0..4] of TDatBitmap;
    { Public declarations }
  end;

var
  Form1: TForm1;



implementation

{$R *.DFM}

function TForm1.Test(a, k: integer): Boolean;
begin
  a := a shl (k - 1);
  if (a and $80) <> 0 then
    Result := True
  else
    Result := False;
end;


procedure TForm1.HZK24(LibCode, X, Y: integer; zw: string; Color: Integer);
var
  n, i, j, l, qq, ww: integer;
  xx, yy, num: Longint;
  WM: array[0..72] of byte;
  Font: string;
  fp: file;
begin

Source.Canvas.Brush.Color := clBlack;
Source.Canvas.FillRect(Image1.ClientRect);

  n := 1;
  Font := '';
  while (n <= Length(zw)) do
  begin
    xx := 0;
    yy := 0;
    if (byte(zw[n]) and $80) = 0 then
    begin
      if (zw[n] = ' ') then
      begin
        X := X + 12;
        n := n + 1;
      end
      else
      begin
        AssignFile(fp,ExtractFilePath(Application.ExeName)+'font\e12x24.fon');
        Reset(fp, 1);
        if IOResult <> 0 then
        begin
          CloseFile(fp);
          exit;
        end;
        num := byte(zw[n]) * 48;
        seek(fp, num);
        blockread(fp, wm, 48);
        CloseFile(fp);
        for i := 0 to 23 do
        begin
          for j := 0 to 1 do
          begin
            for l := 1 to 8 do
            begin
              if (test(byte(wm[i * 2 + j]), l)) then
                begin
                  case abcColorComboBox1.ItemIndex of
                    0: Source.Canvas.Pixels[(x + xx), (y + yy)] := RGB(255 ,   0, 0);
                    1: Source.Canvas.Pixels[(x + xx), (y + yy)] := RGB(0   , 255, 0);
                    2: Source.Canvas.Pixels[(x + xx), (y + yy)] := RGB(255 , 255, 0);
//                    0: Source.Canvas.Pixels[(x + xx), (y + yy)] := RGB(255, 0, 0);
                  end;
                end;
              xx := xx + 1;
            end;
          end;
          y := y + 1;
          xx := 0;
        end;
        x := x + 12;
        y := 0;
        n := n + 1;
      end;
    end
    else
    begin
      case LibCode of
        0: Font :=ExtractFilePath(Application.ExeName)+ 'font\hzk24k';
        1: Font :=ExtractFilePath(Application.ExeName)+ 'font\hzk24s';
        2: Font :=ExtractFilePath(Application.ExeName)+ 'font\hzk24f';
        3: Font :=ExtractFilePath(Application.ExeName)+ 'font\hzk24h';
      else
        Font :=ExtractFilePath(Application.ExeName)+ 'font\hzk24h';
      end;
      qq := (byte(zw[n]) and $7F) - $21;
      ww := (byte(zw[n + 1]) and $7F) - $21;
      if (qq < 15) and (qq >= 0) then
      begin
        num := ((qq * 94) + ww) * 72;
        Font :=ExtractFilePath(Application.ExeName)+ 'font\hzk24t';
      end
      else
        num := (((qq - 15) * 94) + ww) * 72;
      AssignFile(fp, Font);
      Reset(fp, 1);
      if IOResult <> 0 then
      begin
        CloseFile(fp);
        exit;
      end;
      seek(fp, num);
      blockread(fp, wm, 72);
      CloseFile(fp);
      for i := 0 to 23 do
      begin
        for j := 0 to 2 do
          for l := 1 to 8 do
          begin
            if (test(byte(wm[i * 3 + j]), l)) then
                begin
                  case abcColorComboBox1.ItemIndex of
                    0: Source.Canvas.Pixels[(x + xx), (y + yy)] := RGB(255 ,   0, 0);
                    1: Source.Canvas.Pixels[(x + xx), (y + yy)] := RGB(0   , 255, 0);
                    2: Source.Canvas.Pixels[(x + xx), (y + yy)] := RGB(255 , 255, 0);
//                    0: Source.Canvas.Pixels[(x + xx), (y + yy)] := RGB(255, 0, 0);
                  end;
                end;
            yy := yy + 1;
          end;
        X := x + 1;
        yy := 0;
      end;
      n := n + 2;
    end;
  end;
end;

procedure TForm1.ShapeGetColor(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Pt:Tpoint;
begin
if Button = mbleft then
begin
   case (Sender as TShape).Tag of
         0: part := 0;
         1: Part := 1;
         2: Part := 2;
         3: Part := 3;
         4: Part := 4;
         5: Part := 5;
         6: Part := 6;
         7: Part := 7;
   else
       exit;
   end;
   Pt := (sender as TShape).ClientToScreen(point(x,y));
   ColorMenu.Popup(pt.x,pt.y);

end;
end;


procedure TForm1.N1Click(Sender: TObject);
begin
case Part of
0:Shape3.Brush.Color := clRed;
1:Shape4.Brush.Color := clRed;
2:Shape5.Brush.Color := clRed;
3:Shape6.Brush.Color := clRed;
4:Shape9.Brush.Color := clRed;
5:Shape7.Brush.Color := clRed;
6:Shape8.Brush.Color := clRed;
7:Shape10.Brush.Color := clRed;
else
  Exit;
end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
case Part of
0:Shape3.Brush.Color := clLime;
1:Shape4.Brush.Color := clLime;
2:Shape5.Brush.Color := clLime;
3:Shape6.Brush.Color := clLime;
4:Shape9.Brush.Color := clLime;
5:Shape7.Brush.Color := clLime;
6:Shape8.Brush.Color := clLime;
7:Shape10.Brush.Color := clLime;
else
  Exit;
end;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
case Part of
0:Shape3.Brush.Color := clYellow;
1:Shape4.Brush.Color := clYellow;
2:Shape5.Brush.Color := clYellow;
3:Shape6.Brush.Color := clYellow;
4:Shape9.Brush.Color := clYellow;
5:Shape7.Brush.Color := clYellow;
6:Shape8.Brush.Color := clYellow;
7:Shape10.Brush.Color := clYellow;
else
  Exit;
end;
end;

procedure TForm1.LMDFileOpenEdit1Change(Sender: TObject);
begin
  if LMDFileOpenEdit1.Text <> '' then
     begin
       Label12.Caption := '第一行 (4 字)' ;
       Label13.Caption := '第二行 (4 字)' ;
       Edit1.MaxLength := 8;
       Edit2.MaxLength := 8;
       Edit1.text := '';
       Edit2.text := '';
       FullText := false;
     end else
     begin
       Label12.Caption := '第一行 (6 字)' ;
       Label13.Caption := '第二行 (6 字)' ;
       Edit1.MaxLength := 12;
       Edit2.MaxLength := 12;
       Edit1.text := '';
       Edit2.text := '';
       FullText := true;
     end;
end;

procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
   LMDFileOpenEdit1.Text := '';
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Pt:Tpoint;
begin
if Button = mbleft then
begin
   Pt := Image1.ClientToScreen(point(x,y));
   NewsMenu.Popup(pt.x,pt.y);
end;
if Button = mbright then
begin