2018年10月3日 星期三

目錄選取界面

Uses FileCtrl

function SelectDirectory(var Directory: string;
  Options: TSelectDirOpts; HelpCtx: Longint): Boolean; overload;

function SelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string; Options: TSelectDirExtOpts = [sdNewUI]; Parent: TWinControl = nil): Boolean; overload;

function SelectDirectory(const StartDirectory: string; out Directories: TArray<string>; Options: TSelectDirFileDlgOpts = [];
  const Title: string = ''; const FolderNameLabel: string = ''; const OkButtonLabel: string = ''): Boolean; overload;


TSelectDirOpt = (sdAllowCreate, sdPerformCreate, sdPrompt);
TSelectDirOpts = set of TSelectDirOpt;

TSelectDirExtOpt = (sdNewFolder, sdShowEdit, sdShowShares, sdNewUI, sdShowFiles, sdValidateDir);
TSelectDirExtOpts = set of TSelectDirExtOpt;

TSelectDirFileDlgOpt = (sdHidePinnedPlaces, sdNoDereferenceLinks, sdForceShowHidden, sdAllowMultiselect);
TSelectDirFileDlgOpts = set of TSelectDirFileDlgOpt;

idFTP 檢查FTP目錄是否存在

uses IdFTP, IdGlobal, IdFTPCommon, IdAllFTPListParsers;

function fn_FtpDirectoryExists(AidFTP:TidFTP; ADir:String): Boolean;
var index:Integer;
begin
  Index:=0;
  Result := False;
  try
    AidFTP.List;
    if Assigned(AidFTP.DirectoryListing) and (AidFTP.DirectoryListing.Count>0) then
    begin
      while Index<AidFTP.DirectoryListing.Count do
      begin
        with AidFTP.DirectoryListing.Items[Index] do
        begin
          if (trim(FileName)=trim(ADir)) and (ItemType = ditDirectory) then
          begin
            Result:=true;
            Exit;
          end;
        end;
        Index:=Index+1;
      end;
    end;
  except
    Result := False;
  end;
end;

2018年8月22日 星期三

SQL convert Datetime

Select CONVERT(nvarchar(100), GETDATE(), 0)   -- May 28 2019  8:25AM
Select CONVERT(nvarchar(100), GETDATE(), 1)   -- 05/28/19
Select CONVERT(nvarchar(100), GETDATE(), 2)   -- 19.05.28
Select CONVERT(nvarchar(100), GETDATE(), 3)   -- 28/05/19
Select CONVERT(nvarchar(100), GETDATE(), 4)   -- 28.05.19
Select CONVERT(nvarchar(100), GETDATE(), 5)   -- 28-05-19
Select CONVERT(nvarchar(100), GETDATE(), 6)   -- 28 May 19
Select CONVERT(nvarchar(100), GETDATE(), 7)   -- May 28, 19
Select CONVERT(nvarchar(100), GETDATE(), 8)   -- 08:28:35
Select CONVERT(nvarchar(100), GETDATE(), 9)   -- May 28 2019  8:28:35:360AM
Select CONVERT(nvarchar(100), GETDATE(), 10)  -- 05-28-19
Select CONVERT(nvarchar(100), GETDATE(), 11)  -- 19/05/28
Select CONVERT(nvarchar(100), GETDATE(), 12)  -- 190528
Select CONVERT(nvarchar(100), GETDATE(), 13)  -- 28 May 2019 08:28:53:277
Select CONVERT(nvarchar(100), GETDATE(), 14)  -- 08:28:53:277
Select CONVERT(nvarchar(100), GETDATE(), 20)  -- 2019-05-28 08:29:10
Select CONVERT(nvarchar(100), GETDATE(), 21)  -- 2019-05-28 08:29:10.180
Select CONVERT(nvarchar(100), GETDATE(), 22)  -- 05/28/19  8:29:10 AM
Select CONVERT(nvarchar(100), GETDATE(), 23)  -- 2019-05-28
Select CONVERT(nvarchar(100), GETDATE(), 24)  -- 08:29:27
Select CONVERT(nvarchar(100), GETDATE(), 25)  -- 2019-05-28 08:29:27.490
Select CONVERT(nvarchar(100), GETDATE(), 100) -- May 28 2019  8:29AM
Select CONVERT(nvarchar(100), GETDATE(), 101) -- 05/28/2019
Select CONVERT(nvarchar(100), GETDATE(), 102) -- 2019.05.28
Select CONVERT(nvarchar(100), GETDATE(), 103) -- 28/05/2019
Select CONVERT(nvarchar(100), GETDATE(), 104) -- 28.05.2019
Select CONVERT(nvarchar(100), GETDATE(), 105) -- 28-05-2019
Select CONVERT(nvarchar(100), GETDATE(), 106) -- 28 May 2019
Select CONVERT(nvarchar(100), GETDATE(), 107) -- May 28, 2019
Select CONVERT(nvarchar(100), GETDATE(), 108) -- 08:30:00
Select CONVERT(nvarchar(100), GETDATE(), 109) -- May 28 2019  8:30:00:127AM
Select CONVERT(nvarchar(100), GETDATE(), 110) -- 05-28-2019
Select CONVERT(nvarchar(100), GETDATE(), 111) -- 2019/05/28
Select CONVERT(nvarchar(100), GETDATE(), 112) -- 20190528
Select CONVERT(nvarchar(100), GETDATE(), 113) -- 28 May 2019 08:30:21:373
Select CONVERT(nvarchar(100), GETDATE(), 114) -- 08:30:21:373
Select CONVERT(nvarchar(100), GETDATE(), 120) -- 2019-05-28 08:30:40
Select CONVERT(nvarchar(100), GETDATE(), 121) -- 2019-05-28 08:30:40.233
Select CONVERT(nvarchar(100), GETDATE(), 126) -- 2019-05-28T08:30:40.233
Select CONVERT(nvarchar(100), GETDATE(), 130) -- 24 رمضان 1440  8:30:55:117AM
Select CONVERT(nvarchar(100), GETDATE(), 131) -- 24/09/1440  8:31:01:990AM

