|
Registriert seit: 5. Mär 2013 502 Beiträge Delphi 7 Enterprise |
#7
Delphi-Quellcode:
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ElPanel, ElClock, LMDBaseControl, LMDBaseGraphicControl, LMDGraphicControl, LMDLEDCustomLabel, LMDLEDLabel, LMDControl, LMDCustomControl, LMDCustomPanel, LMDCustomBevelPanel, LMDBaseEdit, LMDCustomEdit, LMDCustomMaskEdit, LMDCalculatorEdit, ElPgCtl, ElXPThemedControl, LMDCalendarEdit, ComCtrls, LMDCustomShapeButton, LMDShapeButton, LMDBaseGraphicButton, LMDCustomMMButton, LMDMMButton, StdCtrls, LMDCustomButton, LMDButton, ElComponent, ElCalc, ElEdits, ElBtnEdit, ElCalculatorEdit, LMDCustomExtCombo, LMDCalculatorComboBox, LMDDBCalculatorComboBox, DBCtrls, Mask, Buttons, Grids,comobj, ElTreeInplaceEditors, ElTree, ElTreeGrids,uSharedClass; type TForm7 = class(TForm) ElPageControl1: TElPageControl; ElTabSheet1: TElTabSheet; ElTabSheet2: TElTabSheet; LMDShapeButton1: TLMDShapeButton; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; LMDShapeButton2: TLMDShapeButton; Button1: TButton; Button2: TButton; Label6: TLabel; Label7: TLabel; LMDShapeButton3: TLMDShapeButton; Label8: TLabel; Label9: TLabel; Label10: TLabel; LMDShapeButton4: TLMDShapeButton; SpeedButton1: TSpeedButton; DateTimePicker1: TDateTimePicker; SpeedButton2: TSpeedButton; DateTimePicker2: TDateTimePicker; Edit1: TEdit; Edit2: TEdit; Memo1: TMemo; Edit3: TEdit; Edit4: TEdit; Edit5: TEdit; Edit6: TEdit; Memo2: TMemo; Edit7: TEdit; Edit8: TEdit; Button3: TButton; Label11: TLabel; StringGrid1: TStringGrid; Edit9: TEdit; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure DateTimePicker1Change(Sender: TObject); procedure DateTimePicker2Change(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure LMDDBCalculatorComboBox2Change(Sender: TObject); procedure LMDDBCalculatorComboBox1Change(Sender: TObject); procedure LMDShapeButton1Click(Sender: TObject); procedure LMDShapeButton3Click(Sender: TObject); procedure LMDShapeButton4Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure LMDShapeButton2Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure ElPageControl1Change(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormDestroy(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } FIrgendwas: TIrgendwas; FIrgendwas1: TIrgendwas1; public { Public declarations } property Irgendwas: TIrgendwas read FIrgendwas; property Irgendwas1: TIrgendwas1 read FIrgendwas1; end; var Form7: TForm7; implementation uses Unit1, Unit8; {$R *.dfm} procedure TForm7.FormCreate(Sender: TObject); begin elpagecontrol1.ActivePageIndex:=0; datetimepicker1.DateTime := now; edit1.Text:=''; edit4.Text:=''; edit3.Text:=''; edit2.Text:=''; memo1.Text:=''; End; function Xls_To_StringGrid(AGrid: TeltreeStringGrid; AXLSFile: string): Boolean; const xlCellTypeLastCell = $0000000B; var XLApp, Sheet: OLEVariant; RangeMatrix: Variant; x, y, k, r: Integer; begin Result := False; XLApp := CreateOleObject('Excel.Application'); try XLApp.Visible := False; XLApp.Workbooks.Open(AXLSFile); Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1]; Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate; x := XLApp.ActiveCell.Row; y := XLApp.ActiveCell.Column; AGrid.RowCount := x; AGrid.ColCount := y; RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value; k := 1; repeat for r := 1 to y do AGrid.Cells[(r ), (k )] := RangeMatrix[K, R]; Inc(k, 1); AGrid.RowCount := k + 1; until k > x; RangeMatrix := Unassigned; finally if not VarIsEmpty(XLApp) then begin XLApp.Quit; XLAPP := Unassigned; Sheet := Unassigned; Result := True; end; end; end; function RefToCell(ARow, ACol: Integer): string; begin Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow); end; function SaveAsExcelFile1(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean; const xlWBATWorksheet = -4167; var 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; function SaveAsExcelFile(AGrid: Teltreestringgrid; ASheetName, AFileName: string): Boolean; const xlWBATWorksheet = -4167; var 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; procedure TForm7.Button1Click(Sender: TObject); begin close; end; procedure TForm7.SpeedButton1Click(Sender: TObject); begin datetimepicker1.Visible:=true; DateTimePicker1.Perform(WM_KEYDOWN, VK_F4, 0); end; procedure TForm7.DateTimePicker1Change(Sender: TObject); begin datetimepicker1.Visible:=false; edit5.Text:=datetostr(datetimepicker1.Date); end; procedure TForm7.DateTimePicker2Change(Sender: TObject); begin datetimepicker2.Visible:=false; edit1.Visible:=true; edit1.Text:=datetostr(datetimepicker2.Date); end; procedure TForm7.SpeedButton2Click(Sender: TObject); begin edit1.Visible:=false; datetimepicker2.Visible:=true; DateTimePicker2.Perform(WM_KEYDOWN, VK_F4, 0); end; procedure TForm7.LMDDBCalculatorComboBox2Change(Sender: TObject); begin edit3.Text:=''; end; procedure TForm7.LMDDBCalculatorComboBox1Change(Sender: TObject); begin edit3.text:=''; end; function Xls_To_StringGrid1(AGrid: TStringGrid; AXLSFile: string): Boolean; const xlCellTypeLastCell = $0000000B; var XLApp, Sheet: OLEVariant; RangeMatrix: Variant; x, y, k, r: Integer; begin Result := False; XLApp := CreateOleObject('Excel.Application'); try XLApp.Visible := False; XLApp.Workbooks.Open(AXLSFile); Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1]; Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate; x := XLApp.ActiveCell.Row; y := XLApp.ActiveCell.Column; AGrid.RowCount := x; AGrid.ColCount := y; RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value; k := 1; repeat for r := 1 to y do AGrid.Cells[(r-1 ), (k-1 )] := RangeMatrix[K, R]; Inc(k, 1); AGrid.RowCount := k + 1; until k > x; RangeMatrix := Unassigned; finally if not VarIsEmpty(XLApp) then begin XLApp.Quit; XLAPP := Unassigned; Sheet := Unassigned; Result := True; end; end; end; procedure TForm7.LMDShapeButton1Click(Sender: TObject); begin form8.Label2.Caption:=''; form8.show; end; procedure TForm7.LMDShapeButton3Click(Sender: TObject); begin form8.Label2.Caption:='a'; form8.show; end; procedure TForm7.LMDShapeButton4Click(Sender: TObject); var i,p : integer; begin repeat form1.eltreeStringGrid1.Cols[1]; // die 2. Spalte p := form1.eltreeStringGrid1.Cols[1].IndexOf('1'); // suche nach "rot" if p >= 0 then edit8.Text:=inttostr(p+1); // ersetzen until p < 0; end; procedure TForm7.FormClose(Sender: TObject; var Action: TCloseAction); begin if ModalResult <> mrOK then FreeAndNil(FIrgendwas); if ModalResult <> mrOK then FreeAndNil(FIrgendwas1); end; procedure TForm7.LMDShapeButton2Click(Sender: TObject); var i,k : integer; begin for i:=0 to form1.eltreestringgrid1.rowcount-1 do begin //reihenbis zur letzten durchsuchen if form1.eltreeStringGrid1.Cells[1,i]=''//wenn spalte 2 leer ist dann then edit4.text:='1'// edit4.text ist gleich die zahl 1 else //sonst k:=strtoint(form1.eltreeStringGrid1.Cells[1,i]); // k ist die gefundene Zahl in der zelle edit4.text:=inttostr(k+1); // edit4.text ist dann die gefundene Zahl + 1 end; end; procedure TForm7.FormShow(Sender: TObject); begin edit9.Text:=form1.ElTreeStringGrid1.Cells[4,form1.ElTreeStringGrid1.Row-1]; FIrgendwas := TIrgendwas.Create; if label11.caption='' then elpagecontrol1.ActivePageIndex:=0; if elpagecontrol1.ActivePageIndex=1 then button2.Visible:=false; if elpagecontrol1.ActivePageIndex=1 then button3.Visible:=true; if elpagecontrol1.ActivePageIndex=0 then button3.Visible:=false; if elpagecontrol1.ActivePageIndex=0 then button2.Visible:=true; end; procedure TForm7.ElPageControl1Change(Sender: TObject); begin if elpagecontrol1.ActivePageIndex=1 then button2.Visible:=false; if elpagecontrol1.ActivePageIndex=1 then button3.Visible:=true; if elpagecontrol1.ActivePageIndex=0 then button3.Visible:=false; if elpagecontrol1.ActivePageIndex=0 then button2.Visible:=true; end; procedure TForm7.Button2Click(Sender: TObject); begin form1.eltreestringgrid1.cells[0,form1.ElTreeStringGrid1.Row]:=edit1.text; try FIrgendwas.ErsteZahlAsString := edit3.Text; try FIrgendwas.ZweiteZahlAsString := edit9.text; ModalResult := mrOK; except on E: Exception do begin MessageBox(0, PChar(E.Message), nil, MB_OK or MB_ICONERROR); edit9.SetFocus; edit9.SelectAll; end; end; except on E: Exception do begin MessageBox(0, PChar(E.Message), nil, MB_OK or MB_ICONERROR); edit3.SetFocus; edit3.SelectAll; end; end; end; procedure TForm7.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if ModalResult <> mrOK then FreeAndNil(FIrgendwas); end; procedure TForm7.FormDestroy(Sender: TObject); begin if ModalResult <> mrOK then FreeAndNil(FIrgendwas); end; procedure TForm7.Button3Click(Sender: TObject); begin form1.eltreestringgrid1.cells[0,form1.ElTreeStringGrid1.Row]:=edit5.text; try FIrgendwas1.ErsteZahl1AsString := edit7.Text; try FIrgendwas1.ZweiteZahl1AsString := edit9.text; ModalResult := mrOK; except on E: Exception do begin MessageBox(0, PChar(E.Message), nil, MB_OK or MB_ICONERROR); edit9.SetFocus; edit9.SelectAll; end; end; except on E: Exception do begin MessageBox(0, PChar(E.Message), nil, MB_OK or MB_ICONERROR); edit7.SetFocus; edit7.SelectAll; end; end; end; end. |
Zitat |
Ansicht |
Zur Linear-Darstellung wechseln |
Zur Hybrid-Darstellung wechseln |
Baum-Darstellung |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |