⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 unit1.pas

📁 上海高架路指示牌
💻 PAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 
 if  SaveDialog1.Execute then
     Image1.Picture.SaveToFile(SaveDialog1.FileName);
end;
end;

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

end;

procedure TForm1.N6Click(Sender: TObject);
var bmp:TBitmap;
begin
bmp := TBitmap.Create;
try
  bmp.LoadFromFile(ExtractFilePath(Application.ExeName)+'data\开放.bmp');
  Image2.Canvas.CopyRect(Image2.ClientRect,bmp.Canvas,bmp.Canvas.ClipRect );
finally
  bmp.free;
end;
end;

procedure TForm1.N7Click(Sender: TObject);
var bmp:TBitmap;
begin
bmp := TBitmap.Create;
try
  bmp.LoadFromFile(ExtractFilePath(Application.ExeName)+'data\拥阻.bmp');
  Image2.Canvas.CopyRect(Image2.ClientRect,bmp.Canvas,bmp.Canvas.ClipRect );
finally
  bmp.free;
end;
end;

procedure TForm1.N8Click(Sender: TObject);
var bmp:TBitmap;
begin
bmp := TBitmap.Create;
try
  bmp.LoadFromFile(ExtractFilePath(Application.ExeName)+'data\关闭.bmp');
  Image2.Canvas.CopyRect(Image2.ClientRect,bmp.Canvas,bmp.Canvas.ClipRect );
finally
  bmp.free;
end;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'data\雨天路滑_注意行车.bmp');

end;

procedure TForm1.bmp1Click(Sender: TObject);
begin
Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'data\前方施工_注意安全.bmp');
end;

procedure TForm1.N5Click(Sender: TObject);
begin
Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'data\保持车距_谨慎行驶.bmp');
end;

procedure TForm1.SendPicture(Id, Effect: Byte;Img:TImage;Data: array of byte);
var Senddata :array[0..$FFFF] of Byte;
    I,J,L:integer;
    Chksum:Word;
begin

ApdComPort1.FlushInBuffer;
ApdComPort1.FlushOutBuffer;

Senddata[0]:=$00;   //Id_start_Code
Senddata[1]:=$00;   //Id_End_Code
Senddata[2]:=$4B;   //Ascii "K"
Senddata[3]:=$53;   //AscII "S"
Senddata[4]:=$55;   // Header
Senddata[5]:=$AA;   // Header
Senddata[6]:=$00;   // Command_program

Senddata[7] :=$16;  // low  length commandbuff
Senddata[8] :=$00;  // High length commandbuff
Senddata[9] :=$00;  // low  No. Page
Senddata[10]:=$00;  // High No. Page
Senddata[11]:=lo($04 + Length(Data));  //  L0 length pattern buffer
Senddata[12]:=hi($04 + Length(Data));  //  Hi Length Pattern Buffer

Senddata[13]:=$09;   // command Clear Screen
Senddata[14]:=$05;   // command picture
Senddata[15]:= lo(Effect); // lo instant
Senddata[16]:= Hi(Effect); // Hi
Senddata[17]:=$09;   // lo speed
Senddata[18]:=$00;   // Hi
Senddata[19]:=$00;   // lo X1 : 0
Senddata[20]:=$00;   // hi
Senddata[21]:=$00;   // lo Y1 : 0
Senddata[22]:=$00;   // hi
Senddata[23]:=$00;   // Lo Fist page pattern Start Address
Senddata[24]:=$00;   // hi
Senddata[25]:=$00;   // lo Offset in page Pattern  buffer
Senddata[26]:=$00;   // Hi
Senddata[27]:=$16;   // command Delay
Senddata[28]:=lo($7FFF); // lo delay Time
Senddata[29]:=hi($7FFF); // hi
Senddata[30]:=$16;   // command Delay Time
Senddata[31]:=lo($7FFF); // lo delay Time
Senddata[32]:=Hi($7FFF); // hi
Senddata[33]:=$17;   // End Command
Senddata[34]:=$17;   // end Command buff with end command

case Img.Tag of
0: begin
     Senddata[35]:=$A0;   // lo Width Bitmap
     Senddata[36]:=$00;   // hi
     Senddata[37]:=$30;   // Lo height bitmap
     Senddata[38]:=$00;   // hi
     abcBusy1.Caption :=  '指示牌信息' + ' -- 传输信号';
   end;
1: begin
     Senddata[35]:=$30;   // lo Width Bitmap
     Senddata[36]:=$00;   // hi
     Senddata[37]:=$20;   // Lo height bitmap
     Senddata[38]:=$00;   // hi
     abcBusy1.Caption :=  '娄山关路入口状态' + ' -- 传输信号';
   end;
end;

for I := 0 to Length(Data) -1 do
  Senddata[39 + I] := Data[I];

Chksum := $00;

