2009年5月20日 星期三

搖別人視窗是不好的事


var
hand:HWND;
r:TRect;
i:integer;
begin
hand := GetForegroundWindow;
GetWindowRect(hand , r );
for i := 0 to 4 do
begin
MoveWindow(hand,r.Left,r.Top -3,r.Right-r.Left,r.Bottom-r.Top,true ); sleep(40);
MoveWindow(hand,r.Left-3,r.Top ,r.Right-r.Left,r.Bottom-r.Top,true ); sleep(40);
MoveWindow(hand,r.Left,r.Top +3,r.Right-r.Left,r.Bottom-r.Top,true ); sleep(40);
MoveWindow(hand,r.Left+3,r.Top ,r.Right-r.Left,r.Bottom-r.Top,true ); sleep(40);
end;

2009年4月1日 星期三

字元處理轉成文字 Char to Hex byte


procedure TFVoltage.com7ReceiveData(Sender: TObject; DataPtr:
Pointer; DataSize: Cardinal);
var s : string;
i : smallint;
begin
Label1.Caption := '';
s := stringofchar(' ',DataSize);
move(dataptr^,pchar(s)^,DataSize);
for i := 0 to DataSize-1 do
begin
if (s[i]<>'') and (i>3) and (i<(DataSize-2)) then
Label1.Caption := Label1.Caption+ '[' +inttostr(strtoint('0x' +
inttohex(byte(s[i]),2)))+ '] '
else if (byte(s[i])=0) and (i>3) and (i<(DataSize-2)) then
Label1.Caption := Label1.Caption+ '[' + '0' + '] ';
end;
ListBox1.Items.Insert(0,Label1.Caption);
end;

2009年3月30日 星期一

加載字型

s := ExtractFilePath( Application.ExeName)+'font2\【華康】POP體w5.TTC';

AddFontResource(pchar(s));


在onformcreate中加入 AddFontResourceex('D:\DoulosSILR.ttf',FR_PRIVATE,nil) ;這個字型不會被其他程序所看見. AddFontResourceex('D:\DoulosSILR.ttf',FR_PRIVATE or FR_NOT_ENUM,nil) ;這個字型不會被其他程序所看見, 也不會出現在screen.fonts中, 只是可以用.

鍵盤模仿

keybd_event function

2009年3月23日 星期一

要做indy server client 端程式測試的時候,不能程式自己client call自己server ,一定要分成兩隻程式執行才會正常

base 64 encode/decode

要做base64 有兩個現成的
如果只是短句子,還是base64.pas方便
如果要做檔案 用UUCode.pas

2009年3月18日 星期三

KTOP裏看到一個數獨程式,把set 特性發揮的真好,先備一份以後可以參考

procedure TfrmMain.Button1Click(Sender: TObject);
var
Sudos: TBytes;
I, K, L, C, R: Byte;
S: array[0..2] of TByteSet;
AreaSet: array[0..8] of TByteSet;//作為比對
iCount:integer;
begin
iCount := 0;
Sudos := nil;
repeat
Done := True;
for I := 0 to 8 do AreaSet[I] := [];
FillChar(ResultTable, SizeOf(ResultTable), $FF);
for I := 0 to 80 do
begin
C := I mod 9;
R := I div 9;
K := (R div 3) * 3 + (C div 3);
S[0] := [0..8] - ColSet(C); //Column Available SudoSet 這種用法真聰明,我看不用set很難做
S[1] := [0..8] - RowSet(R); //Row Available SudoSet
S[2] := [0..8] - AreaSet[K]; //Area Available SudoSet
S[0] := S[0] * S[1] * S[2]; //Intersection: The Available SudoSet
找出集合再用暴力法try
if S[0] = [] then
begin
Done := False ;
inc(iCount);
end
else begin
Sudos := SetToBytes(S[0], 9); //Random Selection
L := Sudos[Random(Length(Sudos))];
AreaSet[K] := AreaSet[K] + [L];
ResultTable[C, R] := L;
end;
end;
until Done;

Repaint;//繪出數讀表
Caption := IntToStr(iCount);

end;

function TfrmMain.SetToBytes(ASet: TByteSet; Range: Integer): TBytes;
var
I, J: Byte;
begin
SetLength(Result, Range);
J := 0;
for I := 0 to Range-1 do
begin
if I in ASet then
begin
Result[J] := I;
ASet := ASet - [I];
Inc(J);
end;
if ASet = [] then Break;
end;
SetLength(Result, J);
end;

function TfrmMain.ColSet(Index: Integer): TByteSet;
var
I: Integer;
begin
Result := [];
for I := 0 to 8 do
if ResultTable[Index, I] <> $FF then
Result := Result + [ResultTable[Index, I]];
end;

function TfrmMain.RowSet(Index: Integer): TByteSet;
var
I: Integer;
begin
Result := [];
for I := 0 to 8 do
if ResultTable[I, Index] <> $FF then
Result := Result + [ResultTable[I, Index]];
end;