No FTP list parsers have been registered

 

FTPListItems := idFTP.DirectoryListing，出現錯誤訊息

No FTP list parsers have been registered

只需要在程式的 uses 區段中加入 IdAllFTPListParsers 即可

 

如果想將程式工具提供他人使用，且不想提供程式原始碼，可以參考以下做法

Delphi 函式庫發佈方式（提供 Interface PAS + DCU）

一、目的

當 Delphi 開發完成一個 Unit，希望提供給其他開發者使用，但又不希望公開原始程式碼時，可以採用：

• 公開 Interface PAS
• 提供編譯完成的 DCU

使用者可以正常 uses 該 Unit，也能使用 IDE 的型別提示及程式碼完成（Code Insight），但無法看到真正的程式實作。

---

二、發佈內容

假設原始 Unit 名稱為：

MyLib.pas

發佈內容如下：

Release
│
├── MyLib.pas    ← 只有 Interface 宣告
└── MyLib.dcu    ← 編譯完成的程式

不提供完整原始碼。

---

三、原始 Unit

例如：

unit MyLib;

interface

uses
  System.SysUtils;

type
  TMyClass = class
  public
    constructor Create;
    destructor Destroy; override;

    function Add(A, B: Integer): Integer;
    function Sub(A, B: Integer): Integer;
  end;

function GetVersion: string;

implementation

constructor TMyClass.Create;
begin
  inherited;
end;

destructor TMyClass.Destroy;
begin
  inherited;
end;

function TMyClass.Add(A, B: Integer): Integer;
begin
  Result := A + B;
end;

function TMyClass.Sub(A, B: Integer): Integer;
begin
  Result := A - B;
end;

function GetVersion: string;
begin
  Result := '1.0';
end;

end.

---

四、編譯產生 DCU

使用 Delphi 編譯後，會產生：

MyLib.dcu

真正執行的程式都在 DCU 內。

---

五、建立公開 PAS

建立另一份供發布使用的 MyLib.pas。

注意：不要修改原始碼，而是另外建立一份。

例如：

Project
│
├── Source
│     MyLib.pas        ← 原始完整程式
│
└── Release
      MyLib.pas        ← 公開介面
      MyLib.dcu

---

公開 PAS 保留 Interface：

unit MyLib;

interface

uses
  System.SysUtils;

type
  TMyClass = class
  public
    constructor Create;
    destructor Destroy; override;

    function Add(A, B: Integer): Integer;
    function Sub(A, B: Integer): Integer;
  end;

function GetVersion: string;

implementation

end.

可以看到：

• Class
• Function
• Procedure
• Property
• Event
• Record
• Enum

都需要保留。

但是：

所有 Implementation 內的程式碼全部刪除。

---

六、使用者如何使用

使用者只要：

uses
  MyLib;

即可正常呼叫：

var
  M: TMyClass;
begin
  M := TMyClass.Create;
  try
    ShowMessage(IntToStr(M.Add(3,5)));
  finally
    M.Free;
  end;
end;

不需要任何特殊設定。

---

七、IDE 功能

由於 Interface 仍存在，因此 Delphi IDE 可以提供：

• Code Insight
• Auto Complete
• Parameter Hint
• 型別檢查
• 編譯檢查

使用體驗與一般 Unit 幾乎相同。

---

八、可以隱藏哪些內容

可以隱藏：

• 所有演算法
• 所有商業邏輯
• SQL
• 加解密流程
• API 呼叫方式
• 所有 Function 實作
• 所有 Method 實作

---

仍然會看到：

• Class 名稱
• Function 名稱
• Procedure 名稱
• Property 名稱
• Record 定義
• Enum 定義
• Event 定義

如果 Interface 中宣告了 Private 欄位：

private
  FData: Integer;

使用者仍然可以看到：

FData

只是無法知道如何使用。

因此，如果希望降低資訊曝光，建議不要在 Interface 中放置過多內部欄位或實作細節。

---

九、優點

1. 不公開原始碼。
2. 使用方式與一般 Unit 完全相同。
3. IDE 可正常提供 Code Insight。
4. 不需要 DLL。
5. 執行速度與一般 Delphi 程式相同。
6. 發布方便。

---

十、缺點

1. 無法跨 Delphi 版本

DCU 為 Delphi 編譯器產生的中間檔。

不同 Delphi 版本的 DCU 格式可能不同，因此：

• 無法保證相容
• 通常不可共用

例如：

