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;

  end;

end;

穿著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;

輸出結果:

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

Excel Class Workbook 的 SaveAs 方法失敗

 

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

鬼影

 

洞悉真相

 

Contratiempo - 佈局(2017)

 

操作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;

  end;

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;

  end;

end;

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

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;

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 即可

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

Poor SQL 線上排版

 

https://poorsql.com

在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

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,),
        ),
      ]),
    ));
  }
}

Flutter 返回上一頁

Navigator.pop(context);

 

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