sn. mrmarman hocam gerçekten süpersin.
bu dosya okuma yazma işlerine hiçmi hiçkafam basmıyor.
Kendimce Küçük bir bileşen yazmaya çalışıyorum incelmek isteyenler için kodları. incelemek isteyenler olursa baya bir sadeleştirilecek yeri var.
kodlar bir kaç bileşenden alınmadır ben sadece kendime işeme yarayacak şekilde bir araya getirmeye çalışıyorum
Kod: Tümünü seç
unit LmFormPlus;
interface
uses
Registry, Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls,
Graphics, inifiles, dialogs;
type
TDbType = (dtINI, dtXML);
TLmFormPlusDb = class(TComponent)
private
FDbType: TDbType;
FINIFileName: string;
procedure SetDbType(const Value: TDbType);
procedure SetINIFileName(const Value: string);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ReadString(const Section, Ident, Default: string): string; virtual;
procedure WriteString(const Section, Ident, Value: string); virtual;
function ReadInteger(const Section, Ident: string; Default: Longint): Longint; virtual;
procedure WriteInteger(const Section, Ident: string; Value: Longint); virtual;
function ReadBool(const Section, Ident: string; Default: Boolean): Boolean; virtual;
procedure WriteBool(const Section, Ident: string; Value: Boolean); virtual;
function ReadBinaryStream(const Section, Ident: string; Value: TStream): Integer; virtual;
function ReadDate(const Section, Ident: string; Default: TDateTime): TDateTime; virtual;
function ReadDateTime(const Section, Ident: string; Default: TDateTime): TDateTime; virtual;
function ReadFloat(const Section, Ident: string; Default: Double): Double; virtual;
function ReadTime(const Section, Ident: string; Default: TDateTime): TDateTime; virtual;
procedure WriteBinaryStream(const Section, Ident: string; Value: TStream); virtual;
procedure WriteDate(const Section, Ident: string; Value: TDateTime); virtual;
procedure WriteDateTime(const Section, Ident: string; Value: TDateTime); virtual;
procedure WriteFloat(const Section, Ident: string; Value: Double); virtual;
procedure WriteTime(const Section, Ident: string; Value: TDateTime); virtual;
published
property DbType: TDbType read FDbType write SetDbType;
property INIFileName: string read FINIFileName write SetINIFileName;
end;
type
TLmFormPlus = class;
TEnterAsTab = class(TPersistent)
private
FEnable: Boolean;
FSkipCompNames: TStrings;
procedure SetEnable(const Value: Boolean);
procedure SetSkipCompNames(const Value: TStrings);
public
constructor Create;
destructor Destroy; override;
function IsSkip(Name: string): Boolean;
published
property Enable: Boolean read FEnable write SetEnable default true;
property SkipCompNames: TStrings read FSkipCompNames write SetSkipCompNames;
end;
TFormPosition = class(TPersistent)
private
FSave: Boolean;
FLoad: Boolean;
FFormName: string;
procedure SetLoad(const Value: Boolean);
procedure SetSave(const Value: Boolean);
procedure SetFormName(const Value: string);
public
FormPointer: Pointer;
constructor Create;
destructor Destroy; override;
procedure SetFormPointer(FP: Pointer);
published
property Save: Boolean read FSave write SetSave;
property Load: Boolean read FLoad write SetLoad;
property FormName: string read FFormName write SetFormName;
end;
TLmFormPlus = class(TComponent)
private
FOldWindowProc: TWndMethod;
FEnterAsTab: TEnterAsTab;
FFunctionKeysButton: array[1..12] of TControl;
FFormPosition: TFormPosition;
FLmFormPlusDb: TLmFormPlusDb;
procedure SendClick(index: Integer);
procedure WindowProc(var Message: TMessage);
procedure SetEnterAsTab(const Value: TEnterAsTab);
function GetFunctionKeysButton(const Index: Integer): TControl;
procedure SetFunctionKeysButton(const Index: Integer; const Value: TControl);
procedure SetFormPosition(const Value: TFormPosition);
procedure SetLmFormPlusDb(const Value: TLmFormPlusDb);
protected
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure FormSave;
procedure FormLoad;
published
property EnterAsTab: TEnterAsTab read FEnterAsTab write SetEnterAsTab;
property FormPosition: TFormPosition read FFormPosition write SetFormPosition;
property F1Button: TControl index 1 read GetFunctionKeysButton write SetFunctionKeysButton;
property F2Button: TControl index 2 read GetFunctionKeysButton write SetFunctionKeysButton;
property F3Button: TControl index 3 read GetFunctionKeysButton write SetFunctionKeysButton;
property F4Button: TControl index 4 read GetFunctionKeysButton write SetFunctionKeysButton;
property F5Button: TControl index 5 read GetFunctionKeysButton write SetFunctionKeysButton;
property F6Button: TControl index 6 read GetFunctionKeysButton write SetFunctionKeysButton;
property F7Button: TControl index 7 read GetFunctionKeysButton write SetFunctionKeysButton;
property F8Button: TControl index 8 read GetFunctionKeysButton write SetFunctionKeysButton;
property F9Button: TControl index 9 read GetFunctionKeysButton write SetFunctionKeysButton;
property F10Button: TControl index 10 read GetFunctionKeysButton write SetFunctionKeysButton;
property Esc: TControl index 11 read GetFunctionKeysButton write SetFunctionKeysButton;
property PageDown: TControl index 12 read GetFunctionKeysButton write SetFunctionKeysButton;
property LmFormPlusDb: TLmFormPlusDb read FLmFormPlusDb write SetLmFormPlusDb;
end;
procedure Register;
implementation
uses Math;
procedure Register;
begin
RegisterComponents('Lazymule', [TLmFormPlus]);
RegisterComponents('Lazymule', [TLmFormPlusDb]);
end;
{ TLmFormPlus }
constructor TLmFormPlus.Create(AOwner: TComponent);
begin
inherited;
//Enter As Tab
FEnterAsTab := TEnterAsTab.Create;
FFormPosition := TFormPosition.Create;
FFormPosition.FFormName := TForm(Owner).Name;
if not (csDesigning in ComponentState) and (Owner is TForm) then
begin
FFormPosition.SetFormPointer(@Owner);
FOldWindowProc := TForm(AOwner).WindowProc;
TForm(AOwner).WindowProc := WindowProc;
end;
end;
destructor TLmFormPlus.Destroy;
begin
if not (csDesigning in ComponentState) and (Owner is TForm) then
begin
TForm(Owner).WindowProc := FOldWindowProc;
FOldWindowProc := nil;
end;
inherited;
end;
procedure TLmFormPlus.FormLoad;
begin
if FFormPosition.FLoad and Assigned(FLmFormPlusDb) then
begin
with self do
begin
if FLmFormPlusDb.readString(FFormPosition.FFormName, 'WindowState', '') = 'wsNormal' then
TForm(Owner).WindowState := wsNormal;
if FLmFormPlusDb.readString(FFormPosition.FFormName, 'WindowState', '') = 'wsMinimized' then
TForm(Owner).WindowState := wsMinimized;
if FLmFormPlusDb.readString(FFormPosition.FFormName, 'WindowState', '') = 'wsMaximized' then
TForm(Owner).WindowState := wsMaximized;
TForm(Owner).top := FLmFormPlusDb.readInteger(FFormPosition.FFormName, 'Top',
TForm(Owner).Top);
TForm(Owner).left := FLmFormPlusDb.readInteger(FFormPosition.FFormName, 'Left',
TForm(Owner).Left);
TForm(Owner).width := FLmFormPlusDb.readInteger(FFormPosition.FFormName, 'Width',
TForm(Owner).Width);
TForm(Owner).Height := FLmFormPlusDb.readInteger(FFormPosition.FFormName, 'Height',
TForm(Owner).Height);
end;
end;
end;
procedure TLmFormPlus.FormSave;
begin
if FFormPosition.FSave and Assigned(FLmFormPlusDb) then
begin
case TForm(Owner).WindowState of
wsNormal:
begin
FLmFormPlusDb.WriteString(FFormPosition.FFormName, 'WindowState', 'wsNormal');
FLmFormPlusDb.WriteInteger(FFormPosition.FFormName, 'Top', TForm(Owner).Top);
FLmFormPlusDb.WriteInteger(FFormPosition.FFormName, 'Left', TForm(Owner).Left);
FLmFormPlusDb.WriteInteger(FFormPosition.FFormName, 'Width', TForm(Owner).Width);
FLmFormPlusDb.WriteInteger(FFormPosition.FFormName, 'Height', TForm(Owner).Height);
end;
wsMinimized: FLmFormPlusDb.WriteString(FFormPosition.FFormName, 'WindowState',
'wsMinimized');
wsMaximized: FLmFormPlusDb.WriteString(FFormPosition.FFormName, 'WindowState',
'wsMaximized');
end;
end;
end;
function TLmFormPlus.GetFunctionKeysButton(const Index: Integer): TControl;
begin
Result := FFunctionKeysButton[Index];
end;
procedure TLmFormPlus.Loaded;
begin
inherited;
if not (csDesigning in ComponentState) and (Owner is TForm) then
begin
FormLoad;
end;
end;
procedure TLmFormPlus.SendClick(index: Integer);
var
Comp: TControl;
begin
if (GetAsyncKeyState(VK_LSHIFT) < 0) or
(GetAsyncKeyState(VK_RSHIFT) < 0) or
(GetAsyncKeyState(VK_LCONTROL) < 0) or
(GetAsyncKeyState(VK_RCONTROL) < 0) then
Exit;
if Assigned(FFunctionKeysButton[Index]) then begin
Comp := FFunctionKeysButton[Index];
if (Comp is TWinControl) then begin
TWinControl(Comp).SetFocus;
case index of
1..11: SendMessage(TWinControl(Comp).Handle, BM_CLICK, 0, 0);
end;
end;
end;
end;
procedure TLmFormPlus.SetEnterAsTab(const Value: TEnterAsTab);
begin
FEnterAsTab := Value;
end;
procedure TLmFormPlus.SetFormPosition(const Value: TFormPosition);
begin
FFormPosition := Value;
end;
procedure TLmFormPlus.SetFunctionKeysButton(const Index: Integer;
const Value: TControl);
begin
if (FFunctionKeysButton[Index] <> Value) then
begin
FFunctionKeysButton[Index] := Value;
end;
end;
procedure TLmFormPlus.SetLmFormPlusDb(const Value: TLmFormPlusDb);
begin
FLmFormPlusDb := Value;
end;
procedure TLmFormPlus.WindowProc(var Message: TMessage);
begin
case Message.Msg of
WM_CLOSE:
begin
FormSave;
end;
45102:
begin
case Message.WParam of
VK_F1: SendClick(1);
VK_F2: SendClick(2);
VK_F3: SendClick(3);
VK_F4: SendClick(4);
VK_F5: SendClick(5);
VK_F6: SendClick(6);
VK_F7: SendClick(7);
VK_F8: SendClick(8);
VK_F9: SendClick(9);
VK_F10: SendClick(10);
VK_ESCAPE: SendClick(11);
VK_NEXT: SendClick(12);
end;
end;
CM_DIALOGKEY:
begin
case Message.WParam of
VK_RETURN:
begin
if not EnterAsTab.IsSkip(TForm(Owner).ActiveControl.Name) then
begin
keybd_event(VK_Tab, MapVirtualKey(VK_Tab, 0), 0, 0);
keybd_event(VK_Tab, MapVirtualKey(VK_Tab, 0), KEYEVENTF_KEYUP,
0);
end;
end;
end;
end;
end;
FOldWindowProc(Message);
end;
{ TEnterAsTab }
constructor TEnterAsTab.Create;
begin
FSkipCompNames := TStringList.Create;
FEnable := True;
end;
destructor TEnterAsTab.Destroy;
begin
FSkipCompNames.Free;
inherited;
end;
function TEnterAsTab.IsSkip(Name: string): Boolean;
var i: Integer;
begin
Result := False;
for i := 0 to FSkipCompNames.Count - 1 do
begin
if FSkipCompNames.Strings[i] = Name then Result := True;
end;
end;
procedure TEnterAsTab.SetEnable(const Value: Boolean);
begin
FEnable := Value;
end;
procedure TEnterAsTab.SetSkipCompNames(const Value: TStrings);
begin
FSkipCompNames.Assign(Value);
end;
{ TFormPosition }
constructor TFormPosition.Create;
begin
FSave := True;
FLoad := True;
end;
destructor TFormPosition.Destroy;
begin
inherited;
end;
procedure TFormPosition.SetFormName(const Value: string);
begin
if Value = '' then raise Exception.Create('Form Adı boş olamaz');
FFormName := Value;
end;
procedure TFormPosition.SetFormPointer(FP: Pointer);
begin
FormPointer := FP;
end;
procedure TFormPosition.SetLoad(const Value: Boolean);
begin
FLoad := Value;
end;
procedure TFormPosition.SetSave(const Value: Boolean);
begin
FSave := Value;
end;
{ TLmFormPlusDb }
constructor TLmFormPlusDb.Create(AOwner: TComponent);
begin
inherited;
FDbType := dtini;
FINIFileName := ExtractFileDir(Application.ExeName + 'forms.ini')
end;
destructor TLmFormPlusDb.Destroy;
begin
inherited;
end;
function TLmFormPlusDb.ReadBinaryStream(const Section, Ident: string;
Value: TStream): Integer;
procedure INILoadStream(var Stream: TMemoryStream; DosyaAdi: TFileName; Section, Onisim: string);
var
iniF: TIniFile;
i: Integer;
begin
iniF := TINIFile.Create(DosyaAdi);
i := 0;
Stream.Clear;
while iniF.ValueExists(Section, Format('%s%.10d', [OnIsim, i]))
do begin
iniF.ReadBinaryStream(Section, Format('%s%.10d', [OnIsim, i]), Stream);
Stream.Position := Stream.Size;
Inc(i);
end;
Stream.Position := 0;
iniF.Free;
end;
var
Mem: TMemoryStream;
begin
Result := -1;
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
begin
Mem := TMemoryStream.Create;
INILoadStream(Mem, FINIFileName, Section, Ident);
Mem.Position := 0;
Mem.SaveToStream(Value);
Mem.Free;
end;
end;
end;
end;
end;
function TLmFormPlusDb.ReadBool(const Section, Ident: string;
Default: Boolean): Boolean;
var INI: TIniFile;
begin
Result := Default;
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
Result := INI.ReadBool(Section, Ident, Default);
end;
end;
end;
end;
function TLmFormPlusDb.ReadDate(const Section, Ident: string;
Default: TDateTime): TDateTime;
var INI: TIniFile;
begin
Result := Default;
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
Result := INI.ReadTime(Section, Ident, Default);
end;
end;
end;
end;
function TLmFormPlusDb.ReadDateTime(const Section, Ident: string;
Default: TDateTime): TDateTime;
var INI: TIniFile;
begin
Result := Default;
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
Result := INI.ReadTime(Section, Ident, Default);
end;
end;
end;
end;
function TLmFormPlusDb.ReadFloat(const Section, Ident: string;
Default: Double): Double;
var INI: TIniFile;
begin
Result := Default;
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
Result := INI.ReadTime(Section, Ident, Default);
end;
end;
end;
end;
function TLmFormPlusDb.ReadInteger(const Section, Ident: string;
Default: Integer): Longint;
var INI: TIniFile;
begin
Result := Default;
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
Result := INI.ReadInteger(Section, Ident, Default);
end;
end;
end;
end;
function TLmFormPlusDb.ReadString(const Section, Ident,
Default: string): string;
var INI: TIniFile;
begin
Result := Default;
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
Result := INI.ReadString(Section, Ident, Default);
end;
end;
end;
end;
function TLmFormPlusDb.ReadTime(const Section, Ident: string;
Default: TDateTime): TDateTime;
var INI: TIniFile;
begin
Result := Default;
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
Result := INI.ReadTime(Section, Ident, Default);
end;
end;
end;
end;
procedure TLmFormPlusDb.SetDbType(const Value: TDbType);
begin
FDbType := Value;
end;
procedure TLmFormPlusDb.SetINIFileName(const Value: string);
begin
FINIFileName := Value;
end;
procedure TLmFormPlusDb.WriteBinaryStream(const Section, Ident: string;
Value: TStream);
procedure INISaveStream(Stream: TMemoryStream; DosyaAdi: TFileName; Section, Onisim: string);
var
iniF: TIniFile;
i: Integer;
Mem: TMemoryStream;
Blok: Integer;
begin
iniF := TINIFile.Create(DosyaAdi);
i := 0;
// http://www.delphiturkiye.com/forum/viewtopic.php?t=21029
// Öncelikle bu isimde dilimlenmiş veri varsa tümünü siliyoruz...
// alan isim formatı aşağıda göreceğin üzere 'kısım', 'önisim0000000000' şeklinde...
// Herhalde dilimler için 10 haneli bir rakam yeterli :)
// Öncelikle bu isimde olan dilimleri siliyoruz.
while iniF.ValueExists(Section, Format('%s%.10d', [OnIsim, i]))
do begin
iniF.DeleteKey(Section, Format('%s%.10d', [OnIsim, i]));
Inc(i);
end;
Mem := TMemoryStream.Create;
i := 0;
Blok := 1023;
Stream.Position := 0;
while (Stream.Position < Stream.Size) do begin
Mem.Clear;
if Stream.Size >= (Stream.Position + Blok)
then Mem.CopyFrom(Stream, Blok)
else Mem.CopyFrom(Stream, Stream.Size - Stream.Position);
Mem.Position := 0;
iniF.WriteBinaryStream(Section, Format('%s%.10d', [OnIsim, i]), Mem);
Inc(i);
end;
Mem.Free;
iniF.Free;
end;
var
Mem: TMemoryStream;
begin
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
Mem := TMemoryStream.Create;
Mem.Clear;
Mem.LoadFromStream(Value);
Mem.Position := 0;
INISaveStream(Mem, FINIFileName, Section, Ident);
Mem.Free;
ShowMessage('İşlem Tamam');
end;
end;
end;
end;
procedure TLmFormPlusDb.WriteBool(const Section, Ident: string;
Value: Boolean);
var INI: TIniFile;
begin
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
INI.WriteBool(Section, Ident, Value);
end;
end;
end;
end;
procedure TLmFormPlusDb.WriteDate(const Section, Ident: string;
Value: TDateTime);
var INI: TIniFile;
begin
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
INI.WriteDate(Section, Ident, Value);
end;
end;
end;
end;
procedure TLmFormPlusDb.WriteDateTime(const Section, Ident: string;
Value: TDateTime);
var INI: TIniFile;
begin
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
INI.WriteDateTime(Section, Ident, Value);
end;
end;
end;
end;
procedure TLmFormPlusDb.WriteFloat(const Section, Ident: string;
Value: Double);
var INI: TIniFile;
begin
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
INI.WriteFloat(Section, Ident, Value);
end;
end;
end;
end;
procedure TLmFormPlusDb.WriteInteger(const Section, Ident: string;
Value: Integer);
var INI: TIniFile;
begin
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
INI.WriteInteger(Section, Ident, Value);
end;
end;
end;
end;
procedure TLmFormPlusDb.WriteString(const Section, Ident, Value: string);
var INI: TIniFile;
begin
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
INI.WriteString(Section, Ident, Value);
end;
end;
end;
end;
procedure TLmFormPlusDb.WriteTime(const Section, Ident: string;
Value: TDateTime);
var INI: TIniFile;
begin
case FDbType of
dtINI:
begin
if FINIFileName <> '' then
begin
INI := TIniFile.Create(FINIFileName);
INI.WriteTime(Section, Ident, Value);
end;
end;
end;
end;
end.