編譯版本	使用版本	是否可用
XE10	XE10	✔
XE10	XE8	✘
XE10	Delphi 10.4	✘
XE10	Delphi 11	✘
XE10	Delphi 12	✘

因此，每個 Delphi 版本都需要重新編譯對應的 DCU。

---

2. 每個版本都需要重新發布

若要支援：

• XE10
• 10.4 Sydney
• 11 Alexandria
• 12 Athens

通常需要：

Release
│
├── XE10
│     MyLib.pas
│     MyLib.dcu
│
├── 10.4
│     MyLib.pas
│     MyLib.dcu
│
├── 11
│     MyLib.pas
│     MyLib.dcu
│
└── 12
      MyLib.pas
      MyLib.dcu

---

3. 若公開介面有修改

例如新增：

function Test: Integer;

就需要重新：

1. 編譯 DCU。
2. 更新公開 PAS。
3. 一起發布。

兩者必須保持一致。

---

十一、適用情況

適合：

• 公司內部函式庫。
• 不希望公開原始碼。
• Delphi 開發團隊使用相同版本。
• 商業 Delphi 函式庫。
• 元件開發。

---

十二、不適合情況

若需要：

• 支援 Delphi 多個版本
• 支援 C++
• 支援 C#
• 支援 VB
• 支援其他語言

則建議使用：

• DLL
• COM
• Web API
• REST API

而不是 DCU。

---

十三、建議

若所有使用者皆使用相同 Delphi 版本，採用 Interface PAS + DCU 是一種簡單且成熟的封裝方式，能兼顧開發便利性與原始碼保護。

若需支援不同 Delphi 版本，則必須針對每個版本重新編譯並發布對應的 .dcu；單一 DCU 無法跨 Delphi 版本使用。如果目標是跨 Delphi 版本，建議直接提供相容的原始碼，或改以 DLL、COM、REST API 等方式封裝功能，以降低版本相依性。

Delphi Enum 轉字串

 

uses
  System.TypInfo;

type
  TDataState = (stInquiry, stNew, stEdit, stDelete, stRecall);

function DataStateToString(AState: TDataState): string;
begin
  Result := GetEnumName(TypeInfo(TDataState), Ord(AState));
end;

Delphi FireDAC

 FDManager

var sParams:TStringList;

sParams.Add('Server=xx.xx.xx.xx');

sParams.Add('User_Name=xxxxx');

sParams.Add('Password=xxxxx');

sParams.Add('Database=xxxxx');

sParams.Add('DriverID=MSSQL');

sParams.Add('Pooled=True');

          sParams.Add('ExtendedMetadata=True');  //可以用來取得欄位屬性歸屬

FDManager1.AddConnectionDef('MSSQL_Pool', 'MSSQL', sParams);

FDConnection (與FDManager搭配使用，可以理解是DB Session)

FDConnection1.ConnectionDefName := 'MSSQL_Pool';

FDConnection1.Connected := True;

FDQuery / FDUpdateSQL

with FDQuery1 do

begin

  Connection := FDConnection1;

  CachedUpdates := True;

  UpdateOptions.UpdateTableName := 'Table1';

  UpdateOptions.KeyFields := 'Field1,Field2';

  UpdateOptions.UpdateMode := upWhereKeyOnly;

 
            UpdateObject := Self.FDUpdateSQL1;

  Close;

  SQL.Text :=

    ' select a.*, b.Fiedl5 '+

    ' from Table1 a '+

    ' left join Table2 b on b.field1=a.field1 '+

    ' where ... ';

  Open;

end;

ApplyUpdates

FDQuery1.CheckBrowseMode;

FDQuery1.FetchNext;  //抓資料到本地快取, 確保快取內容有提供回寫的資料

FDQuery1.ApplyUpdates(-1);

取得別名欄位的表格屬性及原欄名稱，需設定連線參數 ExtendedMetadata=True

var column:TFDDatSColumn;

column := FDQuery1.GetFieldColumn(Field);

column.ActualOriginTabName // Field歸屬的Table

column.ActualOriginColName // Field實體表格中的Column Name

FDConnection -> FDQuery，當FDQuery資料是分批讀取還沒完全將資料載入時，FDConnection沒辦法被其他FDQuery操作使用，會出現以下的錯誤訊息。

FDQuery.SourceEOF; //可以知道資料是否已完全載入

