2022年11月29日星期二

Access violation at address xxxxxxxx in module 'rtl70.bpl'. read of address xxxxxxxx

程式中使用到QuickReport物件，機器設備上必須先設定有印表機，如果是網路印表機，必須是已連線的狀態。

2022年10月4日星期二

CheckListBox 勾選項目用顏色反應，加強可讀性。

type
TForm1 = class(TForm)
...
public
{ Public declarations }
procedure pr_CheckListBox_OnDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure pr_CheckListBox_Exit(Sender: TObject);
procedure pr_Set_Highlight_For_CheckListBox(AOwner:TWinControl);
end;

CheckListBox.Style := lbOwnerDrawFixed;

//用來覆寫CheckListBox.OnDrawItem事件，對已勾選的項目做文件上的變化

procedure TForm1.pr_CheckListBox_OnDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);

var sStr:String;

begin

TCheckListBox(Control).Canvas.Font.Color := TCheckListBox(Control).Font.Color;

TCheckListBox(Control).Canvas.Font.Style := TCheckListBox(Control).Font.Style;

if (odSelected in State) then

begin

TCheckListBox(Control).Canvas.Font.Color := clWhite;

end;

if TCheckListBox(Control).Checked[Index] then

begin

TCheckListBox(Control).Canvas.Font.Color := clRed;

TCheckListBox(Control).Canvas.Font.Style := [fsBold];

end;

TCheckListBox(Control).Canvas.FillRect(Rect);

sStr := TCheckListBox(Control).Items[Index];

TCheckListBox(Control).Canvas.TextRect(Rect, sStr);

end;

//用來覆寫CheckListBox.OnExit事件，選焦點被移開時，取消停佇項目的反色選取

procedure TForm1.pr_CheckListBox_Exit(Sender: TObject);

begin

TCheckListBox(Sender).ClearSelection;

end;

//執行此函式將畫面上所有的CheckListBox做處理

procedure TForm1.pr_Set_Highlight_For_CheckListBox(AOwner:TWinControl);

var i:Integer;

begin

for i := 0 to Self.ComponentCount-1 do

begin

if Self.Components[i] is TCheckListBox then

begin

TCheckListBox(Self.Components[i]).Style := lbOwnerDrawFixed;

TCheckListBox(Self.Components[i]).OnDrawItem := pr_CheckListBox_OnDrawItem;

TCheckListBox(Self.Components[i]).OnExit := pr_CheckListBox_Exit;

end;

2022年8月17日星期三

穿著Prada的惡魔 (The Devil Wears Prada)

擴展QuckReport報表內容

報表內容過多過長， Report礙於報表的設計空間，開發階段不容易將報表元件放置到適當的位置。可以在Form上，放置多個QuickRep報表元件，在不同的QuickRep元件中利用ChildBand來設計，再用程式碼控制將ChildBand併到主報表裡做預覽。

uses QRPrntr;

type TQRPrintableExt=class(TQRPrintable);

procedure TForm1.pr_Reset_ParentReport(AChildBand:TQRChildBand; AParentBand:TQRCustomBand);

var i:Integer;

begin

AChildBand.Parent := AParentBand.ParentReport;

AChildBand.ParentBand := AParentBand;

for i := 0 to AChildBand.ControlCount-1 do

TQRPrintableExt(AChildBand.Controls[i]).ParentReport := AChildBand.ParentReport;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

pr_Reset_ParentReport(ChildBand1, DetailBand1);

pr_Reset_ParentReport(QRChildBand1, ChildBand1);

QuickRep1.Preview;

end;

輸出結果:

2022年8月10日星期三

TCategoryPanelGroup - MouseWheel : Not functional ?

//---------------
//Form MouseWheel
//---------------
procedure TForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
if PtInRect(CategoryPanelGroup1.BoundsRect, ScreenToClient(Mouse.CursorPos)) then
CategoryPanelGroup1MouseWheel(Sender, Shift, WheelDelta, MousePos, Handled);
end;

