procedure CloneRecord(Dataset: TDataSet);
var
aField : Variant;
i : Integer;
begin
// Create a variant Array
aField := VarArrayCreate([0,DataSet.Fieldcount-1],VarVariant);
// read values into the array
for i := 0 to (DataSet.Fieldcount-1) do
aField[i] := DataSet.fields[i].Value ;
DataSet.Append ;
// Put array values into new the record
for i := 0 to (DataSet.Fieldcount-1) do
DataSet.fields[i].Value := aField[i] ;
end;
Friday, November 23, 2007
Clone Record (Delphi)
Diposting oleh
Jage
di
4:08 PM
3
komentar
Categorys: Delphi
Thursday, June 21, 2007
HTTP Post
Webbase application is good for any operation system,however, it's not simple to make it easy for bulk data manipulation. While, desktop application has it, easy for bulk data manipulation, user friendly and etc.
Why? Because desktop application, delphi for example, supported event driven, while webbase is not.
Now many webbase language, like php, combined with ajax can handle this, however, it's need huge of memory resources.
In order to solve this obstacle, delphi has already prepared. With IdHTTP (Indy component), we can manipulate web application through dekstop application.
The following is an example:
procedure TFHttpUpload.Upload;
var
Stream : TIdMultipartFormDataStream;
begin
Stream := TIdMultipartFormDataStream.Create;
try
StatusBar1.SimpleText:='Upload............';
Stream.AddFormField('ffield1','one');
Stream.AddFormField('ffield2','dua');
Stream.AddFile( 'fFile', fname, 'text/plain' );
str :=IdHTTP1.Post('http://www.myweb.com/upload.php', Stream );
ShowMessage('Upload Sucess :)');
except
ShowMessage('Upload Fail :(');
end;
Stream.Free;
end;
Diposting oleh
Jage
di
11:56 AM
0
komentar
Categorys: Delphi
Wednesday, March 7, 2007
Form Inherited
Do you experience with delphi form identically many time? If you do, you need to make it simple with inherited.
Actually this method is not something new, because delphi is OOP (Object Oriented Programming) and form is class. If you understanding class very well, you will not find serious trouble with this methode.
However this method doesn't need understanding of class, because this is very simple.
OK, let starting with :
-new application at your delphi and you would have form1 for default
-place one button and save your new application as project1 and form1 as form1
-click File->New->Other->project1->form1
-notice what happen :)
-place another button on your form
-Now you have Form2 identically with Form1, but you added with one button
it's simple, right?
In any complex form with code inside, this would help much without coding same things many times :)
Diposting oleh
Jage
di
3:50 PM
0
komentar
Categorys: Delphi
Saturday, February 24, 2007
Export StringGrid to An Excel File (way one)
{1. With OLE Automation }
uses
ComObj;
function RefToCell(ARow, ACol: Integer): string;
begin
Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;
function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
const
xlWBATWorksheet = -4167;
var
Row, Col: Integer;
GridPrevFile: string;
XLApp, Sheet, Data: OLEVariant;
i, j: Integer;
begin
// Prepare Data
Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
Data[j + 1, i + 1] := AGrid.Cells[i, j];
// Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
// Hide Excel
XLApp.Visible := False;
// Add new Workbook
XLApp.Workbooks.Add(xlWBatWorkSheet);
Sheet := XLApp.Workbooks[1].WorkSheets[1];
Sheet.Name := ASheetName;
// Fill up the sheet
Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
AGrid.ColCount)].Value := Data;
// Save Excel Worksheet
try
XLApp.Workbooks[1].SaveAs(AFileName);
Result := True;
except
// Error ?
end;
finally
// Quit Excel
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
if SaveAsExcelFile(stringGrid1, 'My Stringgrid Data', 'c:\MyExcelFile.xls') then
ShowMessage('StringGrid saved!');
end;
{**************************************************************}
{2. Without OLE }
procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
const AValue: string);
var
L: Word;
const
{$J+}
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
{$J-}
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := ARow;
CXlsLabel[3] := ACol;
CXlsLabel[5] := L;
XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;
function SaveAsExcelFile(AGrid: TStringGrid; AFileName: string): Boolean;
const
{$J+} CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); {$J-}
CXlsEof: array[0..1] of Word = ($0A, 00);
var
FStream: TFileStream;
I, J: Integer;
begin
Result := False;
FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite);
try
CXlsBof[4] := 0;
FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]);
FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
Result := True;
finally
FStream.Free;
end;
end;
// Example:
procedure TForm1.Button2Click(Sender: TObject);
begin
if SaveAsExcelFile(StringGrid1, 'c:\MyExcelFile.xls') then
ShowMessage('StringGrid saved!');
end;
{**************************************************************}
{3. Code by Reinhard Schatzl }
uses
ComObj;
// Hilfsfunktion für StringGridToExcelSheet
// Helper function for StringGridToExcelSheet
function RefToCell(RowID, ColID: Integer): string;
var
ACount, APos: Integer;
begin
ACount := ColID div 26;
APos := ColID mod 26;
if APos = 0 then
begin
ACount := ACount - 1;
APos := 26;
end;
if ACount = 0 then
Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);
if ACount = 1 then
Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
if ACount > 1 then
Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
end;
// StringGrid Inhalt in Excel exportieren
// Export StringGrid contents to Excel
function StringGridToExcelSheet(Grid: TStringGrid; SheetName, FileName: string;
ShowExcel: Boolean): Boolean;
const
xlWBATWorksheet = -4167;
var
SheetCount, SheetColCount, SheetRowCount, BookCount: Integer;
XLApp, Sheet, Data: OLEVariant;
I, J, N, M: Integer;
SaveFileName: string;
begin
//notwendige Sheetanzahl feststellen
SheetCount := (Grid.ColCount div 256) + 1;
if Grid.ColCount mod 256 = 0 then
SheetCount := SheetCount - 1;
//notwendige Bookanzahl feststellen
BookCount := (Grid.RowCount div 65536) + 1;
if Grid.RowCount mod 65536 = 0 then
BookCount := BookCount - 1;
//Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
//Excelsheet anzeigen
if ShowExcel = False then
XLApp.Visible := False
else
XLApp.Visible := True;
//Workbook hinzufügen
for M := 1 to BookCount do
begin
XLApp.Workbooks.Add(xlWBATWorksheet);
//Sheets anlegen
for N := 1 to SheetCount - 1 do
begin
XLApp.Worksheets.Add;
end;
end;
//Sheet ColAnzahl feststellen
if Grid.ColCount <= 256 then
SheetColCount := Grid.ColCount
else
SheetColCount := 256;
//Sheet RowAnzahl feststellen
if Grid.RowCount <= 65536 then
SheetRowCount := Grid.RowCount
else
SheetRowCount := 65536;
//Sheets befüllen
for M := 1 to BookCount do
begin
for N := 1 to SheetCount do
begin
//Daten aus Grid holen
Data := VarArrayCreate([1, Grid.RowCount, 1, SheetColCount], varVariant);
for I := 0 to SheetColCount - 1 do
for J := 0 to SheetRowCount - 1 do
if ((I + 256 * (N - 1)) <= Grid.ColCount) and
((J + 65536 * (M - 1)) <= Grid.RowCount) then
Data[J + 1, I + 1] := Grid.Cells[I + 256 * (N - 1), J + 65536 * (M - 1)];
//-------------------------
XLApp.Worksheets[N].Select;
XLApp.Workbooks[M].Worksheets[N].Name := SheetName + IntToStr(N);
//Zellen als String Formatieren
XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1),
RefToCell(SheetRowCount, SheetColCount)].Select;
XLApp.Selection.NumberFormat := '@';
XLApp.Workbooks[M].Worksheets[N].Range['A1'].Select;
//Daten dem Excelsheet übergeben
Sheet := XLApp.Workbooks[M].WorkSheets[N];
Sheet.Range[RefToCell(1, 1), RefToCell(SheetRowCount, SheetColCount)].Value :=
Data;
end;
end;
//Save Excel Worksheet
try
for M := 1 to BookCount do
begin
SaveFileName := Copy(FileName, 1,Pos('.', FileName) - 1) + IntToStr(M) +
Copy(FileName, Pos('.', FileName),
Length(FileName) - Pos('.', FileName) + 1);
XLApp.Workbooks[M].SaveAs(SaveFileName);
end;
Result := True;
except
// Error ?
end;
finally
//Excel Beenden
if (not VarIsEmpty(XLApp)) and (ShowExcel = False) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;
//Example
procedure TForm1.Button1Click(Sender: TObject);
begin
//StringGrid inhalt in Excel exportieren
//Grid : stringGrid, SheetName : stringgrid Print, Pfad : c:\Test\ExcelFile.xls, Excelsheet anzeigen
StringGridToExcelSheet(StringGrid, 'Stringgrid Print', 'c:\Test\ExcelFile.xls', True);
end;
Diposting oleh
Jage
di
1:12 PM
0
komentar
Categorys: Delphi
10 of Most Delphi Used Function
Here is 10 functions mostly used
procedure TForm1.Button1Click(Sender: TObject);
var
S: String;
begin
{ 1 }
S := Copy('Delphi Rulezz', 5, 6); { Reads the text }
ShowMessage(S);
{ 2 }
S := Concat('1 ',' Two, ','3'); { Connects the text }
ShowMessage(S);
{ 3 }
ShowMessage('Length: '+IntToStr(Length('Good'))); { Shows the length of the
string in numbers [integer] }
{ 4 }
S := 'The Example'; {Deletes the text }
Delete(S, 8, 7);
ShowMessage(S);
{ 5 }
S := 'Ralph is a dog';
Insert('good ', S, 12); { Inserts the text }
ShowMessage(S);
{ 6 }
S := 'Delphi';
ShowMessage(UpperCase(S)); { Converts the text to upper case }
{ 7 }
S := 'Delphi';
ShowMessage(LowerCase(S)); { Converts the text to lower case }
{ 8 }
S := 'Delphi';
ShowMessage('''P'' in ''Delphi'' is:'+IntToStr(Pos('p',S))+'th'); { Gets
the position of the string in the string }
{ 9 }
S := 'a1, a2, a3, a4, a5.';
ShowMessage('a change to b: ' + StringReplace(S, 'a', 'b', [rfReplaceAll]));
{ Changes the text from one to another }
{ 10 }
S := 'This text:goes lower.';
S := WrapText(S, #13#10, [':'], 12);
ShowMessage(S); { Moves the text lower }
end;
Diposting oleh
Jage
di
10:49 AM
0
komentar
Categorys: Delphi