連線網路磁碟/目錄

Procedure pr_AddConnection(APath, ALocalDriver, AUserName, APassword:String);
var netSource:TNetResource;
  dwResult:DWORD;
  sMsg:String;
begin
  dwResult := WNetCancelConnection2(PWideChar(APath), 

    CONNECT_UPDATE_PROFILE, 

    True);
  if APath<>'' then
  begin
    with netSource do
    begin
      dwType := RESOURCETYPE_DISK;
      lpLocalName := '';  // or H:
      lpRemoteName := PWideChar(APath);
      lpProvider := '';
      dwResult := WNetAddConnection2(netSource, 

        PWideChar(APassword), 

        PWideChar(AUsername), 

        CONNECT_UPDATE_PROFILE);
      if dwResult<>NO_ERROR then
      begin
        sMsg := SysErrorMessage(dwResult);
        raise Exception.Create(sMsg);
      end;
    end;
  end;
end;

XML Documentation Comments ，自定函式功能註解。

官方功能說明

XML Documentation Comments

官方範例

/// <summary> Removes the specified item from the collection
/// </summary>
/// <param name="Item">The item to remove
/// </param>
/// <param name="Collection">The group containing the item
/// </param>
/// <remarks>
/// If parameter "Item" is null, an exception is raised.
/// <see cref="EArgumentNilException"/>
/// </remarks>
/// <returns>True if the specified item is successfully removed;
/// otherwise False is returned.
/// </returns>
function RemoveItem(Item: Pointer; Collection: Pointer): Boolean;
begin
  // Non-XML DOC comment
  // ...
end;

初始效果

自定函式註解

house of the disappeared《時間外的家》

Delphi 顯示器-縮放與版面配置，影響報表輸出的表單尺寸

 縮放與版面配置  

當Project Options 勾選 Enable High-DPI ，專案的界面會依照縮放比例做調整，Screen.PixelsPerInch會取得與縮放比對應的數值 (Ex: 縮放比125%會取得120)

沒有勾選 Enable High-DPI，Screen.PixelsPerInch會取得 96 (縮放比100%)

Var

  iHorzres, iDesktopHorzres:Integer;

  iScale:Currency;

begin

  iHorzres := GetDeviceCaps(GetDC(0), HORZRES);  //水平像素總數

  iDesktopHorzres := GetDeviceCaps(GetDC(0), DESKTOPHORZRES); // 桌面水平像素總數

  iScale :=  iDesktopHorzres / iHorzres ;

end

影響QuickRep 報表版面配置的處理方式

with QuickRep1 do

begin

  ...

  ...

  ScaleBy(Screen.PixelsPerInch * iScale , Screen.PixelsPerInch);

  Prepare;

  ...

  ...

end;

Delphi Form Position poDesktopCenter & poScreenCenter

 

Delphi 取用系統圖示(Icon)

Uses ShellAPI;
...
  Button1 : TButton;
  ImageList1 : TImageList;
  TListView1 : TListView;
...
...
procedure TForm1.Button1Click(Sender: TObject);
var
  IconIndex: word;
  sFileName:String;
  Buffer: array[0..2048] of char;
  IconHandle: HIcon;

  objIcon:TIcon;
  i, iCount:Integer;
  lvItem:TListItem;
begin

  objIcon := TIcon.Create;
  sFileName := 'Shell32.dll';
  StrCopy(@Buffer, PChar(sFileName));
  iCount := ExtractIcon(HInstance, PChar(sFileName), $FFFFFFFF);
  for i := 0 to iCount-1 do
  begin
    IconIndex := i;
    IconHandle := ExtractAssociatedIcon(HInstance, Buffer, IconIndex);
    if IconHandle <> 0 then
      objIcon.Handle := IconHandle;
    ImageList1.AddIcon(objIcon);
    lvItem := ListView1.Items.Add;
    lvItem.ImageIndex := i;
    lvItem.Caption := IntToStr(i);
  end;
end;

Windows存放系統圖示的文件

shell32.dll：包含許多與 Windows Shell 有關的圖示

imageres.dll： 是一個包含大量 Windows 系統圖示的檔案

user32.dll：包含一些基本的系統圖示 

comctl32.dll：包含一些常用的圖示 

參考:

https://www.tek-tips.com/viewthread.cfm?qid=918978

CharGRT 

Shell32.dll

Imageres.dll

User32.dll

Comctl32.dll

  

Delphi 要如何取得DLL的檔案名稱

 

var
  DLLFileName: array [0..MAX_PATH] of Char;
begin
  GetModuleFileName(HInstance, DLLFileName, Length(DLLFileName));
  ShowMessage(DLLFileName);
end;

CharGPT 的回應

SQL Count Distinct 統計類別數量