2018年7月15日 星期日

取得< 使用者>資料夾路徑

GetEnvironmentVariable('USERPROFILE');

Result  C:\Users\Administrator

Delphi 取得桌面資料夾的路徑和取得我的文件的路徑

function GetShellFolders(strDir: string): string;
const
  regPath = '\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
var
  Reg: TRegistry;
  strFolders: string;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey(regPath, false) then
    begin
      strFolders := Reg.ReadString(strDir);
    end;
  finally
    Reg.Free;
  end;
  result := strFolders;
end;

Ex:

{獲取桌面}
function GetDeskeptPath: string;
begin
  Result := GetShellFolders('Desktop'); //是取得桌面資料夾的路徑
end;

{獲取我的文件}
function GetMyDoumentpath: string;
begin
  Result := GetShellFolders('Personal'); //我的文件
end;

轉貼至: http://fecbob.pixnet.net/blog/post/38063575-delphi-取得桌面資料夾的路徑和取得我的文件

2018年7月4日 星期三

SynPDF for Delphi


下載 : https://github.com/synopse/SynPDF



Trying to export a report with unicode text to pdf using SynPDF, results in mixed-up text

SynPDF have fixed some unicode issues, but not all of them aparently. The following is a streight forward code for exporting a quickreport to PDF usiny SynPDF:

procedure TForm1.CreatePdf(QuickRep: TCustomQuickRep; const aFileName: TFileName);
var
Pdf: TPdfDocument;
aMeta: TMetaFile;
i: integer;
begin
  Pdf := TPdfDocument.Create;
  Pdf.UseUniscribe := True;
  try
      Pdf.DefaultPaperSize := psA4;
      QuickRep.Prepare;
      for i := 1 to QuickRep.QRPrinter.PageCount do begin
        Pdf.AddPage;
        aMeta := QuickRep.QRPrinter.GetPage(i);
        try
          // draw the page content
          Pdf.Canvas.RenderMetaFile(aMeta,1,0,0);
        finally
          aMeta.Free;
        end;
      end;
      Pdf.SaveToFile(aFileName);
  finally
    Pdf.free;
  end;
end;

轉貼至 https://stackoverflow.com/questions/25910798/trying-to-export-a-report-with-unicode-text-to-pdf-using-synpdf-results-in-mixe

Use Adobe Acrobat (PDF) Files in a Delphi Application

by Zarko Gajic
Updated September 29, 2017

Delphi supports the display of Adobe PDF files from within an application. As long as you've got Adobe Reader installed, your PC will automatically have the relevant ActiveX control you'll need to create a component you can drop into a Delphi form.


Difficulty: Easy

Time Required: 5 minutes

Here's How:

1.Start Delphi and select Component | Import ActiveX Control...

2.Look for the "Acrobat Control for ActiveX (Version x.x)" control and click Install.

3.Select the Component palette location into which the selected library will appear. Click Install.

4.Select a package where the new component must be installed or create a new package for the new
TPdf control.

5.Click OK.

6.Delphi will ask you whether you want to rebuild the modified/new package. Click Yes.

7.After the package is compiled, Delphi will show you a message saying that the new TPdf component was registered and already available as part of the VCL.

8.Close the package detail window, allowing Delphi to save the changes to it.

