Eh tahu gak ? kenapa orang ato perusahaan ato institusi ato dll.. ato lowongan kerja kalo ngomong soal dot Net selalu ke arah VB, C# .. dsb
emang pada ga tahu yah kalo pake delphi juga bisa ?? coba kasih tahu saya, apa yg tidak bisa dilakukan untuk pemrograman dot net framework dengan delphi ??
pembaca tahu ga bagaimana dotnet framework bekerja ? (saya ga tahu lho .. tak baca dulu deh..!! ).
Pernahkah anda berpikir, bagaimana membuat listview dengan tampilan data per group?
Seperti terlihat pada explorer windows XP?, mari kita ikuti caranya sebagai berikut ..
unit LVGroup;
interface
uses
Windows, SysUtils, Classes, Controls, ComCtrls, commctrl;
Type
TLVGroup = class(TCustomListView)
public
published
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(‘heruX’, [TLVGroup]);
end;
end.
Tambahkan constanta untuk listview message
const
LVM_ENABLEGROUPVIEW = LVM_FIRST + 157; // Nilai message utk enable/ disable
LVM_INSERTGROUP = LVM_FIRST + 145; //
LVIF_GROUPID = $0100;
LVGF_HEADER = $00000001;
LVGF_ALIGN = $00000008;
LVGF_GROUPID = $00000010;
LVGA_HEADER_LEFT = $00000001;
LVGA_HEADER_CENTER = $00000002;
LVGA_HEADER_RIGHT = $00000004;
kemudian tambahkan pada seciton Type record seperti ini
type
TLVG = record
cbSize: UINT;
mask: UINT;
pszHeader: LPWSTR;
cchHeader: Integer;
pszFooter: LPWSTR;
cchFooter: Integer;
iGroupIdL: Integer;
stateMask: UINT;
state: UINT;
uAlign: UINT;
end;
Sebelumnya tambahkan unit commctrls yah ..
nah sekarang tinggal kita tambahkan method pada section public ato kalo mo jadiin property juga boleh.
public
function IsLVGrouped(Yup: Boolean): Boolean;
procedure MakeGroup(GroupName: PWidechar; GroupID: Integer);
dan ..
function TLVGroup.IsLVGrouped(Yup: Boolean): Boolean;
begin
if Yup = True
then begin
SendMessage(Handle, LVM_ENABLEGROUPVIEW, 1, 0);
Result := true;
end else begin
Result := false;
SendMessage(Handle, LVM_ENABLEGROUPVIEW, 0, 0);
end;
end;
procedure TLVGroup.MakeGroup(GroupName: PWidechar; GroupID: Integer);
var
LvGroup: TLVG;
begin
FillChar(LvGroup, SizeOf(TLVG), 0);
with LvGroup do
begin
cbSize := SizeOf(TLVG);
mask := LVGF_HEADER or LVGF_ALIGN or LVGF_GROUPID;
pszHeader := GroupName;
cchHeader := Length(LvGroup.pszHeader);
iGroupIdL := GroupID;
uAlign := LVGA_HEADER_LEFT;
end;
SendMessage(Handle, LVM_INSERTGROUP, GroupID, Longint(@LvGroup));
end;
dan listing lengkap nya adalah …
Wah ... gabungin sendiri aja yah?? bisa khan.. males nih kalo kepanjangan!!!
udah gitu ajah. eh..lupa kalo hasilnya ga sesuai perkiraan tambahin komponen XPMan yah ..
ini khan buat xp ajah !!
property TCustomListView di published juga yah .. bisa donk ??!!
Daripada enggak sempat-sempat nerusin.. aku coba masukin blog deh. siapa tahu ada yg mo nerusin.
Component ini menggunakan fungsi dari komponen synaser, jadi anda membutuhkannya untuk install pada delphi.
AT Command saya ambil dari document Nokia.
untuk pertanyaan silakan pake comment ajah yah.
unit smsgateaway;(************************************************************ TSmsGateAway Component (Freeware Delphi Component) HeruX Sms GateAway Component created by: (C)2008. Heru Susanto (herux delphi-id) email: herux.igsw@yahoo.com as THXvidfwin on HeruX palette u can use, modified or redistribute this class... but don't forget my name... of course there is a lot of bug, but i don't have much time. so may be u ... ************************************************************) interface uses SysUtils, Classes, SynaSer, Windows, DesignIntf, StrUtils, TypInfo; const sOK = #$D#$A'OK'#$D#$A; sERROR = #$D#$A'ERROR'#$D#$A; Eq = '='; Qask = '?'; ATCommand = 'AT'; PLUS = '+'; //* Format message in PDU or Text if supported !! MFormatCommandResult = PLUS+'CMGF'; MFormatCommand = ATCommand+MFormatCommandResult; MFormatSupp = MFormatCommand+Eq+Qask; MFormatPDU = MFormatCommand+Eq+'0'; MFormatText = MFormatCommand+Eq+'1'; //* Write message to device memory WriteMtoMemCommandResult= PLUS+'CMGW'; WriteMtoMemCommand = ATCommand+WriteMtoMemCommandResult; WriteMtoMemResp = ATCommand+WriteMtoMemCommandResult+Eq; WriteMtoMemText = ''; //* List message ListMessageCommandResult= PLUS+'CMGL'; ListMessageCommand = ATCommand+ListMessageCommandResult; MessageSpec : array[0..4] of string[11] = ('REC UNREAD','REC READ','STO UNSENT','STO SENT','ALL'); type TMessFormat = (mfPDU, mfTEXT); TCfgParity = (cpNone, cpOdd, cpEven, cpMark, cpSpace); TMessageSpec = (msRECUNREAD, msRECREAD, msSTOUNSENT, msSTOSENT, msALL); TSmsgateaway = class(TComponent) private FConnected : Boolean; serialcomm : TBlockSerial; FBaud : Integer; FBits : Integer; FParity : TCfgParity; FSoftFlow : Boolean; FHardFlow : Boolean; FPort : String; FMessFormat : TMessFormat; FMessageSpecs: TMessageSpec; function GetMessageSpec: TMessageSpec; procedure SetMessageSpec(Value: TMessageSpec); function GetConnected: Boolean; procedure SetConnected(Value: Boolean); procedure Connecting; function GetMessFormat:TMessFormat; procedure SetMessFormat(Value: TMessFormat); procedure SetBaud(Value: Integer); function GetBaud: Integer; procedure SetBits(Value: Integer); function GetBits: Integer; Procedure SetParity(Value: TCfgParity); function GetParity: TCfgParity; function ParityChar: Char; Procedure SetPort(Value: String); function GetPort: String; procedure EnumComPorts(Ports: TStrings); function GetMessageSpecStr(MessSpec: TMessageSpec): String; function GetMessageSpecInt(MessSpec: TMessageSpec): Integer; protected function JmlKataA(Kalimat: string; Out DaftarKata: TStringList): Longint; procedure PreComCondition; public MessagesCon : String; constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetSmsStr:String; function ListWord: TStrings; function SmsCount(MessSpec: TMessageSpec): Integer; published property Baud: Integer read GetBaud write SetBaud default 19200; property Bits: Integer read GetBits write SetBits default 8; property Parity: TCfgParity read GetParity write SetParity default cpNone; property SoftFlow : Boolean read FSoftFlow write FSoftFlow default False; property HardFlow : Boolean read FHardFlow write FHardFlow default True; property Port : String read GetPort write SetPort; property Connected : Boolean read FConnected write SetConnected default False; property MessFormat : TMessFormat read GetMessFormat write SetMessFormat; property MessageSpecS : TMessageSpec read GetMessageSpec write SetMessageSpec; end; procedure Register; implementation procedure Register; begin RegisterComponents('Herux', [TSmsgateaway]); RegisterPropertyInCategory('Config',TSmsgateaway,'Port'); RegisterPropertyInCategory('Config',TSmsgateaway,'Baud'); RegisterPropertyInCategory('Config',TSmsgateaway,'Bits'); RegisterPropertyInCategory('Config',TSmsgateaway,'Parity'); RegisterPropertyInCategory('Config',TSmsgateaway,'SoftFlow'); RegisterPropertyInCategory('Config',TSmsgateaway,'HardFlow'); end; { TSmsgateaway } function TSmsgateaway.GetConnected: Boolean; begin Result := FConnected; end; procedure TSmsgateaway.SetConnected(Value: Boolean); begin FConnected := Value; if FConnected then Connecting; end; procedure TSmsgateaway.SetMessageSpec(Value: TMessageSpec); begin if FMessageSpecs <> Value then FMessageSpecs := Value; end; procedure TSmsgateaway.SetMessFormat(Value: TMessFormat); var ErrCode: String; begin if FConnected then begin try serialcomm := TBlockSerial.Create; serialcomm.RaiseExcept := True; serialcomm.Connect(FPort); serialcomm.Config(FBaud,FBits,ParityChar,0,FSoftFlow,FHardFlow); case Value of mfPDU : ErrCode := serialcomm.ATCommand(MFormatPDU); mfTEXT : ErrCode := serialcomm.ATCommand(MFormatText); end; if ErrCode = sERROR then raise EPropertyError.Create('Your device did not support that format'); if ErrCode = sOK then FMessFormat := Value; finally serialcomm.Free; end; end; end; procedure TSmsgateaway.EnumComPorts(Ports: TStrings); var KeyHandle: HKEY; ErrCode, Index: Integer; ValueName, Data: string; ValueLen, DataLen, ValueType: DWORD; TmpPorts: TStringList; begin ErrCode := RegOpenKeyEx( HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM', 0, KEY_READ, KeyHandle); if ErrCode <> ERROR_SUCCESS then begin Ports.Clear; Exit; end; TmpPorts := TStringList.Create; try Index := 0; repeat ValueLen := 256; DataLen := 256; SetLength(ValueName, ValueLen); SetLength(Data, DataLen); ErrCode := RegEnumValue( KeyHandle, Index, PChar(ValueName), {$IFDEF DELPHI_4_OR_HIGHER} Cardinal(ValueLen), {$ELSE} ValueLen, {$ENDIF} nil, @ValueType, PByte(PChar(Data)), @DataLen); if ErrCode = ERROR_SUCCESS then begin SetLength(Data, DataLen); TmpPorts.Add(Data); Inc(Index); end until (ErrCode <> ERROR_SUCCESS) ; TmpPorts.Sort; Ports.Assign(TmpPorts); finally RegCloseKey(KeyHandle); TmpPorts.Free; end; end; procedure TSmsgateaway.SetBaud(Value: Integer); begin FBaud := Value; end; procedure TSmsgateaway.SetBits(Value: Integer); begin FBits := Value; end; procedure TSmsgateaway.SetParity(Value: TCfgParity); begin FParity := Value; end; procedure TSmsgateaway.SetPort(Value: String); begin if Value <> FPort then begin if FConnected and not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then begin FConnected := False; FPort := Value; FConnected := True; end; end; end; function TSmsgateaway.SmsCount(MessSpec: TMessageSpec): Integer; begin end; function TSmsgateaway.GetMessFormat: TMessFormat; var Res : String; StrList: TStringList; begin try serialcomm := TBlockSerial.Create; serialcomm.RaiseExcept := True; StrList := TStringList.Create; serialcomm.Connect(FPort); serialcomm.Config(FBaud,FBits,ParityChar,0,FSoftFlow,FHardFlow); Res := serialcomm.ATCommand(MFormatCommand+Qask); if JmlKataA(Res,StrList) = 3 then begin if StrList.ValueFromIndex[1] = '1' then Result := mfTEXT else Result := mfPDU; end; StrList.Free; finally serialcomm.Free; end; end; function TSmsgateaway.GetParity: TCfgParity; begin Result := FParity; end; function TSmsgateaway.GetPort: String; begin Result := FPort; end; function TSmsgateaway.ParityChar: Char; begin Result := 'N'; case FParity of cpNone : Result := 'N'; cpOdd : Result := 'O'; cpEven : Result := 'E'; cpMark : Result := 'M'; cpSpace : Result := 'S'; end; end; procedure TSmsgateaway.PreComCondition; begin serialcomm.Connect(FPort); serialcomm.Config(FBaud,FBits,ParityChar,0,FSoftFlow,FHardFlow); end; function TSmsgateaway.GetBaud: Integer; begin Result := FBaud; end; function TSmsgateaway.GetBits: Integer; begin Result := FBits; end; procedure TSmsgateaway.Connecting; begin try serialcomm := TBlockSerial.Create; serialcomm.RaiseExcept := True; serialcomm.Connect(FPort); serialcomm.Config(FBaud,FBits,ParityChar,0,FSoftFlow,FHardFlow); MessagesCon := serialcomm.ATCommand('AT'); if (serialcomm.LastError <> 0) or (not serialcomm.ATResult) then begin FConnected := False; raise EPropertyError.Create('Communication error or modem cannot be connected '+#13 +'please.. Check the port ?'); end else FConnected := True; finally serialcomm.Free; end; end; constructor TSmsgateaway.Create(AOwner: TComponent); begin inherited create(AOwner); FBaud := 19200; FBits := 8; FParity := cpNone; FSoftFlow := False; FHardFlow := True; FPort := 'COM5'; FConnected := False; FMessFormat := GetMessFormat; end; destructor TSmsgateaway.Destroy; begin inherited; end; function TSmsgateaway.GetSmsStr: String; begin if FConnected = True then begin try serialcomm := TBlockSerial.Create; serialcomm.RaiseExcept := True; serialcomm.Connect(FPort); serialcomm.Config(FBaud,FBits,ParityChar,0,FSoftFlow,FHardFlow); case FMessFormat of mfTEXT : begin if serialcomm.ATCommand(MFormatCommand+Eq+'1') <> sERROR then Result := serialcomm.ATCommand(ListMessageCommand+Eq+'"'+GetMessageSpecStr(FMessageSpecs)+'"') else Result := 'The modem is not support in TEXT mode'; end; mfPDU : begin if serialcomm.ATCommand(MFormatCommand+Eq+'0') <> sERROR then Result := serialcomm.ATCommand(ListMessageCommand+Eq+'"'+IntToStr(GetMessageSpecInt(FMessageSpecs))+'"') else Result := 'The modem is not support in PDU mode'; end; end; finally serialcomm.Free; end; end; end; function TSmsgateaway.GetMessageSpec: TMessageSpec; begin Result := FMessageSpecs; end; function TSmsgateaway.GetMessageSpecInt(MessSpec: TMessageSpec): Integer; begin Result := 0; case MessSpec of msRECUNREAD : Result := 0; msRECREAD : Result := 1; msSTOUNSENT : Result := 2; msSTOSENT : Result := 3; msALL : Result := 4; end; end; function TSmsgateaway.GetMessageSpecStr(MessSpec: TMessageSpec): String; begin Result := Qask; case MessSpec of msRECUNREAD : Result := MessageSpec[0]; msRECREAD : Result := MessageSpec[1]; msSTOUNSENT : Result := MessageSpec[2]; msSTOSENT : Result := MessageSpec[3]; msALL : Result := MessageSpec[4]; end; end; function TSmsgateaway.JmlKataA(Kalimat: string; Out DaftarKata: TStringList): Longint; function TandaBaca(Tanda: Char): Boolean; begin Result := Tanda in [#0..#$1F, ' ', '.', ',', '?', ';','"']; end; var Ix: Word; JmlKata: Longint; Hrf: String; begin JmlKata := 0; Ix := 1; while Ix <= Length(Kalimat) do begin while (Ix <= Length(Kalimat)) and (TandaBaca(Kalimat[Ix])) do Inc(Ix); if Ix <= Length(Kalimat) then begin Inc(JmlKata); while (Ix <= Length(Kalimat)) and (not TandaBaca(Kalimat[Ix])) do begin Hrf := Hrf+Kalimat[Ix]; Inc(Ix); end; if Hrf <> '' then DaftarKata.Add(Hrf); Hrf := ''; end; end; Result := JmlKata; end; function TSmsgateaway.ListWord: TStrings; begin end; end.
Silakan kembangkan… baca help WinAPI bawaan delphi 7
unit HXvidfwin; (************************************************************ THXvidfwin Component (Freeware Delphi Component) HeruX video for window class created by: (C)2008. Heru Susanto (herux delphi-id) email: herux.igsw@yahoo.co.id as THXvidfwin on HeruX palette u can use, modified or redistribute this class... but don't forget my name... of course there is a lot of bug, but i don't have much time. so may be u ... ************************************************************) interface uses SysUtils, Classes, Messages, Windows, ExtCtrls, TypInfo, Controls; type PVOID = Pointer; {$EXTERNALSYM PVOID} LONG = Longint; {$EXTERNALSYM LONG} PLONG = ^LONG; {$EXTERNALSYM PLONG} int = Integer; {$EXTERNALSYM int} const WM_CAP_START = WM_USER; WM_CAP_SEQUENCE = WM_CAP_START + 62; WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10; WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11; WM_CAP_SET_PREVIEW = WM_CAP_START + 50; WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52; WM_CAP_SET_SCALE = WM_CAP_START + 53; type THXvidfwin = class(TComponent) private FStartVideo: Boolean; FLayar: TPanel; hwndc: HWND; Ffps: Integer; FOnLayarMouseDown: TMouseEvent; function AVICapSendMess(Hnd: HWND; Msg: Cardinal; wParam: int; lParam: int): DWORD; function capDriverConnect(Hnd: HWND; i: int): Boolean; function capDriverDisconnect(Hnd: HWND): Boolean; function capCreateCaptureWindowA(WindowName : LPCSTR; dwStyle: DWORD; x, y: int;nWidth, nHeight: int; hwndParent: HWND; nID: int): HWND; function capPreviewScale(Hnd: HWND; f: BOOL): Boolean; function capPreviewRate(Hnd: HWND; i: int): Boolean; function capPreview(Hnd: HWND; f: BOOL): Boolean; procedure DoLayarMouseDown(var Message: TWMMouse; Button: TMouseButton; Shift: TShiftState); procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; protected procedure SetStartVideo(Value: Boolean); function GetLayar: TPanel; procedure SetLayar(Value: TPanel); function Getfps: Integer; procedure Setfps(Value: Integer); procedure LayarMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic; public constructor Create(aOwner: TComponent); destructor Destroy; property fps: Integer read Getfps write Setfps default 200; published property Layar: TPanel read GetLayar write SetLayar; property StartVideo: Boolean read fStartVideo write SetStartVideo; property OnLayarMouseDown: TMouseEvent read FOnLayarMouseDown write FOnLayarMouseDown; end; procedure Register; implementation {$R *.dcr} procedure Register; begin RegisterComponents('heruX', [THXvidfwin]); end; function capCreateCaptureWindow( lpszWindowName : LPCSTR; dwStyle : DWORD; x, y : int; nWidth, nHeight : int; hwndParent : HWND; nID : int ): HWND; stdcall; external 'avicap32' name 'capCreateCaptureWindowA'; { THXvidfwin } function THXvidfwin.AVICapSendMess(Hnd: HWND; Msg: Cardinal; wParam, lParam: int): DWORD; begin if IsWindow(Hnd) then Result := SendMessage(Hnd,Msg,wParam,lParam) else Result := 0; end; function THXvidfwin.capCreateCaptureWindowA(WindowName: LPCSTR; dwStyle: DWORD; x, y, nWidth, nHeight: int; hwndParent: HWND; nID: int): HWND; begin Result := capCreateCaptureWindow(WindowName, dwStyle, x, y, nWidth, nHeight, hwndParent, nID); end; function THXvidfwin.capDriverConnect(Hnd: HWND; i: int): Boolean; begin Result := AVICapSendMess(Hnd,WM_CAP_DRIVER_CONNECT,i,0) <> 0; end; function THXvidfwin.capDriverDisconnect(Hnd: HWND): Boolean; begin Result := AVICapSendMess(Hnd,WM_CAP_DRIVER_DISCONNECT, 0, 0) <> 0; end; function THXvidfwin.capPreview(Hnd: HWND; f: BOOL): Boolean; begin Result := AVICapSendMess(Hnd,WM_CAP_SET_PREVIEW,wPARAM(f),0) <> 0; end; function THXvidfwin.capPreviewRate(Hnd: HWND; i: int): Boolean; begin Result := AVICapSendMess(Hnd,WM_CAP_SET_PREVIEWRATE,i,0) <> 0; end; function THXvidfwin.capPreviewScale(Hnd: HWND; f: Bool): Boolean; begin Result := AVICapSendMess(Hnd,WM_CAP_SET_SCALE,wParam(f),0) <> 0; end; constructor THXvidfwin.Create(aOwner: TComponent); begin inherited Create(aOwner); ffps := 200; end; destructor THXvidfwin.Destroy; begin if fStartVideo = True then fStartVideo := False; Destroy; end; procedure THXvidfwin.DoLayarMouseDown(var Message: TWMMouse; Button: TMouseButton; Shift: TShiftState); begin with Message do LayarMouseDown(Button,Shift, XPos, YPos); //KeysToShiftState(Keys) + end; function THXvidfwin.Getfps: Integer; begin Result := ffps; end; function THXvidfwin.GetLayar: TPanel; begin Result := fLayar; end; procedure THXvidfwin.LayarMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Assigned(FOnLayarMouseDown) then FOnLayarMouseDown(FLayar,Button,Shift,x,y); end; procedure THXvidfwin.Setfps(Value: Integer); begin if Value <> ffps then begin ffps := Value; Updated; end; end; procedure THXvidfwin.SetLayar(Value: TPanel); begin fLayar := Value; end; procedure THXvidfwin.SetStartVideo(Value: Boolean); begin if (fLayar <> nil) and (Value = True) then try hwndc := capCreateCaptureWindowA('Video',WS_CHILD + WS_VISIBLE, 5, 5, Layar.Width-10, Layar.Height-10, Layar.Handle,1); capDriverConnect(hwndc,0); capPreviewScale(hwndc,true); capPreviewRate(hwndc,ffps); finally capPreview(hwndc,True); end; if Value = False then capDriverDisconnect(hwndc); end; procedure THXvidfwin.WMLButtonDown(var Message: TWMLButtonDown); begin inherited; DoLayarMouseDown(Message, mbLeft, []); end; end.
Herux's Weblog 