2012/03/31

Use Thread to open ADO


type
  TOpenQuery = Class(TThread)
  Public
     constructor Create(Q: TADOQuery;sSQL: String);
  protected
     tQry: TADOQuery;
     tSQL: String;
     procedure Execute; override;
  end;

{ TOpenQuery }

constructor TOpenQuery.Create(Q: TADOQuery; sSQL: String);
begin
  inherited Create(False);

  FreeOnTerminate:=True;
  tQry:=Q;
  tSQL:=sSQL;
end;

procedure TOpenQuery.Execute;
begin
  inherited;

  Screen.Cursor:=crAppStart;
  with tQry do Begin
     SQL.Text:=tSQL;
     Open;
  End;

  Screen.Cursor:=crDefault;
end; 

2012/03/21

Delphi XE 的 ZIP 實現方法

圖片來源


連結:将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/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」來搜尋「說明及支援中心」。
  1. 按一下 [開始],再按一下 [執行],輸入 cmd,然後按一下 [確定]
  2. 確認您是位於想要存取的 [System Volume Information] 資料夾所在的磁碟分割的根目錄下。 例如,假設您要存取 C:\System Volume Information 資料夾,請確認您是位於磁碟機 C 的根目錄下 (在「C:\」命令提示字元下)。
  3. 輸入下面這行命令,然後按 ENTER:
    cacls "driveletter:\System Volume Information" /E /Gusername:F
    請務必按上述方式輸入引號。這個命令會將具有「完全控制」權限的指定使用者新增到這個資料夾。
  4. 按兩下根目錄下的 [System Volume Information] 資料夾,開啟這個資料夾。
  5. 如果您需要在疑難排解完成後移除這些權限,請在命令提示字元輸入以下這行命令:
    cacls "driveletter:\System Volume Information" /E /Rusername
    這個命令會移除指定使用者的所有權限。