9.The component is now available in the ActiveX tab (if you didn't change this setting in step 4).

10.Drop the TPdf component onto a form and then select it.

11.Using the object inspector, set the src property to the name of an existing PDF file on your system. Now all you have to do is resize the component and read the PDF file from your Delphi application.

Tips:

The Adobe ActiveX control installs automatically when you install Adobe Reader.
Step 11 can be completed during runtime, so you can open and close files programmatically as well as resize the control.


轉貼至:https://www.thoughtco.com/adobe-acrobat-pdf-files-delphi-applications-1056893

Ex:
  AcroPDF1.src := 'C:\Test.pdf';

2018年6月10日 星期日

StrToDatetime


Ex:

//設定日期時間格式不受系統變化影響
Application.UpdateFormatSettings := False;


var fmt :TFormatSettings ; //建議設成全域變數,日期格式才能全面性

  dtDate:TDateTime; 

  fmt.ShortDateFormat := 'MM/DD/YY';
  fmt.DateSeparator := '/';
  fmt.ShortTimeFormat := 'hh:nn:ss';
  fmt.TimeSeparator := ':';
  fmt.DecimalSeparator := '.';
  dtDate := StrToDateTime('06/10/18', fmt );


2018年5月28日 星期一

TreeView 增加 CheckBox/RadioButton操作選項



Ex1:


Uses CommCtrl;


procedure TForm1.FormCreate(Sender: TObject);
var dw:DWORD;
begin
  dw := GetWindowLong(tvWorkStep.Handle, GWL_STYLE);
  dw := dw or TVS_CHECKBOXES;
  SetWindowLong(tvWorkStep.Handle, GWL_STYLE , dw);
end;


增加2個Function
    function SetTreeViewNodeChecked(ATreeView: TTreeView; ATreeNode: TTreeNode;
Checked: Boolean): Boolean;

    function GetTreeViewNodeChecked(ATreeView: TTreeView; ATreeNode: TTreeNode): Boolean;


function TForm1.SetTreeViewNodeChecked(ATreeView: TTreeView; ATreeNode: TTreeNode; Checked: Boolean): Boolean;
var
  tvItem: TTVItem;
begin
  tvItem.mask := TVIF_HANDLE or TVIF_STATE;
  tvItem.hItem := ATreeNode.ItemId;
  tvItem.stateMask := TVIS_STATEIMAGEMASK;

  (*Image 1 in the tree-view check box image list is the
  unchecked box. Image 2 is the checked box.*)
  if Checked then
    tvItem.state := IndexToStateImageMask(2)
  else
    tvItem.state := IndexToStateImageMask(1);

  Result := TreeView_SetItem(ATreeView.Handle, tvItem);
end;

function TForm1.GetTreeViewNodeChecked(ATreeView: TTreeView; ATreeNode: TTreeNode): Boolean;
var
  tvItem: TTVItem;
begin
  // Prepare to receive the desired information.
  tvItem.mask := TVIF_HANDLE or TVIF_STATE;
  tvItem.hItem := ATreeNode.ItemId;
  tvItem.stateMask := TVIS_STATEIMAGEMASK;

  // Request the information.
  TreeView_GetItem(ATreeView.Handle, tvItem);

  // Return zero if it's not checked, or nonzero otherwise.
  Result := Boolean((tvItem.state shr 12) - 1);
end;

轉貼至 http://www.cnblogs.com/spiritofcloud/p/3976170.html


==================================================================
==================================================================

Ex2:

搭配 TImageList,TreeView.StateImages指向TImageList, 設定 Item.StateIndex 用圖示反應狀態
TImageList

Const
 cFlatUnCheck=1;  
 cFlatChecked=2;
 cFlatRadioUnCheck=3;
 cFlatRadioChecked=4;


//ToggleTreeViewCheckBoxes同時處理CheckBox/RadioButton的圖示
//操作時只需調整 Item.StateIndex 就可以決定呈現方式
Procedure ToggleTreeViewCheckBoxes(
  Node :TTreeNode; cUnChecked, cChecked, cRadioUnchecked, cRadioChecked :integer);
var
 tmp:TTreeNode;
begin
  if Assigned(Node) then
  begin
    if Node.StateIndex = cUnChecked then
      Node.StateIndex := cChecked
    else if Node.StateIndex = cChecked then
      Node.StateIndex := cUnChecked
    else if Node.StateIndex = cRadioUnChecked then
    begin
      tmp := Node.Parent;
      if not Assigned(tmp) then
        tmp := TTreeView(Node.TreeView).Items.getFirstNode
      else
        tmp := tmp.getFirstChild;
      while Assigned(tmp) do
      begin
        if (tmp.StateIndex in [cRadioUnChecked,cRadioChecked]) then
          tmp.StateIndex := cRadioUnChecked;
        tmp := tmp.getNextSibling;
      end;
      Node.StateIndex := cRadioChecked;
    end;
  end;
end;


//TreeView.OnClick
procedure TForm1.TreeView1Click(Sender: TObject);
var
 P:TPoint;
begin
 GetCursorPos(P);
 P := TTreeView(Sender).ScreenToClient(P);
 if (htOnStateIcon in TTreeView(Sender).GetHitTestInfoAt(P.X,P.Y)) then
  ToggleTreeViewCheckBoxes(
    TTreeView(Sender).Selected,
    cFlatUnCheck,
    cFlatChecked,
    cFlatRadioUnCheck,
    cFlatRadioChecked);
end;


//TreeView.KeyDown
procedure TForm1.TreeView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_SPACE) and Assigned(TTreeView(Sender).Selected) then
    ToggleTreeViewCheckBoxes(
      TTreeView(Sender).Selected,
      cFlatUnCheck,
      cFlatChecked,
      cFlatRadioUnCheck,
      cFlatRadioChecked);
end;


轉貼/參考

2018年5月21日 星期一

WIN API LockWindowUpdate-封鎖重繪視窗內容

The LockWindowUpdate function disables or reenables drawing in the specified window. Only one window can be locked at a time.

BOOL LockWindowUpdate(

    HWND hWndLock     // handle of window to lock 
   );   


Parameters

hWndLock

Specifies the window in which drawing will be disabled. If this parameter is NULL, drawing in the locked window is enabled.



Return Values

If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero, indicating that an error occurred or another window was already locked.


截錄自 Windows SDK

Ex:
   LockWindowUpdate(Handle);  //封鎖某個視窗重繪
   LockWindowUpdate(0);  //解除

2018年3月28日 星期三

InputBox ComboBox輸入視窗