提供的建議做法是放二個FDConnection，一個做 Select...，另一個做Update/Insert/Delete/Exec ...
如果沒有閒置的 FDConnection， 就要Create一個FDConnection提供給FDQuery使用。

修正 Quick Report 預覽/列印的顯示比例

 當調整了電腦螢幕的縮放比例後，操作程式裡的報表QuickReport，發現報表預覽的資料內容沒有隨著顯示縮放比跟著做調整，但不影響實際列印輸出的結果。

參考網上的作法，修正 QuickReport 需 QRPrntr.pas 排除縮放比的問題。

我採用網友提供的方法1來處理。

File Name : QRPrntr.pas

Procedure Name : CreateMetafileCanvas

QRPrntr.pas 修正後，重新編譯QR506RunDXE10.bpl，

預覽結果就會以符合系統縮放比做調整了。

【參考連結】

老森常譚 IT Help 《Delphi》修正 Quick Report 預覽列印的比例問題

QuickReport - 載入 Qrp 報表文件時，會預先使用預設印表機的紙張格式套用在文件上，與設計的報表格式不符...

 var 

  repReport:TQuickRep;
  iPageHeightPixel, iPageWidthPixel:Integer;
  Meta: TMetafile;
begin
  inherited;
  repReport := TQuickRep.Create(nil);
  repReport.PrevInitialZoom := qrZoomToWidth;   //頁寬
  repReport.PrevShowThumbs := False;            //不顯示簡視欄
  repReport.PrevShowSearch := False;            //不顯示搜尋欄
  repReport.PreviewInitialState := wsMaximized; //最大化
  repReport.ShowProgress := True;
  repReport.PreviewDefaultSaveType := stQRP;

  repReport.Prepare;
  repReport.QRPrinter.Load('Report.qrp');    //載入檔案

  Meta := repReport.QRPrinter.GetPage(1);
  iPageWidthPixel := Meta.Width;    //取得文件記錄中的尺寸 Pixel
  iPageHeightPixel := Meta.Height;  //取得文件記錄中的尺寸 Pixel

  repReport.Page.Orientation := repReport.QRPrinter.Orientation; //報表直/橫向
  repReport.Page.PaperSize := TQRPaperSize.Custom; //報表紙張格式
  repReport.Units := TQRUnit.Pixels;
  repReport.Page.Length := iPageHeightPixel; //設定報表長度
  repReport.Page.Width := iPageWidthPixel;   //設定報表寬度

  repReport.PrinterSettings.PaperSize := TQRPaperSize.Custom;  //報表紙張格式

  repReport.PrinterSettings.PrinterIndex := 1;      //指定印表機
  repReport.PrinterSettings.ApplySettings(repReport.QRPrinter);

  repReport.QRPrinter.PrinterIndex := 1;            //指定印表機
  repReport.QRPrinter.aPrinterSettings.ApplySettings;
  repReport.QRPrinter.PreviewModal;      //預覽文件
end;

QuickReport Prepare / Preview / Print Event觸發的差異

 

ComboBoxLib

 

常用函數

String

System

function Copy(S: String; Index: Integer; Count: Integer): string;

 

System.SysUtils

function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;

function FormatDateTime(const Format: string; DateTime: TDateTime): string;

function FormatFloat(const Format: string; Value: Extended): string;

function FormatCurr(const Format: string; Value: Currency): string;

function Trim(const S: string): string; 

function TrimLeft(const S: string): string; overload;

function TrimRight(const S: string): string; overload;

function QuotedStr(const S: string): string; overload;

 比對字串 (不區分大小寫)

function CompareText(const S1, S2: string): Integer; 

                    function SameText (const S1, S2:String):Boolean;  

 

function UpperCase(const S: string): string; 

function UpperCase(const S: string; LocaleOptions: TLocaleOptions): string;

function LowerCase(const S: string): string; overload;

function LowerCase(const S: string; LocaleOptions: TLocaleOptions): string;

function Languages: TLanguages;

function FormatFloat(const Format: string; Value: Extended): string; 

System.StrUtils

 回傳Text存在於Array裡的索引值 (區分大小寫)

function IndexStr(const AText: string; const AValues: array of string): Integer;

回傳Text存在於Array裡的索引值 (不區分大小寫)

function IndexText(const AText: string; const AValues: array of string): Integer; 

 

function LeftStr(const AText: string; const ACount: Integer): string; overload;

function RightStr(const AText: string; const ACount: Integer): string; overload;

function MidStr(const AText: string; const AStart, ACount: Integer): string; overload;

