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

📄 unitmain.pas

📁 西门子 X65 系列手机截屏工具
💻 PAS
📖 第 1 页 / 共 2 页
字号:
      begin
        Row[J] := w[J];
        Application.ProcessMessages;
      end;    // for
      ImageA.Picture.Graphic := Bitmap;
      Application.ProcessMessages;
    end;    // for
  finally
    Bitmap.Free;
    BitBtn1.Enabled := true;
    CheckBox1.Enabled := true;
    //StatusBar1.Panels[MESSINFO].Text := '截取屏幕内容,执行完毕!';
  end;
end;

procedure TfrmMain.BitBtn1Click(Sender: TObject);
var
  bTime:TDateTime;
  ms: Int64;
  Image :TImage;
  i:integer;
begin
  Label6.Caption := CapTime;
  bTime := now;
  GetDisp;
  ms := MilliSecondsBetween(now, bTime);
  Label6.Caption := Format(CapTime+' %5.3fs',[ms/1000]);//IntToStr(ms);
  for I:=1 to 8 do
  begin
    Image := TImage(FindComponent('Image' + IntToStr(i)));
    if Image.Picture.Graphic = nil then
    begin
      Image.Picture.Graphic := ImageA.Picture.Graphic;
      Exit;
    end;
  end;
end;

procedure TfrmMain.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  (Sender as TImage).Picture.Graphic:=(Source as TImage).Picture.Graphic;
end;

procedure TfrmMain.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:= True;
end;

procedure TfrmMain.BitBtn2Click(Sender: TObject);
var
  I: Integer;
  Image:  TImage;
  jpg : TJpegImage;
  Ext : String;
begin
  //SavePictureDialog1.FileName := FormatDateTime('yy-MM-dd hh:mm:ss',now);
  if not SavePictureDialog1.Execute then Exit;
  Image := TImage.Create(self);
  jpg := TJpegImage.Create;
  //jpg.Performance := jpBestQuality ;
  try
    Image.Width := DisplayWidth*(RadioGroup1.ItemIndex+3)+16;
    Image.Height := DisplayHeight*2+16;
    for I := 1 to RadioGroup1.ItemIndex+3 do    // Iterate
    begin
      Image.Canvas.Draw((I-1)*DisplayWidth+6+I,6,TImage(FindComponent('Image'+IntToStr(I))).Picture.Graphic);
    end;    // for
    for I := 5 to RadioGroup1.ItemIndex+7 do    // Iterate
    begin
      Image.Canvas.Draw((I-5)*DisplayWidth+2+I,DisplayHeight+6,TImage(FindComponent('Image'+IntToStr(I))).Picture.Graphic);
    end;
    case SavePictureDialog1.FilterIndex of
      1: begin
           //SavePictureDialog1.DefaultExt := '.jpg';
           jpg.Assign( Image.Picture.Bitmap);
           jpg.SaveToFile(SavePictureDialog1.FileName);
         end;
      2: begin
           //SavePictureDialog1.DefaultExt := '.bmp';
           Image.Picture.SaveToFile(SavePictureDialog1.FileName);
         end;
    end;
  finally
    Image.Free;
    jpg.Free;
  end;
end;

procedure TfrmMain.N1Click(Sender: TObject);
var
  Image:  TImage;
  jpg : TJpegImage;
  Ext : String;
begin
  //SavePictureDialog1.FileName := FormatDateTime('yy-MM-dd hh:mm:ss',now);
  Image:=TImage(FindComponent('Image'+Chr(PopupMenu1.Tag)));
  if not SavePictureDialog1.Execute then Exit;
  case SavePictureDialog1.FilterIndex of
    1:  begin
          jpg := TJpegImage.Create;
          try
            //SavePictureDialog1.DefaultExt := '.jpg';
            jpg.Assign( Image.Picture.Bitmap);
            jpg.SaveToFile(SavePictureDialog1.FileName);
          finally
            jpg.Free;
          end;
        end;
    2:  begin
          //SavePictureDialog1.DefaultExt := '.bmp';
          Image.Picture.SaveToFile(SavePictureDialog1.FileName);
        end;
  end;
end;

procedure TfrmMain.ImageAMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PopupMenu1.Tag := (Sender as TImage).Tag;
end;

procedure TfrmMain.SavePictureDialog1TypeChange(Sender: TObject);
begin
  case SavePictureDialog1.FilterIndex of
    1: SavePictureDialog1.DefaultExt := '.jpg';
    2: SavePictureDialog1.DefaultExt := '.bmp';
  end;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Inifile.WriteString('LANGUAGE','LANGUAGE',SpeedButton7.Caption);
  if {btnCommOpen.Caption = '断开'}BitBtn1.Enabled then
  begin
    BFC_SendAT('AT^SQWE=0'^M);
    CloseCom;
  end;
  Inifile.Free;
end;

procedure TfrmMain.SpeedButton3Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.SpeedButton4Click(Sender: TObject);
begin
  AboutBox.Show;
end;

procedure TfrmMain.SpeedButton1Click(Sender: TObject);
begin
  MessageBox(handle,PChar(Tips),PChar(SpeedButton1.Hint),MB_ICONQUESTION	);
end;

procedure TfrmMain.SpeedButton2Click(Sender: TObject);
var
  i:integer;