//ComboBox輸入視窗
//Ex: InputBox('Caption', '血型', 'A;B;O;AB','A型;B型;O型;AB型', Result)

function fn_InputBox(const ACaption, APrompt: WideString; AListValue, AListDesc:WideString; var AResult:String): Boolean; overload; //ComboBox輸入視窗
var
  Form: TForm;
  Prompt:TLabel;
  Combobox: TCombobox;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
  j, iTop, iHeight:Integer;
  DescList, ValueList:TStringList;
  function GetAveCharSize(Canvas: TCanvas): TPoint;
  var
    I: Integer;
    Buffer: array[0..51] of Char;
  begin
    for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
    for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
    GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
    Result.X := Result.X div 52;
  end;
begin
  Result := False;
  ValueList := TStringList.Create;
  DescList := TStringList.Create;
  Form := TForm.Create(Application);
  with Form do
  begin
    try
      Font.Name := 'Arial';
      Font.Size := 12;
      Font.Style := [fsBold];
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;

      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;

      Combobox := TCombobox.Create(Form);
      with Combobox do
      begin
        Parent := Form;
        CharCase := ecUpperCase;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);

        ValueList.Assign(fn_SplitStr(';', AListValue));
        DescList.Assign(fn_SplitStr(';', AListDesc));
        Items.Clear;
        for j := 0 to DescList.Count-1 do
        begin
          if j >= ValueList.Count then
            Break;
          if (ValueList[j]+DescList[j])<>'' then
            Items.Add(ValueList[j]+ ' - ' +DescList[j]);
        end;
        ItemIndex := ValueList.IndexOf(AResult);

        iTop := Top;
        iHeight := Height;
      end;

      ButtonTop := iTop + iHeight + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '確定';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;

      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '取消';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        AResult := '';
        if Combobox.ItemIndex<>-1 then
          AResult := ValueList[Combobox.ItemIndex];
        Result := True;
      end;
    finally
      FreeAndNil(ValueList);
      FreeAndNil(DescList);
      Form.Free;
    end;
  end;
end;

InputBox DateTime輸入視窗

//DateTime 輸入視窗
function fn_InputBox(const ACaption, APrompt: WideString;var ADatetime: TDatetime): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  MonthCalendar:TMonthCalendar;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
  iTop, iHeight:Integer;
  APoint:TPoint;
  function GetAveCharSize(Canvas: TCanvas): TPoint;
  var
    I: Integer;
    Buffer: array[0..51] of Char;
  begin
    for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
    for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
    GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
    Result.X := Result.X div 52;
  end;
begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do
  begin
    try
      Font.Name := 'Arial';
      Font.Size := 12;
      Font.Style := [fsBold];
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      //Position := poScreenCenter;

      APoint := Screen.ActiveControl.ClientToScreen(Point(0, Screen.ActiveControl.ClientHeight));
      Left := APoint.X;
      Top := APoint.Y;
      Position := poDesigned;

      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;

      with TComboBox.Create(Form) do
      begin
        Parent := Form;
        DropDownCount := 9;
        Top := Prompt.Top;
        Left := MulDiv(45, DialogUnits.X, 4);
        Style := StdCtrls.csDropDownList;
        Items.Add('');
        Items.Add('昨日');
        Items.Add('今日');
        Items.Add('上月初');
        Items.Add('上月底');
        Items.Add('月初');
        Items.Add('月底');
        Items.Add('年初');
        Items.Add('年底');
        OnChange := TVirtualClass.pr_ComboBox_OnChange;
      end;

      MonthCalendar := TMonthCalendar.Create(Form);
      with MonthCalendar do
      begin
        Parent := Form;
        AutoSize := False;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 10;
        Width := MulDiv(164, DialogUnits.X, 4);
        Height := 213;
        MonthCalendar.Date := ADatetime;
        iTop := Top;
        iHeight := Height;
      end;

      ButtonTop := iTop + iHeight + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);

      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '確定';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;

      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '取消';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;

      if ShowModal = mrOk then
      begin
        ADatetime := MonthCalendar.Date;
        Result := True;
      end;
    finally
      Form.Free;
    end;
  end;
end;

InputBox String輸入視窗

//
function fn_InputBox(const ACaption, APrompt: WideString;var AString: String): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
  iTop, iHeight:Integer;
  function GetAveCharSize(Canvas: TCanvas): TPoint;
  var
    I: Integer;
    Buffer: array[0..51] of Char;
  begin
    for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
    for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
    GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
    Result.X := Result.X div 52;
  end;
begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do
  begin
    try
      Font.Name := 'Arial';
      Font.Size := 12;
      Font.Style := [fsBold];
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;

      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;

      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        CharCase := ecUpperCase;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text := AString;
        iTop := Top;
        iHeight := Height;
        Color := $00F5D8BC;
        SelectAll;
      end;

      ButtonTop := iTop + iHeight + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '確定';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '取消';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        AString := Edit.Text;
        //
        Result := True;
      end;
    finally
      Form.Free;
    end;
  end;
end;

日期相關的函式

Uses SysUtils, DateUtils;

//取得系統日期格式
procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings);

//時間
function Time: TDateTime;

//日期時間
function Now: TDateTime;

//今天
function Today: TDateTime;

//昨天
function Yesterday: TDateTime;