for j := 7 to (39 + Length(Data)-1) do
  Chksum := Chksum + Senddata[j];

Senddata[40 + Length(Data)-1] := lo(Chksum);



abcBusy1.Show;
abcBusy1.ProgressMax := (40 + Length(Data)) * 10;
abcBusy1.ProgressMin := 0;

for L := 0 to (40 + Length(Data)-1) do
begin
  ApdComPort1.PutChar(char(senddata[L]));
  abcBusy1.StepIt;
end;

abcBusy1.Hide;
end;

procedure TForm1.GetPictureData(Img:TImage;var PictureData:array of byte);
var
  x,y,n : Integer;
  CBt,SBt:Byte;
begin
    for y := 0 to Img.Height - 1 do
    begin
      for x := 0 to  (Img.Width div 4) - 1  do
         begin
           SBt := 0;
           for n := 0 to 3 do
             begin
                CBt := $00 ;
                if GetRValue(Img.Canvas.Pixels[x*4 + n,y]) > 128  then
                   CBt := $01;
                if GetGValue(Img.Canvas.Pixels[x*4 + n,y]) > 128  then
                   CBt := CBt + $02;
                case n of
                  0:begin
                     SBt := CBt shl 6;
                    end;
                  1:begin
                     SBt := SBt  + (CBt shl 4);
                    end;
                  2:begin
                     SBt := SBt  + (CBt shl 2);
                    end;
                  3:begin
                     SBt := SBt  + CBt;
                    end;
                end;
              end;
           case Img.Tag of
            0:  PictureData[X + ((Img.Width div 4)* Y)] := SBt;
            1:  PictureData[X + ((Img.Width div 4)* Y)] := SBt;
            end;
         end;
    end;

end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
Label21.Caption := '';
GetPictureData(Image1,Picture1Data);
SendPicture($00,ComboBox1.Itemindex{s.IndexOf(ComboBox1.Text)},Image1,Picture1Data);
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
Label21.Caption := '';
GetPictureData(Image2,Picture2Data);
SendPicture($01,ComboBox3.Itemindex{s.IndexOf(ComboBox3.Text)},Image2,Picture2Data);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Canvas.Brush.Color := clBlack;
Image1.Canvas.FillRect(Image1.ClientRect);
Image2.Canvas.Brush.Color := clBlack;
Image2.Canvas.FillRect(Image2.ClientRect);
abcColorComboBox1.ItemIndex := 0;
ComboBox1.ItemIndex := 0;
ComboBox2.ItemIndex := 0;
ComboBox3.ItemIndex := 0;
LMDFileOpenEdit1.InitialDir:= ExtractFilePath(Application.ExeName)+'ico';
FullText := true;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
//showmessage(inttostr(abcColorComboBox1.ItemIndex));
//BitBlt(Image1.Canvas.Handle,4,0,48,48,Image2.Canvas.Handle,0,0,SRCCOPY);
source.Canvas.Brush.Color := clBlack;
source.Canvas.FillRect(Image1.ClientRect);
Image1.Canvas.Brush.Color := clBlack;
Image1.Canvas.FillRect(Image1.ClientRect);

if FullText then
  begin
    HZK24(1,0,0,Edit1.Text,1);
    BitBlt(Image1.Canvas.Handle,8,0,160,23,Source.Canvas.Handle,0,0,SRCCOPY);
    HZK24(1,0,0,Edit2.Text,1);
    BitBlt(Image1.Canvas.Handle,8,24,160,48,Source.Canvas.Handle,0,0,SRCCOPY);
  end else
  begin
    try
      Image3.Picture.LoadFromFile(LMDFileOpenEdit1.Text);
      BitBlt(Image1.Canvas.Handle,0,0,48,48,Image3.Canvas.Handle,0,0,SRCCOPY);
    except
    end;
    HZK24(1,0,0,Edit1.Text,1);
    BitBlt(Image1.Canvas.Handle,56,0,107,23,Source.Canvas.Handle,0,0,SRCCOPY);
    HZK24(1,0,0,Edit2.Text,1);
    BitBlt(Image1.Canvas.Handle,56,24,107,48,Source.Canvas.Handle,0,0,SRCCOPY);
  end;
end;



procedure TForm1.SpeedButton7Click(Sender: TObject);
var i: integer; Stemp:string;
begin
  Memo1.Lines.Clear;
  GetColor(Shape3);
  GetColor(Shape4);
  GetColor(Shape5);
  GetColor(Shape6);
  GetColor(Shape9);
  GetColor(Shape7);
  GetColor(Shape8);
  GetColor(Shape10);

BtA:=0;
BtB:=0;
BtC:=0;
BtD:=0;
ChrA :=' ';
ChrB :=' ';
ChrC :=' ';
ChrD :=' ';