function ReverseString(const AText: string): string;

function SplitString(const S, Delimiters: string): TStringDynArray;

 

function IfThen(AValue: Boolean; const ATrue: string; AFalse: string = ''): string; overload;  

Integer / Float

System

是否為奇數

function Odd(X: Integer): Boolean;

 

procedure Inc(var X: Integer); 

procedure Inc(var X: Integer; N: Integer);

 

System.SysUtils

function StrToIntDef(const S: string; const Default: Extended): Extended;

function StrToFloatDef(const S: string; const Default: Extended): Extended;

function TryStrToFloat(const S: string; out Value: Extended): Boolean;

function TryStrToCurr(const S: string; out Value: Currency): Boolean;

function TryStrToInt(const S: string; out Value: Integer): Boolean; overload;

 

System.Math

平方

function Power(const Base, Exponent: Double): Double;

 

將變數向上捨入至正無窮大。

function Ceil(const X: Double): Integer; 

 

將變數向負無窮方向舍入。

function Floor(const X: Double): Integer;  

 

Form.Width / 2 回傳浮點數

Form.Width div 2 回傳整數值 (不計小數)

function Max(const A, B: Integer): Integer; overload;

function MaxValue(const Data: array of Double): Double; overload;

function MaxIntValue(const Data: array of Integer): Integer;

function Min(const A, B: Integer): Integer; overload;

function MinValue(const Data: array of Double): Double; overload;

function MinIntValue(const Data: array of Integer): Integer;

function InRange(const AValue, AMin, AMax: Int64): Boolean; overload;

取整數

function Int(const X: Extended): Extended;

取小數

function Frac(const X: Extended): Extended;

判斷正/負號

function Sign(const AValue: Integer): TValueSign; 

Array中的平均值

function Mean(const Data: array of Single): Single;

function IfThen(AValue: Boolean; const ATrue: Integer; const AFalse: Integer = 0): Integer; overload;

Datetime

System.DateUtils

function IsPM(const AValue: TDateTime): Boolean; 
function IsAM(const AValue: TDateTime): Boolean;
function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
 
傳回指定 TDateTime 值所在年份的週數。
function WeeksInYear(const AValue: TDateTime): Word;
 
傳回指定年份的週數。
function WeeksInAYear(const AYear: Word): Word;       
 
傳回指定 TDateTime 值所在年份的天數。
function DaysInYear(const AValue: TDateTime): Word; 
 
傳回指定年份的天數。
function DaysInAYear(const AYear: Word): Word; 
 
傳回指定月份的天數。
function DaysInMonth(const AValue: TDateTime): Word;
 
傳回指定年份的指定月份的天數。
function DaysInAMonth(const AYear, AMonth: Word): Word;

 

function Today: TDateTime;
function Yesterday: TDateTime;
function Tomorrow: TDateTime;

 

function YearOf(const AValue: TDateTime): Word;
function MonthOf(const AValue: TDateTime): Word;
function WeekOf(const AValue: TDateTime): Word;           
function DayOf(const AValue: TDateTime): Word;
function HourOf(const AValue: TDateTime): Word;
function MinuteOf(const AValue: TDateTime): Word;
function SecondOf(const AValue: TDateTime): Word;
function MilliSecondOf(const AValue: TDateTime): Word;
function StartOfTheMonth(const AValue: TDateTime): TDateTime;
function EndOfTheMonth(const AValue: TDateTime): TDateTime;
function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
function StartOfTheWeek(const AValue: TDateTime): TDateTime; 
function EndOfTheWeek(const AValue: TDateTime): TDateTime;  
function StartOfAWeek(const AYear, AWeekOfYear: Word;const ADayOfWeek: Word = 1): TDateTime;
function EndOfAWeek(const AYear, AWeekOfYear: Word;const ADayOfWeek: Word = 7): TDateTime;
 
function YearsBetween(const ANow, AThen: TDateTime): Integer;
function MonthsBetween(const ANow, AThen: TDateTime): Integer;
function WeeksBetween(const ANow, AThen: TDateTime): Integer;
function DaysBetween(const ANow, AThen: TDateTime): Integer;
function HoursBetween(const ANow, AThen: TDateTime): Int64;
function MinutesBetween(const ANow, AThen: TDateTime): Int64;
function SecondsBetween(const ANow, AThen: TDateTime): Int64;
function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;

 

function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer = 1): TDateTime; inline;