//明天
function Tomorrow: TDateTime;

//目前年份
function CurrentYear: Word;

//取DateTime年份
function YearOf(const AValue: TDateTime): Word;

//取DateTime月份
function MonthOf(const AValue: TDateTime): Word;

//取DateTime週數
function WeekOf(const AValue: TDateTime): Word;                     

//取DateTime日期
function DayOf(const AValue: TDateTime): Word;

//取DateTime小時數
function HourOf(const AValue: TDateTime): Word;

//取DateTime分鐘數
function MinuteOf(const AValue: TDateTime): Word;

//取DateTime秒數
function SecondOf(const AValue: TDateTime): Word;

//月份增減
function IncMonth(const DateTime: TDateTime; NumberOfMonths: Integer = 1): TDateTime; 

//年度增減
function IncYear(const AValue: TDateTime;  const ANumberOfYears: Integer = 1): TDateTime;

//週數增減
function IncWeek(const AValue: TDateTime;  const ANumberOfWeeks: Integer = 1): TDateTime;

//日期增減
function IncDay(const AValue: TDateTime;  const ANumberOfDays: Integer = 1): TDateTime;

//時數增減
function IncHour(const AValue: TDateTime;  const ANumberOfHours: Int64 = 1): TDateTime;

//分鐘增減
function IncMinute(const AValue: TDateTime;  const ANumberOfMinutes: Int64 = 1): TDateTime;

//秒數增減
function IncSecond(const AValue: TDateTime;  const ANumberOfSeconds: Int64 = 1): TDateTime;

//是否為潤年
function IsLeapYear(Year: Word): Boolean;

//以指定的日期格式輸出字串
function FormatDateTime(const Format: string; DateTime: TDateTime): string;
function FormatDateTime(const Format: string; DateTime: TDateTime; const FormatSettings: TFormatSettings):

//AM/PM
function IsPM(const AValue: TDateTime): Boolean;

//檢查日期的正確性
function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;

//年度第一天(年初)
function StartOfTheYear(const AValue: TDateTime): TDateTime;
function StartOfAYear(const AYear: Word): TDateTime;

//年度最後一天(年底)
function EndOfTheYear(const AValue: TDateTime): TDateTime;
function EndOfAYear(const AYear: Word): TDateTime;

//月份第一天(月初)
function StartOfTheMonth(const AValue: TDateTime): TDateTime;
function StartOfAMonth(const AYear, AMonth: Word): TDateTime;

//月份最後一天(月底)
function EndOfTheMonth(const AValue: TDateTime): TDateTime;
function EndOfAMonth(const AYear, AMonth: Word): TDateTime;

//週數第一天
function StartOfTheWeek(const AValue: TDateTime): TDateTime;

//週數最後一天
function EndOfTheWeek(const AValue: TDateTime): TDateTime; 

//日期區間的天數
function DaysBetween(const ANow, AThen: TDateTime): Integer;

取檔案日期

function fn_Get_FileDatetime(AFileName:String):TDatetime;
var
  iFileAge:Integer;
begin
  iFileAge := FileAge(AFileName);
  Result := FileDateToDatetime(iFileAge);
end;

2018年3月27日 星期二

檔案文件相關的函式

Uses SysUtils;

//取檔案名稱
//Ex: C:\Test\NoName.txt -> NoName.txt
function ExtractFileName(const FileName: string): string;

//取檔案副檔名
//Ex: C:\Test\NoName.txt -> .txt
function ExtractFileExt(const FileName: string): string;

//取檔案所在磁碟代號
//Ex: C:\Test\NoName.txt -> C:
function ExtractFileDrive(const FileName: string): string;

//取檔案路徑
//Ex: C:\Test\NoName.txt -> C:\Test\
function ExtractFilePath(const FileName: string): string;

//取檔案目錄
//Ex: C:\Test\NoName.txt -> C:\Test
function ExtractFileDir(const FileName: string): string;

//變更副檔案名稱
//Ex: C:\Test\NoName.txt -> C:\Test\NoName.xxx
function ChangeFileExt(const FileName, Extension: string): string;

//取得檔案目錄路徑 (目錄後面加斜線符號)
//Ex: C:\Test -> C:\Test\
function IncludeTrailingPathDelimiter(const S: string): string;
function IncludeTrailingBackslash(const S: string): string;

//取得檔案目錄路徑 (目錄後面去除斜線符號)
//Ex: C:\Test\ -> C:\Test
function ExcludeTrailingPathDelimiter(const S: string): string;
function ExcludeTrailingBackslash(const S: string): string;

//檢查檔案是否存在
function FileExists(const FileName: string): Boolean;

//檢查目錄是否存在
function DirectoryExists(const Directory: string): Boolean;

//產生多層資料夾
//Ex: ForceDirectories('c:\a\b\c')
function ForceDirectories(Dir: string): Boolean;

//檢查檔案是否唯讀
function FileIsReadOnly(const FileName: string): Boolean;

//取得檔案屬性
function FileGetAttr(const FileName: string): Integer;

//設定檔案屬性
function FileSetAttr(const FileName: string; Attr: Integer): Integer;

//設定唯讀檔案
function FileSetReadOnly(const FileName: string; ReadOnly: Boolean): Boolean;

//刪除檔案
function DeleteFile(const FileName: string): Boolean;