Select Field1, Count(Distinct Field2) as Qty
From Table1
Group by Field1

Delphi ClientDataset GetGroupState

GetGroupState

ClientDataset 需先建立IndexDef，GetGroupState代入GroupingLevel，可以取得資料列在Group中所屬的狀態gbFirst、gbMiddle、gbLast

procedure TForm1.FormCreate(Sender: TObject);
var inxIndex:TIndexDef;
  aggAggregate:TAggregate;
begin
  //Create Index
  inxIndex := ClientDataSet1.IndexDefs.AddIndexDef;
  inxIndex.Name := 'Index1';
  inxIndex.Fields := 'Field1;Field2';
  inxIndex.GroupingLevel := 2; //群組的層級，取決於Fields的數量
  ClientDataset1.IndexName := inxIndex.Name;
end;

procedure TForm1.ClientDataSet1Field1GetText(Sender: TField; var Text: string;
  DisplayText: Boolean);
begin
  //TGroupPosInd = (gbFirst, gbMiddle, gbLast);
  if gbFirst in ClientDataset1.GetGroupState(1) then
    Text := Sender.AsString
  else
    Text := '';
end;

原資料

gbFirst in ClientDataset1.GetGroupState(1)

gbMiddle in ClientDataset1.GetGroupState(1)

gbLast in ClientDataset1.GetGroupState(1)

ClientDataset Methods 說明

Datasnap.DBClient.TClientDataSet Methods

Delphi ClientDataset Aggregates & Index 分組合計

 

procedure TForm1.FormCreate(Sender: TObject);
var inxIndex:TIndexDef;
  aggAggregate:TAggregate;
begin
  with ClientDataSet1 do
  begin
    //Create Dataset
    FieldDefs.Add('Field1', ftString, 20);
    FieldDefs.Add('Field2', ftString, 20);
    FieldDefs.Add('Qty', ftInteger);
    CreateDataSet;
    //Append Data

    AppendRecord(['1', '1', 10]);
    AppendRecord(['1', '1', 30]);
    AppendRecord(['1', '2', 50]);
    AppendRecord(['2', '2', 70]);
    AppendRecord(['2', '1', 90]);
  end;

  //Create Index
  inxIndex := ClientDataSet1.IndexDefs.AddIndexDef;
  inxIndex.Name := 'Index1';
  inxIndex.Fields := 'Field1;Field2';
  inxIndex.GroupingLevel := 2; //群組的層級，取決於Fields的數量
  ClientDataset1.IndexName := inxIndex.Name;

  //Create Aggregates
  aggAggregate := ClientDataset1.Aggregates.Add;
  aggAggregate.AggregateName := 'Aggregate0';
  aggAggregate.Expression := 'Sum(Qty)';

  //針對指定的群組層級做統計. 0:全部, Dataset可以不指定IndexName
  aggAggregate.GroupingLevel := 0;
  aggAggregate.IndexName := inxIndex.Name;
  aggAggregate.Active := True;

  aggAggregate := ClientDataset1.Aggregates.Add;
  aggAggregate.AggregateName := 'Aggregate1';
  aggAggregate.Expression := 'Sum(Qty)';
  //針對指定的群組層級做統計, Ex: Gropup by Field1
  aggAggregate.GroupingLevel := 1;
  aggAggregate.IndexName := inxIndex.Name;
  aggAggregate.Active := True;

  aggAggregate := ClientDataset1.Aggregates.Add;
  aggAggregate.AggregateName := 'Aggregate2';
  aggAggregate.Expression := 'Sum(Qty)';
  //針對指定的群組層級做統計, Ex: Group by Field1, Field2
  aggAggregate.GroupingLevel := 2;
  aggAggregate.IndexName := inxIndex.Name;
  aggAggregate.Active := True;

  aggAggregate := ClientDataset1.Aggregates.Add;
  aggAggregate.AggregateName := 'Aggregate3';
  aggAggregate.Expression := 'Max(Qty)';
  //針對指定的群組層級做統計, Ex: Group by Field1
  aggAggregate.GroupingLevel := 1;
  aggAggregate.IndexName := inxIndex.Name;
  aggAggregate.Active := True;

  Memo1.Clear;
  Memo1.Lines.Add('Aggregate0 (Sum(Qty)) = '+VarToStr(ClientDataSet1.Aggregates.Find('Aggregate0').Value));
  Memo1.Lines.Add('Aggregate1 (Sum(Qty) Group by Field1) = '+VarToStr(ClientDataSet1.Aggregates.Find('Aggregate1').Value));
  Memo1.Lines.Add('Aggregate2 (Sum(Qty) Group by Field1, Field2) = '+VarToStr(ClientDataSet1.Aggregates.Find('Aggregate2').Value));
  Memo1.Lines.Add('Aggregate3 (Max(Qty) Group by Field1) = '+VarToStr(ClientDataSet1.Aggregates.Find('Aggregate3').Value));
