需安裝 Microsoft Access Database Engine 2016 Redistributable，選擇適用於系統/應用程式的版本安裝。
安裝操作32位元版本出現警示訊息，可以使用參數來強制安裝。
C:\Accessdatabaseengine /quiet
2024年10月17日 星期四
2024年8月4日 星期日
2024年6月17日 星期一
瀏覽器頁面內容另存為圖檔
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;
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;
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;
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;
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;
begin
WebBrowser1.Silent := True;
Webbrowser1.Navigate('https://www.google.com.tw');
end;
end.
2024年6月13日 星期四
Delphi 在桌面產生捷徑
uses
Windows, SysUtils, ComObj, ShlObj;
Windows, SysUtils, ComObj, ShlObj;
procedure CreateShortcutOnDesktop(const TargetPath, ShortcutName: string);
var
WSHShell: Variant;
Shortcut: Variant;
DesktopPath: array[0..MAX_PATH] of Char;
begin
// 初始化 WSHShell
WSHShell := CreateOleObject('WScript.Shell');
// 獲取桌面路徑
SHGetSpecialFolderPath(0, DesktopPath, CSIDL_DESKTOP, False);
// 創建捷徑對象
Shortcut := WSHShell.CreateShortcut(IncludeTrailingPathDelimiter(DesktopPath) + ShortcutName + '.lnk');
// 設置捷徑目標路徑和描述
Shortcut.TargetPath := TargetPath;
Shortcut.Description := 'Shortcut to ' + ShortcutName;
// 保存捷徑
Shortcut.Save;
end;
var
WSHShell: Variant;
Shortcut: Variant;
DesktopPath: array[0..MAX_PATH] of Char;
begin
// 初始化 WSHShell
WSHShell := CreateOleObject('WScript.Shell');
// 獲取桌面路徑
SHGetSpecialFolderPath(0, DesktopPath, CSIDL_DESKTOP, False);
// 創建捷徑對象
Shortcut := WSHShell.CreateShortcut(IncludeTrailingPathDelimiter(DesktopPath) + ShortcutName + '.lnk');
// 設置捷徑目標路徑和描述
Shortcut.TargetPath := TargetPath;
Shortcut.Description := 'Shortcut to ' + ShortcutName;
// 保存捷徑
Shortcut.Save;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// 創建 A.EXE 的捷徑到桌面
CreateShortcutOnDesktop('C:\path\to\A.EXE', 'A.EXE Shortcut');
end;
2024年6月5日 星期三
Exception EInOutError in module xxx.exe at 0000854A. File access denied.
啟動程式遇到以上的錯誤訊息，資料夾必須開放存取權限，資料夾內的文件必須取消唯讀屬性。
2024年5月15日 星期三
SQL 十進位轉分數
取最大公因數
Create FUNCTION dbo.GCD(@a INT, @b INT)RETURNS INT
AS
BEGIN
--最大公因數
WHILE @b != 0
BEGIN
DECLARE @temp INT;
SET @temp = @b;
SET @b = @a % @b;
SET @a = @temp;
END
RETURN @a;
END;
十進位轉分數
Create function dbo.DecimalToFraction (@decimal_value DECIMAL(18, 2))
returns NVARCHAR(50) AS
BEGIN
DECLARE @whole_part INT;
DECLARE @fraction_part DECIMAL(18, 2);
DECLARE @numerator INT;
DECLARE @denominator INT;
DECLARE @gcd_value INT;
DECLARE @fraction_string NVARCHAR(50);
-- 取得整數部分和小數部分
SET @whole_part = FLOOR(@decimal_value);
SET @fraction_part = @decimal_value - @whole_part;
-- 初始分母为100，以处理小数部分的十分位
SET @denominator = 100;
-- 将小数部分转换为分数的分子 0.75 * 100
SET @numerator = @fraction_part * @denominator;
-- 确保分子和分母为整数
SET @numerator = ROUND(@numerator, 0);
SET @denominator = ROUND(@denominator, 0);
-- 求分子和分母的最大公因数
SET @gcd_value = dbo.GCD(@numerator, @denominator);
WHILE @gcd_value > 1
BEGIN
SET @numerator = @numerator / @gcd_value;
SET @denominator = @denominator / @gcd_value;
SET @gcd_value = dbo.GCD(@numerator, @denominator);
END;
-- 将整数部分和分数部分组合成分数形式
if @numerator<>0
begin
SET @fraction_string = CONCAT(@whole_part, '-', @numerator, '/', @denominator);
end
else
begin
SET @fraction_string = @whole_part
end
return @fraction_string;
END;
SQL 英呎轉分數
取最大公因數
Create FUNCTION dbo.GCD(@a INT, @b INT)
RETURNS INT
AS
BEGIN
--最大公因數
WHILE @b != 0
BEGIN
DECLARE @temp INT;
SET @temp = @b;
SET @b = @a % @b;
SET @a = @temp;
END
RETURN @a;
END;
AS
BEGIN
--最大公因數
WHILE @b != 0
BEGIN
DECLARE @temp INT;
SET @temp = @b;
SET @b = @a % @b;
SET @a = @temp;
END
RETURN @a;
END;
英吋轉分數
Create function dbo.FeetToFraction (@decimal_value DECIMAL(18, 2))
returns NVARCHAR(50)
AS
BEGIN
--英呎轉分數
declare @Int int;
DECLARE @whole_part DECIMAL(18, 2);
DECLARE @fraction_part DECIMAL(18, 2);
DECLARE @numerator DECIMAL(18, 2);
DECLARE @denominator DECIMAL(18, 2);
DECLARE @gcd_value DECIMAL(18, 2);
DECLARE @fraction_string NVARCHAR(50);
-- 取得整數部分和小數部分
SET @Int = FLOOR(@decimal_value); --整數
SET @fraction_part = @decimal_value - @Int; --小數
-- 初始分母為16
SET @denominator = 16;
-- 將小數部份乘以 0.75 * 12
SET @numerator = @fraction_part * 12;
-- 取相乘後的整數
SET @whole_part = FLOOR(@numerator); --整數
SET @fraction_part = @numerator - @whole_part; --小數
Set @fraction_part = FLOOR(@fraction_part * @denominator)
-- 求分子和分母的最大公因数
SET @gcd_value = dbo.GCD(@fraction_part, @denominator);
WHILE @gcd_value > 1
BEGIN
SET @fraction_part = @fraction_part / @gcd_value;
SET @denominator = @denominator / @gcd_value;
SET @gcd_value = dbo.GCD(@fraction_part, @denominator);
END;
-- 組合成分數
if convert(int, @fraction_part) <> 0
begin
SET @fraction_string = CONCAT(@Int, ''' ' ,
convert(int, @whole_part), '-',
convert(int, @fraction_part), '/', convert(int, @denominator),'"');
end
else
begin
SET @fraction_string = CONCAT(@Int, ''' ' ,
convert(int, @whole_part), '"');
end
Return @fraction_string;
END;
2024年5月14日 星期二
DBGrid FixedCols Selution
DBGrid FixedCols Selution
type
TFixDBGrid = class(TDBGrid)
protected
function SelectCell(ACol, ARow: Longint): Boolean; Override;
function SelectCell(ACol, ARow: Longint): Boolean; Override;
public
property FixedCols;
end;
...
...
function TFixDBGrid.SelectCell(ACol, ARow: Longint): Boolean;
Begin
Result := Inherited SelectCell(ACol, ARow);
If ACol < FixedCols Then
Result := False;
End;
...
...
...
function TFixDBGrid.SelectCell(ACol, ARow: Longint): Boolean;
Begin
Result := Inherited SelectCell(ACol, ARow);
If ACol < FixedCols Then
Result := False;
End;
...
...
參考轉: https://delfusa.main.jp/delfusafloor/archive/www.nifty.ne.jp_forum_fdelphi/samples/00715.html
2024年5月6日 星期一
蟾宮折桂
蟾宮折桂
蟾宮，指月亮。折桂，比喻科舉及第。參見「折桂」條。蟾宮折桂相傳月中有桂樹，用以比喻科舉登第。元．施惠《幽閨記》第一一齣：「胸中書富五車，筆下句高千古，鎮朝經暮史，寐晚興夙，擬蟾宮折桂雲梯步。」《孽海花》第五回：「舉人是月宮裡管的，祇要吳剛老爹修桂樹的玉斧砍下一枝半枝，肯賜給我們爺，我們爺就可以中舉，名叫蟾宮折桂。」
https://dict.idioms.moe.edu.tw/idiomView.jsp?ID=11566&webMd=2&la=0
2024年4月2日 星期二
2024年2月20日 星期二
2024年1月30日 星期二
System.Generics.Collections.TDictionary
System.Generics.Collections.TDictionary
uses System.Generics.Collections;
...
var dicDoctionary: TDictionary<String, String> //Key, Value
//宣告
dicDoctionary := TDictionary<String, String>.Create;
//新增
dicDoctionary.Add(Key, Value);
//刪除
dicDoctionary.Remove(Key);
//新增或取代Value
dicDoctionary.AddOrSetValue(Key, Value);
//比對Key是否存在
dicDoctionary.ContainsKey(Key);
//比對Value是否存在
dicDoctionary.ContainsValue(Value);
//數量
dicDoctornary.Count;
//取值
var sValue:String;
dicDoctionary.TryGetValue(Key, sValue);
2024年1月15日 星期一
DialogLib.pas 記錄
 |