//變更檔案名稱
function RenameFile(const OldName, NewName: string): Boolean;

//取得磁碟空間
function DiskSize(Drive: Byte): Int64;

//取得目前所在目錄
function GetCurrentDir: string;

//設定目前所在目錄
function SetCurrentDir(const Dir: string): Boolean;

//建立目錄
function CreateDir(const Dir: string): Boolean;

//移除目錄
function RemoveDir(const Dir: string): Boolean;

//----------------------------------------------------------------------------------------------------------------
//取檔案日期
//----------------------------------------------------------------------------------------------------------------
function fn_Get_FileDatetime(AFileName:String):TDatetime;
var
  iFileAag:Integer;
begin
  iFileAag := FileAge(AFileName);
  Result := FileDateToDatetime(iFileAge);
end;

//----------------------------------------------------------------------------------------------------------------
//取檔案清單
//----------------------------------------------------------------------------------------------------------------
function fn_Get_FileList(APath:String; AFullPath:Boolean=False; ASearchSubPath:Boolean=False):TStringList;
var SearchRec: TSearchRec;
  Status: Integer;
  sFileList:TStringList;
  sPath:String;
begin
  sPath := '';
  if AFullPath then
    sPath := IncludeTrailingPathDelimiter(APath); // Ex: C:\temp -> C:\temp\
  sFileList := TStringList.Create;
  Status := FindFirst(APath+'\*.*', faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin
      if ((SearchRec.Attr and faHidden)<>faHidden) and //非隱藏檔
        ((SearchRec.Attr and faSysFile)<>faSysFile) and //非系統檔
        (SearchRec.Name <> '.') and
        (SearchRec.Name <> '..') then
      begin
        if ((SearchRec.Attr and faDirectory) = faDirectory) then //目錄
        begin
          if ASearchSubPath then
            sFileList.AddStrings(fn_Get_FileList(APath+'\'+SearchRec.Name, AFullPath, ASearchSubPath))
        end
        else
          sFileList.Add(sPath+SearchRec.Name);
      end;
      Status := FindNext(SearchRec);
    end;
  Finally
    FindClose(SearchRec);
  end;
  Result := sFileList;
end;

//----------------------------------------------------------------------------------------------------------------
//檔案被使用中
//----------------------------------------------------------------------------------------------------------------
function fn_FileInUse(fName: string): boolean;
var
  HFileRes: HFILE;
begin
  Result := false;
  if not FileExists(fName) then
    exit;
  HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(HFileRes);
end;

//----------------------------------------------------------------------------------------------------------------
//建立資料夾
//----------------------------------------------------------------------------------------------------------------
procedure pr_CreateDir(ADir:String);
var sFolderList:TStringList;
  sDrive, sFolder:String;
  i:Integer;
begin
  sFolderList := TStringList.Create;
  ADir := ExcludeTrailingPathDelimiter(ADir); //Ex: C:\Temp\A\1\ -> C:\Temp\A\1
  sDrive := ExtractFileDrive(ADir)+'\'; //Ex: C:\
  //
  sFolderList.Add(ADir);
  sFolder := ADir;
  while True do
  begin
    sFolder := ExtractFileDir(sFolder);
    if sFolder=sDrive then
      Break;
    sFolderList.Insert(0, sFolder);
  end;
  //
  for i:=0 to sFolderList.Count-1 do
  begin
    if not DirectoryExists(sFolderList[i]) then
      CreateDir(sFolderList[i]);
  end;
  FreeAndNil(sFolderList);
end;

//----------------------------------------------------------------------------------------------------------------
//檔案複製/搬移 (含子資料夾)
//----------------------------------------------------------------------------------------------------------------
procedure pr_CopyFile(ASourceFile, ATargetPath:String; ASearchSubPath:Boolean=False; AMoveFile:Boolean=False);
var SearchRec: TSearchRec;
  Status: Integer;
  sSourcePath, sTargetPath, sTargetDir,
  sSearchFileName, sTargetFileName, sFileName:String;
begin
  sFileName := ExtractFileName(ASourceFile);
  sSourcePath := ExtractFilePath(ASourceFile);
  sTargetPath := IncludeTrailingPathDelimiter(ATargetPath);
  sTargetDir := ExcludeTrailingPathDelimiter(ATargetPath);
  if CompareText(sSourcePath, sTargetPath)=0 then
    Exit;
  //
  pr_CreateDir(sTargetDir); //建立目的資料夾
  //
  Status := FindFirst(ASourceFile, faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin
      if ((SearchRec.Attr and faHidden)<>faHidden) and //非隱藏檔
        ((SearchRec.Attr and faSysFile)<>faSysFile) and //非系統檔
        (SearchRec.Name <> '.') and
        (SearchRec.Name <> '..') then
      begin
        sSearchFileName := sSourcePath + SearchRec.Name;
        if ((SearchRec.Attr and faDirectory) = faDirectory) then //目錄
        begin
          if ASearchSubPath then
          begin
            if CompareText(sSearchFileName, sTargetDir)<>0 then
            begin
              pr_CopyFile(sSearchFileName+'\'+sFileName, sTargetPath+SearchRec.Name, ASearchSubPath);
            end;
          end;
        end
        else if not fn_FileInUse(sSearchFileName) then
        begin
          sTargetFileName := sTargetPath + SearchRec.Name;
          if AMoveFile then
            MoveFile(PWideChar(sSearchFileName), PWideChar(sTargetFileName)) //搬移
          else
            CopyFile(PWideChar(sSearchFileName), PWideChar(sTargetFileName), False); //複製
        end;
      end;
      Status := FindNext(SearchRec);
    end;
  Finally
    FindClose(SearchRec);
  end;
end;






2018年3月26日 星期一

Runtime error 217 at 004539BD

Delphi 專案

  Project -> Options
  [Link with runtime packages] 設成 False

  一樣還是出現 Runtime error 217 at xxxxxxxx的訊息

  結果發現是專案裡 Uses 了其他的 Unit File,Unit File裡引用了其他資源文件導至錯誤 !

2018年3月21日 星期三

Runtime error 217 at 5015D5F4 (Windows 2016)

Delphi 編譯後的執行檔安裝到Windows2016中執行,出現 Runtime error 217 at xxxxxxxx

處理辦法:
  執行檔滑鼠右鍵 > 內容,使用Run compatibility troubleshooter功能可以排除狀況



2018年3月7日 星期三

《遙控器學習設定》一支bbtv機上盒遙控器就能搞定開關電視、轉台、調整音量

《遙控器學習設定》一支bbtv機上盒遙控器就能搞定開關電視、轉台、調整音量

設定前請先準備好家中電視遙控器與bbTV遙控器
並確認您的bbTV遙控器是屬於下圖ABC的哪一隻
確認之後,並再照著此遙控器操作步驟進行設定




【A遙控器使用說明】


【B遙控器使用說明】


【C遙控器使用說明】


轉貼至: http://www.cdtv.com.tw/zh_TW/news_content/id/77

2018年3月5日 星期一

MessageBox

函數原型及參數
 function MessageBox(hWnd: HWND; TextCaption: PChar; Type: Word): Integer;

hWnd:對話框父窗口句柄,對話框顯示在Delphi窗體內,可使用窗體的Handle屬性,否則可用0,使其直接作為桌面窗口的子窗口。

Text:欲顯示的信息字符串。

Caption:對話框標題字符串。

Type:對話框類型常量。

按鈕組合常量
   MB_OK = $00000000;                                     //一個確定按鈕
   MB_OKCANCEL = $00000001;                     //一個確定按鈕,取消按鈕
   MB_ABORTRETRYIGNORE = $00000002;  //一個異常終止按鈕,重試按鈕,忽略按鈕
   MB_YESNOCANCEL = $00000003;             //一個是按鈕,一個否按鈕,一個取消按鈕
   MB_YESNO = $00000004;                             //一個是按鈕,一個否按鈕
   MB_RETRYCANCEL = $00000005;              //一個重試按鈕,一個取消按鈕

預設按鈕
   MB_DEFBUTTON1 = $00000000;           //第一個按鈕為缺省按鈕
   MB_DEFBUTTON2 = $00000100;           //第二個按鈕為缺省按鈕
   MB_DEFBUTTON3 = $00000200;           //第三個按鈕為缺省按鈕
   MB_DEFBUTTON4 = $00000300;           //第四個按鈕為缺省按鈕

圖標常量
   MB_ICONHAND = $00000010;                                        //「×」號圖標
   MB_ICONQUESTION = $00000020;                              //「?」號圖標
   MB_ICONEXCLAMATION = $00000030;                      //「!」號圖標
   MB_ICONASTERISK = $00000040;                                //「i」圖標
   MB_USERICON = $00000080;                                         //用戶圖標
   MB_ICONWARNING = MB_ICONEXCLAMATION;    //「!」號圖標
   MB_ICONERROR = MB_ICONHAND;                          //「×」號圖標
   MB_ICONINFORMATION = MB_ICONASTERISK;    //「i」圖標
   MB_ICONSTOP = MB_ICONHAND;                             //「×」號圖標

運行模式常量
   MB_APPLMODAL = $00000000;     
      //應用程序模式,在未結束對話框前也能切換到另一應用程序
   MB_SYSTEMMODAL = $00001000;     
      //系統模式,必須結束對話框後,才能做其他操作
   MB_TASKMODAL = $00002000;       
      //任務模式,在未結束對話框前也能切換到另一應用程序
   MB_HELP = $00004000;           
      //Help Button

函數返回值
   0                        //對話框建立失敗
   idOk = 1            //按確定按鈕
   idCancel = 2      //按取消按鈕
   idAbout = 3       //按異常終止按鈕
   idRetry = 4        //按重試按鈕
   idIgnore = 5      //按忽略按鈕
   idYes = 6           //按是按鈕
   idNo = 7            //按否按鈕

例:
  Result := MessageBox(Handle, 'Test', 'Message', MB_OK);
  Result := MessageBox(Handle, 'Exit ?', 'Question', MB_ICONQUESTION+MB_YESNO+MB_DEFBUTTON2);


轉貼至 http://chengyan35.pixnet.net/blog/post/142390734-[delphi]delphi中的messagebox用法

2018年2月2日 星期五

Winapi.ShellAPI.ShellExecute

uses
  ShellAPI;

function ShellExecute(hWnd: HWND; Operation, FileName, Parameters,  Directory: LPWSTR; ShowCmd: Integer): HINST; stdcall;


以下轉貼至:
https://msdn.microsoft.com/en-us/library/windows/desktop/bb762153(v=vs.85).aspx

Performs an operation on a specified file.
Syntax
HINSTANCE ShellExecute(
  _In_opt_ HWND    hwnd,
  _In_opt_ LPCTSTR lpOperation,
  _In_     LPCTSTR lpFile,
  _In_opt_ LPCTSTR lpParameters,
  _In_opt_ LPCTSTR lpDirectory,
  _In_     INT     nShowCmd
);

Parameters
hwnd [in, optional]
Type: HWND
A handle to the parent window used for displaying a UI or error messages. This value can be NULL if the operation is not associated with a window.
lpOperation [in, optional]
Type: LPCTSTR
A pointer to a null-terminated string, referred to in this case as a verb, that specifies the action to be performed. The set of available verbs depends on the particular file or folder. Generally, the actions available from an object's shortcut menu are available verbs. The following verbs are commonly used:
edit
Launches an editor and opens the document for editing. If lpFile is not a document file, the function will fail.
explore
Explores a folder specified by lpFile.
find
Initiates a search beginning in the directory specified by lpDirectory.
open
Opens the item specified by the lpFile parameter. The item can be a file or folder.
print
Prints the file specified by lpFile. If lpFile is not a document file, the function fails.
NULL
The default verb is used, if available. If not, the "open" verb is used. If neither verb is available, the system uses the first verb listed in the registry.
lpFile [in]
Type: LPCTSTR
A pointer to a null-terminated string that specifies the file or object on which to execute the specified verb. To specify a Shell namespace object, pass the fully qualified parse name. Note that not all verbs are supported on all objects. For example, not all document types support the "print" verb. If a relative path is used for the lpDirectory parameter do not use a relative path for lpFile.
lpParameters [in, optional]
Type: LPCTSTR
If lpFile specifies an executable file, this parameter is a pointer to a null-terminated string that specifies the parameters to be passed to the application. The format of this string is determined by the verb that is to be invoked. If lpFile specifies a document file, lpParameters should be NULL.
lpDirectory [in, optional]
Type: LPCTSTR
A pointer to a null-terminated string that specifies the default (working) directory for the action. If this value is NULL, the current working directory is used. If a relative path is provided at lpFile, do not use a relative path for lpDirectory.
nShowCmd [in]
Type: INT
The flags that specify how an application is to be displayed when it is opened. If lpFile specifies a document file, the flag is simply passed to the associated application. It is up to the application to decide how to handle it. These values are defined in Winuser.h.
SW_HIDE (0)
Hides the window and activates another window.
SW_MAXIMIZE (3)
Maximizes the specified window.
SW_MINIMIZE (6)
Minimizes the specified window and activates the next top-level window in the z-order.
SW_RESTORE (9)
Activates and displays the window. If the window is minimized or maximized, Windows restores it to its original size and position. An application should specify this flag when restoring a minimized window.
SW_SHOW (5)
Activates the window and displays it in its current size and position.
SW_SHOWDEFAULT (10)
Sets the show state based on the SW_ flag specified in the STARTUPINFO structure passed to the CreateProcess function by the program that started the application. An application should call ShowWindow with this flag to set the initial show state of its main window.
SW_SHOWMAXIMIZED (3)
Activates the window and displays it as a maximized window.
SW_SHOWMINIMIZED (2)
Activates the window and displays it as a minimized window.
SW_SHOWMINNOACTIVE (7)
Displays the window as a minimized window. The active window remains active.
SW_SHOWNA (8)
Displays the window in its current state. The active window remains active.
SW_SHOWNOACTIVATE (4)
Displays a window in its most recent size and position. The active window remains active.
SW_SHOWNORMAL (1)
Activates and displays a window. If the window is minimized or maximized, Windows restores it to its original size and position. An application should specify this flag when displaying the window for the first time.
Return value
Type: HINSTANCE
If the function succeeds, it returns a value greater than 32. If the function fails, it returns an error value that indicates the cause of the failure. The return value is cast as an HINSTANCE for backward compatibility with 16-bit Windows applications. It is not a true HINSTANCE, however. It can be cast only to an int and compared to either 32 or the following error codes below.
Return code
Description
0
The operating system is out of memory or resources.
ERROR_FILE_NOT_FOUND
The specified file was not found.
ERROR_PATH_NOT_FOUND
The specified path was not found.
ERROR_BAD_FORMAT
The .exe file is invalid (non-Win32 .exe or error in .exe image).
SE_ERR_ACCESSDENIED
The operating system denied access to the specified file.
SE_ERR_ASSOCINCOMPLETE
The file name association is incomplete or invalid.
SE_ERR_DDEBUSY
The DDE transaction could not be completed because other DDE transactions were being processed.
SE_ERR_DDEFAIL
The DDE transaction failed.
SE_ERR_DDETIMEOUT
The DDE transaction could not be completed because the request timed out.
SE_ERR_DLLNOTFOUND
The specified DLL was not found.
SE_ERR_FNF
The specified file was not found.
SE_ERR_NOASSOC
There is no application associated with the given file name extension. This error will also be returned if you attempt to print a file that is not printable.
SE_ERR_OOM
There was not enough memory to complete the operation.
SE_ERR_PNF
The specified path was not found.
SE_ERR_SHARE
A sharing violation occurred.