end;

Delphi ForceDirectories 建立資料夾

 

ForceDirectories     建置到指定的層級目錄 

Ex : 

ForceDirectories ('C:\Temp\Sub1\Sub2');

ForceDirectories ('\\10.10.10.10\Temp\Sub1\Sub2');

 

SQL PIVOT 直向資料內容轉橫向輸出

Select *
  (

    Select Field01, Field02, Field03, Field04

    From Table1

  ) a

Pivot

  ( 

    Sum(Field05) /*合計值*/

    For Field04 in ([Value01], [Value02], [Value03], [Value04])  /*橫向表頭*/

  ) b

ScorllBar 系統寬高

 
ScrollBar High

    GetSystemMetrics(SM_CYHSCROLL)

ScrollBar Width

    GetSystemMetrics(SM_CXVSCROLL)

Delphi TAggregate Row Summary

Ex:

var 

  sFieldName :String;
  fdAggregate:TAggregate;

begin
  cdsTemp := TClientDataset.Create(Self);

  cdsTemp.Aggregates.Clear;

  cdsTemp.AggregatesActive := True;
  cdsTemp.CloneCursor(Master, False, True);

  for i:=0 to Master.FieldCount-1 do
  begin
    sFieldName := Master.Fields[i].FieldName;
    if cdsTemp.FieldByName(sFieldName).DataType in 

      [ftSmallint, ftInteger, ftFloat, ftCurrency, ftLargeint] then
    begin
      fdAggregate := TAggregate.Create(cdsTemp.Aggregates, cdsTemp);
      fdAggregate.AggregateName := 'agg' + sFieldName;
      fdAggregate.Expression := 'sum('+sFieldName+')';
      fdAggregate.Active := True;
    end;
  end;

  //Get Value

  cdsTemp.Aggregates.Find('agg'+sFieldName).Value;

end;

Delphi 編譯時觸發的事件處理設定

 

[dcc32 Fatal Error] ToolsAPI.pas(18): F2613 Unit 'DockForm' not found.

 專案 Uses ToolsAPI 編譯時，Unit ToolsAPI 出現找不到 DockForm的錯誤訊息。

[Project]  >  [Options...] 

在  [Options...] 裡圖中的位置輸入 -LUDesignIDE

參考:

• https://www.cnblogs.com/cb168/p/4380756.html
• http://stackoverflow.com/questions/27699662/how-to-build-delphi-projects-for-win64-when-units-inside-it-uses-designeditors-d

取得Class所有屬性及數值

 
Uses TypInfo;

procedure GetClassProperties(AClass: TComponent; AStrings: TStrings);
var
  PropCount, I: SmallInt;
  PropList: PPropList;
  PropStr, sClass, sName, sValue: string;
begin
  PropCount := GetTypeData(AClass.ClassInfo).PropCount;
  GetPropList(AClass.ClassInfo, PropList);
  for I := 0 to PropCount - 1 do
  begin
    case PropList[I]^.PropType^.Kind of
      tkClass      : PropStr := '[Class] ';
      tkMethod     : PropStr := '[Method]';
      tkSet        : PropStr := '[Set]   ';
      tkEnumeration: PropStr := '[Enum]  ';
    else
      PropStr := '[Field] ';
    end;

    sName := PropList[I]^.Name; //名稱
    sValue := GetPropValue(AClass, sName ); //值

    sClass := PropList[I]^.PropType^.Name; //類別

    PropStr := PropStr + PropList[I]^.Name;
    PropStr := PropStr + ': ' + sClass ;
    PropStr := PropStr + ' Value='+sValue;
    AStrings.Add(PropStr);
  end;
  FreeMem(PropList);
end;

轉貼/改寫至 https://tcoline.com/resource/Delphi/typeinfo/top_delphi_typeinfo_0.htm

enum(枚舉)型態取得對應名稱的簡易作法

Const
  QRUnitDesc:Array[TQRUnit] of String=('MM', 'Inches', 'Pixels', 'Characters', 'Native');

procedure TForm1.Button1Click(Sender: TObject);

var iUnit:TQRUnit;

begin

  //Page Units
  ShowMessage(QRUnitDesc[QuickRep1.Page.Units]);

  // List

  for iUnit := Low(QRUnitDesc) to High(QRUnitDesc) do

  begin

    ShowMessage(QRUnitDesc[iUnit]);

  end;

end;

----

Uses TypInfo;

procedure TForm1.Button1Click(Sender: TObject);

var sEnumName:String;