for i :=0 to 7 do
begin
  Stemp := Memo1.Lines.Strings[i];
  Case i of
    0:begin
        Btb := strtoint(Stemp[1]) shl 3;
        Btd := strtoint(Stemp[2]) shl 3;
      end;
    1:begin
        Btb := Btb + (strtoint(Stemp[1]) shl 2);
        Btd := Btd + (strtoint(Stemp[2]) shl 2);
      end;
    2:begin
        Btb := Btb + (strtoint(Stemp[1]) shl 1);
        Btd := Btd + (strtoint(Stemp[2]) shl 1);
      end;
    3:begin
        Btb := Btb + strtoint(Stemp[1]);
        Btd := Btd + strtoint(Stemp[2]);
      end;
    4:begin
        Bta := strtoint(Stemp[1]) shl 3;
        Btc := strtoint(Stemp[2]) shl 3;
      end;
    5:begin
        Bta := Bta + (strtoint(Stemp[1]) shl 2);
        Btc := Btc + (strtoint(Stemp[2]) shl 2);
      end;
    6:begin
        Bta := Bta + (strtoint(Stemp[1]) shl 1);
        Btc := Btc + (strtoint(Stemp[2]) shl 1);
      end;
    7:begin
        Bta := Bta + strtoint(Stemp[1]);
        Btc := Btc + strtoint(Stemp[2]);
      end;
    end;
end;

ChrA := inttohex(BtA,1)[1];
ChrB := inttohex(BtB,1)[1];
ChrC := inttohex(BtC,1)[1];
ChrD := inttohex(BtD,1)[1];

ListBox1.Clear;
ListBox1.Items.Add(inttohex(BtA,1));
ListBox1.Items.Add(inttohex(BtB,1));
ListBox1.Items.Add(inttohex(BtC,1));
ListBox1.Items.Add(inttohex(BtD,1));

{Memo1.lines.add(inttobin ((GetColor(Shape3) shl 2) + GetColor(Shape4),1));
Memo1.lines.add(inttohex((GetColor(Shape5) shl 2) + GetColor(Shape6),1));
Memo1.lines.add(inttohex((GetColor(Shape9) shl 2) + GetColor(Shape7),1));
Memo1.lines.add(inttohex((GetColor(Shape8) shl 2) + GetColor(Shape10),1));
}//inttohex
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
begin
Shape3.Brush.Color := clBlack;
Shape4.Brush.Color := clBlack;
Shape5.Brush.Color := clBlack;
Shape6.Brush.Color := clBlack;
Shape7.Brush.Color := clBlack;
Shape8.Brush.Color := clBlack;
Shape9.Brush.Color := clBlack;
Shape10.Brush.Color := clBlack;
end;

procedure TForm1.SpeedButton9Click(Sender: TObject);
begin
Shape3.Brush.Color := clRed;
Shape4.Brush.Color := clRed;
Shape5.Brush.Color := clRed;
Shape6.Brush.Color := clRed;
Shape7.Brush.Color := clRed;
Shape8.Brush.Color := clRed;
Shape9.Brush.Color := clRed;
Shape10.Brush.Color := clRed;
end;

procedure TForm1.SpeedButton10Click(Sender: TObject);
begin
Shape3.Brush.Color := clLime;
Shape4.Brush.Color := clLime;
Shape5.Brush.Color := clLime;
Shape6.Brush.Color := clLime;
Shape7.Brush.Color := clLime;
Shape8.Brush.Color := clLime;
Shape9.Brush.Color := clLime;
Shape10.Brush.Color := clLime;
end;

procedure TForm1.SpeedButton11Click(Sender: TObject);
begin
Shape3.Brush.Color := clYellow;
Shape4.Brush.Color := clYellow;
Shape5.Brush.Color := clYellow;
Shape6.Brush.Color := clYellow;
Shape7.Brush.Color := clYellow;
Shape8.Brush.Color := clYellow;
Shape9.Brush.Color := clYellow;
Shape10.Brush.Color := clYellow;
end;

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

procedure TForm1.SpeedButton12Click(Sender: TObject);
begin
Label21.Caption := '';
SpeedButton2.Click;
Sleep(1000);
SpeedButton4.Click;
Sleep(5000);
SpeedButton3.Click;
end;

procedure TForm1.SpeedButton13Click(Sender: TObject);
begin
SpeedButton8.Click;
SpeedButton7.Click;
Image1.Canvas.Brush.Color := clBlack;
Image1.Canvas.FillRect(Image1.ClientRect);
Image2.Canvas.Brush.Color := clBlack;
Image2.Canvas.FillRect(Image2.ClientRect);
SpeedButton12.Click;
end;

procedure TForm1.SpeedButton14Click(Sender: TObject);
begin
close;
end;

procedure TForm1.ComboBox2Click(Sender: TObject);
begin
Panel1.SetFocus;
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -