Delphi DFM ミニメモ帳 minimemo ソースコード ― 2022年08月26日 11:51


unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Buttons,
  Vcl.Menus, System.Actions, Vcl.ActnList, Vcl.ExtDlgs, System.IOUtils,
  System.ImageList, Vcl.ImgList, Vcl.Clipbrd;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Memo1: TMemo;
    PopupMenu1: TPopupMenu;
    bbtnMenu: TBitBtn;
    S1: TMenuItem;
    ActionList1: TActionList;
    acSave: TAction;
    SaveTextFileDialog1: TSaveTextFileDialog;
    acSaveAs: TAction;
    A1: TMenuItem;
    acNew: TAction;
    acOpen: TAction;
    N1: TMenuItem;
    O1: TMenuItem;
    OpenTextFileDialog1: TOpenTextFileDialog;
    ImageList1: TImageList;
    N2: TMenuItem;
    C1: TMenuItem;
    V10byArihiko1: TMenuItem;
    N3: TMenuItem;
    bbtnAllSelect: TBitBtn;
    bbtnCopy: TBitBtn;
    bbtnPaste: TBitBtn;
    procedure bbtnMenuMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure acSaveExecute(Sender: TObject);
    procedure acSaveAsExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure acOpenExecute(Sender: TObject);
    procedure acNewExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure bbtnAllSelectClick(Sender: TObject);
    procedure bbtnCopyClick(Sender: TObject);
    procedure bbtnPasteClick(Sender: TObject);
  private
    { Private 宣言 }
    FFileName: String;
    FEncodingIndex: Integer;
    procedure Init;
    procedure SaveFile;
    procedure UpdateCaption;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.acNewExecute(Sender: TObject);
begin
  Init;
end;

procedure TForm1.acOpenExecute(Sender: TObject);
var
  Enc: TEncoding;
begin
  if OpenTextFileDialog1.Execute then
    begin
      // 値を保存
      FFileName := OpenTextFileDialog1.FileName;
      FEncodingIndex := OpenTextFileDialog1.EncodingIndex;
      // キャプションを変更
      UpdateCaption; // <---------------------追加
      // EncodingIndex によりエンコーディングを指定
      case FEncodingIndex of
        1: Enc := TEncoding.Unicode;
        2: Enc := TEncoding.BigEndianUnicode;
        3: Enc := TEncoding.UTF8;
      else
        Enc := TEncoding.Default;
      end;
      // エンコーディングを指定して読み込み
      Memo1.Lines.LoadFromFile(FFileName, Enc);
    end;
end;

procedure TForm1.acSaveAsExecute(Sender: TObject);
begin
  if SaveTextFileDialog1.Execute then
    begin
      // 値を保存
      FFileName := SaveTextFileDialog1.FileName;
      FEncodingIndex := SaveTextFileDialog1.EncodingIndex;
      // キャプションを変更
      UpdateCaption;
      // ファイルへ保存
      SaveFile;
    end;
end;

procedure TForm1.acSaveExecute(Sender: TObject);
begin
  if (FFileName = '') then
    begin
      // 名前を付けて保存
      acSaveAs.Execute;          // <- 追加
    end
  else
    begin
      // 上書き保存
      SaveFile;
    end;
end;

procedure TForm1.bbtnMenuMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  popupmenu1.Popup(form1.left+x,form1.top+y);
end;

procedure TForm1.bbtnPasteClick(Sender: TObject);
begin
  Memo1.SelText:=Clipboard.AsText;
end;

procedure TForm1.bbtnAllSelectClick(Sender: TObject);
begin
  memo1.selectall;
  memo1.SetFocus;
end;