begin

  sEnumName := GetEnumName(TypeInfo(TFieldType), Integer(ftString));

  ShowMessage(sEnumName);

end;

程式在非中文語系的系統中操作中文檔名的文件，中文會變成亂碼 ?????...

程式在非中文語系的系統中操作中文檔名的文件，中文會變成亂碼 ?????... 

問題排除方式

Control Panel (控制台)

Region 

How to Generate Code 128 Barcode Font for Excel (With Easy Steps)

 

轉貼/作法參考: https://www.exceldemy.com/code-128-barcode-font-for-excel/

STEP 1: Download Code 128 Font

• First of all, you need to download Code 128 You can download the font from this link.
• After that, extract the downloaded folder to the C:\Windows\Fonts folder.
• Otherwise, unzip the downloaded folder, copy the Code 128 font and paste it to the C:\Windows\Fonts folder.
• Also, select Continue if the administrator permissions window appears.

下載Code 128條碼字型，必須搭配Code128編碼後的文字使用。

STEP 2: Apply VBA Code

在Excel文件裡建立資料編碼的模組函式。

網頁中內文附的VBA程式碼貼過來使用，會發現之後產生出來的條碼刷不出來。後來發現是Unicode的關係，造成編碼內容錯誤。

VBA程式碼中

Chr() 要修正成 ChrW()

Asc() 要修正成 AscW()

修正後內容如下

Option Explicit
Public Function Code128(SourceString As String)
    Dim Counter As Integer
    Dim CheckSum As Long
    Dim mini As Integer
    Dim dummy As Integer
    Dim UseTableB As Boolean
    Dim Code128_Barcode As String
    If Len(SourceString) > 0 Then
        For Counter = 1 To Len(SourceString)
            Select Case AscW(Mid(SourceString, Counter, 1))
                Case 32 To 126, 203
                Case Else
                    MsgBox "Invalid character in barcode string" & vbCrLf & vbCrLf & "Please only use standard ASCII characters", vbCritical
                    Code128 = ""
                    Exit Function
            End Select
        Next
        Code128_Barcode = ""
        UseTableB = True
        Counter = 1
        Do While Counter <= Len(SourceString)
            If UseTableB Then
                mini = IIf(Counter = 1 Or Counter + 3 = Len(SourceString), 4, 6)
                GoSub testnum
                If mini% < 0 Then
                    If Counter = 1 Then
                        Code128_Barcode = ChrW(205)
                    Else
                        Code128_Barcode = Code128_Barcode & ChrW(199)
                    End If
                    UseTableB = False
                Else
                    If Counter = 1 Then Code128_Barcode = ChrW(204)
                End If
            End If
            If Not UseTableB Then
                mini% = 2
                GoSub testnum
                If mini% < 0 Then
                    dummy% = Val(Mid(SourceString, Counter, 2))
                    dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
                    Code128_Barcode = Code128_Barcode & ChrW(dummy%)
                    Counter = Counter + 2
                Else
                    Code128_Barcode = Code128_Barcode & ChrW(200)
                    UseTableB = True
                End If
            End If
            If UseTableB Then
                Code128_Barcode = Code128_Barcode & Mid(SourceString, Counter, 1)
                Counter = Counter + 1
            End If
        Loop
        For Counter = 1 To Len(Code128_Barcode)
            dummy% = AscW(Mid(Code128_Barcode, Counter, 1))
            dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)
            If Counter = 1 Then CheckSum& = dummy%
            CheckSum& = (CheckSum& + (Counter - 1) * dummy%) Mod 103
        Next
        CheckSum& = IIf(CheckSum& < 95, CheckSum& + 32, CheckSum& + 100)
        Code128_Barcode = Code128_Barcode & ChrW(CheckSum&) & ChrW$(206)
    End If
    Code128 = Code128_Barcode
    Exit Function
testnum:
        mini% = mini% - 1
        If Counter + mini% <= Len(SourceString) Then
            Do While mini% >= 0
                If AscW(Mid(SourceString, Counter + mini%, 1)) < 48 Or AscW(Mid(SourceString, Counter + mini%, 1)) > 57 Then Exit Do
            mini% = mini% - 1
            Loop
        End If
        Return
End Function

 

STEP 3: Use Code 128 Function

建立模組函式後，就可以在儲存格中使用。

Ex:

  =Code128("ABCDEFG")

  =Code128(A1)

使用函式後會得到Code128編碼後的字串

STEP 4: Change Font Theme and Size

針對Code128編碼後的文字更換為Code 128的字型(STEP 1下載安裝的字型)。

在字型下拉選項中可能找不到，可以手動輸入 Code 128 字型就會被套用。

進行到這個步驟Code 128條碼的部份就可以正確顯示出來了。