function IncWeek(const AValue: TDateTime;const ANumberOfWeeks: Integer = 1): TDateTime; inline;

指定天數偏移的日期 

function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer = 1): TDateTime; inline;
 
function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64 = 1): TDateTime; inline;
function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64 = 1): TDateTime; 

function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64 = 1): TDateTime;

function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds:Int64 = 1): TDateTime;

File/Fold

System.SysUtil

資料夾是否存在.

function DirectoryExists(const Directory: string; FollowLink: Boolean = True): Boolean;

檔案是否存在

function FileExists(const FileName: string; FollowLink: Boolean = True): Boolean;

檔案放置的資料夾

function ExtractFileDir(const FileName: string): string;

檔案放置的路徑

function ExtractFilePath(const FileName: string): string;

檔案放置的磁碟代號

function ExtractFileDrive(const FileName: string): string;

檔案名稱

function ExtractFileName(const FileName: string): string;

變更副檔名

function ChangeFileExt(const FileName, Extension: string): string;

檔案是否唯讀

function FileIsReadOnly(const FileName: string): Boolean;

檔案設定唯讀

function FileSetReadOnly(const FileName: string; ReadOnly: Boolean): Boolean;

刪除檔案

function DeleteFile(const FileName: string): Boolean;

檔案名稱更名

function RenameFile(const OldName, NewName: string): Boolean;

檔案搜尋

function FileSearch(const Name, DirList: string): string;

目前的使用路徑

function GetCurrentDir: string;

設定目前的使用路徑

function SetCurrentDir(const Dir: string): Boolean;

建立資料夾(樹狀)

function ForceDirectories(Dir: string): Boolean;

建立資料夾

function CreateDir(const Dir: string): Boolean;

移除資料夾

function RemoveDir(const Dir: string): Boolean;

Delphi 表單建立/釋放時的事件順序

在 Delphi 中，當一個表單 (Form) 被建立時，會依序觸發以下事件：

Constructor (Create):

在這個階段，表單的物件會被建立，但視窗還沒有初始化。
如果使用的是 TForm.Create(nil)，此時還沒有分配 Parent，也沒有顯示。

CreateWnd:

建立表單的 Windows 視窗句柄 (Handle)。
此時可以進行與視窗句柄相關的操作，例如 API 呼叫。

Loaded:

當表單是從 DFM (表單文件) 加載時會觸發。
所有的組件屬性和子組件都已經被初始化。
適合在這裡進行一些屬性設定或初始化動作。

OnCreate (或 FormCreate 事件):

當表單完成建立時觸發。
通常用於初始化變數、設定控制項屬性或載入資料。

OnShow:

當表單即將顯示在螢幕上時觸發。
表單已經可見，但還沒有繪製完全。
適合用於需要在顯示時更新畫面的操作，例如 UI 資料刷新。

OnActivate:

當表單獲得焦點 (成為最上層視窗) 時觸發。
每次表單被切換回來時都會觸發，不只是第一次顯示時。

OnPaint:

當表單需要重繪時觸發。
一般用於自訂繪圖邏輯，例如畫布 (Canvas) 操作。

OnResize (可選，視情況而定):

當表單大小改變時觸發。
可用於調整內部控制項的佈局。

當表單關閉或釋放時，事件順序如下：

OnCloseQuery:

在關閉前詢問是否允許關閉 (CanClose 參數)。
可用於彈出確認視窗或檢查條件。

OnClose:

當表單正在關閉時觸發。
可透過 Action 參數決定是隱藏還是釋放表單。

OnHide:

當表單從螢幕上消失時觸發。

OnDestroy (或 FormDestroy 事件):

在表單物件被釋放前觸發。
通常用於釋放資源、清理記憶體或結束程序。

Destructor (Destroy):

最後的資源釋放動作，然後表單物件從記憶體中移除。

From Char-GPT

判斷環境處於開發狀態

使用 {$IFDEF DEBUG} 編譯條件

在開發過程中，您可以通過設置 DEBUG 編譯器條件來區分開發模式和執行模式。通常在 IDE 中執行程式時，會啟用 DEBUG 模式。
delphi
複製程式碼
procedure CheckMode;
begin
  {$IFDEF DEBUG}
  ShowMessage('目前是開發模式');
  {$ELSE}
  ShowMessage('目前是執行模式');
  {$ENDIF}
end;
注意：您需要在專案的編譯選項中啟用 DEBUG 定義。

判斷 IsDebuggerPresent（Windows 專用）