procedure TForm1.bbtnCopyClick(Sender: TObject);
begin
  Memo1.SetFocus;
  Clipboard.AsText:=Memo1.SelText;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Memo1.Modified then    //テキストが変更されていれば
    case MessageDlg('メモの内容が変更されています，保存しますか？'
        + #13#10 +'はい:保存，いいえ:終了',mtWarning,mbYesNo,0) of
      mrYes: acSaveAs.Execute;
      mrCancel:  CanClose := False;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Init;
end;

procedure TForm1.Init;
begin
 // 値を初期化
  FFileName := '';
  FEncodingIndex := 0;
  Memo1.Lines.Clear; // Memo1 の中身を消去する。
  // キャプションを変更
  UpdateCaption;
end;

procedure TForm1.SaveFile;
var
  Enc: TEncoding;
begin
  // EncodingIndex によりエンコーディングを指定
  case FEncodingIndex of
    1: Enc := TEncoding.Unicode;
    2: Enc := TEncoding.BigEndianUnicode;
    3: Enc := TEncoding.UTF8;
  else
    Enc := TEncoding.Default;
  end;
  // エンコーディングを指定して保存
  Memo1.Lines.SaveToFile(FFileName, Enc);
  Memo1.Modified := false;
end;

procedure TForm1.UpdateCaption;
var
  Dmy: String;
begin
  if FFileName = '' then
    Dmy := '無題'
  else
    Dmy := TPath.GetFileName(FFileName);
  Self.Caption := Dmy + '_miniメモ';
end;

end.


by tukasa [コメント(0)｜トラックバック(0)]

Delphi FMX メディアプレイヤー miniDPlay ソースコード ― 2022年08月26日 11:46


unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Media,
  FMX.StdCtrls, FMX.Controls.Presentation, FMX.Media.Win, FMX.Edit, FMX.ExtCtrls,
  FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Platform, FMX.Layouts,
  FMX.ListBox, FMX.Objects, FMX.Effects,System.IOUtils, FMX.DialogService,
  Winapi.Windows;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    OpenDialog1: TOpenDialog;
    MediaPlayer1: TMediaPlayer;
    MediaPlayerControl1: TMediaPlayerControl;
    Timer1: TTimer;
    ListBox1: TListBox;
    pnlFile: TPanel;
    pnlMain: TPanel;
    MediaPlayer2: TMediaPlayer;
    pnlPView: TPanel;
    MediaPlayerControl2: TMediaPlayerControl;
    Panel2: TPanel;
    btnFileOpen: TButton;
    btnStopPlay: TButton;
    Panel3: TPanel;
    edNow: TEdit;
    edNagasa: TEdit;
    pnlSeek: TPanel;
    TrackBar1: TTrackBar;
    ProgressBar1: TProgressBar;
    pnlPie: TPanel;
    Pie1: TPie;
    Circle1: TCircle;
    Circle2: TCircle;
    StyleBook1: TStyleBook;
    pnlPreMei: TPanel;
    lblFilDrop: TLabel;
    edPRev: TEdit;
    edPRevTime: TEdit;
    Timer2: TTimer;
    lblPrgFilmei: TLabel;
    Splitter2: TSplitter;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure btnStopPlayClick(Sender: TObject);
    procedure btnFileOpenClick(Sender: TObject);
    function filSetPlay(filmei:string):boolean;
    procedure ListBox1DragOver(Sender: TObject; const Data: TDragObject;
      const Point: TPointF; var Operation: TDragOperation);
    procedure ListBox1DragDrop(Sender: TObject; const Data: TDragObject;
      const Point: TPointF);
    procedure ListBox1Change(Sender: TObject);
    procedure timeKaku(var ed:Tedit; tim:Tmediatime);
    procedure ProgressBar1MouseEnter(Sender: TObject);
    procedure ProgressBar1MouseLeave(Sender: TObject);
    procedure ProgressBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure ProgressBar1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Pie1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Pie1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure Pie1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure zeroTank(fom:TForm; stb:TStatusbar; pnl:TPanel; pai:TPie; var zero:single; var tank:single);
    procedure listFontSetei(lsb:TListbox);
    procedure FormShow(Sender: TObject);
    procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure ListBox1MouseEnter(Sender: TObject);
    procedure ListBox1MouseLeave(Sender: TObject);
    procedure pnlFileResize(Sender: TObject);
    procedure Pie1MouseEnter(Sender: TObject);
    procedure Pie1MouseLeave(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;


implementation

{$R *.fmx}

var
  saigo:boolean;
  genban:integer;
  nagasa:single;
  genDir:string;
  zeroKak:single;
  mauleftOn:boolean;
  tankak:single;
  lbxGetText:string;
  volset:single;{規定ボリュームセット}

//////////////////////////////////////////////////////////////////////////////
//ゼロ角　タン角　変更
//左下45度が0で(右回りで)右下45度が270
procedure TForm1.zeroTank(fom:TForm; stb:TStatusbar; pnl:TPanel; pai:TPie; var zero, tank: single);
begin
  var PtScreen,PtForm : TPointF;
  var cyusinX,cyusinY : single;
  var zureX,zureY : single;

  cyusinX := 0;
  cyusinY := 0;
  PtScreen := Screen.MousePos;
  PtForm := fom.ScreenToclient(PtScreen);
  zureX := PtForm.x - stb.position.x - pnl.Position.x  - pai.Position.x - pai.Width / 2 - cyusinX;
  zureY := PtForm.y - stb.position.y - pnl.Position.y - pai.position.y - pai.Height / 2 - cyusinY;

  tank := 0;
  if (zureX = 0)and(zureY = 0) then begin
    //
  end else if (zureX = 0)and(zureY > 0) then begin
    tank := 90; zero := 0;
  end else if (zureX = 0)and(zureY < 0) then begin
    tank := 270; zero := 135;
  end else if (zureX > 0)and(zureY = 0) then begin
    tank := 0;  zero := 225;
  end else if (zureX < 0)and(zureY = 0) then begin
    tank := 180;  zero := 45;
  end else if (zureX > 0)and(zureY > 0) then  begin
    tank := arctan(zureY / zureX) * 180 / pi;
    zero := 360 + tank - 135;
  end else if (zureX < 0)and(zureY > 0) then begin
    tank := 90 - arctan(zureX/ zureY) * 180 / pi;
    zero := tank - 135;
  end else if (zureX < 0)and(zureY < 0) then begin
    tank := 180 + arctan(zureY/ zureX) * 180 / pi;
    zero := tank - 135;
  end else if (zureX > 0)and(zureY < 0) then begin
    tank := 270 - arctan(zureX/ zureY) * 180 / pi;
    zero := tank - 135;
  end;
end;

procedure TForm1.listFontSetei(lsb: TListbox);
begin
  var i:integer;

  for i:=0 to Lsb.Items.Count-1 do begin
    Lsb.ListItems[i].StyledSettings:=[]; // 全部反映される
    with Lsb.ListItems[i].Font do begin
      Family := 'Meiryo';
      Lsb.Listitems[i].TextSettings.FontColor := TAlphaColorRec.white;//TAlphaColorRec.Blue; //$FFDDDDDD;
      Size := 11;
    end;
  end;
end;

procedure TForm1.btnFileOpenClick(Sender: TObject);
begin
  if opendialog1.Execute then begin
    genDir := extractfilePath(opendialog1.filename);
    listbox1.Items.Clear;
    listbox1.items.Add(extractfilename(opendialog1.filename));
    //listFontSetei(Listbox1);
    genban := 0;
    lblFilDrop.Visible := false;
    timer1.Enabled := false;
    timer2.Enabled := false;
    listbox1.ItemIndex := genban; {リストボックスチェンジで動画スタート}
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
//
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TMediaCodecManager.RegisterMediaCodecClass('.mp4', 'mp4 Files', TMediaType.Video, TWindowsMediaCodec);
  //TMediaCodecManager.RegisterMediaCodecClass('.mpg', 'mpg Files', TMediaType.Video, TWindowsMediaCodec);
  OpenDialog1.Filter := TMediaCodecManager.GetFilterString ;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  //
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  lbxGetText := '';
  timer1.Enabled := false;
  timer2.Enabled := false;
end;

procedure TForm1.ListBox1Change(Sender: TObject);
begin
  //if lbxMauOn then  begin
    genban :=  listbox1.ItemIndex;
    if filSetPlay(genDir + '\' + listbox1.Items[genban]) = false then begin
      //TDialogService.ShowMessage('FILE ERROR');
      inc(genban);
      if genban > listbox1.items.Count - 1 then begin
        genban := 0;
        listbox1.ItemIndex := 0;
        listbox1.ItemIndex := 1;
        listbox1.ItemIndex := 0;
      end;
    end;
    listbox1.ItemIndex := genban;
  //end;
end;

procedure TForm1.ListBox1DragDrop(Sender: TObject; const Data: TDragObject;
  const Point: TPointF);
begin
  var U:Tstringlist;
  var D:string;
  var sdmy:string;

  U := Tstringlist.Create;
  try
    genDir := extractfilePath(data.files[0]);
    listbox1.Items.Clear;
    for D in data.files do begin
      if TPath.hasExtension(D) then begin
        U.Add(extractfilename(D)); {フォルダは除外して拡張子のあるファイルのみゲット}
      end;
    end;
    listbox1.items.AddStrings(U);
  finally
    U.free;
  end;
  //listFontSetei(Listbox1);
  genban := 0;
  lblFilDrop.Visible := false;
  timer1.Enabled := false;
  timer2.Enabled := false;
  volset := 0.5;/////////////////////////////////////////////////////////////////
  listbox1.ItemIndex := genban; {リストボックスチェンジで動画スタート}
end;

procedure TForm1.ListBox1DragOver(Sender: TObject; const Data: TDragObject;
  const Point: TPointF; var Operation: TDragOperation);
begin
  Operation := TDragOperation.copy;
end;

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  var gIndex:integer;

  if listbox1.Items.Count = 0 then exit;


  gIndex := listbox1.ItemByPoint(x,y).Index;
  if gIndex  = genban then begin
    TDialogService.ShowMessage('すでに再生されています');
    Winapi.Windows.SetCursorPos(round(form1.left+1), round(form1.top+1));
    mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
    mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
  end else begin
    //TDialogService.ShowMessage('TIGAU'+inttostr(gIndex)+','+inttostr(genban));
  end;
end;

procedure TForm1.ListBox1MouseEnter(Sender: TObject);
begin
  lbxGetText := '';
end;

procedure TForm1.ListBox1MouseLeave(Sender: TObject);
begin
  mediaplayer2.Clear;
  lbxGetText := '';
end;

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Single);
begin
  var gText:string;

  try
    gText := listbox1.ItemByPoint(x,y).Text;
    edPrev.text := gText;
    //TDialogService.ShowMessage('MOVE');
    if gText <> lbxGetText then
      mediaplayer2.FileName :=  genDir + '\' + gText;
      mediaplayer2.Volume := 0;
      mediaplayer2.play;
      timer2.Enabled := true;
      lbxGetText := gText;
  except
    //
  end;

end;

//////////////////////////////////////////////////////////////////////////////
//パイ　マウス　ダウン
procedure TForm1.Pie1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if button = TMouseButton.mbLeft then begin
    zeroTank(Form1,Statusbar1,pnlPie,Pie1,zeroKak,tankak);

    mauleftOn := false;
    if zerokak <= 0 then begin
      mauleftOn := false; {左下45度よりも左下はマウスダウン認識させない}
      zerokak := 0;
    end else if zerokak >= 270 then begin
      mauleftOn := false; {右下45度よりも右下はマウスダウン認識させない}
      zerokak := 0; {もしもこの範囲でマウスダウンしたら，安全側の最小値0にする}
    end else begin
      mauleftOn := true; {左下45度から右回りで右下45度の範囲のみマウスダウン認識}
    end;
  end;
end;

procedure TForm1.Pie1MouseEnter(Sender: TObject);
begin
  with pie1.fill do begin
    Kind := TBrushkind.Gradient;
    Gradient.Color := Talphacolorrec.Gold; //.Darkgoldenrod;
  　Gradient.Color1 := $FF555555;
  　Gradient.Style := TGradientStyle.gsRadial ;
    Color := Talphacolorrec.Darkgoldenrod;
  end;
end;

procedure TForm1.Pie1MouseLeave(Sender: TObject);
begin
  with pie1.fill do begin
    Kind := TBrushkind.Solid;
    Color := $FF555555;
  end;
end;

//////////////////////////////////////////////////////////////////////////////
//パイ　マウス　ムーブ
procedure TForm1.Pie1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  if mauLeftOn then begin
    zeroTank(Form1,Statusbar1,pnlPie,Pie1,zeroKak,tankak);

    if zerokak <= 0 then begin
      mauleftOn := false;
      zerokak := 0;
      tankak := 135;
    end else if zerokak >= 270 then begin
      mauleftOn := false;
      zerokak := 270;
      tankak := 45;
    end;
    Pie1.RotationAngle := zerokak; {OK}
    try
      mediaplayer1.Volume := zerokak / 270; {ボリューム OK}
      volset := mediaplayer1.Volume;
    except
      //
    end;
  end;
end;

///////////////////////////////////////////////////////////////////////////////
//パイ　マウス　アップ
procedure TForm1.Pie1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  mauLeftOn := false;
end;

procedure TForm1.pnlFileResize(Sender: TObject);
begin
  pnlPView.Height := pnlFile.Width * 0.5625; {16:9}
end;

procedure TForm1.ProgressBar1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  trackbar1.value := progressbar1.max * x / progressbar1.width;
end;

procedure TForm1.ProgressBar1MouseEnter(Sender: TObject);
begin
  try
    mediaplayer2.FileName :=  genDir + '\' + listbox1.Selected.Text;
    timer2.Enabled :=true;
    edPRev.text := listbox1.Selected.Text;
  except
    //
  end;
end;

procedure TForm1.ProgressBar1MouseLeave(Sender: TObject);
begin
  mediaplayer2.Clear;
end;

procedure TForm1.ProgressBar1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  try
    mediaplayer2.Volume := 0;
    mediaplayer2.CurrentTime := round(Progressbar1.max * x / progressbar1.width * mediatimescale);
    mediaplayer2.play;
  except
    //
  end;
end;


procedure TForm1.timeKaku(var ed: Tedit; tim: Tmediatime);
begin
  var DurationMin, DurationSec: integer;

  DurationMin := tim div 10000 div 60000;
  DurationSec := tim div 10000 mod 60000 div 1000;
  ed.Text := IntToStr(DurationMin) + ':' + IntToStr(DurationSec);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

  try
    with mediaplayer1 do begin
      progressbar1.Value := CurrentTime / mediatimescale;
      timeKaku(edNow,CurrentTime);
      if Duration  = CurrentTime then saigo := true;
    end;
  except
    //
  end;

  if saigo then begin
    saigo := false;
    timer1.Enabled := false;
    sleep(500);
    inc(genban);
    if genban > listbox1.Items.Count - 1 then begin
      genban := 0;
      //mediaplayer1.Stop;
    end;
    listbox1.ItemIndex := genban; {リストボックスチェンジで動画スタート}
  end;
  //listFontSetei(listbox1);
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  timeKaku(edPRevTime,mediaplayer2.CurrentTime);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  try
    mediaplayer1.CurrentTime := round(trackbar1.Value * mediatimescale);
    mediaplayer1.play;
  except
    //
  end;
end;

procedure TForm1.btnStopPlayClick(Sender: TObject);
begin
  try
    with mediaplayer1 do begin
      if State = TmediaState.Unavailable then begin
        timer1.Enabled := false;
      end else if State = TmediaState.Playing then begin
        Stop;
        timer1.Enabled := false;
      end else if state = TmediaState.Stopped then begin
        Play;
        timer1.Enabled := true;
      end;
    end;
  except
    //
  end;
end;


function TForm1.filSetPlay(filmei: string):boolean;
begin
  var sdmy:string;

  //listFontSetei(listbox1);
  result := true;
  try
    if mediaplayer1.FileName =  filmei then exit;
    mediaplayer1.FileName :=  filmei;
    sdmy := filmei + ' ('+ FloatToStr(MediaPlayer1.VideoSize.X) + 'x' +
      FloatToStr(MediaPlayer1.VideoSize.Y) + ')';
    form1.caption := sdmy;
    sdmy := extractfilename(filmei);
    lblPrgFilmei.Text := sdmy;
    mediaplayer1.play;
    timer1.Enabled := true;
  except
    result := false;//ShowMessageFmt('%s', ['メディアファイルを開けませんでした']);
  end;
  mediaplayer1.Volume := volset;////////////////////////////////////////////////////////////////////
  pie1.RotationAngle :=  270 * mediaplayer1.Volume;

  try
    nagasa := mediaplayer1.Duration / mediatimescale;
    with trackbar1 do begin Min := 0; Max := nagasa; Value := 0; end;
    with ProgressBar1 do begin Min := 0; Max := nagasa; Value := 0; end;
    timekaku(edNagasa,mediaplayer1.Duration);
  except
    //
  end;
end;

end.


by tukasa [コメント(0)｜トラックバック(0)]

Delphi 簡易電卓 ソースコード ― 2022年08月25日 15:44



unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Vcl.Touch.Keyboard, Vcl.Buttons, MSScriptControl_TLB, System.ImageList,
  Vcl.ImgList;

type
  TForm1 = class(TForm)
    TouchKeyboard1: TTouchKeyboard;
    Memo1: TMemo;
    Edit1: TEdit;
    sbtnClia: TSpeedButton;
    sbtnKeisan: TSpeedButton;
    Edit2: TEdit;
    sbtnMemory: TSpeedButton;
    sbtnRecal: TSpeedButton;
    sbtnKakoST: TSpeedButton;
    ImageList1: TImageList;
    sbtnKakoEN: TSpeedButton;
    sbtnKyaret: TSpeedButton;
    sbtnHidari: TSpeedButton;
    sbtnMigi: TSpeedButton;
    sbtnBS: TSpeedButton;
    sbtnSin: TSpeedButton;
    sbtnCos: TSpeedButton;
    sbtnTan: TSpeedButton;
    sbtnPai: TSpeedButton;
    sbtnE: TSpeedButton;
    sbtnRuto: TSpeedButton;
    sbtnKuhak: TSpeedButton;
    sbtnGyakusu: TSpeedButton;
    procedure FormShow(Sender: TObject);
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
    procedure clia;
    procedure sbtnCliaClick(Sender: TObject);
    procedure sbtnKeisanClick(Sender: TObject);
    procedure sbtnMemoryClick(Sender: TObject);
    procedure sbtnRecalClick(Sender: TObject);
    function MSsisoku(siki:string):string;
    procedure sbtnKakoSTClick(Sender: TObject);
    procedure sbtnKakoENClick(Sender: TObject);
    procedure sbtnKyaretClick(Sender: TObject);
    procedure sbtnMigiClick(Sender: TObject);
    procedure sbtnHidariClick(Sender: TObject);
    procedure sbtnBSClick(Sender: TObject);
    function doToRad(atai:string):string;
    procedure sbtnSinClick(Sender: TObject);
    procedure sbtnCosClick(Sender: TObject);
    procedure sbtnTanClick(Sender: TObject);
    procedure sbtnPaiClick(Sender: TObject);
    procedure sbtnEClick(Sender: TObject);
    procedure sbtnRutoClick(Sender: TObject);
    procedure sbtnKuhakClick(Sender: TObject);
    procedure sbtnGyakusuClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

const
  PAI = '3.141592653';
  RADD = '0.01745329252';

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.doToRad(atai: string): string;
begin
  var sdmy:string;
  sdmy := atai;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  clia;
end;

procedure TForm1.clia; //答えの欄と計算式の欄をクリアする
begin
  edit1.text := '';
  memo1.Lines.Clear;
  memo1.SetFocus;
end;//clia end


procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
  if ord(key) = VK_RETURN then begin key := #0;{ビープ音を消す}
    edit1.text := MSsisoku(memo1.Text); //計算する
  end;
end;

function TForm1.MSsisoku(siki: string): string;  //'Microsoft Script Control 1.0
begin
  var msc: TScriptControl;
  msc := TScriptControl.Create( Self );
  msc.Language := 'VBScript';
  //MOTOlabel1.caption := VarToStr( msc.Eval( 'sin(0.2) + log(20)' ) ) ;
  try
    //label1.caption := varToStr(msc.Eval('(1.5+2)/-2'));
    result := varToStr(msc.Eval(siki));
  except
    result := '計算式が不正です';
  end;
  msc.Free;
end;

procedure TForm1.sbtnCliaClick(Sender: TObject); //クリア
begin
  clia;
end;

procedure TForm1.sbtnKeisanClick(Sender: TObject); //計算
begin
  edit1.text := MSsisoku(memo1.Text);
  memo1.SetFocus;
end;

procedure TForm1.sbtnKuhakClick(Sender: TObject);
begin
  memo1.SelText := ' ';
end;

procedure TForm1.sbtnBSClick(Sender: TObject);
begin
  SetForegroundWindow(hwnd(memo1.Handle));
  keybd_event(VK_BACK, 0, 0, 0); // Bsキー
  keybd_event(VK_BACK, 0, KEYEVENTF_KEYUP, 0);
end;

procedure TForm1.sbtnEClick(Sender: TObject);
begin
  memo1.SelText := 'E';
end;

procedure TForm1.sbtnGyakusuClick(Sender: TObject);
begin
  memo1.SelText := '1/';
end;

procedure TForm1.sbtnMigiClick(Sender: TObject);
begin
  memo1.selstart := memo1.selstart + 1;
end;

procedure TForm1.sbtnPaiClick(Sender: TObject);
begin
  memo1.SelText := '3.141592653';
end;

procedure TForm1.sbtnHidariClick(Sender: TObject);
begin
  memo1.selstart := memo1.selstart - 1;
end;

procedure TForm1.sbtnKakoENClick(Sender: TObject);
begin
  memo1.SelText := ')';
end;

procedure TForm1.sbtnKakoSTClick(Sender: TObject);
begin
  memo1.SelText := '(';
end;

procedure TForm1.sbtnKyaretClick(Sender: TObject);
begin
  memo1.SelText := '^';
end;

procedure TForm1.sbtnMemoryClick(Sender: TObject); //答えの値を記憶させる
begin
  Edit2.text := Edit1.Text;
  memo1.SetFocus;
end;

procedure TForm1.sbtnRecalClick(Sender: TObject); //記憶値を数式画面へ挿入する
begin
  memo1.SelText := Edit2.text;
end;

procedure TForm1.sbtnRutoClick(Sender: TObject);
begin
  memo1.SelText := 'sqr()';
  memo1.selstart := memo1.selstart - 1;
end;

procedure TForm1.sbtnSinClick(Sender: TObject);
begin
  memo1.SelText := 'sin(0.01745329252*)';
  memo1.selstart := memo1.selstart - 1;
end;

procedure TForm1.sbtnCosClick(Sender: TObject);
begin
  memo1.SelText := 'cos(0.01745329252*)';
  memo1.selstart := memo1.selstart - 1;
end;

procedure TForm1.sbtnTanClick(Sender: TObject);
begin
  memo1.SelText := 'tan(0.01745329252*)';
  memo1.selstart := memo1.selstart - 1;
end;

end.


by tukasa [コメント(0)｜トラックバック(0)]

C# WindowsForm エクスプローラ Program.cs ― 2022年08月25日 11:58

using System;
using System.Collections.Generic;
using System.Linq;
using System.Threading.Tasks;
using System.Windows.Forms;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Text;
using Microsoft.WindowsAPICodePack.Shell;

namespace myExprore
{
    internal static class Program
    {
        /// <summary>
        /// アプリケーションのメイン エントリ ポイントです。
        /// </summary>
        [STAThread]
        static void Main()
        {
            Application.EnableVisualStyles();
            Application.SetCompatibleTextRenderingDefault(false);
            Application.Run(new Form1());
        }
    }
}



by tukasa [コメント(0)｜トラックバック(0)]

C# WindowsForm エクスプローラ Form1.cs ― 2022年08月25日 11:57

using System;
using System.Collections.Generic;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Linq;
using System.Text;
using System.Threading.Tasks;
using System.Windows.Forms;
using Microsoft.WindowsAPICodePack.Shell;

namespace myExprore
{
    public partial class Form1 : Form
    {
        public Form1()
        {
            InitializeComponent();
        }

        private void Form1_Shown(object sender, EventArgs e)
        {
            explorerBrowser1.Navigate((ShellObject)KnownFolders.Desktop);
        }

        private void explorerBrowser1_NavigationComplete(object sender, Microsoft.WindowsAPICodePack.Controls.NavigationCompleteEventArgs e)
        {
            //
        }

        private void button1_Click(object sender, EventArgs e)
        {
            string mylocation;
            ShellObject myfolder;

            //mylocation = "c:\\aaa\\example";
            mylocation = textBox1.Text;
            myfolder= ShellObject.FromParsingName(mylocation);
            explorerBrowser1.Navigate(myfolder);            
        }

        private void explorerBrowser1_SelectionChanged(object sender, EventArgs e)
        {
            ShellObjectCollection items = explorerBrowser1.SelectedItems;
            textBox1.Text = items[0].ParsingName;
         }
    }
}



by tukasa [コメント(0)｜トラックバック(0)]

最近の記事

<< 2022/08
日 月 火 水 木 金 土
01 02 03 04 05 06
07 08 09 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31

このブログについて

ネットで見つけたいろいろ雑記

バックナンバー

RSS