| InputBox |
 |
| EditConnectionString |
 |
| FindDialog / ReplaceDialog |
 |
| OpenDialog / SaveDialog |
 |
| Waiting Form |
2024年1月14日 星期日
2023年12月26日 星期二
ComboBox 繪製模式
ComboBox1.Style
csOwnerDrawFixed
- 當 ComboBox.Style 設定為 csOwnerDrawFixed 時，所有項目將以相同的高度顯示，並且當需要時，控制元件會調用 OnDrawItem 事件來繪製每個項目。
- 所有項目的高度由 ItemHeight 屬性定義。這表示無論項目的內容有多長，顯示的高度都是相同的。
- 對於列表中的每個項目，OnDrawItem 事件都會觸發，並且您必須在該事件中進行繪製。
csOwnerDrawVariable
- 當 ComboBox.Style 設定為 csOwnerDrawVariable 時，可以根據每個項目的實際內容來設置不同的高度，並且在需要時會調用 OnMeasureItem 和 OnDrawItem 事件來繪製每個項目。
- OnMeasureItem 事件用於指定每個項目的高度，您可以根據項目的內容計算不同的高度。這樣，不同的項目可以具有不同的顯示高度。
- OnDrawItem 事件用於實際的繪製操作。在該事件中，您可以根據需要來繪製每個項目的外觀。
資料來源 : CharGPT
2023年12月25日 星期一
PopupMenuLib.pas 記錄
AttachFilePopupMenu
procedure TForm1.FormCreate(Sender: TObject);beginpopAttachFile := TAttachFilePopupMenu.Create;end;procedure TForm1.Button9Click(Sender: TObject);beginpopAttachFile.Popup(Button9); //參數 nil 會在游標處展開下拉選單end;
//Property// popAttachFile.AttachFiles //附加的文件清單// popAttachFile.Readonly //唯讀，不可附加、移除// popAttachFile.DisableAttachFile //不提供附加// popAttachFile.DisableRemove //不提供移除// popAttachFile.DisableOpenFile //不提供文件開啟
PrinterPopupMenu
Uses Printers;
procedure TForm1.Button9Click(Sender: TObject);var pmPrinterList: TPrinterPopupMenu;beginpmPrinterList := TPrinterPopupMenu.Create;pmPrinterList.Popup(Button9); //參數 nil 會在游標處展開下拉選單end;
// Property// pmPrinterList.PrinterIndex //印表機Index// pmPrinterList.PrinterName //印表機名稱
TColor 調整亮度
procedure pr_BrightenColor(var Color: TColor; Brightness: Integer);
var R, G, B: Byte;
begin
R := GetRValue(Color);
G := GetGValue(Color);
B := GetBValue(Color);
var R, G, B: Byte;
begin
R := GetRValue(Color);
G := GetGValue(Color);
B := GetBValue(Color);
R := Min(255, R + Brightness);
G := Min(255, G + Brightness);
B := Min(255, B + Brightness);
Color := RGB(R, G, B);
end;
2023年12月14日 星期四
Dataset 查詢介面上被異動過的資料
ADO Dataset
在ADODataset要查看修改過且尚未寫回資料庫的資料列，可以用FilterGroup來查看
Ex：
with ADataset do
begin
if LockType = ltBatchOptimistic then
begin
Filtered := True;
FilterGroup := fgPendingRecords;
end;
FilterGroup := fgUnassigned;
Filtered := False;
end;
with ADataset do
begin
if LockType = ltBatchOptimistic then
begin
Filtered := True;
FilterGroup := fgPendingRecords;
end;
FilterGroup := fgUnassigned;
Filtered := False;
end;
ClientDataset
ClientDataset Delta 記錄了維護畫面上被異動過的資料列，ApplyUpdates將取用Delta記錄的資料狀態回寫到資料庫中。
Ex：
使用CleintDataset、DataSource、DBGrid並設定關連性。procedure TForm1.Button1Click(Sender:TObject);begin...//cdsDetail異動過的資料列，反應在ClientDataset1ClientDataset1.Data := cdsDetail.Delta;...end;
2023年12月6日 星期三
PageControl ActivePage 做顏色區別，增加閱讀性。
PageControl1.OwnerDraw := True;
Procedure TForm1.pr_PageControl1_DrawTab(Control: TCustomTabControl; TabIndex: Integer; const [Ref] Rect: TRect; Active: Boolean);
var iMidWidth, iMidHeight, iTextWidth, iTextHeight:Integer;
sCaption:String;
begin
sCaption := TPageControl(Control).Pages[TabIndex].Caption;
iTextWidth := TPageControl(Control).Canvas.TextWidth(sCaption);
iTextHeight := TPageControl(Control).Canvas.TextHeight(sCaption);
iMidWidth := Rect.Left + Ceil((Rect.Width-iTextWidth)/2);
iMidHeight := Rect.Top + Ceil((Rect.Height-iTextHeight)/2);
if Active then
begin
TPageControl(Control).Canvas.Brush.Color := clHighlight;
TPageControl(Control).Canvas.Font.Color := clHighlightText;
end
else
TPageControl(Control).Canvas.Brush.Color := clScrollBar;
TPageControl(Control).Canvas.FillRect(Rect);
TPageControl(Control).Canvas.TextOut(iMidWidth, iMidHeight, sCaption);
end;
訂閱：
文章 (Atom)