在 Windows 系統中，可以使用 Windows API 的 IsDebuggerPresent 函數來判斷程式是否被除錯工具附加，這可以間接反映是否處於開發模式。
delphi
複製程式碼
uses
  Winapi.Windows;
function IsDevelopmentMode: Boolean;
begin
  Result := IsDebuggerPresent;
end;
procedure CheckMode;
begin
  if IsDevelopmentMode then
    ShowMessage('目前是開發模式')
  else
    ShowMessage('目前是執行模式');
end;

判斷設計時期元件的 ComponentState

如果您正在開發元件，您可以檢查元件的 ComponentState 是否包含 csDesigning 標誌來判斷是否處於設計時期：
delphi
複製程式碼
function IsDesignTime(AComponent: TComponent): Boolean;
begin
  Result := csDesigning in AComponent.ComponentState;
end;
// 使用範例
if IsDesignTime(Self) then
  ShowMessage('目前是開發模式（設計時期）')
else
  ShowMessage('目前是執行模式');
適用場景
檢查程式是否在 IDE 中執行：使用 IsDebuggerPresent 或 {$IFDEF DEBUG}。
檢查元件是否處於設計時期：使用 csDesigning。
請依據您的需求選擇合適的方式。如果需要更多協助，請提供您的具體需求！

from Char GPT

Delphi 專案編譯前/後的觸發事件

Project → Options 

如果需要將編譯後的文件複製到其他資料夾，可以參考上圖的作法

在 Post-build events → Commads 填入

XCopy "$(OUTPUTDIR)$(OUTPUTFILENAME)" "C:\Temp" /Y

瀏覽器頁面內容另存為圖檔

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.OleCtrls,
  SHDocVw, MSHTML, ActiveX, Vcl.Imaging.jpeg;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(ASender: TObject;
      const pDisp: IDispatch; const [Ref] URL: OleVariant);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure SaveWebPageAsImage(WebBrowser: TWebBrowser; FileName: string; AFullPage:Boolean=True);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SaveWebPageAsImage(WebBrowser: TWebBrowser; FileName: string; AFullPage:Boolean=True);
var
  HTMLDocument: IHTMLDocument2;
  HTMLBody: IHTMLElement2;
  ViewObject: IViewObject;
  Bitmap: TBitmap;
  JpegImage: TJpegImage;
  vRect: TRect;
  DC: HDC;
  orgWidth, orgHeight:Integer;
  orgAlign:TAlign;
begin
  if not Assigned(WebBrowser.Document) then
    Exit;
  

  with WebBrowser do
  begin
    Visible := False;
    orgWidth := Width;
    orgHeight := Height;
    orgAlign := Align;
    Align := alCustom;
  end;

  HTMLDocument := WebBrowser.Document as IHTMLDocument2;
  HTMLBody := HTMLDocument.body as IHTMLElement2;

  // Create a bitmap to hold the webpage content
  Bitmap := TBitmap.Create;
  try
    // Get the view object of the document
    if HTMLDocument.QueryInterface(IViewObject, ViewObject) = S_OK then
    begin
      // Get the bounding rectangle of the WebBrowser
      if AFullPage then
      begin
        WebBrowser.Width := HTMLBody.scrollWidth;
        WebBrowser.Height := HTMLBody.scrollHeight+30;
      end;

      vRect := Rect(0, 0, WebBrowser.Width, WebBrowser.Height);
      Bitmap.Width := WebBrowser.Width;
      Bitmap.Height := WebBrowser.Height;

      // Get a device context (DC) for the bitmap canvas
      DC := Bitmap.Canvas.Handle;

      // Draw the content of the WebBrowser into the bitmap
      ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, 0, DC, @vRect, nil, nil, 0);
    end;

    // Create a TJpegImage and assign the bitmap to it
    JpegImage := TJpegImage.Create;
    try
      JpegImage.Assign(Bitmap);
      JpegImage.SaveToFile(FileName);
    finally
      JpegImage.Free;
    end;

  finally
    Bitmap.Free;
    with WebBrowser do
    begin
      Width := orgWidth;
      Height := orgHeight;
      Align := orgAlign;
      Visible := True;
    end;
  end;

end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const [Ref] URL: OleVariant);
begin
  SaveWebPageAsImage(TWebBrowser(ASender), 'c:\temp\test.jpg');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Silent := True;
  Webbrowser1.Navigate('https://www.google.com.tw');
end;

end.