大匠之風: 3月 2012

2012/03/31

2012/03/21

連結：将Delphi Xe2的Zip单元移植了一份到Delphi Xe上

再利用万一博客的這篇文章，就可以再加上進度條了！

给 System.Zip 增加了个(多文件解压时的)解压进度事件

2015/12/22 補充：
Delphi XE 使用 XE2 移轉過來的 System.Zip，在使用上雖然能壓縮，但卻無法被 Zip 解壓縮程式直接打開 (正確來說是壓縮檔毀損)。

哼哼……原來還有藏一手啊……

在比對 XE2 的原始碼後，經過調整，總算是能夠正確使用，真是謝謝前人的努力！

2012/03/20

使StringGrid中的一列具有Check功能，和CheckBox效果一樣

從CSDN上找到的，感覺還不錯
來源：在StringGrid控件的单元格中动态插入CheckBox？

{//***********************************

  使StringGrid中的一列具有Check功能，和CheckBox效果一樣

//***********************************}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids;

type
  TForm1 = class(TForm)
    grid: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure gridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure gridClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  fcheck, fnocheck: tbitmap;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  bmp: TBitmap;
begin
  FCheck := TBitmap.Create;
  FNoCheck := TBitmap.Create;
  bmp := TBitmap.create;
  try
    bmp.handle := LoadBitmap(0, PChar(OBM_CHECKBOXES));
    with FNoCheck do
    begin
      width := bmp.width div 4;
      height := bmp.height div 3;
      canvas.copyrect(canvas.cliprect, bmp.canvas, canvas.cliprect);
    end;
    with FCheck do
    begin
      width := bmp.width div 4;
      height := bmp.height div 3;
      canvas.copyrect(
        canvas.cliprect,
        bmp.canvas,
        rect(width, 0, 2 * width, height));
    end;
  finally
    bmp.free
  end;

end;

procedure TForm1.gridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if not (gdFixed in State) then
    with TStringGrid(Sender).Canvas do
    begin
      brush.Color := clWindow;
      FillRect(Rect);
      if Grid.Cells[ACol, ARow] = 'yes ' then
        Draw((rect.right + rect.left - FCheck.width) div 2,
          (rect.bottom + rect.top - FCheck.height) div 2,
          FCheck)
      else
        Draw((rect.right + rect.left - FCheck.width) div 2,
          (rect.bottom + rect.top - FCheck.height) div 2,
          FNoCheck);
    end;

end;

procedure TForm1.gridClick(Sender: TObject);
begin
  if grid.Cells[grid.col, grid.row] = 'yes ' then
    grid.Cells[grid.col, grid.row] := 'no '
  else
    grid.Cells[grid.col, grid.row] := 'yes ';
end;

end.

2012/03/15

[轉]datasnap中如何修改ADOconnection的连接字串

[求助]datasnap中如何修改ADOconnection的连接字串。。
DELPHI DATASNAP 2010 入门操作(2)不写一行代码，绿色三层我也行

摘錄
Q. 因为作业原因，看了这篇文章，实现了最简单的三层。（局域网的datasnap sever：服务器是unit1+ServerMethodsUnit1+ServerContainerUnit1）
http://www.cnblogs.com/zhqian/archive/2010/07/06/1771798.html

后来把里面的ADOTable改成ADOquery,ADOconnection的相关设置修改了，做了个可执行条件查询的服务端，简单的三层就做好了。考虑到程序的灵活性，又设置了客户端的连接IP配置在ini文件中，客户端配置好，就剩下服务器的灵活性了，可是发现了个问题，不知道怎么才能修改ServerMethodsUnit1中的ADOconnection1的连接字串，在unit1中uses了ServerMethodsUnit1也不能引用到ADOconnection1。。。

A. 把adoconnection放在另一个单元，比如form，然后在ServerMethodsUnit中uses form的单元，就行
现在在form下的adoconn随你怎么弄了

=========================================
討論區的結局是成功的，但我還沒試過，有時間再來玩玩

2012/03/13

Delphi XE 出現 zlib 缺 xx.obj 時的處理

到 delphi zlib » current version 下載最新的版本

2012/03/07

Delphi 中 SendMessage 使用技巧

作者：吳祐賓

2024/02/19 更新

VCL 最厲害的地方是將 Windows 完美的封裝成易用的框架，又保留 Windows Message 事件機制的處理方式。在 2012 年我還在使用 C++ Builder 就曾為了學習 SendMessage 技巧而吃了很多苦頭。2024 年再回頭看這份【Delphi中SendMessage使用技巧】文件，發現原文來源網址已失效。在網路上搜尋到的資料都沒有標記來源，盜文嚴重程度可見一般。這份文件到現在仍然可以使用，作為 Windows API 的入門仍然很有價值，我整理這份文件的重點如下。

使用 SendMessage 向元件發送 Message

VCL 容器元件如 ListBox, ComboBox 等，其寬度屬於靜度設定。有時畫面在排列時需要將容器元件寬度調得很窄，但呼叫下拉清單時則寬度需要隨 item 最大長度配合調整。這種情況就很適合 SendMessage 處理。

先取得下拉清單項目的最大長度，再使用 SendMessage 對下拉清單傳遞 CB_SETDROPPEDWIDTH 及寬度值，就可以滿足預期顯示的效果。如下圖顯示。

左邊是原始 VCL 元件效果，右邊是搭配 SendMessage 傳遞寬度值的效果

部份程式碼如下所示

begin
  i := 0; // 清單計數器
  MaxWidth := 0;
  //讀 LastName 清單到 ComboBox.Items
  ComboBox1.Clear;
  Table1.First;
  while not Table1.Eof do begin
    ComboBox1.Items.add(Table1LastName.AsString);
    LWidth := ComboBox1.Font.Size * Length(ComboBox1.Items[i]);
    if LWidth > MaxWidth then
      MaxWidth := LWidth; //找出最大值
    Table1.Next;
    i := i + 1;
  end;
  ComboBox1.Text := ComboBox1.Items[0];
  //傳遞 Message 以改變顯示區域的寬度
  SendMessage(ComboBox1.Handle, CB_SETDROPPEDWIDTH, MaxWidth, 0);
end;

把 Button 變成 RadioButton

利用 SendMessage API 還可以實現一些有趣效果，例如在 Button 的 Click 事件添加下列指令，就可以在按下按鈕後看到按鈕 UI 的變化。

SendMessage(TButton(Sender).Handle, BM_SETSTYLE, BS_RADIOBUTTON, 1);

【同場加映】自定接收 Message 方法

對元件的操作大多是不會經過 TForm 傳遞的，而是直接對該元件直接觸發，Windows 這樣的設計目的在於程式操作的體驗會比較好。以 ListBox 元件為例，它沒有封裝清單滾動事件，但內部仍然有滾動事件的處理，此時就可以干涉元件內部的滾動事件處理。步驟如下：

1. 繼承 TListBox 元件為 TMyListBox，並重載 WndProc 方法

    TMyListBox=class(TListBox)
    private
      procedure WndProc(var Msg: TMessage); override; //重載 WndProc，處理所有傳遞到元件的 Message
    end;

TMessage 為 record 型別，包含 Message Code 和 Param

2. WndProc 事件加入對滾動事件的處理

procedure TMyListBox.WndProc(var Msg: TMessage);
begin
  if (Msg.Msg = WM_VSCROLL) and (Msg.WParamLo = SB_ENDSCROLL) then
  begin
    //獲得滑鼠位置對應的列
    ItemIndex := ItemAtPos(LPoint, True);
    Form1.Edit1.Text := IntToStr(ItemIndex);
  end;

  inherited;
end;

程式接收到 WM_VSCROLL Message，且 WParamLo 參數為 SB_ENDSCROLL 時，表示 TMyListBox 已停止滾動，接著就可以用 ItemAtPos 方法確定滑鼠位置所對應的 ItemIndex。ItemAtPos 方法的 Point 參數是一個 TPoint 類別的全域變數，用於儲存滑鼠的位置。

3. 滑鼠移動時，將當前位置儲存在 TPoint 裡

procedure TForm1.ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  LPoint.X := X;
  LPoint.Y := Y;
end;

4. 建立及初始化 TMyListBox

var
  List: TMyListBox;
  i: Integer;
begin
    LPoint.X := 0;
    LPoint.Y := 0;
    //創建自定義列表框
    List := TMyListBox.Create(Form1);
    List.Parent := Form1;
    List.Left := 250;
    List.Top := 200;
    List.Width := 150;
    List.Height := 200;
    for i := 0 to 300 do
    begin
      List.Items.Add(inttostr(i)); //初始化
    end;
    //指定處理MouseMove事件的方法
    List.OnMouseMove := ListBoxMouseMove;
end;

2012/03/05

WinXP Home 如何刪除特殊系統目錄

參考來源：http://support.microsoft.com/kb/309531/zh-tw

節錄部份內容：

配合使用 NTFS 檔案系統的 Windows XP Home Edition 使用 CACLS

在使用 NTFS 檔案系統的 Windows XP Home Edition 中，您也可以使用 Cacls 工具 (一種命令列工具) 來顯示或修改檔案或資料夾存取控制清單 (ACL)。如需有關 Cacls 工具的詳細資訊 (包括其用法與參數)，請以「cacls」來搜尋「說明及支援中心」。

按一下 [開始]，再按一下 [執行]，輸入 cmd，然後按一下 [確定]。
確認您是位於想要存取的 [System Volume Information] 資料夾所在的磁碟分割的根目錄下。例如，假設您要存取 C:\System Volume Information 資料夾，請確認您是位於磁碟機 C 的根目錄下 (在「C:\」命令提示字元下)。
輸入下面這行命令，然後按 ENTER：
cacls "driveletter:\System Volume Information" /E /Gusername:F
請務必按上述方式輸入引號。這個命令會將具有「完全控制」權限的指定使用者新增到這個資料夾。
按兩下根目錄下的 [System Volume Information] 資料夾，開啟這個資料夾。
如果您需要在疑難排解完成後移除這些權限，請在命令提示字元輸入以下這行命令：
cacls "driveletter:\System Volume Information" /E /Rusername
這個命令會移除指定使用者的所有權限。

訂閱：文章 (Atom)

大匠之風

網頁

2012/03/31

Use Thread to open ADO

2012/03/21

Delphi XE 的 ZIP 實現方法

2012/03/20

使StringGrid中的一列具有Check功能，和CheckBox效果一樣

2012/03/15

[轉]datasnap中如何修改ADOconnection的连接字串

2012/03/13

Delphi XE 出現 zlib 缺 xx.obj 時的處理

2012/03/07

Delphi 中 SendMessage 使用技巧

2024/02/19 更新

使用 SendMessage 向元件發送 Message

把 Button 變成 RadioButton

【同場加映】自定接收 Message 方法

1. 繼承 TListBox 元件為 TMyListBox，並重載 WndProc 方法

2. WndProc 事件加入對滾動事件的處理

3. 滑鼠移動時，將當前位置儲存在 TPoint 裡

4. 建立及初始化 TMyListBox

2012/03/05

WinXP Home 如何刪除特殊系統目錄

配合使用 NTFS 檔案系統的 Windows XP Home Edition 使用 CACLS