//-----------------------------
//CategoryPanelGroup MouseWheel
//-----------------------------
procedure TForm.CategoryPanelGroup1MouseWheel(Sender: TObject;
Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
var
msg: Cardinal;
code: Cardinal;
i, n: Integer;
begin // Thanks to *Peter Below* for this code (adapted here)
Handled := true;
if ssShift in Shift then
msg := WM_HSCROLL
else
msg := WM_VSCROLL;
if WheelDelta > 0 then
code := SB_LINEUP
else
code := SB_LINEDOWN;
n:= Mouse.WheelScrollLines;
for i:= 1 to n do
CategoryPanelGroup1.Perform(msg, code, 0);
CategoryPanelGroup1.Perform(msg, SB_ENDSCROLL, 0);
end;

轉貼至:https://codeverge.com/embarcadero.delphi.nativeapi/tcategorypanelgroup-mousewheel-n/1065463

2022年8月2日星期二

Excel Class Workbook 的 SaveAs 方法失敗

操作遠端連線在Terminal主機使用相同的程式，部份使用者在操作Excel匯出時會出現「Class Workbook 的 SaveAs 方法失敗」，需要將使用者的UserProfile刪除，重新登入後讓系統重建就可以正常匯出。

2022年7月27日星期三

鬼影

洞悉真相

2022年7月25日星期一

Contratiempo - 佈局(2017)

2022年6月15日星期三

操作Printers.Printer.PrintIndex 無法變更 QuickReport PrintSetup裡的輸出印表機!?

Uses Printers;

...

Printers.Printer.PrintIndex := 1; //指定輸出的印表機索引，不會變更預設印表機

...

TPrintDialog會依據PrintIndex的變更指向對應的印表機，

QuickReport PrintSetup沒有因為PrintIndex變更指定輸出的印表機，維持指向預設印表機。

修正QuickReport QRPrnSu.pas文件

Ver. QuickRep506
File : QRPrnSu.pas
Proceure : GetPrinter

原內容

{ TQRBasePrintDialog }
// HERE the important changes - see dialogs.pas from delphi vcl - source.
// note the Brackets and type casts! It's tricky :-)

procedure TQRBasePrintDialog.GetPrinter(var DeviceMode, DeviceNames: THandle);

var

DevNames: PDevNames;

Offset: PChar;

size : integer;

begin

FPrinter.GetPrinter(Device, Driver, Port, DeviceMode);

if DeviceMode <> 0 then

begin

size:=SizeOf(TDevNames) +

(StrLen(Device) + StrLen(Driver) + StrLen(Port) + 3) *Sizeof(Char);

//DeviceNames := GlobalAlloc(GHND,SizeOf(TDevNames) +

// (StrLen(Device) + StrLen(Driver) + StrLen(Port) + 3) *Sizeof(Char));

//DevNames := PDevNames(GlobalLock(DeviceNames));

GetMem(DevNames, Size);

try

Offset := PChar(PByte(DevNames) + SizeOf(TDevnames));

with DevNames^ do

begin

wDriverOffset := NativeInt(Offset) - NativeInt(DevNames);

Offset := StrECopy(Offset, Driver) + 1;

wDeviceOffset := NativeInt(Offset) - NativeInt(DevNames);

Offset := StrECopy(Offset, Device) + 1;

wOutputOffset := NativeInt(Offset) - NativeInt(DevNames);;

StrCopy(Offset, Port);

end;

finally

//GlobalUnlock(DeviceNames);

FreeMem(DevNames, Size);

end;

參考備註指定的 Dialogs.pas 修正

{ TQRBasePrintDialog }
// HERE the important changes - see dialogs.pas from delphi vcl - source.
// note the Brackets and type casts! It's tricky :-)

procedure TQRBasePrintDialog.GetPrinter(var DeviceMode, DeviceNames: THandle);

var

DevNames: PDevNames;

Offset: PChar;

size : integer;

begin

FPrinter.GetPrinter(Device, Driver, Port, DeviceMode);

if DeviceMode <> 0 then

begin

//size:=SizeOf(TDevNames) +

// (StrLen(Device) + StrLen(Driver) + StrLen(Port) + 3) *Sizeof(Char);

DeviceNames := GlobalAlloc(GHND, SizeOf(TDevNames) +

(StrLen(Device) + StrLen(Driver) + StrLen(Port) + 3) *Sizeof(Char));

DevNames := PDevNames(GlobalLock(DeviceNames));

//GetMem(DevNames, Size);

try

Offset := PChar(PByte(DevNames) + SizeOf(TDevnames));

with DevNames^ do

begin

wDriverOffset := Offset - PChar(DevNames);

Offset := StrECopy(Offset, Driver) + 1;

wDeviceOffset := Offset - PChar(DevNames);

Offset := StrECopy(Offset, Device) + 1;

wOutputOffset := Offset - PChar(DevNames);;

StrCopy(Offset, Port);

end;

finally

GlobalUnlock(DeviceNames);

//FreeMem(DevNames, Size);

end;

QRPrnSu.pas修正後儲存，重新編譯/安裝 QR506DesignDXE10.bpl、QR506RunDXE10.bpl

2022年5月26日星期四

DLL MDI Form 切換

procedure pr_PageBtn_OnClick(Sender: TObject);
var
i, j:integer;
vhandle,xhandle:Thandle;
vbuffer: array[0..255] of char;
apfunc : Pointer;
// p: PInteger;
begin
//Dll Form
vhandle := StrToInt(Copy(TSpeedButton(Sender).Name, 2, Length(TSpeedButton(Sender).Name)-1));
if vhandle = 0 then
exit;
while vhandle <> 0 do
begin
GetClassName(vhandle, vbuffer, SizeOf(vbuffer));
if vhandle = strtoint(copy(TSpeedButton(Sender).Name, 2, length(TSpeedButton(Sender).Name)-1)) then
begin
if vhandle > 0 then
begin
xhandle := findwindowex(vhandle, 0, 'MDIClient', nil);
xhandle := getwindow(vhandle, GW_CHILD);
SendMessage(vhandle, WM_CHILDACTIVATE, 0, 0);
end
else begin
TSpeedButton(Sender).Destroy;
TSpeedButton(Sender).Free;
self.Refresh;
end;
break;
end;
end;
end;

2022年4月19日星期二

Delphi VFW 操作Web Cam影像輸出，出現黑屏的解決方式

VFW 操作Web Cam影像輸出，換了不同型號的Web Cam出現黑屏，原來是「視訊格式」不同造成。

Code:

hCapWnd := THandle;

hCapWnd := capCreateCaptureWindow('Cam. Window',WS_VISIBLE or WS_CHILD,

0, 0, Panel1.Width, Panel1.Height, Panel1.Handle, 0);

capDriverConnect(hCapWnd, 0);

capDlgVideoFormat(hCapWnd); //會出現「視訊各式」的視窗

將「像素深度(位元)及壓縮」設置成 YUY2 即可

2022年4月12日星期二

Excel 操作出現 "外部資料表不是預期的格式"

用程式操作開啟Excel文件，出現 "外部資料表不是預期的格式"

或是用Excel開啟文件，出現檔案格式不相符的訊息

存檔時將文件格式指定為 "一般活頁簿"，可以排除這類的狀況。

excel := CreateOleObject('Excel.Application');

excel.Visible := False;

excel.Workbooks.Add;

workbook := excel.Workbooks[1];

...

workbook.SaveAs(OleVariat(filename), -4143);

轉貼自 https://docs.microsoft.com/zh-tw/office/vba/api/excel.xlfileformat

XlFileFormat 列舉 (Excel)

會指定儲存工作表時的檔案格式。

名稱	值	描述	副檔名
xlAddIn	18	Microsoft Excel 97-2003 增益集	*.xla
xlAddIn8	18	Microsoft Excel 97-2003 增益集	*.xla
xlCSV	6	CSV	*.csv
xlCSVMac	22	Macintosh CSV	*.csv
xlCSVMSDOS	24	MSDOS CSV	*.csv
xlCSVUTF8	62	UTF8 CSV	*.csv
xlCSVWindows	至	Windows CSV	*.csv
xlCurrentPlatformText	-4158	目前平台文字	*.txt
xlDBF2	7	Dbase 2 格式	*.dbf
xlDBF3	8	Dbase 3 格式	*.dbf
xlDBF4	11	Dbase 4 格式	*.dbf
xlDIF	9	資料交換格式	*.dif
xlExcel12	50	Excel 二進位活頁簿	*.xlsb
xlExcel2	16	Excel 2.0 版 (1987)	*.xls
xlExcel2FarEast	7	Excel 2.0 遠東版 (1987)	*.xls
xlExcel3	29	Excel 3.0 版 (1990)	*.xls
xlExcel4	33	Excel 4.0 版 (1992)	*.xls
xlExcel4Workbook	35	Excel 4.0 版活頁簿格式 (1992)	*.xlw
xlExcel5	39	Excel 5.0 版 (1994)	*.xls
xlExcel7	39	Excel 95 (7.0 版)	*.xls
xlExcel8	56	Excel 97-2003 活頁簿	*.xls
xlExcel9795	43	Excel 95 與 97 版	*.xls
xlHtml	44	HTML 格式	.htm；.html
xlIntlAddIn	得到	國際增益集	沒有副檔名
xlIntlMacro	0.25	國際巨集	沒有副檔名
xlOpenDocumentSpreadsheet	60	OpenDocument 試算表	*.ods
xlOpenXMLAddIn	55	開啟 XML 增益集	*.xlam
xlOpenXMLStrictWorkbook	61 (&H3D)	Strict Open XML 檔案	*.xlsx
xlOpenXMLTemplate	54	開啟 XML 範本	*.xltx
xlOpenXMLTemplateMacroEnabled	53	開啟 Open XML 範本巨集啟用	*.xltm
xlOpenXMLWorkbook	51	開啟 XML 活頁簿	*.xlsx
xlOpenXMLWorkbookMacroEnabled	52	開啟 XML 活頁簿巨集啟用	*.xlsm
xlSYLK	第	符號連結格式	*.slk
xlTemplate	17	Excel 範本格式	*.xlt
xlTemplate8	17	範本 8	*.xlt
xlTextMac	19	Macintosh 文字	*.txt
xlTextMSDOS	21	MSDOS 文字	*.txt
xlTextPrinter	36	印表機文字	*.prn
xlTextWindows	共	Windows 文字	*.txt
xlUnicodeText	42	Unicode 文字	沒有副檔名；*.txt
xlWebArchive	45	Web 封存	.mht；.mhtml
xlWJ2WD1	14	日文 1-2-3	*.wj2
xlWJ3	40	日文 1-2-3	*.wj3
xlWJ3FJ3	41	日文 1-2-3 格式	*.wj3
xlWK1	5	Lotus 1-2-3 格式	*.wk1
xlWK1ALL	加	Lotus 1-2-3 格式	*.wk1
xlWK1FMT	大約	Lotus 1-2-3 格式	*.wk1
xlWK3	15	Lotus 1-2-3 格式	*.wk3
xlWK3FM3	32	Lotus 1-2-3 格式	*.wk3
xlWK4	38	Lotus 1-2-3 格式	*.wk4
xlWKS	4	Lotus 1-2-3 格式	*.wks
xlWorkbookDefault	51	預設活頁簿	*.xlsx
xlWorkbookNormal	-4143	一般活頁簿	*.xls
xlWorks2FarEast	日	Microsoft Works 2.0 遠東格式	*.wks
xlWQ1	34	Quattro Pro 格式	*.wq1
xlXMLSpreadsheet	46	XML 試算表	*.xml

2022年1月23日星期日

Poor SQL 線上排版

https://poorsql.com

2022年1月19日星期三

在Delphi中打印各种已知类型的文件

uses shellapi, printers;

procedure PrintDocument(const documentToPrint : string) ;
var
printCommand : string;
printerInfo : string;
Device, Driver, Port: array[0..255] of Char;
hDeviceMode: THandle;
begin
if Printer.PrinterIndex = cboPrinter.ItemIndex then
begin
printCommand := 'print';
printerInfo := '';
end
else
begin
printCommand := 'printto';
Printer.PrinterIndex := cboPrinter.ItemIndex;
Printer.GetPrinter(Device, Driver, Port, hDeviceMode) ;
printerInfo := Format('"%s" "%s" "%s"', [Device, Driver, Port]) ;
end;

ShellExecute(Application.Handle,

PChar(printCommand),

PChar(documentToPrint),

PChar(printerInfo),

nil,

SW_HIDE) ;
end;

轉貼: http://blog.sina.com.cn/s/blog_67da41590100y4pr.html

2021年12月29日星期三

Flutter DropdownButton / DropdownButtonFormField 下拉選單

DropdownButton

import 'package:flutter/material.dart';

class dropdownButton extends StatefulWidget {
  @override
  _dropdownButtonState createState() => _dropdownButtonState();
}

class _dropdownButtonState extends State<dropdownButton> {
  List<DropdownMenuItem<String>> listDrop = [];
  String selected = "1";

  void loadData() {
    listDrop = [];
    listDrop.add(DropdownMenuItem(child: Text("item 1"), value: "1"));
    listDrop.add(DropdownMenuItem(child: Text("item 2"), value: "2"));
    listDrop.add(DropdownMenuItem(child: Text("item 3"), value: "3"));
    listDrop.add(DropdownMenuItem(child: Text("item 4"), value: "4"));
    listDrop.add(DropdownMenuItem(child: Text("item 5"), value: "5"));
  }

  @override
  Widget build(BuildContext context) {
    loadData();

    return Scaffold(
        body: Center(
      child: Column(children: [
        DropdownButton(
          dropdownColor: Colors.amber,
          style: TextStyle(color: Colors.white,),
          icon: Icon(Icons.arrow_drop_down_circle),
          elevation: 36,
          items: listDrop,
          value: selected,
          hint: Text("Select item..."),
          onChanged: (String? newValue) {
            setState(() {
              selected = newValue!;
            });
          },
        ),
      ]),
    ));
  }
}

DropdownButtonFormField

import 'package:flutter/material.dart';
import 'package:untitled/Constants.dart';

class dropdownButton extends StatefulWidget {
  @override
  _dropdownButtonState createState() => _dropdownButtonState();
}

class _dropdownButtonState extends State<dropdownButton> {
  List<DropdownMenuItem<String>> listDrop = [];
  String selected = "1";

  void loadData() {
    listDrop = [];
    listDrop.add(DropdownMenuItem(child: Text("item 1"), value: "1"));
    listDrop.add(DropdownMenuItem(child: Text("item 2"), value: "2"));
    listDrop.add(DropdownMenuItem(child: Text("item 3"), value: "3"));
    listDrop.add(DropdownMenuItem(child: Text("item 4"), value: "4"));
    listDrop.add(DropdownMenuItem(child: Text("item 5"), value: "5"));
  }

  @override
  Widget build(BuildContext context) {
    loadData();

    void Function() Button_OnClick = () {
      Navigator.pop(context);
    };

    return Scaffold(
      backgroundColor: appGreyColor,
        body: Center(
      child: Column(children: [
        DropdownButtonFormField(
          decoration: InputDecoration(
            icon: Icon(Icons.bug_report),
            labelText: "Select item...",
            labelStyle: TextStyle(
              color: Colors.black,
            ),
            contentPadding: EdgeInsets.fromLTRB(20.0, 10.0, 20.0, 10.0),
            border: OutlineInputBorder(
              borderRadius: BorderRadius.circular(32.0),
            ),
            hintStyle: TextStyle(
              color: Colors.white,
            ),
          ),
          style: TextStyle(
            color: Colors.white,
          ),
          items: listDrop,
          onChanged: (String? newValue) {
            setState(() {
              selected = newValue!;
            });
          },
          dropdownColor: appBackgroundGreyColor,
          icon: Icon(Icons.arrow_drop_down_circle, color: Colors.white,),
        ),
      ]),
    ));
  }
}

2021年12月24日星期五

Flutter 返回上一頁

Navigator.pop(context);

2021年12月16日星期四

Flutter warning: [deprecation] get(int,int) in CamcorderProfile has been deprecated 排除

warning: [deprecation] get(int,int) in CamcorderProfile has been deprecated 排除

compileSdkVersion = 31
targetSdkVersion = 31

截錄:

[Camera] CamcorderProfile deprecated in Android API level 31

Flutter Error: Cannot run with sound null safety, because the following dependencies 排除

Error: Cannot run with sound null safety, because the following dependencies

Copy: --no-sound-null-safety

截錄

Cannot run with sound null safety because dependencies don't support null safety

訂閱：文章 (Atom)

2022年11月29日 星期二

2022年10月4日 星期二

2022年8月17日 星期三

2022年8月10日 星期三

2022年8月2日 星期二

2022年7月27日 星期三

2022年7月25日 星期一

2022年6月15日 星期三

2022年5月26日 星期四

2022年4月19日 星期二

2022年4月12日 星期二

XlFileFormat 列舉 (Excel)

2022年1月23日 星期日

2022年1月19日 星期三

2021年12月29日 星期三

DropdownButton

DropdownButtonFormField

2021年12月24日 星期五

2021年12月16日 星期四

截錄

2022年11月29日星期二

2022年10月4日星期二

2022年8月17日星期三

2022年8月10日星期三

2022年8月2日星期二

2022年7月27日星期三

2022年7月25日星期一

2022年6月15日星期三

2022年5月26日星期四

2022年4月19日星期二

2022年4月12日星期二

2022年1月23日星期日

2022年1月19日星期三

2021年12月29日星期三

2021年12月24日星期五

2021年12月16日星期四