begin
  // 取得串口列表
  CommList.Items.Clear;
  for I := 1 to 30 do    // Iterate
  begin
    iComNum := I;
    if OpenCom(False) then
    begin
      CommList.Items.Add(Format('COM%d',[I]));
      CloseCom;
    end;
    Application.ProcessMessages;
  end;    // for
  CommList.ItemIndex := CommList.Items.Count-1;
end;

procedure TfrmMain.SpeedButton5Click(Sender: TObject);
begin
  frmTools := TfrmTools.Create(self);
  frmTools.ShowModal;
  frmTools.Free
end;

procedure TfrmMain.SpeedButton6Click(Sender: TObject);
begin
  PopupMenu1.Tag := 65;
  N1Click(Sender);
end;

procedure TfrmMain.SpeedButton7Click(Sender: TObject);
var
  Image:TImage;
  i:integer;
begin
  if SpeedButton7.Tag = 0 then
  begin
    frmMain.Caption := 'Siemens X65 Screen Capturer';
    Label3.Caption  := 'Siemens X65 Screen Capturer';
    Label4.Caption  := 'Siemens X65 Screen Capturer';
    SpeedButton4.Hint := 'About';
    SpeedButton3.Hint := 'Close';
    Label2.Caption    := 'Port:';
    SpeedButton2.Caption := 'Refresh';
    btnCommOpen.Caption := 'Connect';
    Label1.Caption    := 'Screen:';
    CheckBox1.Caption := 'Interleaved';
    BitBtn1.Caption := 'Capture!';
    SpeedButton6.Hint := 'Save Picture...';
    BitBtn2.Caption   := 'Save frames';
    RadioGroup1.Caption := 'Frames Format:';
    RadioGroup1.Items.Strings[0] := '3*2';
    RadioGroup1.Items.Strings[1] := '4*2';
    N1.Caption := 'Save Picture...';
    ImageA.Hint := 'You can drag the captured pic to a frame on the right';

    Product      := 'Product:';
    SW_Version   := 'SW-Version:';
    CurrentMode  := 'SecurityStatus:';
    CapTime      := 'Capture Time:';
    Scre         := 'Screen:';
    CopyErr      := 'Capture Error!';
    OpenErr      := 'Port Open Error!';
    Conn         := 'Connect';
    DisConn      := 'DisConn';
    ConnErr      := 'Get mobile info Error!';
    ConnSucc    := ' Connect succeed!';
    Tips         := 'You can drag the captured pic to a frame on the right.'#13#10+
                    'You can drag a pic from one frame to another.'#13#10+
                    'Click the right-button of your mouse on a pic,you can'#13#10'save each individually.';
    SpeedButton7.Caption := 'Chinese';
    SpeedButton1.Hint := 'Tips';
    for I:=1 to 8 do
    begin
      Image := TImage(FindComponent('Image' + IntToStr(i)));
      Image.Hint := IntToStr(i)+'#,You can drag a pic from one frame to another';
    end;

    SpeedButton7.Tag := 1;
  end
  else
  begin
    frmMain.Caption := '西门子 X65 截屏';
    Label3.Caption  := '西门子 X65 截屏';
    Label4.Caption  := '西门子 X65 截屏';
    SpeedButton4.Hint := '关于';
    SpeedButton3.Hint := '退出';
    Label2.Caption    := '端口:';
    SpeedButton2.Caption := '刷新';
    btnCommOpen.Caption := '连接';

    Label1.Caption    := '屏幕:';
    CheckBox1.Caption := '隔行扫描';
    BitBtn1.Caption := '截取屏幕';
    SpeedButton6.Hint := '保存图片...';
    BitBtn2.Caption   := '保存相册';
    RadioGroup1.Caption := '保存大小:';
    RadioGroup1.Items.Strings[0] := '3×2';
    RadioGroup1.Items.Strings[1] := '4×2';
    N1.Caption := '保存图片';
    ImageA.Hint := '你可以将图片拖到右边的相框中。';

    Product      := '型号:';
    SW_Version   := '版本:';
    CurrentMode  := '模式:';
    CapTime      := '耗时:';
    Scre         := '屏幕:';
    CopyErr      := '屏幕截取失败!';
    OpenErr      := '端口打开失败!';
    Conn         := '连接';
    ConnSucc     := ' 连接成功!';
    DisConn      := '断开';
    Tips         := '  你可用鼠标将左边截取的图片拖到右边的相框'#13'中,也可以在相框中,相互之间来回进行拖动。'#13#13'  你可以用鼠标右键点击各图片,单个保存,也'#13'可以将全部图片保存为单个文件。';
    SpeedButton7.Tag := 0;
    ConnErr      := '获取手机信息失败!';
    SpeedButton7.Caption := 'English';
    SpeedButton1.Hint := '操作提示';
    for I:=1 to 8 do
    begin
      Image := TImage(FindComponent('Image' + IntToStr(i)));
      Image.Hint := IntToStr(i)+'#,你可将图片在相框间来回拖动。';
    end;
  end;
end;

procedure TfrmMain.BitBtn1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Shift=[ssCtrl, ssRight] then SpeedButton5.Visible := true;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Font.Assign(Screen.IconFont);
end;

end.

⌨️ 快捷键说明

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